/* REXX -- */
ADDRESS "ISREDIT"
  "MACRO NOPROCESS (FLOW)"
/* TITLE:   Reformat and sort dictionary update ".du add " cards     */
/* Users:   SCRIPT users                                             */
/* Entry:   Used as an EDIT CLIST within ISPF EDIT  ===> DUADD       */
/* Contributed: 1985/08/05 David McRitchie                           */
/*     Converted to REXX mainly line for line on 1994/04/26 D.McR.   */
/* Options: FLOW option default is 70  e.g.  ===> DUADD 70           */
/*     The resulting sorted ".du add " entries will fit within the   */
/*     column specified since that is what TFLOW does.               */
/*     The DUADDSTR option default is ".du add "                     */
/*       ===> DUADD (,'.du add')                                     */
/* Requirements:                                                     */
/*  All ".du add " in the section must begin in col 1 and have no    */
/*  other control statements .DUADF  label required at beginning of  */
/*  a contiguous  ".du add  " section .DUADX  label immediately      */
/*  after end of the contiguous  ".du add  " section.                */
/*                                                                   */
/*  The reason that .DUADX must be below the last line is to be able */
/*  to identify when there is only one line to be processed -- a     */
/*  possible alternative might have been to pass names of the line   */
/*  labels when invoking this edit macro, but I think the method     */
/*  used is better than the alternative.                             */
/*                                                                   */
/* SPECIAL OR HIDDEN FEATURES:                                       */
/*  Used by the CLIST DUADDX to convert an entire list to .DU ADD    */
/*    cards provided that "DSMDOT459I WORDS NOT FOUND:" is found in  */
/*    appropriate place.                                             */
/*   e.g.   DUADDX S6133                                             */
/*      would convert users   SYSVAR(SYSUID).S6133..LIST             */
/*     dataset by invoking...        Address "ISPEXEC",              */
/*          "EDIT DATASET(SYSVAR('sysuid').S6133..LIST) MACRO(DUADD)"*/
/*                                                                   */
  /* ************ ADDED D.MCR 1987/05/22 TO add/del list of names */
  /* example   ===> duadd CNTL MIDILIST hasn haven             */
  /******************************/
  "PROCESS RANGE C"
  If rc = 0 then Do
     /* make CC process range look like original usage */
     "(duadfNO) = LINENUM .DUADF"
     LCC1 = rc
     "(duadlNO) = LINENUM .DUADX"
     LCC2 = rc
     If LCC1  = 0 | LCC2  = 0 then Do
       ZEDSMSG = ".DUADF CC Conflict"
       ZEDLMSG = ".DUADF .DUADX labels conflict with CC range"
       Address "ISPEXEC" "SETMSG MSG(ISRZ000) "
     END
     "LABEL .ZFRANGE = .DUADF 0"
     "(LABL) = LINENUM .ZLRANGE"
     LABL = LABL + 1
     "LABEL" labl "= .DUADX 0"
  END
  /******************************/
  If flow = "(1)" then Do
     SFLOW = "(1)"
     "c all .duadf .duadx 1 '.if &&&&locdu. ne no .du add ' '.du add '"
     FLOW = 52
  END
  If flow = "(2)" then Do
     FLOW = 52
  END
  If flow = "(3)"  then Do
     "c all .duadf .duadx 1 '.du add ' '.if &&&&locdu. ne no .du add '"
     EXIT 1
  END
  xflow = translate(flow)
  dflow = datatype(flow)
  if xflow  = "DICTIONARY" then Do
         Address "TSO" "$EDIT SYS6.DCF40.INSTALL(DSMDMJCL)"
         EXIT 1
  END
  if dflow = "CHAR" & flow \= "" then Do
      "(DSNX) = DATASET"
      "F 1 first '.if &&&&locdu. ne no '"
      If rc = 0 then DSNX = "TECH.LIBR2.TEXT"     /*fake it */
      If dsnx = "TECH.LIBR2.TEXT" then Do
         "F 1 first '.if &&&&locdu. ne no .du add '"
         If rc = 0 then Do
            "LOC 30   "
            "f prev '.if &&&&locdu. ne no .du add '"
            "LINE_AFTER         .ZCSR   = ",
               """.if &&&&locdu. ne no .du add" flow""""
            "LINE_AFTER         .ZCSR   = ",
               "NOTELINE '.* duadd --------------'"
         END
         ELSE "LINE_AFTER         .ZFIRST = ",
            "'.if &&&&locdu. ne no .du add" flow"'"
         "F 1 last '.if &&&&locdu. ne no .du del '"
         If rc = 0 then
              "LINE_AFTER         .ZCSR   = ",
                 """.if &&&&locdu. ne no .du del" FLOW""""
         ELSE "LINE_AFTER         .ZLAST  = ",
            """.if &&&&locdu. ne no .du del" flow""""
   /*huh?  "F 1 last '.if &&&&locdu. ne no .du del" flow"'" */
         "loc .ZLAST"
         "up 15"
      END
      ELSE Do
         "F 1 first '.du add '"
         If rc = 0 then Do
              "LOC 30 "
              "f prev 1 '.du add '"
              "LINE_AFTER .ZCSR = "".du add" flow""""
              "LINE_AFTER         .ZCSR   = ",
                "NOTELINE "".* duadd --------------"""
         END
         ELSE "LINE_BEFORE .ZFIRST = '.du add" FLOW"'"
         "F 1 last '.du del ' "
         If rc = 0 then
              "LINE_AFTER .ZCSR   = "".du del" FLOW""""
         ELSE "LINE_AFTER .ZLAST  = "".du del" FLOW""""
         /* huh?  "F 1 last '.du del $FLOW.'" */
         "loc .ZLAST"
         "up 15"
      END
      "(DSNX)           = DATASET"
      EXIT 1
  END
  /*** ADDED D.MCR 1987/03/06 TO ACCOMODATE OUTPUT LIST AS INPUT */
  "SEEK FIRST 1 '.'  "
  If rc = 0 then SIGNAL NORML01
  wanted = 0
  "SEEK FIRST 1 p'DSMDOT459I=WORDS=NOT=FOUND$'"
  If rc = 0 then wanted = 1
  "SEEK FIRST 1 p'=DSMDOT459I=WORDS=NOT=FOUND$'"
  If rc = 0 then wanted = 1
  "SEEK FIRST 1 p'==DSMDOT459I=WORDS=NOT=FOUND$'"
  If rc = 0 then wanted = 1
  If wanted = 0 then SIGNAL NORML01
  /* modified 1991/04/22 to combine words not found lines*/
  /* (error message never continues beyond two lines)  */
  "X ALL"
  "F ALL         1 X P'=DSMDOT459I=WORDS=NOT=FOUND$='  "
  "X ALL 61 ' '   "
  "F ALL         1 NX P'=DSMDOT459I=WORDS=NOT=FOUND$=' "
  "(,VAR024) = FIND_COUNTS"
  Do ii=1 to var024
     "(line1) = line .zcsr"
     "(line1NO) = linenum .zcsr"
     line2no = line1no + 1
     "(line2) = line" line2no
     line = strip('.du add '||substr(line1,30,32)||substr(line2,2))
     "line" line1no "= (line)"
     "del" line2no
     "F next 1 NX P'=DSMDOT459I=WORDS=NOT=FOUND$=' "
  END
  "C ALL 1 P'=DSMDOT459I=WORDS=NOT=FOUND$=' '.du add ' "
  "C ALL 1  p'dsmdot459i=words=not=found$=' '.du add '"
  "x all"
  "f all 2 ""DSMMOM395I '""" /*'match single quote*/
  "f '.du add ' 1 all"
  "c all 1 nx p'=DSMMOM395I ' '.DSMMOM395I '"
  "(change7,change8) = change_counts"
  "(line) = line .zcsr"
  parse var line line ' LINE '
  "seek 1 """line""" all"
  "(seek7,seek8) = seek_counts"
  "f 1 '.*' all"
  if seek7 = change7 then Do
     "x all 1 '.dsmmom395i '"
     "del x all"
     "LABEL .zfirst   = .DUADF 0"
     "LINE_AFTER .ZL = dataline "".* .DUADX"""
     "LABEL   .ZLAST = .DUADX 0"
     signal norml01
  end
  "del x all"
  "x all '.du add ' 1"
  "LABEL             .ZCSR   = .DUADF 0"
  "LINE_AFTER .ZL = dataline "".* .DUADX"""
  "LABEL   .ZLAST = .DUADX 0"
  "x .duadx .duadx all"
  "LINE_AFTER 0 = NOTELINE ""  ===> duadd """
  "LINE_AFTER 0 = NOTELINE ",
     """  ===> c all p'.' ' '     << check changes"""
  "LINE_AFTER 0 = NOTELINE",
     """ ===> <LABEL RANGE OF DUADD IS .DUADF .DUADX"""
  "LINE_AFTER 0 = NOTELINE "" otherwise you may want to ",
     "update several members"""
  "LINE_AFTER 0 = NOTELINE ""If it IS -- SIMPLY ISSUE ",
     "===> DEL NX ALL"""
  "LINE_AFTER 0 = NOTELINE ""CHECK THAT SAME MEMBER",
     "IS USED THROUGHOUT"""
  ZEDSMSG = "read =NOTE= lines"
  ZEDLMSG = "Please read =NOTE= lines, most of",
    "conversion was done for you"
  Address "ISPEXEC" " SETMSG MSG(ISRZ000)"
  EXIT 1

NORML01:
  if flow = "" then flow = 70
  "(duadfNO) = LINENUM .DUADF "
  If rc > 0 then Do
    ZEDSMSG = .DUADF MISSING
    ZEDLMSG = A .DUADF label (at the first '.du add ' line) ,
      is not in the file
    Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
    EXIT 1
  END
  "(duadxNO) = LINENUM .DUADX "
  If rc > 0 then Do
    ZEDSMSG = .DUADX MISSING
    ZEDLMSG = A .DUADX label (at the line after the last ,
      '.du add ' line) is not in the      file
    Address "ISPEXEC" " SETMSG MSG(ISRZ000)"
    EXIT 1
  END
  "F 1 first '.if &&&&locdu. ne no '  "
  If rc = 0 then Do
     DSNX = "TECH.LIBR2.TEXT"       /*fake it*/
     "c all .DUADF .duadx '.if &&&&locdu. ne no .du add ' ",
       "'.du add '"
  END
  If FLOW. = "" then Do
     If  dsnx = "TECH.LIBR2.TEXT" then flow = 52
     ELSE FLOW = 70
  END
  ELSE If DATATYPE(FLOW) \= "NUM" then Do
    ZEDSMSG = BAD PARAMETER
    ZEDLMSG = flow "is an unknown parameter.  Use a" ,
      "column number."
    Address "ISPEXEC" " SETMSG MSG(ISRZ000)"
    EXIT  12
  END
  "(LBOUND,RBOUND) = BOUNDS"
  "(DWIDTH) = DATA_WIDTH"
  If FLOW = "" then nop
  ELSE If FLOW < 10 then Do
    ZEDSMSG = "Parameter too small"
    ZEDLMSG = "The FLOW parameter" flow "must be at least 10"
    Address "ISPEXEC" " SETMSG MSG(ISRZ000)"
    EXIT  12
  END
  If FLOW  = "" then nop
  ELSE If FLOW > RBOUND then Do
    ZEDSMSG = PARAMETER TOO LARGE
    ZEDLMSG = "The parameter must be smaller than or",
      "equal to" RBOUND", the right-bound."
    Address "ISPEXEC" " SETMSG MSG(ISRZ000)"
    EXIT  12
  END
  "LABEL" value(duadxNO-1) "= .DUADL"
  If RBOUND < DWIDTH then Do
  "SEEK .DUADF .DUADL P'^'" value(RBOUND+1) DWIDTH
    If rc = 0 then Do
      ZEDSMSG = DATA OUTSIDE BOUNDS
      ZEDLMSG = "Non-blank characters exist outside",
        "of the edit bounds."
      Address "ISPEXEC" " SETMSG MSG(ISRZ000) "
      EXIT  12
    END
  END
   /* ************ ADDED D.MCR 1985/08/03 TO END ***** */
  If value(duadxNO) < value(duadfNO) then Do
      ZEDSMSG = "LABEL ERR .DUADF/X"
      ZEDLMSG = ".DUADF MUST APPEAR EARLIER THAN .DUADX"
      Address "ISPEXEC" "SETMSG MSG(ISRZ000)"
      EXIT  12
  END
  "CHANGE ALL 1 .DUADF .DUADL ",
     " p'=DSMDOT459I=WORDS=NOT=FOUND$=' '.du add '"
  "CHANGE ALL 1 .DUADF .DUADL ",
     "  p'=0DSMDOT459I=WORDS=NOT=FOUND$=' '.du add '"
  "SEEK  .DUADF .DUADL 1 '.du add ' ALL"
  "(SEEK1,SEEK2) = SEEK_COUNTS"
  SEEK3 = value(duadxNO - duadfNO )
  If value(SEEK3) \= value(SEEK2) ,
  | seek3  \= seek1  then Do
      ZEDSMSG = "INCORRECT .DU DATA"
      ZEDLMSG = ".du add ",
         "Must be in pos. 1 of each line beginning .duadf to",
         "the line before .duadx"
      Address "ISPEXEC" " SETMSG MSG(ISRZ000) "
      say 'You''re all washed up in this town mister' sysvar('sysuid')
      say " "
      say "read the upper right hand corner buster"
      EXIT  12
  END
  "SEEK .DUADF .DUADL 1 ';.'  ALL"
  "(SEEK1,SEEK2) = SEEK_COUNTS"
  If seek2 \= 0     then Do
      ZEDSMSG = "ONE COMMAND PER LINE"
      ZEDLMSG = "CAN ONLY HANDLE ".du add           " COMMANDS AND" ,
         "THEY MUST BEGIN IN COL 1"
      Address "ISPEXEC" " SETMSG MSG(ISRZ000) "
      EXIT  12
  END
  /*ALL VERIFICATION HAS BEEN COMPLETED ABOVE -- */
  /*  --NOW SETTING UP TO CHANGE DATA */
  " (duadfNO) = LINENUM .DUADF"
  " LABEL" value(duadxNO - 1) "= .DUADR 0"
  " LINE_BEFORE .DUADR = DATALINE LINE .DUADR "
  " LABEL" duadfNO "= .DUADF"
     /*PROVIDED IN CASE .DUADX WAS ENTERED ONE LINE AFTER .DUADF*/
  " (duadxNO) = LINENUM .DUADX"
     /*RECALCULATED BECAUSE IT HAS MOVED ONE LINE DOWN*/
  " LABEL" value(duadxNO - 1) "= .DUADR 0"
     /*REDOING LABEL BECAUSE OF LINE INSERTED */
  " (duadrNO) = LINENUM .DUADR"
     /*RECALCULATED BECAUSE IT HAS MOVED ONE LINE DOWN */
  " LABEL" duadfNO "= .DUADF 0"
     /*REDOING LABEL BECAUSE IN CASE COPY WENT BEFORE IT*/
  " CHANGE .DUADF .DUADR '.du add    ' '.du add ' 1 ALL   "
  " CHANGE .DUADF .DUADR '.du add   ' '.du add ' 1 ALL    "
  " CHANGE .DUADF .DUADR '.du add '         '        ' 1 8 ALL"
  /********** START SPLITTING UP LINES FROM THE FIRST WORD*/
  " CURSOR =" duadfNO "0"
  TSBEG:
  " SEEK P' ^'       "
  If rc \= 0 then SIGNAL SORTS
  TSF1:
  " (SEEK1) = LINENUM .ZCSR"
  TSF2:
  " SEEK P' ^'       "
  If rc \= 0 then SIGNAL SORTS
  " (SEEK2) = LINENUM .ZCSR"
  If seek2  >= duadrNO then SIGNAL SORTS
  If seek1 \= seek2 then SIGNAL TSF1
  " TSPLIT           "
  " (duadrNO) = LINENUM .DUADR"
  SIGNAL TSBEG
  SORTS:
  " CHANGE .DUADR .DUADR '        ' '.*STOPFLOW' 1 8 ALL  "
  " (CURLINE) = LINENUM .DUADX"
  " LABEL" value(CURLINE - 2)"= .DUADL 0"
  "(ifrom) = linenum .duadf"
  Do i = ifrom to value(curline -1)
     "(line) = line" i
     line = substr(line,1,50)||translate(substr(line,1,20))
     "line" i "= (line)"
   end
  " SORT .DUADF .DUADL 51 70 1 50"
   /* *********** remove any duplicates *****************/
  /* *********** remove any duplicates *****************/
  /* sortf to .sortv  (sortv itself never a duplicate) */
  "(sortfn) = linenum .duadf"
  "(sortvn) = linenum .duadx"
  prevline = " "
  delcnt=0
  sortvv = sortvn - 2
  Do i = sortvv to sortfn by -1
     /* could make line = substr(line,1,50)translate(line,1,20)) */
     /* and sort 51 70 1 50 */
     "(line) = line" i
     line=substr(line,1,50)
     "line" i "= (line)"
     if line = prevline then Do;"delete" i+1;delcnt=delcnt+1;end;
     else prevline = line
  end
  call note "There were "||delcnt||" duplicate word(s) deleted"
   /* ***************************************************/
  " (duadxNO) = LINENUM .DUADX"
     /*RECALCULATED BECAUSE IT HAS MOVED ONE LINE DOWN */
  diff = duadxNO - duadfNO   /*number of entries in list*/
  " TFLOW .DUADF" flow
  " CHANGE .DUADF .DUADR '        ' '.du add ' 1 8 ALL    "
  " DELETE .DUADR .DUADR"
  If rc = 0 then diff = diff - 1
  " RESET CHANGE .DUADF .DUADF"
     /* RESHOW LABEL EVEN if changed*/
  If DSNX  = "TECH.LIBR2.TEXT" then ,
     "c all .duadf .duadx 1 '.du add ' ",
       "'.if &&&&locdu. ne no .du add '"
  " RESET COMMAND    "
  ZEDSMSG = "DUADD FINISHED OK"
  ZEDLMSG = "DUADD MACRO FINISHED OKAY -- "DIFF" entries",
     "--"   CHANGED "LINES INCLUDE  .duadf"
  Address "ISPEXEC" " SETMSG MSG(ISRZ000)"
  If diff > 600 then Do
  "LINE_BEFORE" DUADF "= NOTELINE """diff" ENTRIES APPROACHES"""
  "LINE_BEFORE" duadfNO "= NOTELINE """CCC"             MAX OF 804 ",
     "WORDS ALLOWED IN ADDENDA DICTIONARY"""
  END
  EXIT 1
  note: parse arg limey
      "line_after .zcsr = noteline (limey)"
      return