/**rexx******* REMDUPS ********************************************** TITLE: Remove duplicates (remove if same as previous line) Users: TSO ISPF EDIT users Entry: Used as an EDIT CLIST within ISPF EDIT ===> REMDUPS .label1 .label2 Contributed: 1985/09/16 David McRitchie converted to REXX 1993/05/31 David McRitchie, DMcRitchie@hotmail.com Requirements: two labels This macro can be used within a macro for instance within DUADD it is invoked using ------- ISREDIT REMDUPS .DUADF .DUADL EXAMPLE: REMDUPS .ZFIRST .ZLAST NX remdups .zfirst .zlast nx 1 40 OPTIONS: NX | X (OPTIONAL) PROCESS only NX or X lines LPTR-RANGE | ENTIRE (optional) LINE POINTER RANGE NOTE DELETED LINES WILL BE SHOWN WITHIN NOTELINES SHOW lines that would otherwise be deleted will show up as a noteline ---FLAG--- BEST RESULTS IF X ALL FIRST THEN USE FLAG(0) FLAG Same as FLAG(0) FLAG(0) Only changes X-Status to NX-Status for duplicates. Both original of duplicate and duplicate become NX. Suggest use of NXDUP instead, unless you wish to retain NX status of lines already displayed. FLAG(n) Original line and lines that would otherwise be deleted are changed to nonexluded (NX) status. Original and duplicates are flagged in column n. SEP Insert separator when line changes e.g. REMDUPS sep 71 82 BLANK Use blank line as separator when line changes. '.string to use with sep--' in quotes turns sep on n1 n2 from and to columns -- warning may cause trouble if variable length NXDUP All lines in range are made X before starting. All duplicates and their originals become NX. <<>>> Keep only dups, remove all others REMDUPS .a .b 1 8 NXDUP ; del .a .b x all Keep only unique entries (delete all matched entries REMDUPS .a .b 1 8 NXDUP ; del .a .b NX all ; reset REQUIREMENTS: none ================================================================ **/ /*********************************************************************/ address 'ISREDIT'; 'MACRO (PARMS) NOPROCESS'; after=0; Before=0; Change=''; Labf=''; Labl=''; Remainder=''; SEPSTR = ".* ========= REMDUPS SEP ====== "; blank=''; blankstr='';debug=''; entire=''; flag=''; help=''; note=''; nx=''; deleted=0; /*initialize*/ zedlmsg='xxx'; zedsmsg='sss'; test=''; test=''; /* for continuous testing may be reset to TEST*/ nxdup='';sep=''; show=''; x=''; fromcol='';tocol='';FORcol=100;done=0 lastk = 0 /* line number of last k */ /* Collect Parameters */ if parms = '' Then signal NOPARMS 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,' NX X NOTE SHOW FLAG SEP BLANK DEBUG NXDUP TEST ') if j <> 0 then do; string = token ' = '''token''''; interpret string; iterate iii; end; if substr(token,1,6) = 'AFTER(' then do; parse var token 'AFTER(' after ')' Right; iterate iii; end if 'FLAG(' = Substr(token,1,5) then do; parse var token 'FLAG(' flag ')' 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 if datatype(token,"NUM") then do if fromcol = '' then fromcol = value(token) else if tocol = '' then do; tocol = value(token); FORcol=tocol + 1 - fromcol end; else do zedsmsg = "From/To Plus ??" zedlmsg = "Can Handle only a Single From/To Pair of Columns" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" exit 12 end iterate iii end say 'testing remainder --' token '<--' remainder = remainder token end iii if remainder <> "" Then do zedsmsg = Remainder zedlmsg = remainder "-- Parameters unknown to REMDUPS" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" Exit 8 end if nxdup = "NXDUP" then do xyz = x||nx||sep||flag if xyz \= '' then do zedsmsg = "NXDUP conflict" xyz zedlmsg = "NXDUP option conflicts with X NX SEP FLAG()" "line_before .zfirst = NOTELINE ""NXDUP option conflicts", "with X NX SEP FLAG()""" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" Exit 8 end end 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 if entire = "ENTIRE" then if labf = '' then do; labf=".ZFIRST"; labl=".ZLAST"; end else do zedsmsg = "ENTIRE" zedlmsg = "ENTIRE used and already specified" labf labl "line_before .zfirst = NOTELINE" zedlmsg Address "ISPEXEC" "SETMSG MSG(ISRZ000)" Exit 8 end NOPARMS: nop /* 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 "(LABLNO) = lineNUM" LABL "LINE_BEFORE" labf "= noteline ""===============begin range========", time('n') "REMDUPS" parms"""" "LINE_AFTER" labl "= noteline ""=============== end range========", time('n') "REMDUPS" parms"""" if FLAG = "FLAG" then flag = 0 if FLAG \= "" then if flag \= 0 then do "seek first p'^'" labf labl flag if rc = 0 then do zedsmsg = "FLAG("flag") col" /* zedlmsg = "xxxxx flag() error" */ zedlmsg = "FLAG("flag") column not blank" labf labl "line_before .zfirst = NOTELINE" """"zedlmsg"""" Address "ISPEXEC" "SETMSG MSG(ISRZ000)" Exit 8 end end /****** all parameters have been received and procesed relationships*/ if nxdup = "NXDUP" then "X ALL" labf labl "reset SPECIAL" labf labl lineLST = "..$..#..#..$$$..$$..99" time('n') k = labfno /*=================================================================*/ loop1: "(KL) = lineNUM" LABL IF K > KL THEN signal LOOP1E IF K >= KL THEN DONE = 1 IF "" \= X||NX then do "(XSTATUS) = XSTATUS" k IF XSTATUS \= x||NX THEN signal LOOP2 END "(lineCUR) = LINE" K IF tocol \= "" THEN , lineCUR = substr(lineCUR,FROMcol,FORcol) IF sep = "SEP" | blank = "BLANK" then do IF lineCUR \== lineLST THEN DO sepcur = sepstr||lineCUR IF BLANK = "BLANK" THEN "LINE_BEFORE" k "= (blankstr)" ELSE "LINE_BEFORE" K "= dataline (sepcur)" K = K + 1 lineLST = lineCUR END signal LOOP2 END /* strictly equal == include leading, imbeded blankstr*/ IF lineCUR == lineLST THEN DO IF NXDUP = "NXDUP" THEN DO "reset x" lastk lastk "reset x" k k signal LOOP2 END IF NOTE = "NOTE" then " LINE_AFTER" K "= NOTELINE ""deleted" k "--" , lineCUR"""" IF flag \= "" THEN DO "reset x" lastk lastk "reset x" k k if flag \= 0 then do "LABEL" lastk "=.FLAG 1" "C ALL .FLAG .FLAG" FLAG "' ' '*' " "LABEL" k "= .FLAG 1" "C ALL .FLAG .FLAG" FLAG "' ' '*' " end signal LOOP2 END IF SHOW = "SHOW" then do "(XSTATUS) = XSTATUS" k IF XSTATUS = "X" then do "(lineSHW) = LINE" k "LINE_AFTER" k "= NOTELINE (lineSHW)" END xyz = "LINE" K "would be deleted --" lineCUR; "LINE_AFTER" K "= NOTELINE (xyz)" signal LOOP2 END if TEST = "TEST" then do "LINE_AFTER" k "= MSGLINE ""TEST in effect;", "otherwise, the above line would be deleted --", time('N')"""" "reset" k k end else do; /* delete the line if not up 8 */ "DELETE" k DELETED = DELETED + 1 signal LOOP1 end END lineLST = lineCUR lastk = k LOOP2: IF DONE = 1 THEN signal LOOP1E K = K + 1 signal LOOP1 LOOP1E: IF 0 \= DELETED THEN DO zedlmsg = DELETED "lines deleted" "LINE_BEFORE .ZF = NOTELINE" , """"time('N') REMDUPS "--" DELETED "lines deleted""" address "ISPEXEC" "SETMSG MSG(ISRZ000)" END exit 0