/* REXX */ /* */ /* AUTHOR: Mark Zelden */ /* */ /*********************************************************************/ /* LMPREXX: */ /* */ /* This edit macro will do the following: */ /* */ /* 1) Create a KEYSOLD member from the member being edited. */ /* 2) Append keys from the KEYSNEW member into member being edited. */ /* 3) Check for duplicates and only keep the more current one. */ /* 4) Write the duplicates to the KEYSDUP member. */ /* 5) Write expired keys to the KEYSDUP member. Expired keys are */ /* also removed from the original file, but can optionally be */ /* kept if the "KEEPEXP" parameter is used at invocation. */ /* */ /* Duplicate keys are defined as keys that have the same PROD(nn) */ /* code and the same last 4 characters of the CPU serial number. */ /* */ /* NOTE: This macro will not automatically save the data being */ /* edited. However, since the data will most likely */ /* be changed the data will be saved if you type END or */ /* use the END PFK. This also depends on your profile */ /* settings for AUTOSAVE. */ /*********************************************************************/ /* The KEYS for the member being edited and the keys in the KEYSNEW */ /* member must start in column 1 and look similar to this: */ /* */ /* *---+----1----+----2----+----3----+----4----+----5----+----6----+ */ /* Prod(nn) Date(ddmthyy) CPU(nnnn-nnn /ssssss) LMPCODE(... */ /* */ /*********************************************************************/ /* Execution Syntax: */ /* */ /* LMPREXX (delete dups and expired keys) */ /* LMPREXX KEEPEXP (delete dups but keep expired keys) */ /*********************************************************************/ ADDRESS ISREDIT "MACRO (opt)" opt = Translate(opt) /* force upper case */ If opt <> '' & opt <> 'KEEPEXP' then do zedsmsg = 'Invalid Option -' opt zedlmsg = 'Invalid option specified. The only valid option is', '"KEEPEXP".' Address ISPEXEC "SETMSG MSG(ISRZ001)" /* msg - with alarm */ Exit 12 End /*********************************************************************/ /* House Keeping */ /*********************************************************************/ "(status) = USER_STATE" /* save current settings */ "(lastln) = LINENUM .ZLAST" /* last data line */ "(lmpdsn) = DATASET" /* cur data set name */ "BOUNDS" /* reset bounds */ "RESET EXCLUDED" /* reset exclude status */ Call RDATE TODAY /* get today's "NDATE" */ NTODAY = Substr(RESULT,16,5) /* num days since 1900 */ /*********************************************************************/ /* Create KEYSOLD backup member */ /*********************************************************************/ "REPLACE KEYSOLD 1" lastln /*********************************************************************/ /* Append additions from KEYSNEW into member being edited */ /*********************************************************************/ "COPY KEYSNEW AFTER" lastln /*********************************************************************/ /* SORT RECORDS - By CPU serial number and by KEY */ /*********************************************************************/ "SORT 40 44 5 9" /*********************************************************************/ /* Duplicate check */ /*********************************************************************/ CURRLN = 1 /* current line number */ DUPCOUNT = 0 /* count of duplicate lines */ KEYCOL1 = 5 /* start col for key check */ KEYCOL2 = 9 /* end col for key check */ CPUCOL1 = 40 /* start col for cpu check */ CPUCOL2 = 44 /* end col for cpu check */ /* */ Do while currln < lastln "(data1) = LINE "currln /* data1 = current line */ key1 = Substr(data1,keycol1,keycol2-keycol1+1) /* extract key */ cpu1 = Substr(data1,cpucol1,cpucol2-cpucol1+1) /* extract CPU */ nextln = currln + 1 /* bump up line counter */ "(data2) = LINE "nextln /* data2 = next line */ key2 = Substr(data2,keycol1,keycol2-keycol1+1) /* extract key */ cpu2 = Substr(data2,cpucol1,cpucol2-cpucol1+1) /* extract CPU */ If KEY1 == KEY2 & CPU1 == CPU2 then do /* duplicate */ dupcount = dupcount + 1 /* add 1 to dupcount */ dateYY1 = '20' || Substr(data1,20,2) /* extract year */ dateDD1 = Substr(data1,15,2) /* extract day */ dateMTH1 = Substr(data1,17,3) /* extract month */ dateYY2 = '20' || Substr(data2,20,2) /* extract year */ dateDD2 = Substr(data2,15,2) /* extract day */ dateMTH2 = Substr(data2,17,3) /* extract month */ Call MTH_to_MM dateMTH1 /* convert MTH to numeric month */ dateMM1 = RESULT /* answer from MTH_to_MM */ Call MTH_to_MM dateMTH2 /* convert MTH to numeric month */ dateMM2 = RESULT /* answer from MTH_to_MM */ Call RDATE dateMM1 dateDD1 dateYY1 /* call RDATE to get "NDATE" */ keydate1 = Substr(RESULT,16,5) /* num days since 1900 */ Call RDATE dateMM2 dateDD2 dateYY2 /* call RDATE to get "NDATE" */ keydate2 = Substr(RESULT,16,5) /* num days since 1900 */ If keydate1 <= keydate2 then do /* nextln is a newer key */ dup.dupcount = data1 /* save the data for later */ "ISREDIT XSTATUS "currln" = X" /* exclude this line */ End /* if keydate1 */ Else do /* currln is a newer key */ dup.dupcount = data2 /* save the data for later */ "ISREDIT XSTATUS "nextln" = X" /* exclude this line */ End /* else do */ currln = currln + 1 /* bump up currln counter */ End /* If KEY1 == KEY2 */ Else currln = currln + 1 /* no dup found - loop */ End /* do while currln < lastln */ /*********************************************************************/ /* End duplicate check */ /*********************************************************************/ "DELETE ALL EXCLUDED" /* end dup search - delete all excl. lines */ "(lastln) = LINENUM .ZLAST" /* last data line */ /*********************************************************************/ /* Expired check */ /*********************************************************************/ CURRLN = 1 /* current line number */ EXPCOUNT = 0 /* count of duplicate lines */ Do while currln < lastln "(data3) = LINE "currln /* data3 = current line */ dateYY3 = '20' || Substr(data3,20,2) /* extract year */ dateDD3 = Substr(data3,15,2) /* extract day */ dateMTH3 = Substr(data3,17,3) /* extract month */ Call MTH_to_MM dateMTH3 /* convert MTH to numeric month */ dateMM3 = RESULT /* answer from MTH_to_MM */ Call RDATE dateMM3 dateDD3 dateYY3 /* call RDATE to get "NDATE" */ keydate3 = Substr(RESULT,16,5) /* num days since 1900 */ If keydate3 <= ntoday then do /* key is expired */ "ISREDIT XSTATUS "currln" = X" /* exclude this line */ expcount = expcount + 1 /* add 1 to expcount */ exp.expcount = data3 /* save the data for later */ End currln = currln + 1 /* bump up currln counter */ End /* do while currln < lastln */ /*********************************************************************/ /* End expired check */ /*********************************************************************/ If opt <> 'KEEPEXP' then , /* "KEEPEXP" not specified, */ "DELETE ALL EXCLUDED" /* delete all excluded lines */ "(lastln) = LINENUM .ZLAST" /* last data line */ /*********************************************************************/ "RESET" /* issue RESET command */ "USER_STATE = (status)" /* restore saved settings including bounds */ "UP MAX" /* move display to first line */ /*********************************************************************/ Address ISPEXEC If dupcount = 0 & expcount = 0 then do zedsmsg = 'No duplicate/expired keys' zedlmsg = 'No duplicate or expired keys were found in the file.' "SETMSG MSG(ISRZ000)" /* msg - no alarm */ Exit 0 End Else do Call Write_Dups /* create KEYSDUP member with duplicates */ lastln = Format(lastln) /* remove leading zeros */ zedsmsg = dupcount 'key(s) deleted.' If opt = 'KEEPEXP' then , /* "KEEPEXP" specified */ zedlmsg = dupcount 'duplicate key(s) were deleted and', 'written to the KEYSDUP member.' expcount 'expired' , 'key(s) were also written and not deleted.' , lastln' keys were kept in the file.' Else , zedlmsg = dupcount 'duplicate key(s) were deleted and', 'written to the KEYSDUP member.' expcount 'expired' , 'key(s) were also written and deleted.' , lastln' keys were kept in the file.' "SETMSG MSG(ISRZ000)" /* msg - no alarm */ Exit 0 End /*********************************************************************/ /* End of main code */ /*********************************************************************/ /* Start of sub-routines */ /*********************************************************************/ MTH_to_MM: /* convert MTH to numeric MM value */ Parse upper arg MTH Select When MTH = 'JAN' then MM = '01' When MTH = 'FEB' then MM = '02' When MTH = 'MAR' then MM = '03' When MTH = 'APR' then MM = '04' When MTH = 'MAY' then MM = '05' When MTH = 'JUN' then MM = '06' When MTH = 'JUL' then MM = '07' When MTH = 'AUG' then MM = '08' When MTH = 'SEP' then MM = '09' When MTH = 'OCT' then MM = '10' When MTH = 'NOV' then MM = '11' When MTH = 'DEC' then MM = '12' Otherwise MM = '??' /* Error - should not happen */ End /* select */ Return MM Write_Dups: /* write duplicates to KEYSDUP member */ Address TSO "ALLOC FI(DUPS) DA('" || lmpdsn || "(KEYSDUP)') SHR REUSE" Queue '/********************************************************/' Queue '/* The following duplicate keys were found and deleted. */' Queue '/********************************************************/' Do I = 1 to dupcount Queue dup.i End If opt = 'KEEPEXP' then do /* "KEEPEXP" specified */ Queue '/********************************************************/' Queue '/* The following expired keys were found (but kept). */' Queue '/********************************************************/' End Else Do Queue '/********************************************************/' Queue '/* The following expired keys were found and deleted. */' Queue '/********************************************************/' End Do I = 1 to expcount Queue exp.i End Queue '' /* null queue to end stack */ "EXECIO * DISKW DUPS (FINIS" "FREE FI(DUPS)" Return RDATE: /* */ /* AUTHOR: Mark Zelden */ /* */ /************************************************/ /* Convert MM DD YYYY , YYYY DDD, or NNNNN to */ /* standard date output that includes the day */ /* of the week and the number of days (NNNNN) */ /* from January 1, 1900. This is not the same */ /* as the Century date! */ /* */ /* A parm of "TODAY" can also be passed to */ /* the date conversion routine. */ /* MM DD YYYY can also be specifed as */ /* MM/DD/YYYY or MM-DD-YYYY. */ /* */ /* The output format is always as follows: */ /* MM/DD/YYYY.JJJ NNNNN WEEKDAY */ /* */ /* The above value will be put in the special */ /* REXX variable "RESULT" */ /* example: CALL RDATE TODAY */ /* example: CALL RDATE 1996 300 */ /* example: CALL RDATE 10 26 1996 */ /* example: CALL RDATE 10/26/1996 */ /* example: CALL RDATE 10-26-1996 */ /* example: CALL RDATE 35363 */ /* result: 10/26/1996.300 35363 Saturday */ /************************************************/ arg P1 P2 P3 If Pos('/',P1) <> 0 | Pos('-',P1) <> 0 then do PX = Translate(P1,' ','/-') Parse var PX P1 P2 P3 End JULTBL = '000031059090120151181212243273304334' DAY.0 = 'Sunday' DAY.1 = 'Monday' DAY.2 = 'Tuesday' DAY.3 = 'Wednesday' DAY.4 = 'Thursday' DAY.5 = 'Friday' DAY.6 = 'Saturday' Select When P1 = 'TODAY' then do CURDATE = date('s') P1 = Substr(CURDATE,5,2) P2 = Substr(CURDATE,7,2) P3 = Substr(CURDATE,1,4) call CONVERT_MDY call THE_END end When P2 = '' & P3 = '' then do call CONVERT_NNNNN call THE_END end When P3 = '' then do call CONVERT_JDATE call DOUBLE_CHECK call THE_END end otherwise do call CONVERT_MDY call DOUBLE_CHECK call THE_END end end /* end select */ /* say RDATE_VAL; exit 0 */ return RDATE_VAL /**********************************************/ /* E N D O F M A I N L I N E C O D E */ /**********************************************/ CONVERT_MDY: if P1<1 | P1>12 then do say 'Invalid month passed to date routine' exit 12 end if P2<1 | P2>31 then do say 'Invalid day passed to date routine' exit 12 end if (P1=4 | P1=6 | P1=9 | P1=11) & P2>30 then do say 'Invalid day passed to date routine' exit 12 end if P3<1900 | P3>2099 then do say 'Invalid year passed to date routine' exit 12 end BASE = Substr(JULTBL,((P1-1)*3)+1,3) if (P3//4=0 & P3<>1900) then LEAP= 1 else LEAP = 0 if P1 > 2 then BASE = BASE+LEAP JJJ = BASE + P2 MM = P1 DD = P2 YYYY = P3 return CONVERT_NNNNN: if P1<1 | P1>73049 then do say 'Invalid date passed to date routine. NNNNN must be 1-73049' exit 12 end /* Determine YYYY and JJJ */ if P1>365 then P1=P1+1 YEARS_X4=(P1-1)%1461 JJJ=P1-YEARS_X4*1461 EXTRA_YEARS=(JJJ*3-3)%1096 JJJ=JJJ-(EXTRA_YEARS*1096+2)%3 YYYY=YEARS_X4*4+EXTRA_YEARS+1900 P1 = YYYY ; P2 = JJJ ; call CONVERT_JDATE CONVERT_JDATE: if P1<1900 | P1>2099 then do say 'Invalid year passed to date routine' exit 12 end if P2<1 | P2>366 then do say 'Invalid Julian date passed to date routine' exit 12 end if (P1//4=0 & P1<>1900) then LEAP= 1 else LEAP = 0 ADJ1 = 0 ADJ2 = 0 Do MM = 1 to 11 VAL1 = Substr(JULTBL,((MM-1)*3)+1,3) VAL2 = Substr(JULTBL,((MM-1)*3)+4,3) if MM >=2 then ADJ2 = LEAP if MM >=3 then ADJ1 = LEAP if P2 > VAL1+ADJ1 & P2 <= VAL2+ADJ2 then do DD = P2-VAL1-ADJ1 MATCH = 'Y' leave end end if MATCH <> 'Y' then do MM = 12 DD = P2-334-LEAP end YYYY = P1 JJJ = P2 return DOUBLE_CHECK: if MM = 2 then do if DD > 28 & LEAP = 0 then do say 'Invalid day passed to date routine' exit 12 end if DD > 29 & LEAP = 1 then do say 'Invalid day passed to date routine' exit 12 end end if LEAP = 0 & JJJ > 365 then do say 'Invalid Julian date passed to date routine' exit 12 end return THE_END: YR_1900 = YYYY-1900 NNNNN = (YR_1900*365) +(YR_1900+3)%4 + JJJ if YYYY > 1900 then NNNNN = NNNNN-1 INDEX = NNNNN//7 /* index to DAY stem */ WEEKDAY = DAY.INDEX DD = Right(DD,2,'0') MM = Right(MM,2,'0') YYYY = Strip(YYYY) NNNNN = Right(NNNNN,5,'0') JJJ = Right(JJJ,3,'0') RDATE_VAL = MM||'/'||DD||'/'||YYYY||'.'||JJJ||' '||NNNNN||' '||WEEKDAY return