/*REXX: Title:   Sort grouping of  NX and X lines between labels   */
/*  Users:       TSO ispf EDIT users   | Script users              */
/*  Contributed: 1990/02/05 David McRitchie "The REXX Macros Toolbox" */
/*    "The REXX Macros Toolbox"                                    */
/*    Converted to REXX 1994/04/21 D.McRitchie                     */
/*                                                                 */
/*  Example:     SORTG    .a .b 7 9 4 5                            */
/*                                                                 */
/*  Options:                                                       */
/*      lptr-range | entire   (required) line pointer range        */
/*      column pairs for sorting                                   */
/*         limited to ability to sort ascending only               */
/*      LEAVE    -- leave in sorting criteria                      */
/*   ----------- features added later -----------------------------*/
/*      NOSORT   -- place column pair to last columns,             */
/*                  leave option turn on, will not be sorted       */
/*                  will not include sequence number               */
/*  Requirements:                                                  */
/*      display and non-displayed lines within label range         */
/*  Additional clists or executes required:                        */
/*      reformat                                                   */
/*  Documented in  -- IS03.SHARE.TEXT(SORTG)                       */
  Address "ISREDIT";"MACRO (TOKENS)"
  addendum="*-*-*-*-*"
  debug=""
  fr = 0
  help=""
  labi=0;pairsi=0;labels="";pairs="";remain=""
  leave=''
  lower = 0
  needcols=0
  nosort=""
  xsubstr=""
  "(autosave) = autosave"
  "(row,col) = cursor"
  tokenso = tokens
  tokens = translate(tokens)
  "(dwidth) = data_width"
  "(MEMBER) = member"
  if tokens = "DEBUG" then tokens="DEBUG .a .b 1 5 11 15"
  call Dnote time('n') 'SORTG' tokens
  do i = 1 to words(tokens)
     token = word(tokens,i)
     /****************** debug begin *********/
     if token = "?" then do
        Call Dnote "<<<<<<<< Help was requested with ? >>>>>>>>>>>>>"
        address "TSO" "CLIST SORTG HELP"

        return 4
     end
     if token = "DEBUG" then do
        call Dnote "DEBUG --- processing has begun"
        "reset labels"
        "c all 100 251 p'^' ' '"
        dwidth = 123
        "f first p' ######## ' 49"
        if rc \= 0 then return 4
        "sort .zcsr .zl 49 60"
        "f first p' ######## ' 49"
        "label .zcsr = .a 0"
        "f first .a .zl 49 ' 00000016'"
        if rc \= 0 then return 4
        "label .zcsr = .b 0"
        "x all 41 p'^' .a .b"
        iterate i
        debug="DEBUG"
        call Dnote "DEBUG --- processing has ended"
     end
     /******************** debug end ************/
     if substr(token,1,1) = '.'    then do
        labi=labi+1
        labels = labels token
        iterate i
     end
     if datatype(token,"n") then do
        if lower = 0 then do
           lower = 1
           bseg = token
           iterate i
        end
        else do
           lower = 0
           lseg = token + 1 - bseg
           if (token+0) < (bseg+0) then do
              call Dnote 'Column PAIR order invalid for ' beseg token
              return 4
           end
           xsubstr=xsubstr"||substr(line,"bseg","lseg")"
           needcols = needcols + lseg
           pairs = pairs bseg token
           iterate i
         end
      end
      if token = "HELP" | token = "DEBUG" ,
         | token = "LEAVE" ,
         | token = "NOSORT" ,
         then do
           xxx = TOKEN "= """TOKEN""""
           interpret xxx  /* execute the instruction */
           iterate i
         end
      remain = remain token
   end
  /* end of tokens inputted */
  if remain \= "" then do
     call Dnote remain " -- Not provided for in SORTG"
     return 4
  end
  if substr(xsubstr,1,2)\='||' then do
     call Dnote "No column pairs supplied"
     return 4
  end
  /* sort upper/lowercase as if uppercase  1994/04/25 */
  xsubstr = 'addendum ='translate(substr(xsubstr,3))
  line=' '; interpret xsubstr
  if labels = '' then labels = ".ZFIRST .ZLAST"
  labels = translate(labels)
  if words(labels) \= 2 then do
     call Dnote 'Label-range must be a single pair, found -->' labels
     return 4
  end

  /************** end of label requirements *******************/
  "(lbound,rbound) = bounds"
  "(var019,var020) = display_cols"
  /****************************/
  "(var057) = recfm"
  "(var049,var050) = number"
  llbound = lbound
  lladj = 0
  if var057 = "V" and var049 = "ON" then do
     lladj = 8
     llbound = lbound + 8
  end
  /****************************/
  if pairs = ""    then do
      call Dnote 'No column pairs specified'
      return 4
  end
  if lower = 1 then do
      call Dnote "Both start and end cols",
         "must be present -- missing an end portion missing"
      return 4
  end
  seekcol = dwidth - needcols - 6 + 1 - 1
  if nosort = "NOSORT" then seekcol = dwidth - needcols + 1 -1
  if nosort = "LEAVE"  then seekcol = dwidth - needcols + 1 -1
  "seek first" labels seekcol dwidth "p'^'"
  if rc = 0 then do
     call Dnote 'Columns' seekcol'-'dwidth 'must be blank for sort data'
     return 4
  end
  "seek first" labels "x p'='"
  if rc \= 0 then do
     call Dnote 'Undisplayed (X) lines missing'
     return 4
  end
  "(labf) = linenum" word(labels,1)
  "(labl) = linenum" word(labels,2)
  do i = labf to labl
     "(line) = line" i
     "(xstatus) = xstatus" i
     if xstatus = "NX" then do;interpret xsubstr;x="-";end;
     else x=" "
     if leave = "LEAVE"
       then line = substr(line,1,seekcol-1)x||addendum
       else line = substr(line,1,seekcol-1)x||addendum||right(i,6,'0')
     "LINE" i "= (LINE)"
  end;
  sortcol = seekcol + 1
  "(NUMLABF) = linenum" word(labels,1)
  "(NUMLABL) = linenum" word(labels,2)
  "(NUMLast) = linenum .zlast"
  if nosort = "NOSORT" then signal leaving
  if x2c('41') = "A" then do;  /* Make ascii look like EBCDIC */
    /* attempt to make sort look more ebcdic like */
    "change all x'30' x'f0'" labels sortcol dwidth
    "change all x'31' x'f1'" labels sortcol dwidth
    "change all x'32' x'f2'" labels sortcol dwidth
    "change all x'33' x'f3'" labels sortcol dwidth
    "change all x'34' x'f4'" labels sortcol dwidth
    "change all x'35' x'f5'" labels sortcol dwidth
    "change all x'36' x'f6'" labels sortcol dwidth
    "change all x'37' x'f7'" labels sortcol dwidth
    "change all x'38' x'f8'" labels sortcol dwidth
    "change all x'39' x'f9'" labels sortcol dwidth
  end
  "sort" labels sortcol dwidth
  if x2c('41') = "A" then do;
    /* restore normal ascii chars */
    "change all x'f0' x'30'" labels sortcol dwidth
    "change all x'f1' x'31'" labels sortcol dwidth
    "change all x'f2' x'32'" labels sortcol dwidth
    "change all x'f3' x'33'" labels sortcol dwidth
    "change all x'f4' x'34'" labels sortcol dwidth
    "change all x'f5' x'35'" labels sortcol dwidth
    "change all x'f6' x'36'" labels sortcol dwidth
    "change all x'f7' x'37'" labels sortcol dwidth
    "change all x'f8' x'38'" labels sortcol dwidth
    "change all x'f9' x'39'" labels sortcol dwidth
  end
  if leave = "LEAVE" then signal leaving
  if numlabf \= 1 then
     "label" NUMlabf "=" word(labels,1) "0"
  if numlabl \= numlast then
     "label" NUMlabl "=" word(labels,2) "0"
  /* remove sorting information that was added */
  "change" labels sortcol dwidth " p'^' '' all"
  /* in spf/pc the above line must use an single space null */
  "seek" sortcol dwidth "P'#' first"
  if rc = 0 then do
     call dnote "found --- # -- aborting 1"
     call dnote "change" labels sortcol dwidth " p'^' ' ' all"
     return 12
  end
  leaving:
  "X" labels "ALL"
  "change all '-' ' '" labels seekcol dwidth
  "reset chg" labels /* spf/pc 3.07 does not like reset change*/
  "bounds" lbound rbound
  call Dnote time('n') 'SORTG --- completed' 'dwidth='dwidth
  "find first nx p'=' 1"
  "cursor =" row col
  "line_before" numlabf "= noteline ""begin SORTG" tokens""""
  "line_after" numlabl "= noteline ""--end SORTG" tokens labels""""
  return 1

 Dnote: parse arg yyy; "LINE_BEFORE .zf = NOTELINE (yyy)"
      zedsmsg = ''
      zedlmsg = yyy
      Address "ISPEXEC" " SETMSG MSG(ISRZ000)"
    return;
 /* use (in another file) with option DEBUG for testing...
zxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000001 NX
yxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000002 NX
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000003 NX
wxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x        00000004  X
vxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x        00000005  X
uxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x        00000006  X
txxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x        00000007  X
sxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000008 NX
rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000009 NX
qxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000010 NX
pxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx q        00000011  X
oxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx q        00000012  X
nxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx q        00000013  X
mxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx q        00000014  X
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx q        00000015  X
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000016 NX
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000017 NX
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000018 NX
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx          00000019 end DEBUG*/