/* REXX -- @SEQ Place sequence numbers into data for use of sort etc.
     Title:       Place sequence numbers into data for use of sort etc.
     Users:       TSO ISPF edit users
     Contributed: 1986/11/17 David McRitchie -- "The REXX Macros Toolbox"
     Converted to REXX: 1993/05/01 F. David McRitchie

     Example:     @SEQ
     example:     @SEQ     .zfirst .zlast col(100) l(8)   =equivalent=
     example:     @SEQ     force ast(**) col(100) l(12) nx
     example:     @SEQ     add(13) .a .b col(53) l(4)   nx

     OPTIONS:
         NX | X    (optional)  Process all, or non-excluded, or
                    excluded lines do not exclude .zfirst line since
                    this clist utilizes "loc 0" which will make it no
                    longer excluded and will alter processing.
         LPTR-RANGE  (optional) Line pointer range
         ADD(NN)   (optional) Adds to existing numbers the constant nn
         COL(NN)   (optional) Default is 100, columm that 8-digit
                    sequence number will go into
         INCR(NN)  (optional) Increment used when begin(nn) used
                    default is 1
         L(N)      (optional) Default is 8, length of sequence number
                    field including ast(x) prefix and suffix if
                    supplied
         FORCE     Force sequence numbers into specified columns even
                    if specified columns are non-blank cannot be use
                    with  the exclude option   "x"
         BEGIN(N)  (optional) Supply a beginning number for
                    sequencing; otherwise, the  edit sequence number of
                    the card will be used.  if  nx | x is used only
                    those lines will be changed and cause an increment.
         INCR(NN)  (optional) Increment from begin(n) after first is
                    done
         REPEATX   Place latest sequence number in x cards -- labels
                    required
                    force will cause x cards to be changed as well as
                    nx cards
         AST       (optional)  Reset ast value from null to "*"
         AST(CC)   (optional)  Reset ast value  to "cc" value specified
                   may be any number of characters and will surround
                   the column length defined numbers as a set off.
      <<<ADDITIONAL operands>>>
     --- METHOD TO spread numbers in manuals library ----
         C ALL .A .B 1 P'##$##' '     '
         X ALL .A .B
         REMDUPS .A .B SEP 1 20
         @SEQ .A .B REPEATX COL(1) BEGIN(7701) INCR(11) L(4) FORCE
         REFORMAT .A .B 1 2 '.' 3 4 '-' 7 250
         RESET .A .B \ X .A .B 9 '=====' ALL \ DEL X .A .B ALL

     REQUIREMENTS:
       ...............................................*/
       /* */

 ADDRESS 'ISREDIT'; 'MACRO (PARMS) NOPROCESS';
 NOTE = 'LINE_BEFORE .ZFIRST = NOTELINE ';
 INCR=1;ADD='';COL='';BEGIN='';L='';AST='';
 DEBUG='';TEST='';REMAINDER='';LABF='';LABL='';
 X='';NX='';FORCE=''; repeatx='';ast='';

 /* COLLECT PARAMETERS */
 IF PARMS = '' THEN DO;  /* NO PARAMETERS -- DEFAULT TO A TEST*/
    ZEDSMSG = ''
    ZEDLMSG = "@SEQ MISSING OPERANDS SUCH AS",
       "COL(3) INCR(1) BEGIN(1)"
    ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)"
    EXIT 8
 END
PARMS = TRANSLATE(PARMS)

/* NOT SUITED FOR IMBEDDED BLANKS BUT WILL SEE INITIAL ENDING QUOTES*/
 DO III = 1 TO 10;
   TOKEN = WORD(PARMS,III)
   IF TOKEN = '' THEN LEAVE
   TOKENX = TRANSLATE(TOKEN);
   IF TOKENX = "DEBUG" THEN DO
      TRACE INTERMEDIATE
   END
   J = POS(TOKENX,' DEBUG TEST FORCE NX X REPEATX AST ')
   IF J <> 0 THEN DO;
      STRING = TOKEN ' = '''TOKEN''''; INTERPRET  STRING; ITERATE III;
   END;
   IF 'ADD(' = SUBSTR(TOKEN,1,4)     THEN DO;
      PARSE VAR TOKEN  'ADD(' ADD ')' RIGHT; ITERATE III;
   END
   IF 'AST(' = SUBSTR(TOKEN,1,4)     THEN DO;
      PARSE VAR TOKEN  'AST(' AST ')' RIGHT; ITERATE III;
   END
   IF 'COL(' = SUBSTR(TOKEN,1,4)     THEN DO;
      PARSE VAR TOKEN  'COL(' COL ')' RIGHT; ITERATE III;
   END
   IF SUBSTR(TOKEN,1,5) = 'INCR(' THEN DO;
      PARSE VAR TOKEN  'INCR(' INCR ')' RIGHT; ITERATE III;
   END
   IF 'BEGIN(' = SUBSTR(TOKEN,1,6)   THEN DO;
      PARSE VAR TOKEN  'BEGIN(' BEGIN ')' RIGHT; ITERATE III;
   END
   IF 'L(' = SUBSTR(TOKEN,1,2)     THEN DO; /*TEST LATER THAN COL()*/
      PARSE VAR TOKEN  'L(' L ')' RIGHT; ITERATE III;
   END
   IF SUBSTR(TOKEN,1,1) = '.' THEN DO
      IF LABF = '' THEN LABF = TOKEN
      ELSE IF LABL = '' THEN LABL = TOKEN
      ELSE DO
            ZEDSMSG = '.LABEL RC=8'
            ZEDLMSG = 'TOO MANY LABELS --' LABF LABL TOKEN
            ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)"
            EXIT 8
      END
      ITERATE III
   END

   IF SUBSTR(TOKEN,1,1) = "'" THEN DO /* "'"*/
      SEPSTR = SUBSTR(TOKEN,2,VALUE(LENGTH(TOKEN)-2))
      ITERATE III
   END

   SAY 'TESTING REMAINDER --' TOKEN '<--'
   REMAINDER = REMAINDER TOKEN
 END III

 IF REMAINDER <> "" THEN DO
    ZEDSMSG =  REMAINDER
    ZEDLMSG =  REMAINDER "-- PARAMETERS UNKNOWN TO @SEQ"
    ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)"
    EXIT 8
 END

/* PROCESS ADDITIONAL LABEL / RANGE RELATIONSHIPS */
IF LABL = '' THEN DO
   "PROCESS RANGE C"
   IF RC = 0 THEN DO
      "LABEL .ZFRANGE = .LABF 1"
      "LABEL .ZLRANGE = .LABL 1"
      LABF = ".LABF"
      LABL = ".LABL"
   END
END
IF LABL = '' THEN DO; LABF='.ZFIRST'; LABL='.ZLAST'; END;
"(LABFNO) = LINENUM" LABF
IF RC \= 0 THEN EXIT 12
"(LABLNO) = LINENUM" LABL

 IF FROMCOL \= '' THEN IF TOCOL = '' THEN DO
       ZEDSMSG =  "FROM/TO"
       ZEDLMSG =  "FROM/TO PAIR INVALID, MISSING TO COLUMN"
       "LINE_BEFORE .ZFIRST = NOTELINE" "FROM/TO PAIR INVALID,",
            "MISSING TO COLUMN"
       ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)"
       EXIT 8
  END

/****** ALL PARAMETERS HAVE BEEN RECEIVED -- PROCESS RELATIONSHIPS */
        /****************** CODE FOR  @SEQ COMMANDS ***************/
        /****************** CODE FOR  @SEQ COMMANDS ***************/
        /****************** CODE FOR  @SEQ COMMANDS ***************/
    IF REPEATX = "REPEATX" THEN NX = "NX"
    IF COL="" THEN COL = 100
    IF ast = "AST" then ast = "*"
    if l = '' then l = 8
    NDCOL = col + L - 1
    IF ADD \= '' THEN SIGNAL ADDEM
    BLANKS=SUBSTR(' ',1,32)
    IF FORCE  = "FORCE" THEN IF X = "X" THEN DO
       ZEDSMSG = "FORCE & X"
       ZEDLMSG = "FORCE OPTION INCOMPATIBLE WITH  X OPTION"
       ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)"
       EXIT 12
    END
    IF FORCE = "FORCE" THEN
           "Change" LABF LABL "ALL P'^'" COL VALUE(COL+L-1) "' '"  NX
           /* lines with "^" check OS/2 <--> TSO/E bad translations*/
 /* "LOC 0"*/
    "SEEK" X  NX  LABF  LABL "FIRST" COL "'"SUBSTR(' ',1,L)"'"
    IF RC \=0 THEN SIGNAL DONE
    astl = l - length(ast) - length(ast)
    if astl < 1 then do
       ZEDSMSG = "L value low"
       ZEDLMSG = "L value must be at least 1 plus 2X length ast Value"
       ADDRESS "ISPEXEC" "SETMSG MSG(ISRZ000)"
       EXIT 12
    END
    /*.....................................*/
    XYZ = "@SEQ" PARM
    "LINE_AFTER 0 = NOTELINE (XYZ)"
    if begin \= "" then
       I = BEGIN - incr  /* correction 1993/10/12 D.McR*/
       else i = labfno
    i = i - incr         /* correction 04/07/1997 for pc only?*/
    SIGNAL R2
  R: IF REPEATX = "REPEATX" THEN DO
      "SEEK" LABF  LABL "NEXT"  COL "'"SUBSTR(' ',1,L)"'"
      IF RC \= 0 THEN SIGNAL DONE
      SIGNAL R2
    END
    "SEEK" X NX LABF LABL "NEXT" COL "'"SUBSTR(' ',1,L)"'"
    IF RC \= 0 THEN SIGNAL DONE
R2: IF BEGIN = "" THEN "(I) = LINENUM .ZCSR"
    ELSE DO
       IF REPEATX = "REPEATX" THEN DO
          "(VAR075) = XSTATUS .ZCSR"
          IF VAR075 = "X" THEN SIGNAL R2U
       END
       IF INCR = 0 THEN INCR = 1
       ELSE I = I + INCR
    END
R2U:
    "CHANGE .ZCSR .ZCSR FIRST" COL "'"SUBSTR(" ",1,L)"' '"AST,
          ||RIGHT("00000000"I,astL,'0')||AST"'"
    IF X = "X" THEN "EXCLUDE .ZCSR .ZCSR ALL"
    IF REPEATX = "REPEATX" THEN
       IF VAR075 = "X" THEN "EXCLUDE .ZCSR .ZCSR ALL"
    SIGNAL R
 ADDEM:
     IF ADD=0 THEN SAY "..........DEAD......."
     if force = "FORCE"
        then PICSTR =  SUBSTR('===========================',1,L)
        else PICSTR =  SUBSTR('###########################',1,L)
     "LINE_AFTER 0 = NOTELINE ""@SEQ" LABF LABL "ADD("ADD")" X,
          ||NX "COL("COL") L("L")"""
     "cursor =" labfno "0"
     fNEXT = "FIRST"
 TADD1: "SEEK" X NX LABF LABL fNEXT  COL "P'"PICSTR"'"
     IF RC \= 0 THEN SIGNAL DONE
     fNEXT = "NEXT"
     "(VAR036) = LINE .ZCSR"
     I = strip(SUBSTR(VAR036,COL,L),"B")
     rcx=verify(i,"0123456789");
     if rcx /=0 then do;seek p'=' next; signal tadd1;end;
     i= i + ADD
     "Change ALL .ZCSR .ZCSR" COL,
         "P'"PICSTR"' '"RIGHT("00000000"I,L,'0')"'"
     IF X = "X" THEN "EXCLUDE .ZCSR .ZCSR ALL"
     SIGNAL TADD1
 DONE:  EXIT 0