//M4J6060S JOB CLASS=A,MSGCLASS=X, //* RESTART=SAS.SAS609, // NOTIFY=&SYSUID /*JOBPARM ROOM=PROG //* use symbolic names //SORT1 EXEC PGM=SORT //SYMNAMES DD * TC,'LA' //SYSOUT DD SYSOUT=* //SORTMSG DD SYSOUT=* //SORTIN DD DISP=SHR,DSN=TCLM.CQ000154.ECF.LATRAN.X060123 //SORTOUT DD DSN=TEMP.M4J6060.W1.DATA(+1), //SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(10,20)) //SYSIN DD * SORT FIELDS=COPY OUTFIL INCLUDE=(1,2,CH,EQ,TC),OUTREC=(1,80) // //* SUMMARIZING //SORT3 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTMSG DD SYSOUT=* //SORTIN DD DISP=SHR,DSN=TEMP.M4J6060.V2.DATA //SORTOUT DD DSN=TEMP.M4J6060.V5.DATA(+1), // UNIT=TEMP,DISP=(,CATLG,DELETE), // SPACE=(TRK,(10,10),RLSE) //SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(10,20)) //SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(10,20)) //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(10,20)) //SORTWK04 DD UNIT=SYSDA,SPACE=(CYL,(10,20)) //SORTWK05 DD UNIT=SYSDA,SPACE=(CYL,(10,20)) //SYSIN DD * INREC FIELDS=(55,4,X,X'00001C',X,C'0000',65,2) SORT FIELDS=(1,4,CH,A) SUM FIELDS=(6,3,PD,10,6,ZD) //* //* SUMMARIZING PRESORTED USING SECTIONS, TRAILER //SORT4 EXEC PGM=ICEMAN //SYSOUT DD SYSOUT=* //SORTIN DD * 101 20 101 30 102 40 102 50 103 60 103 70 /* //SORTOUT DD SYSOUT=* //SYSIN DD * OPTION COPY OUTFIL REMOVECC,NODETAIL, SECTIONS=(3,3, TRAILER3=(1,11,TOT=(12,5,FS,LENGTH=5))) //* TRAILER3=(1,11,TOT=(12,5,FS,TO=FS,LENGTH=5))) /* //* SUMMARIZING PRESORTED USING MERGE //SORT5 EXEC PGM=ICEMAN //SYSOUT DD SYSOUT=* //SORTIN01 DD * 101 20 101 30 102 40 102 50 103 60 103 70 /* //SORTOUT DD SYSOUT=* //SYSIN DD * OPTION ZDPRINT MERGE FIELDS=(3,3,CH,A) SUM FIELDS=(12,5,ZD) /* //* convert a fixed length record to variable //SYSIN DD * SORT FIELDS=COPY OUTFIL FILES=OUT,FTOV //* EXAMPLE THIS IS A VB FILE, which gets converted to fixed (see CONVERT) //*----+----1----+----2----+----3----+----4----+----5----+----6----+--- //********************************** TOP OF DATA ********************** //*ZJ000544....NB186456..*C.....510932570RYAN'S EXPRESS MOVIN56K G ..%M //*ZJ000544....NB186456..%C.....510932570RYAN'S EXPRESS MOVIN56K G ..%M //*ZJSTATES....TL168158...C.....555232482DEPT OF JUSTICE 98Z I ..%M //*ZJSTATES....TL168158..1 SORT FIELDS=(34,2,CH,A) .* SORT BY ZONAD OUTFILE FNAMES=REPORT,LINES=50, HEADER1=(01:'LIST OF WISP NOT MATCHING TO SALV PMT=41 WITH DUP AMTS', 70:'RUN DATE ',DATE=(4MD-), .* (or plain DATE or DATENS=(abc)) 100:'PAGE ',PAGE), HEADER2=(/,01:'CLMNO',17:'AMOUNT',26:'GROUP',34:'POLICY',42:'YEAR', 47:'SFX',51:'DIST',56:'FM',60:'LASTNAME',72:'DIS', 76:'COUNT', /,01:'-----',17:'------',26:'-----',34:'------',42:'----', 47:'---',51:'----',56:'--',60:'--------',72:'---', 76:'-----'), SECTIONS=(34,2,SKIP=L, .* GROUP BY ZONAD TRAILER3=(10:'-------------',52:'--',76:'---', .* GROUP TOTALS /,03:TOTAL=(9,7,PD,M2),52:34,2, 64:TOTAL=(50,2,PD,M0),' RECORDS')), OUTREC=(01:1,8,11:9,7,PD,M2,LENGTH=13, 26:16,6,34:22,7,43:29,4,49:33,1,52:34,2,56:36,2,60:38,11, 73:49,1,76:50,2,PD,M0,120:X), TRAILER1=(/,03:TOTAL=(9,7,PD,M2), .* FINAL TOTALS 30:COUNT,' CLAIMS', .* FINAL COUNT 64:TOTAL=(50,2,PD,M0),' RECORDS') //* how to read a field like -123.45 //* use inrec to chop into dollars (including sign) and cents //* then during outfile,outrec, read in as FS but output as PD or ZD //SORTIN DD DISP=SHR,DSN=TCLM.CLJJN.GET6A.WISP //SORTOUT DD DSN=TEMP.M4J6060.V1.DATA(+1), // UNIT=TEMP,SPACE=(TRK,(1,1),RLSE), // RECFM=FB,LRECL=80,BLKSIZE=0, // DISP=(,CATLG,DELETE) //*-+----1----+----2----+----3----+----4----+----5----+----6----+----7-- //*09225 6A SUBATFEE 2003-01-23 -0000070.00 <= VB INPUT //SYSIN DD * * GET CLMNO,DATE,AMTDOLR,AMTCENT (DROP DECIMAL POINT) INREC FIELDS=(1,4,5,8,26,10, 37,8,46,2) .* (DLRS & CENTS, LEADING SIGN, NO DOT) OUTFILE FNAMES=SORTOUT, OUTREC=(01:5,8,09:13,10, 19:23,10,FS,PD, .* READ IN AS FLOATING SIGN, OUT AS PD 80:C' '),CONVERT SORT FIELDS=(5,8,CH,A,23,6,PD,A) //* edit may be followed by SIGNS=(lp,ln,tp,tn) to control leading/trailing //* positive/negative signs of output field //* this is the pseudo code for computing day of week (sun=0) from any date int getDayOfWeek(int m, int d, int y, int csys) { // csys = 1 for Gregorian Calendar (if year>=1582) if (m < 3) { m = m + 12; y = y - 1; } return ( d + (2 * m) + int(6 * (m + 1) / 10) + y + int(y / 4) - int(y / 100) + int(y / 400) + csys ) % 7; } EZTRIEVE job to execute day-of-week macro derived from zeller's congruence (in this version, sunday=1) 000900,//STEP001 EXEC PGM=EZTPA00,REGION=8M 001000,//STEPLIB DD DSN=SCIFXA.APLIB,DISP=SHR 001100,// DD DSN=EZTP.LOADLIB,DISP=SHR 001200,// DD DSN=SORT.SORTLIB,DISP=SHR 001300,//USRPRINT DD SYSOUT=* 001400,//SYSUDUMP DD SYSOUT=* 001500,//SYSOUT DD SYSOUT=A 001600,//EZTVFM DD UNIT=SYSDA,SPACE=(4096,(100,100)) 001700,//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(15,5),RLSE) 001800,//SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(15,5),RLSE) 001900,//SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(15,5),RLSE) 002000,//SORTWK04 DD UNIT=SYSDA,SPACE=(CYL,(15,5),RLSE) 002100,//SORTWK05 DD UNIT=SYSDA,SPACE=(CYL,(15,5),RLSE) 002200,//SYSPRINT DD SYSOUT=* 002300,//DATEFILE DD * 002400,2005-10-26 002500,1982-04-24 002600,2054-06-19 002800,1900-03-01 003000,//SYSIN DD * 003100,MSTART DOWMAC 003200,* GIVEN YEAR, MONTH, DAY - RETURN DAY OF WEEK 003300,* (SAMPLE USAGE: DOWMAC 2001 12 31 DOW, WHERE 1=SUNDAY) 003400,* (NO VALID-DATE CHECKING; WORKS STARTING 3/1/1900) 003500,* (USES ZELLER'S CONGRUENCE) 003600,MACRO 4 INP-YEAR INP-MONTH INP-DAY OUP-DOW 003700, DEFINE WMS-YEAR W 4 N 003800, DEFINE WMS-MONTH W 2 N 003900, DEFINE WMS-T1 W 2 N 004000, DEFINE WMS-T4 W 4 N 004100, DEFINE WMS-T100 W 2 N 004200, DEFINE WMS-T400 W 2 N 004300, DEFINE WMS-SUM W 4 N 004400, DEFINE WMS-WORK W 4 N 004500, DEFINE WMS-CSYS W 1 N VALUE 1 004600, IF &INP-MONTH < 3 004700, WMS-MONTH = &INP-MONTH + 12 004800, WMS-YEAR = &INP-YEAR - 1 004900, ELSE 005000, WMS-MONTH = &INP-MONTH 005100, WMS-YEAR = &INP-YEAR 005200, END-IF 005300, WMS-T1 = 6 * (WMS-MONTH + 1 ) / 10 005400, WMS-T4 = WMS-YEAR / 4 005500, WMS-T100 = WMS-YEAR / 100 005600, WMS-T400 = WMS-YEAR / 400 005700, WMS-SUM = &INP-DAY + 2 * WMS-MONTH + WMS-YEAR - 005800, + WMS-T1 + WMS-T4 - WMS-T100 + WMS-T400 + WMS-CSYS 005900, WMS-WORK = WMS-SUM / 7 006000, &OUP-DOW = WMS-SUM - 7 * WMS-WORK + 1 006100,MEND 006200,FILE DATEFILE F(80) 006300, DTE-REC 1 80 A 006400, DTE-YEAR 1 4 N 006500, DTE-MONTH 6 2 N 006600, DTE-DAY 9 2 N 006700,DEFINE DOW W 4 N 006800,JOB INPUT DATEFILE 006900, %DOWMAC DTE-YEAR DTE-MONTH DTE-DAY DOW 007000, DISPLAY DTE-YEAR '-' DTE-MONTH '-' DTE-DAY ' DOW=' DOW *** eztrieve for calling LE callable service ceeloct (get local time) //STEPLIB DD DSN=SCIFXA.APLIB,DISP=SHR // DD DSN=EZTP.LOADLIB,DISP=SHR // DD DSN=SORT.SORTLIB,DISP=SHR // DD DSN=SYS1.SCEERUN,DISP=SHR PARM ENVIRONMENT COBOL DEFINE LILLIAN W 4 B DEFINE TIMESEC W 8 A DEFINE GREGSTR W 17 A DEFINE FEEDBCK W 12 A JOB INPUT NULL CALL CEELOCT USING (LILLIAN TIMESEC GREGSTR FEEDBCK) DISPLAY 'L=' LILLIAN ' S=' TIMESEC ' G=' GREGSTR STOP *** this etrieve uses macro to access ceedays (date-to-lillian) and ceedate (lillian-to-date) //DATEFILE DD * 2005-11-23 1982-04-24 2054-06-19 1900-01-01 1900-03-01 1948-08-19 //SYSIN DD * MSTART EZEDAYS MACRO 1 WZDPARM DEFINE WZD-PARM W 140 A DEFINE WZD-FLD WZD-PARM 22 A DEFINE WZD-FLD-LEN WZD-FLD 2 B DEFINE WZD-FLD-VAL WZD-FLD +2 20 A DEFINE WZD-PIC WZD-PARM +22 22 A DEFINE WZD-PIC-LEN WZD-PIC 2 B DEFINE WZD-PIC-VAL WZD-PIC +2 20 A DEFINE WZD-LILLIAN WZD-PARM +44 4 B DEFINE WZD-FEEDBK WZD-PARM +48 12 A DEFINE WZD-FDBK-RC WZD-FEEDBK 2 B DEFINE WZD-FDBK-MSG WZD-FEEDBK +2 2 B DEFINE WZD-FDBK-ETC WZD-FEEDBK +4 8 A DEFINE WZD-DTE-OUT WZD-PARM +60 80 A WZD-PARM = &WZDPARM WZD-LILLIAN = 0 WZD-FEEDBK = X'00000000' CALL CEEDAYS USING (WZD-FLD WZD-PIC WZD-LILLIAN WZD-FEEDBK) MEND MSTART EZEDATE MACRO 1 WZDPARM DEFINE WZD-PARM W 140 A DEFINE WZD-FLD WZD-PARM 22 A DEFINE WZD-FLD-LEN WZD-FLD 2 B DEFINE WZD-FLD-VAL WZD-FLD +2 20 A DEFINE WZD-PIC WZD-PARM +22 22 A DEFINE WZD-PIC-LEN WZD-PIC 2 B DEFINE WZD-PIC-VAL WZD-PIC +2 20 A DEFINE WZD-LILLIAN WZD-PARM +44 4 B DEFINE WZD-FEEDBK WZD-PARM +48 12 A DEFINE WZD-FDBK-RC WZD-FEEDBK 2 B DEFINE WZD-FDBK-MSG WZD-FEEDBK +2 2 B DEFINE WZD-FDBK-ETC WZD-FEEDBK +4 8 A DEFINE WZD-DTE-OUT WZD-PARM +60 80 A WZD-PARM = &WZDPARM WZD-DTE-OUT = ' ' WZD-FEEDBK = X'00000000' CALL CEEDATE USING (WZD-LILLIAN WZD-PIC WZD-DTE-OUT WZD-FEEDBK) MEND PARM ENVIRONMENT COBOL FILE DATEFILE F(80) DTE-REC 1 80 A DTE-FLD 1 10 A DTE-YEAR 1 4 N DTE-MONTH 6 2 N DTE-DAY 9 2 N DEFINE WZD-PARM W 140 A DEFINE WZD-FLD WZD-PARM 22 A DEFINE WZD-FLD-LEN WZD-FLD 2 B DEFINE WZD-FLD-VAL WZD-FLD +2 20 A DEFINE WZD-PIC WZD-PARM +22 22 A DEFINE WZD-PIC-LEN WZD-PIC 2 B DEFINE WZD-PIC-VAL WZD-PIC +2 20 A DEFINE WZD-LILLIAN WZD-PARM +44 4 B DEFINE WZD-FEEDBK WZD-PARM +48 12 A DEFINE WZD-FDBK-RC WZD-FEEDBK 2 B DEFINE WZD-FDBK-MSG WZD-FEEDBK +2 2 B DEFINE WZD-FDBK-ETC WZD-FEEDBK +4 8 A DEFINE WZD-DTE-OUT WZD-PARM +60 80 A JOB INPUT DATEFILE WZD-PIC-LEN = 10 WZD-FLD-VAL = DTE-FLD WZD-PIC-LEN = 10 WZD-PIC-VAL = 'YYYY-MM-DD' %EZEDAYS WZD-PARM DISPLAY '===> ' WZD-FLD-VAL ',' WZD-PIC-VAL ',' WZD-LILLIAN + ',' WZD-FEEDBK WZD-LILLIAN = WZD-LILLIAN + 1 WZD-DTE-OUT = ' ' %EZEDATE WZD-PARM DISPLAY '===> ' WZD-DTE-OUT ',' WZD-PIC-VAL ',' WZD-LILLIAN + ',' WZD-FEEDBK *** this etrieve is same as above but direct call to ceedays and ceedate PARM ENVIRONMENT COBOL FILE DATEFILE F(80) DTE-REC 1 80 A DTE-FLD 1 10 A DTE-YEAR 1 4 N DTE-MONTH 6 2 N DTE-DAY 9 2 N DEFINE WZD-FLD W 17 A DEFINE WZD-FLD-LEN WZD-FLD 2 B DEFINE WZD-FLD-VAL WZD-FLD +2 15 A DEFINE WZD-PIC W 17 A DEFINE WZD-PIC-LEN WZD-PIC 2 B DEFINE WZD-PIC-VAL WZD-PIC +2 15 A DEFINE WZD-LILLIAN W 4 B 0 DEFINE WZD-DTE-OUT W 80 A DEFINE WZD-FEEDBACK W 12 A JOB INPUT DATEFILE WZD-PIC-LEN = 10 WZD-FLD-VAL = DTE-FLD WZD-PIC-LEN = 10 WZD-PIC-VAL = 'YYYY-MM-DD' CALL CEEDAYS USING (WZD-FLD WZD-PIC WZD-LILLIAN WZD-FEEDBACK) DISPLAY '===> ' WZD-FLD-VAL ',' WZD-PIC-VAL ',' WZD-LILLIAN + ',' WZD-FEEDBACK WZD-LILLIAN = WZD-LILLIAN + 1 CALL CEEDATE USING (WZD-LILLIAN WZD-PIC WZD-DTE-OUT WZD-FEEDBACK) DISPLAY '===> ' WZD-DTE-OUT ',' WZD-PIC-VAL ',' WZD-LILLIAN + ',' WZD-FEEDBACK // *** COBOL to demonstrate calls to ceeloct, ceedays, ceedate WORKING-STORAGE SECTION. 01 WS-CEELOCT. 03 WS-LILIAN PIC S9(09) BINARY. 03 WS-SECONDS COMP-2. 03 WS-DATE-TIME PIC X(17). 03 FILLER REDEFINES WS-DATE-TIME. 05 WS-DATE-CCYYMMDD PIC 9(08). 05 WS-TIME-HHMMSSTHM PIC 9(09). 03 WS-FEEDBACK-LIST PIC X(12). 03 FILLER REDEFINES WS-FEEDBACK-LIST. 05 WS-FEEDBACK-RC PIC S9(04) COMP. 05 WS-FEEDBACK-MSG-NO PIC S9(04) COMP. 03 WS-DATE-PIC PIC X(17). 03 WS-OUT-DATE PIC X(80). PROCEDURE DIVISION. CALL 'CEELOCT' USING WS-LILIAN, WS-SECONDS, WS-DATE-TIME, WS-FEEDBACK-LIST. DISPLAY 'CEELOCT:' 'L=' WS-LILIAN ' S=' WS-SECONDS ' DT=' WS-DATE-TIME ' RC=' WS-FEEDBACK-RC MOVE '2005-11-22' TO WS-DATE-TIME MOVE 'YYYY-MM-DD' TO WS-DATE-PIC CALL 'CEEDAYS' USING WS-DATE-TIME WS-DATE-PIC WS-LILIAN WS-FEEDBACK-LIST DISPLAY 'CEEDAYS: L=' WS-LILIAN ' F=' WS-FEEDBACK-RC ADD 1 TO WS-LILIAN CALL 'CEEDATE' USING WS-LILIAN WS-DATE-PIC WS-OUT-DATE WS-FEEDBACK-LIST DISPLAY 'CEEDATE: D=' WS-OUT-DATE ' F=' WS-FEEDBACK-RC GOBACK . /* Date picture samples: MM 01-12 */ /* ZM 1-12 */ /* YY 98 */ /* YYYY 1998 */ /* MMM JAN-DEC */ /* Mmm Jan-Dec */ /* MMMMMMMMMM JANUARY-DECEMBER with trailing blanks */ /* Mmmmmmmmmz January-December without trailing blanks*/ /* DD 01-31 */ /* ZD 1-31 */ /* HH, ZH 00-23, 0-23? */ /* MI minute */ /* SS second */ /* 9 99 999 microseconds 10 100 1000 */ /* AP, ap AM-PM, am-pm */ /* A.P., a.p. A.M.-P.M., a.m.-p.m. */ /* W S-M-T-W-T-F-S */ /* Www Sun-Sat */ /* WWWWWWWWWW SUNDAY-SATURDAY without trailing spaces */ /* Wwwwwwwwwz Sunday-Saturday with trailing spaces */ /* Examples: MM/DD/YYYY 06/09/1999 */ /* MM-DD-YYYY 06-09-1999 */ /* YYYY-MM-DD 1998-06-09 */ /* ZM/ZD/YYYY 6/9/1998 */ /* ZDMMMMMMMMMZYYYY 9JUNE1998 JOB CREATES TEMP TABLE TO BE USED LATER IN QUERY //SORT EXEC PGM=SORT //SORTMSG DD SYSOUT=* //SYSOUT DD SYSOUT=* //SORTIN DD DISP=SHR,DSN=TCLM.TD000206.KREVCHK.KBATCHR.LHTRAN.D050314 //SYSIN DD * INCLUDE COND=(1,2,CH,EQ,C'LH') SORT FIELDS=COPY OUTFIL FILES=1, INCLUDE=(1,2,CH,EQ,C'LH', AND,71,2,CH,EQ,C'JV', AND,96,8,CH,NE,C' '), OUTREC=(C' INSERT INTO SESSION.SEL(CLMNO) VALUES(''', 96,8, C''');',80:X) OUTFIL FILES=2, INCLUDE=(1,2,CH,EQ,C'LH', AND,96,8,CH,EQ,C' '), OUTREC=(C' INSERT INTO SESSION.SEL(CLMNO) VALUES(''', 71,8, C''');',80:X) //SORTOF1 DD DSN=TEMP.M4J6060.V1.DATA(+1), // UNIT=SYSDA,SPACE=(TRK,(1,10),RLSE), // RECFM=FB,LRECL=80,BLKSIZE=0, // DISP=(,CATLG,DELETE) //* //SORTOF2 DD DSN=TEMP.M4J6060.V2.DATA(+1), // UNIT=SYSDA,SPACE=(TRK,(1,10),RLSE), // RECFM=FB,LRECL=80,BLKSIZE=0, // DISP=(,CATLG,DELETE) //* //SPUFI PROC SYS=V //PSTEP010 EXEC PGM=IKJEFT01,REGION=1M //**************************************************** //SYSTSPRT DD SYSOUT=* //SYSPRINT DD SYSOUT=* //STEPLIB DD DSN=DB2&SYS..DSNLOAD,DISP=SHR // DD DSN=DLVY.DB2&SYS..LOAD,DISP=SHR //SYSTSIN DD DISP=SHR,DSN=&SYS.UNI.CNTLLIB(DLVYRSQL) //SYSIN DD DUMMY // PEND //RUN EXEC SPUFI,SYS=V //SYSTSIN DD * DSN SYSTEM(DB2V) RUN PROGRAM(DLVYRSQL) PLAN(DLVYRSQL) + PARM('/ COMMITOP(NOERROR) + ERROROPT(QUIT) + PAGESIZE(55) + ROWLIMIT(5000) + RETRIES(0) + RETRWAIT(5) ') //SYSIN DD * --DROP TABLE SESSION.SEL; DECLARE GLOBAL TEMPORARY TABLE SESSION.SEL ( CLMNO CHAR(8) NOT NULL ); // DD DISP=SHR,DSN=TEMP.M4J6060.V1.DATA // DD DISP=SHR,DSN=TEMP.M4J6060.V2.DATA // DD * SELECT '$',CLMNO , CHECK_NUMBER_CKN AS DBCKNO , CHECK_REVERSAL_CDE AS CKREVCD , CHECK_DTE AS CHKDTE , DEPT_ALPHA_IDN AS ZONAD , CHECK_AMT AS CHKAMT , TRANSACTION_DTE AS TRNDTE , ACTIVITY_DTE AS ACTDTE , POSTING_DTE AS PSTDTE , BATCH_STATUS_CDE AS BATSTAT FROM SESSION.SEL AS S LEFT JOIN KDEV.CLM_CHECK_REVERSAL AS R ON (S.CLMNO = R.CLAIM_NUMBER_IDN) ; // SUPERCE //* THIS PROC CHANGES FORMAT DEPENDING ON SS - SIDE-BY-SIDE VALUE //SUPERCH PROC PCLM=TCLM.PS010108, // SS=1 /* SS=1, SIDE BY SIDE */ // IF &SS=1 THEN //SUPERC EXEC PGM=ISRSUPC, // PARM=(LINECMP, // LONGL, /* FULL COMPARE, SHOW DIFF */ //*DELTAL, /* CHANGED LINES ONLY */ //*CHNGL, /* CHANGES +/- 10 LINES */ // 'COVSUM NARROW', /* SIDE BY SIDE COMPARE */ // '') //NEWDD DD DISP=SHR,DSN=&PCLM..&MID.Q.&TYPE.&SFX //OLDDD DD DISP=SHR,DSN=&PCLM..&MID.P.&TYPE.&SFX //OUTDD DD SYSOUT=* //SYSIN DD DUMMY // ELSE //SUPERC EXEC PGM=ISRSUPC, // PARM=(LINECMP, // LONGL, /* FULL COMPARE, SHOW DIFF */ //*DELTAL, /* CHANGED LINES ONLY */ //*CHNGL, /* CHANGES +/- 10 LINES */ // 'COVSUM ', /* UP AAND DOWN COMPARE */ // '') //NEWDD DD DISP=SHR,DSN=&PCLM..&MID.Q.&TYPE.&SFX //OLDDD DD DISP=SHR,DSN=&PCLM..&MID.P.&TYPE.&SFX //OUTDD DD SYSOUT=* //SYSIN DD DUMMY // ENDIF // PEND //SC21 EXEC SUPERCH,SS=1,MID=MCLOPEN,SFX=.CLMACT,TYPE=ECFSTAT EZTRIEVE SAMPLE PARM LINK(K0021RPE R) *=====================================================================* * DESCRIPTION * *=====================================================================* * * * - IT READS THE CLAIMS ESTIMATE EXTRACT FILE, AND DEPENDING ON THE * * PARM (INPUT CONTROL CARD) IT PRINTS THE K0021 OR K0022 REPORT. * * * * INPUT: * * - PCLM.KESTXTR.EXTRACT: CLAIMS ESTIMATE EXTRACT FILE * * * * OUTPUT: * * - K0021: MONTHLY SUMM REVISED EST LIST OVER $100,000 BY PY,YA * * - K0022: MONTHLY SUMM REV USTAT EST LIST OVER $100,000 BY PY,YA * * * *=====================================================================* * MAINTENANCE LOG * FILE INFILE FB(150 0) ++INCLUDE ESTIMRCE *=================================================== * INPUT CONTROL CARD TO DEFINE HEADER *=================================================== FILE INCNTL FB(80 0) CNTLREC 1 80 A CNTL-RPTID 1 5 A *========================================= * INTERNAL TABLE *========================================= FILE TBSTRAT TABLE INSTREAM ARG 1 1 A DESC 4 12 A A NO CHANGE B 0 TO 09999 C 1 TO 19999 D 2 TO 29999 E 3 TO 39999 F 4 TO 49999 G 5 TO 59999 H 6 TO 69999 I 7 TO 79999 J 8 TO 89999 K 9 TO 99999 L OVER 100000 M 0 TO 09999- N 1 TO 19999- O 2 TO 29999- P 3 TO 39999- Q 4 TO 49999- R 5 TO 59999- S 6 TO 69999- T 7 TO 79999- U 8 TO 89999- V 9 TO 99999- W OVER 100000- ENDTABLE *======================================= * TEMPORARY SUMFILE *======================================= FILE K0021SUM FB(200 0) VIRTUAL SUMREC 1 200 A SUM-ZONAD 1 2 A SUM-CATEG 3 7 A SUM-PYAY 10 5 A SUM-STRAT-CHG 15 12 A SUM-CLMNO 27 8 A SUM-ESTTP 35 1 A SUM-COUNT 36 10 P 0 SUM-PREV-COMP-EST-AMT 46 10 P 0 SUM-PREV-MED-EST-AMT 56 10 P 0 SUM-COMP-EST-AMT 66 10 P 0 SUM-MED-EST-AMT 76 10 P 0 SUM-NET-COMP-EST-AMT 86 10 P 0 SUM-NET-MED-EST-AMT 96 10 P 0 * 106 95 A * *======================================== * REPORT FILES *========================================= FILE K0021TEM PRINTER FB(133 0) FILE K0021RPT PRINTER FB(133 0) *========================================= * WORK AREAS *========================================= WS-PY W 4 A WS-PY-CCYY WS-PY 4 A WS-PY-CC WS-PY 2 A WS-PY-YY WS-PY +2 2 A WS-YA W 4 A WS-YA-CCYY WS-YA 4 A WS-YA-CC WS-YA 2 A WS-YA-YY WS-YA +2 2 A WS-PY-YA-RPT W 5 A WS-PY-YY-RPT WS-PY-YA-RPT 2 A * +2 1 A WS-YA-YY-RPT WS-PY-YA-RPT +3 2 A WS-EST-CHNG-STRAT-DESC W 12 A WS-ESTIM-EST-TYP W 01 A WS-ESTIM-CLAIM-NUMBER-IDN W 08 A WS-ESTIM-PREV-COMP-EST-AMT W 05 P 0 MASK 'ZZZZZZ,ZZZ-' WS-ESTIM-PREV-MED-EST-AMT W 05 P 0 MASK 'ZZZZZZ,ZZZ-' WS-ESTIM-COMP-EST-AMT W 05 P 0 MASK 'ZZZZZZ,ZZZ-' WS-ESTIM-MED-EST-AMT W 05 P 0 MASK 'ZZZZZZ,ZZZ-' WS-ESTIM-NET-COMP-EST-AMT W 05 P 0 MASK 'ZZZZZZ,ZZZ-' WS-ESTIM-NET-MED-EST-AMT W 05 P 0 MASK 'ZZZZZZ,ZZZ-' WS-CASE-COUNT W 06 N 0 MASK 'ZZZZZZ' WS-HDR W 49 A WS-RPTID W 5 A *==================================================== * PROCESS SECTION *==================================================== *==================================================== * 1ST: WRITE TEMP SUMFILE TO FACILITATE FORMATTING K0 *==================================================== JOB INPUT INFILE + START (INIT-PROC) SEARCH TBSTRAT WITH EZ-ESTIM-EST-CHNG-STRAT-IND + GIVING WS-EST-CHNG-STRAT-DESC WS-PY-CCYY = EZ-ESTIM-POLICY-YEAR WS-PY-YY-RPT = WS-PY-YY WS-YA-CCYY = EZ-ESTIM-INJYY WS-YA-YY-RPT = WS-YA-YY WS-ESTIM-PREV-COMP-EST-AMT = EZ-ESTIM-PREV-COMP-EST-AMT WS-ESTIM-PREV-MED-EST-AMT = EZ-ESTIM-PREV-MED-EST-AMT WS-ESTIM-COMP-EST-AMT = EZ-ESTIM-COMP-EST-AMT WS-ESTIM-MED-EST-AMT = EZ-ESTIM-MED-EST-AMT WS-ESTIM-NET-COMP-EST-AMT = EZ-ESTIM-NET-COMP-EST-AMT WS-ESTIM-NET-MED-EST-AMT = EZ-ESTIM-NET-MED-EST-AMT IF EZ-ESTIM-EST-CHNG-STRAT-IND = 'L' + OR EZ-ESTIM-EST-CHNG-STRAT-IND = 'W' WS-ESTIM-EST-TYP = EZ-ESTIM-EST-TYP WS-ESTIM-CLAIM-NUMBER-IDN = EZ-ESTIM-CLAIM-NUMBER-IDN ELSE WS-ESTIM-EST-TYP = ' ' WS-ESTIM-CLAIM-NUMBER-IDN = ' ' END-IF PRINT RPT-T * INIT-PROC. PROC GET INCNTL WS-RPTID = CNTL-RPTID IF WS-RPTID = 'K0021' WS-HDR = 'MONTHLY SUMM REVISED ESTIMATES LIST OVER $100,000' ELSE WS-HDR = 'MONTHLY SUMM REV EST LIST OVER $100,000-UNIT STAT' END-IF END-PROC *================================================================= * REPORT SECTION *================================================================= REPORT RPT-T PRINTER K0021TEM SUMFILE K0021SUM + SUMMARY NODATE NOPAGE NOADJUST + TITLESKIP 1 TALLYSIZE 4 LINESIZE 132 CONTROL FINAL NOPRINT EZ-ESTIM-ZONAD EZ-ESTIM-GROUP-CATEG NEWPAGE + WS-PY-YA-RPT WS-EST-CHNG-STRAT-DESC + WS-ESTIM-CLAIM-NUMBER-IDN WS-ESTIM-EST-TYP TITLE COL 001 WS-RPTID + COL 007 EZ-ESTIM-ZONAD + COL 010 'ZONE OF ADJ' EZ-ESTIM-ZONAD + COL 028 WS-HDR + COL 079 'BY PY,YA' + COL 089 EZ-ESTIM-GROUP-CATEG + COL 104 SYSDATE + COL 121 'PAGE' + COL 126 PAGE-COUNT HEADING WS-ESTIM-EST-TYP ('EST' 'TYP') HEADING WS-ESTIM-CLAIM-NUMBER-IDN ('CLAIM NO') HEADING WS-PY-YA-RPT ('PY YA') HEADING WS-EST-CHNG-STRAT-DESC ('STRAT DESCR') HEADING TALLY ('CASE' 'COUNT') HEADING WS-ESTIM-PREV-COMP-EST-AMT ('OLD COMP') HEADING WS-ESTIM-PREV-MED-EST-AMT ('OLD MED') HEADING WS-ESTIM-COMP-EST-AMT ('NEW COMP') HEADING WS-ESTIM-MED-EST-AMT ('NEW MED') HEADING WS-ESTIM-NET-COMP-EST-AMT ('NET COMP') HEADING WS-ESTIM-NET-MED-EST-AMT ('NET MED') LINE 01 COL 001 WS-ESTIM-EST-TYP + COL 008 WS-ESTIM-CLAIM-NUMBER-IDN + COL 018 WS-PY-YA-RPT + COL 025 WS-EST-CHNG-STRAT-DESC + COL 039 TALLY + COL 045 WS-ESTIM-PREV-COMP-EST-AMT + COL 060 WS-ESTIM-PREV-MED-EST-AMT + COL 075 WS-ESTIM-COMP-EST-AMT + COL 090 WS-ESTIM-MED-EST-AMT + COL 105 WS-ESTIM-NET-COMP-EST-AMT + COL 118 WS-ESTIM-NET-MED-EST-AMT *========================================================= * 2ND: READ TEMP SUMFILE TO GENERATE K0021 REPORT *========================================================= JOB INPUT K0021SUM WS-PY-YA-RPT = SUM-PYAY WS-EST-CHNG-STRAT-DESC = SUM-STRAT-CHG WS-ESTIM-EST-TYP = SUM-ESTTP WS-ESTIM-CLAIM-NUMBER-IDN = SUM-CLMNO WS-CASE-COUNT = SUM-COUNT WS-ESTIM-PREV-COMP-EST-AMT = SUM-PREV-COMP-EST-AMT WS-ESTIM-PREV-MED-EST-AMT = SUM-PREV-MED-EST-AMT WS-ESTIM-COMP-EST-AMT = SUM-COMP-EST-AMT WS-ESTIM-MED-EST-AMT = SUM-MED-EST-AMT WS-ESTIM-NET-COMP-EST-AMT = SUM-NET-COMP-EST-AMT WS-ESTIM-NET-MED-EST-AMT = SUM-NET-MED-EST-AMT PRINT RPT-1 *=========================================================== * REPORT SECTION *=========================================================== REPORT RPT-1 PRINTER K0021RPT NODATE NOPAGE NOADJUST + TITLESKIP 1 TALLYSIZE 4 LINESIZE 132 DTLCTL EVERY CONTROL FINAL NOPRINT SUM-ZONAD SUM-CATEG NEWPAGE + WS-PY-YA-RPT TITLE COL 001 WS-RPTID + COL 007 SUM-ZONAD + COL 010 'ZONE OF ADJ' SUM-ZONAD + COL 028 WS-HDR + COL 079 'BY PY,YA' + COL 089 SUM-CATEG + COL 104 SYSDATE + COL 121 'PAGE' + COL 126 PAGE-COUNT HEADING WS-ESTIM-EST-TYP ('EST' 'TYP') HEADING WS-ESTIM-CLAIM-NUMBER-IDN ('CLAIM NO') HEADING WS-PY-YA-RPT ('PY YA') HEADING WS-EST-CHNG-STRAT-DESC ('STRAT DESCR') HEADING WS-CASE-COUNT (' CASE' ' COUNT') HEADING WS-ESTIM-PREV-COMP-EST-AMT (' OLD COMP') HEADING WS-ESTIM-PREV-MED-EST-AMT (' OLD MED') HEADING WS-ESTIM-COMP-EST-AMT (' NEW COMP') HEADING WS-ESTIM-MED-EST-AMT (' NEW MED') HEADING WS-ESTIM-NET-COMP-EST-AMT (' NET COMP') HEADING WS-ESTIM-NET-MED-EST-AMT (' NET MED') LINE 01 COL 001 WS-ESTIM-EST-TYP + COL 006 WS-ESTIM-CLAIM-NUMBER-IDN + COL 016 WS-PY-YA-RPT + COL 023 WS-EST-CHNG-STRAT-DESC + COL 036 WS-CASE-COUNT + COL 045 WS-ESTIM-PREV-COMP-EST-AMT + COL 060 WS-ESTIM-PREV-MED-EST-AMT + COL 075 WS-ESTIM-COMP-EST-AMT + COL 090 WS-ESTIM-MED-EST-AMT + COL 105 WS-ESTIM-NET-COMP-EST-AMT + COL 118 WS-ESTIM-NET-MED-EST-AMT * (SEE ALSO FILES EZRPT2.TXT) PDSUNLD/PDSLOAD //DEL EXEC PGM=IDCAMS //SYSPRINT DD SYSOUT=* //SYSIN DD * DELETE M4J6060.TCLM.CQ000154.UNLOAD //SAS EXEC SAS609 //PDS DD DISP=SHR,DSN=TCLM.CQ000154.PROMOTE.JOBSUB //SEQ DD DSN=M4J6060.TCLM.TD000154.UNLOAD, // UNIT=DISK,SPACE=(CYL,(5,1),RLSE), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=6160), // DISP=(,CATLG,DELETE) //*SELECT SC:; //SYSIN DD * PROC SOURCE INDD=PDS OUTDD=SEQ; //*ELECT KESDMDN:-KESDMDZ:; // //DEL EXEC PGM=IDCAMS //SYSPRINT DD SYSOUT=* //SYSIN DD * DELETE TCLM.CQ000154.PROMOTE.JOBSUB //PDSLOAD2 EXEC PGM=IEBUPDTE,PARM=NEW //SYSUT2 DD DSN=TCLM.CQ000154.PROMOTE.JOBSUB, // UNIT=DISK,SPACE=(TRK,(30,10,20),RLSE), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=0), // DISP=(,CATLG,DELETE) //SYSIN DD DISP=SHR,DSN=TEMP.M4J6060.V9.DATA //SYSPRINT DD SYSOUT=* // SAS THINGS //SAS EXEC SAS609 //INP DD * WORD=VALUE AB_DATE=20061011 AB_FILENAME=ABC.CDF.EFGH.FILE AB_DIR=/ABC/DEF //SYSIN DD * DATA INP; LENGTH KEY $16 VALUE $16; INFILE INP DLM='=' DSD; INPUT KEY $ VALUE $; PROC PRINT; // DATA CLINE;INFILE CLINE; INPUT @85 ACCT PD8.; FORMAT ACCT ACCTPIC.; PROC SORT;BY ACCT; DATA _NULL_;FILE PRINT N=PS;SET CLINE; RETAIN C L 1; IF(L>50)THEN DO;C=C+33;L=1;END; IF(C>132)THEN DO;PUT _PAGE_;C=1;L=1;END; PUT #L @C ACCT ACCTPIC.; L=L+1; // S370FZDW.D - SIGNED ZONED DECIMAL S370FZDUW.D - UNSIGNED ZONED DECIMAL S370FZDSW.D - LEADING SIGN S370FZDTW.D - TRAILING SIGN //* SORT ZELLER //SORT1 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SYMNAMES DD * ZLYY,1,4,ZD ZLMM,6,2,ZD ZLDD,9,2,ZD //SORTIN DD * 2005-10-26 1982-04-24 2054-06-19 2007-02-28 2007-03-01 //SORTOUT DD SYSOUT=* //* MSTART DOWMAC //** GIVEN YEAR, MONTH, DAY - RETURN DAY OF WEEK //** (SAMPLE USAGE: DOWMAC 2001 12 31 DOW, WHERE 1=SUNDAY) //** (NO VALID-DATE CHECKING; WORKS STARTING 3/1/1900) //** (USES ZELLER'S CONGRUENCE) //* MACRO 4 INP-YEAR INP-MONTH INP-DAY OUP-DOW //* //* IF &INP-MONTH < 3 //* WMS-MONTH = &INP-MONTH + 12 //* WMS-YEAR = &INP-YEAR - 1 //* ELSE //* WMS-MONTH = &INP-MONTH //* WMS-YEAR = &INP-YEAR //* END-IF //* WMS-T1 = 6 * (WMS-MONTH + 1 ) / 10 //* WMS-T4 = WMS-YEAR / 4 //* WMS-T100 = WMS-YEAR / 100 //* WMS-T400 = WMS-YEAR / 400 //* WMS-SUM = &INP-DAY + 2 * WMS-MONTH + WMS-YEAR - //* + WMS-T1 + WMS-T4 - WMS-T100 + WMS-T400 + WMS-CSYS //* WMS-WORK = WMS-SUM / 7 //* &OUP-DOW = WMS-SUM - 7 * WMS-WORK + 1 //* //SYSIN DD * INREC IFTHEN=(WHEN=(ZLMM,LT,3), OVERLAY=(1:ZLYY,SUB,+1,EDIT=(TTTT), 6:ZLMM,ADD,+12,EDIT=(TT))) OUTFIL REMOVECC,FNAMES=SORTOUT,OUTREC=(C' ',1,10, X,C'T1=',((ZLMM,ADD,+1),MUL,+6),DIV,+10, X,C'T4=',ZLYY,DIV,+4,EDIT=(TTTT), X,C'T100=',ZLYY,DIV,+100,EDIT=(TT), X,C'T400=',ZLYY,DIV,+400,EDIT=(TT), X,C'DOW=', * (((ZLMM,MUL,+2),ADD,ZLYY,ADD,ZLDD, ADD,(((ZLMM,ADD,+1),MUL,+6),DIV,+10), ADD,(ZLYY,DIV,+4), SUB,(ZLYY,DIV,+100), ADD,(ZLYY,DIV,+400), ADD,+1), SUB, (((ZLMM,MUL,+2),ADD,ZLYY,ADD,ZLDD, ADD,(((ZLMM,ADD,+1),MUL,+6),DIV,+10), ADD,(ZLYY,DIV,+4), SUB,(ZLYY,DIV,+100), ADD,(ZLYY,DIV,+400), ADD,+1), DIV,+7),MUL,+7), ADD,+1, * 80:X) SORT FIELDS=COPY // direct computation of gregorian to julian (NOT JYYDDD) and back //SAS EXEC SAS9 //SYSIN DD * * 0 IS 1/1/1960; DATA _NULL_; DT=MDY(6,27,2007); PUT DT= DT= DATE9.; Y=YEAR(DT); M=MONTH(DT); D=DAY(DT); A=INT((M - 14) / 12); JD = INT ( ( 1461 * ( Y + 4800 + A ) ) / 4 ) + INT ( ( 367 * ( M - 2 - 12 * ( A ) ) ) / 12 ) - INT ( ( 3 * INT( ( Y + 4900 + A ) / 100 ) ) / 4 ) + D - 32075; PUT JD=; L = JD + 68569; N = INT ( ( 4 * L ) / 146097 ); L = L - INT ( ( 146097 * N + 3 ) / 4 ); I = INT ( ( 4000 * ( L + 1 ) ) / 1461001 ); L = L - INT ( ( 1461 * I ) / 4 ) + 31; J = INT ( ( 80 * L ) / 2447 ); D = L - INT ( ( 2447 * J ) / 80 ); L = INT ( J / 11 ); M = J + 2 - ( 12 * L ); Y = 100 * ( N - 49 ) + I + L; PUT Y= M= D=; // * SOURCE: HTTP://BCN.BOULDER.CO.US/Y2K/Y2KBCALC.HTM * LD = JD - 2299160 * SASDATE USES 1/1/1960 = 0 * GREGORIAN TO JULIAN JD = ( 1461 * ( Y + 4800 + ( M - 14 ) / 12 ) ) / 4 + ( 367 * ( M - 2 - 12 * ( ( M - 14 ) / 12 ) ) ) / 12 - ( 3 * ( ( Y + 4900 + ( M - 14 ) / 12 ) / 100 ) ) / 4 + D - 32075 * JULIAN TO GREGORIAN L = JD + 68569 N = ( 4 * L ) / 146097 L = L - ( 146097 * N + 3 ) / 4 I = ( 4000 * ( L + 1 ) ) / 1461001 L = L - ( 1461 * I ) / 4 + 31 J = ( 80 * L ) / 2447 D = L - ( 2447 * J ) / 80 L = J / 11 M = J + 2 - ( 12 * L ) Y = 100 * ( N - 49 ) + I + L SAME AS ABOVE BUT FOR SORT! //STP010 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SYMNAMES DD * ZLYY,1,4,ZD ZLMM,6,2,ZD ZLDD,9,2,ZD //SORTIN DD * 2007-06-27 2454279 2007-06-28 2004-02-28 2004-02-29 2004-03-01 //SORTOUT DD SYSOUT=* //* INT ( ( 3 * INT( ( Y + 4900 + A ) / 100 ) ) / 4 ) + //* D - 32075; //SYSIN DD * OUTFIL FNAMES=SORTOUT,OUTREC=(1,10, * JD = ( 1461 * ( Y + 4800 + ( M - 14 ) / 12 ) ) / 4 (+1461,MUL,(ZLYY,ADD,+4800,ADD,(ZLMM,SUB,+14),DIV,+12)),DIV,+4, ADD, * + ( 367 * ( M - 2 - 12 * ( ( M - 14 ) / 12 ) ) ) / 12 (+367,MUL,(ZLMM,SUB,+2,SUB,(+12,MUL,((ZLMM,SUB,+14),DIV,+12))), DIV,+12), SUB, * - ( 3 * ( ( Y + 4900 + ( M - 14 ) / 12 ) / 100 ) ) / 4 (+3,MUL,((ZLYY,ADD,+4900,ADD,((ZLMM,SUB,+14),DIV,+12)),DIV,+100), DIV,+4), * + D - 32075 ADD,ZLDD, SUB,+32075) SORT FIELDS=COPY //* //STP020 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTIN DD * 2454279 2454280 2453064 2453065 2453066 //SORTOUT DD SYSOUT=* //SYSIN DD * INREC OVERLAY=(1,7,ZD, * CREATE WORK VARIABLES AS NEEDED START @9 AND EVERY 9, PIC 9(8) EACH * L = JD + 68569; 009:1,7,ZD,ADD,+68569,EDIT=(TTTTTTTT), * N = INT ( ( 4 * L ) / 146097 ); 018:+4,MUL,9,8,ZD,DIV,+146097,EDIT=(TTTTTTTT), * L = L - INT ( ( 146097 * N + 3 ) / 4 ); 009:9,8,ZD,SUB,((18,8,ZD,MUL,+146097,ADD,+3),DIV,+4),EDIT=(TTTTTTTT), * I = INT ( ( 4000 * ( L + 1 ) ) / 1461001 ); 027:+4000,MUL,(9,8,ZD,ADD,+1),DIV,+1461001,EDIT=(TTTTTTTT), * L = L - INT ( ( 1461 * I ) / 4 ) + 31 009:9,8,ZD,SUB,((27,8,ZD,MUL,+1461),DIV,+4),ADD,+31,EDIT=(TTTTTTTT), * J = INT ( ( 80 * L ) / 2447 ); 036:9,8,ZD,MUL,+80,DIV,+2447,EDIT=(TTTTTTTT), * D = L - INT ( ( 2447 * J ) / 80 ); 045:9,8,ZD,SUB,((+2447,MUL,36,8,ZD),DIV,+80),EDIT=(TTTTTTTT), * L = INT ( J / 11 ); 009:36,8,ZD,DIV,+11,EDIT=(TTTTTTTT), * M = J + 2 - ( 12 * L ); 054:36,8,ZD,ADD,+2,SUB,(9,8,ZD,MUL,+12),EDIT=(TTTTTTTT), * Y = 100 * ( N - 49 ) + I + L; 063:((18,8,ZD,SUB,+49),MUL,+100),ADD,27,8,ZD,ADD,9,8,ZD, EDIT=(TTTTTTTT)) SORT FIELDS=COPY OUTFIL FNAMES=SORTOUT,OUTREC=(1,7,X, 63,8,ZD,EDIT=(TTTT),C'-', 54,8,ZD,EDIT=(TT),C'-', 45,8,ZD,EDIT=(TT)) // EZPIVOT * * TRANSLATE KEY TO INDEX * * SIZE OF DESC MUST MATCH DEST OF SEARCH (WATCH OUT FOR OVERFLOW) FILE TRXTBL TABLE INSTREAM ARG 1 6 A DESC 8 2 N 200601 01 200602 02 200603 03 200604 04 200605 05 200606 06 200607 07 200608 08 200609 09 200610 10 200611 11 200612 12 ENDTABLE * THE VALUE BELOW MUST MATCH OCCURS COUNT OF ELEMENT ABOVE DEFINE WS-ARG W 6 A FILE INPFILE INP-ARG 1 6 A INP-KEY1 1 4 A INP-IDX 5 2 N INP-KEY2 8 30 A INP-SUMVARX 38 11 A INP-SUMVAR INP-SUMVARX 11 N FILE OUPFILE FB (180 0) OUP-KEY1 1 4 A OUP-KEY2 * 30 A OUP-ARRAY * 144 A OUP-SUMVARX OUP-ARRAY 12 A OCCURS 12 FILLER OUP-SUMVARX 1 A OUP-SUMVAR OUP-SUMVARX +1 11 N * ZERO ELEMENT ZRO-SUMVARX W 12 A FILLER ZRO-SUMVARX 1 A VALUE ' ' ZRO-SUMVAR ZRO-SUMVARX +1 11 N VALUE 0 * THE VALUE BELOW MUST MATCH OCCURS COUNT OF ELEMENT ABOVE DEFINE ARRAY-CNT W 4 N VALUE 12 * SIZE OF TBL DESC MUST MATCH DEST OF SEARCH (WATCH OUT FOR OVERFLOW) DEFINE IDXCTR W 2 N VALUE 0 * JOB INPUT (INPFILE KEY (INP-KEY2 INP-KEY1 )) START RESET-VAR * PERFORM GET-NEXT-INPFILE IF LAST-DUP INPFILE OR NOT DUPLICATE INPFILE PERFORM WRITE-FINAL END-IF * GET-NEXT-INPFILE. PROC ** -- SET INDEX (FROM RECORD) * IDXCTR = INP-IDX * OUP-SUMVAR (IDXCTR) = INP-SUMVAR * -- SET INDEX (BY TRANSLATING FIELD VIA TRXTBL) MOVE INP-ARG TO WS-ARG SEARCH TRXTBL WITH WS-ARG GIVING IDXCTR IF TRXTBL OUP-SUMVAR (IDXCTR) = INP-SUMVAR END-IF END-PROC * WRITE-FINAL. PROC MOVE INP-KEY1 TO OUP-KEY1 MOVE INP-KEY2 TO OUP-KEY2 PUT OUPFILE PERFORM RESET-VAR END-PROC * RESET-VAR. PROC IDXCTR = 1 DO UNTIL IDXCTR GT ARRAY-CNT OUP-SUMVARX (IDXCTR) = ZRO-SUMVARX IDXCTR = IDXCTR + 1 END-DO END-PROC // OTHER SORT GOODIES //SYSIN DD * OPTION COPY OUTFIL OUTREC=(C' DELETE ', 21,60,SQZ=(SHIFT=LEFT,LEAD=C'''',TRAIL=C''''),80:X),CONVERT //* //* RIGHT JUSTIFY OUTFIL OUTREC=(1,17,JFY=(SHIFT=RIGHT),... //* //SORTIN DD * DATE=20070401,FILE=PRUPB.RE.ABC.DATA FILE=PRUPB.RE.ABC.DATX,DATE=20070402 DATE=20070501 FILE=PRUPB.RE.ABC.DATC //SYSIN DD * SORT FIELDS=COPY OUTREC PARSE=(%01=(STARTAFT=C'DATE=',ENDBEFR=C',',FIXLEN=10), %02=(STARTAFT=C'FILE=',ENDBEFR=C',',FIXLEN=30)), BUILD=(%01,12:%02) //** IFTHEN AND ARITHMETIC //SORT EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTIN DD * 200711 //SORTOUT DD SYSOUT=* //SYSIN DD * * INCREMENT YYYYMM ON OUTREC OUTFIL FNAMES=SORTOUT, IFTHEN=(WHEN=(5,2,ZD,EQ,12), BUILD=(5,2,/,1,4,ZD,ADD,+1,EDIT=(TTTT),C'01')), IFTHEN=(WHEN=NONE, BUILD=(5,2,/,1,4,5,2,ZD,ADD,+1,EDIT=(TT))) SORT FIELDS=COPY // ===> BUILD=(1,4,5,2,ZD,ADD,+1,EDIT=(TT))) SORT FIELDS=COPY // OUTFIL FNAMES=SORTOUT,INCLUDE=(5,2,ZD,EQ,12), PARSE=(%00=(ABSPOS=1,FIXLEN=4), %01=(ABSPOS=5,FIXLEN=2)), BUILD=(1:%00,6:%01) //* CLPUTPRM - convert parm to string // SET CURRMM=200601 // JCLLIB ORDER=(PRUPB.AD.JCLLIB) // INCLUDE MEMBER=CLPUTPRM //GO EXEC PGM=PUTPARM, // PARM='CURRMM,C''&CURRMM''' //STEPLIB DD DISP=SHR,DSN=&LOD //PARM DD DSN=&&CARDS,RECFM=FB,LRECL=80,BLKSIZE=0,DISP=(,PASS) //* //*============================================================ //* DELETE EVERYTHING BELOW // // SEE ASMHCL ALSO PRUPB.R0101.APT.JCL(P846658A) // //* THIS IS AD.JCLLIB(CLPUTPRM) // //* THIS WILL CREATE &LOD(X) - CONVERTS PARM TO DATA IN DD PARM //* //* // JCLLIB ORDER=(... PRUPB.AD.JCLLIB ...) //* // SET CURRMM=200701 //* // INCLUDE MEMBER=CLPUTPRM //* //GO EXEC PGM=PUTPARM, //* // PARM=' LISTC ENT(''PRUPB.RE.PB.HHINFO.D&CURRMM'')' //* //STEPLIB DD DISP=SHR,DSN=&LOD //* //PARM DD DSN=&&CARDS,RECFM=FB,LRECL=80,BLKSIZE=0,DISP=(,PASS) //* //LC EXEC PGM=IDCAMS //* //SYSPRINT DD=SYSOUT=* //* //SYSIN DD DISP=(OLD,DELETE,DELETE),DSN=&&CARDS //* // EXEC ASMHCL //C.SYSLIB DD // DD DISP=SHR,DSN=SYS1.MACLIB //C.SYSIN DD DISP=SHR,DSN=PRUPB.AD.CTLLIB(CLPUTPRM) //L.SYSLMOD DD DSN=&LOD(PUTPARM) // //* THIS IS AD.CLLLIB(CLPUTPRM) // * From: Perry Winter (PWINTER@UNCMVS.OIT.UNC.EDU) * Subject: Re: Symbolic parameter substitution * Newsgroups: bit.listserv.ibm-main * Date: 1993-10-07 07:56:04 PST * * // EXEC ASMHCL,MEM=PUTPARM * //C.SYSIN DD * * PUTPARM CSECT SJK SAVE (14,12) STANDARD LINKAGE CONVENTION BASE12 LR 12,15 | USING PUTPARM,12 | LA 3,SAVAREA | ST 3,8(13) | ST 13,4(3) | LR 13,3 V START DS 0H * * THIS PGM WRITES 80 CHARACTER RECORDS BASED ON USER SUPPLIED PARM. * ALL SYMBOLICS USED IN PARM ARE EXPANDED BEFORE EXECUTION OF PGM. * THE SEMICOLON IS USED AS A RECORD SEPARATOR IN THE PARM THEREFORE * SEVERAL 80 CHARACTER RECORDS CAN BE GENERATED FROM ONE 100 CHAR * PARM FIELD. THE OUTPUT RECORDS ARE WRITTEN ON DDNAME PARM WHERE * THE LRECL IS ALWAYS 80 CHARACTERS. THE USER CAN SELECT ANY BLOCKING * FACTOR ON THE PARM DD CARD. THE OUTPUT FILE CAN BE CONCATENATED * BEFORE OR AFTER ANY 80 CHAR LRECL DATA FILE IN THE JOB STREAM. * $$$$$$$$$$$$$$$$$$$$ * WHEN NO PARM IS SUPPLIED PUTPARM WRITES AN EOF MARKER ON PARM DD * $$$$$$$$$$$$$$$$$$$$ * EXAMPLE #1 * * //PARMGEN EXEC PGM=PUTPARM,PARM='THIS IS A SIMPLE PARM' * //STEPLIB DD DSN=STARTEST.DEV.LOAD,DISP=SHR * //PARM DD DSN=&&TEMP,UNIT=DISK,DISP=(,PASS), * // DCB=(BLKSIZE=800,RECFM=FB) * * THE FOLLOWING 80 CHARACTER RECORD IS GENERATED BY PUTPARM * THE RECORD GENERATED IS DISPLAYED BETWEEN THE GRIDS:- * 0000+000010000+000020000+000030000+000040000+000050000+000060000+000 * THIS IS A SIMPLE PARM * 0000+000010000+000020000+000030000+000040000+000050000+000060000+000 * * EXAMPLE #2 * THE FOLLOWING JCL ILLUSTRATES USE OF PUTPARM USING THE SEMICOLON * IN THE PARM TO CAUSE SEVERAL RECORDS TO BE WRITTEN BUY ONE PARM * * //MYPROC PROC A=1709,B=1338 * //PARMGEN EXEC PGM=PUTPARM,PARM='ABC $22.95;DEF;;01234;;&A,&B' * //STEPLIB DD DSN=STARTEST.DEV.LOAD,DISP=SHR * //PARM DD DSN=&&TEMP,UNIT=DISK,DISP=(,PASS), * // DCB=(BLKSIZE=800,RECFM=FB) * * THE FOLLOWING 80 CHARACTER RECORDS ARE GENERATED BY PUTPARM * ALL SIX RECORDS GENERATED ARE DISPLAYED BETWEEN THE GRIDS:- * 0000+000010000+000020000+000030000+000040000+000050000+000060000+000 * ABC $22.95 * DEF * * 01234 * * 1709,1338 * 0000+000010000+000020000+000030000+000040000+000050000+000060000+000 * * SEMICOLONS IN THE PARM FORCE RECORDS TO BE WRITTEN AT THAT POINT. * ALL RECORDS WRITTEN ARE ALWAYS PADDED WITH BLANKS WHEN LESS THAN * 80 NON-BLANK CHARACTERS APPEAR BETWEEN THE SEMICOLONS. * SEMICOLONS WITHOUT INTERVENING DATA FORCE WRITING OF BLANK RECORDS. * NOTE THAT RECORDS THREE AND FIVE ARE BLANK BECAUSE THE DOUBLE * SEMICOLON IN THE PARM FORCED THE BLANK RECORD TO BE WRITTEN. * SYMBOLIC PARAMETERS &A AND &B ARE RESOLVED BY THE VALUES IN THE * PROC STATEMENT AND APPEAR IN THE LAST OF THE SIX RECORDS WRITTEN * BY PUTPARM. ALL OF THE SIX RECORDS CHOSEN BY THIS PARTICULAR * PARM HAVE THE AUTOMATIC BLANK PADDING AT THE END OF EACH RECORD. * PRINT ON,NOGEN L R2,0(R1) POINT R2 TO PARM LH R3,0(R2) GET PARM LEN IN R3 LTR R3,R3 IS THE PARM LEN ZERO BZ NOPARM THEN OPEN/CLOSE AND RETURN WTO 'PUTPARM USER PARM FOLLOWS',ROUTCDE=(11) BCTR R3,0 MINUS ONE FROM PARM LEN FOR EXEC EX R3,MVC EXECUTE THE MOVE TO SAVE PARM MVC WTOPARM+8(100),SAVPARM SHOW USER HIS PARM WTOPARM WTO ' X ',ROUTCDE=(11) LA R3,1(R3) RESTORE ORIGINAL PARM LEN LA R4,SAVPARM POINT TO SAVED PARM LA R5,OUTPARM POINT TO OUTPUT PARM REC OPEN (PARM,OUTPUT) NEXTCHAR CLI 0(R4),X'5E' SEMICOLON IS THIS END OF REC BE NEWREC WRITE THIS RECORD MVC 0(1,R5),0(R4) NON END-OF-REC CHAR TO OUTPARMRM LA R4,1(R4) STEP TO NEXT PARM CHAR LA R5,1(R5) STEP TO NEXT OUTPARM CHAR BCT R3,NEXTCHAR MINUS ONE LEN TEST NEXT CHAR B EOJ PARM LEN IS ZERO WRITE LAST REC NEWREC PUT PARM,OUTPARM FOUND SEMI WRITE RECORD MVC OUTPARM(80),=CL80' ' CLR IT FOR NEXT RECORD LA R4,1(R4) STEP TO NEXT PARM CHAR LA R5,OUTPARM POINT TO BEGNNNG OF NEW OUTPARM BCT R3,NEXTCHAR TEST NEXT CHAR IF ANY B RETURN GO BACK - NO MORE CHARS EOJ PUT PARM,OUTPARM WRITE LAST 80 CHAR PARM REC RETURN CLOSE PARM CLOSE THE PARM FILE L R13,SAVAREA+4 RETURN (14,12),RC=0 OUTPARM DC CL80' ' NOPARM OPEN (PARM,OUTPUT) WTO 'NO PARM SUPPLIED - EOF WRITTEN ON PARM DD',ROUTCDE=11 B RETURN PARM DCB DDNAME=PARM,DSORG=PS,MACRF=(PM),LRECL=80 MVC MVC SAVPARM(1),2(R2) EXECUTED MOVE SAVPARM DC CL100' ' SAVED USER PARM SAVAREA DS 18F REG SAVE AREA YREGS SJK END PUTPARM CSV TO MAIL // INCLUDE MEMBER=CLPUTPRM //GO EXEC PGM=PUTPARM, // PARM='CURRDT,C''&CURRDT'';OPRNUM,C''&OPRNUM'';SK,C'',''' //STEPLIB DD DISP=SHR,DSN=&LOD //PARM DD DSN=&&CARDS,RECFM=FB,LRECL=80,BLKSIZE=0,DISP=(,PASS) //* //* //DEL030 EXEC PGM=IKJEFT01, // PARM=' DEL ''PRUPB.AD.P&OPRNUM..CSV''' <== CSV //SYSTSIN DD DUMMY //SYSTSPRT DD SYSOUT=* //* //STP030 EXEC PGM=SORT //SYMNAMES DD DISP=SHR,DSN=&&CARDS //SYSOUT DD SYSOUT=* //SORTIN DD DSN=&INFILE, // DISP=SHR //SORTOUT DD DSN=PRUPB.AD.P&OPRNUM..CSV, // UNIT=SYSDA,SPACE=(TRK,(1,1),RLSE), // DISP=(,CATLG,DELETE) //SYSIN DD * OUTFIL REMOVECC,FNAMES=SORTOUT, HEADER1=('AU',SK,'STORE',SK,'TRANDATE',SK,'TR',SK,'TRANTYP', SK,'COUNT', 80:X), OUTREC=(1,5,SK,6,25,SK,35,2,C'-',37,2,C'-',31,4, SK,39,2,SK,41,4,SK,45,7, 80:X) SORT FIELDS=COPY //GENSUB EXEC PGM=SORT //SYMNAMES DD DISP=SHR,DSN=&&CARDS //SYSOUT DD SYSOUT=* //SORTIN DD DISP=SHR,DSN=PRUPB.AD.CTLLIB(DUMMY) //SORTOF1 DD DSN=&&SUBJLINE, // UNIT=SYSDA,SPACE=(TRK,(1,1),RLSE), // DISP=(,PASS,DELETE) //SORTOF2 DD DSN=&&CSVNAME, // UNIT=SYSDA,SPACE=(TRK,(1,1),RLSE), // DISP=(,PASS,DELETE) //SYSIN DD * SORT FIELDS=COPY OUTFIL FILES=1, OUTREC=(C'SUBJECT: EXTRACT P',OPRNUM, C' RUNDATE T',CURRDT, C'.CSV',80:X) OUTFIL FILES=2, OUTREC=(C'CONTENT-DISPOSITION: ATTACHMENT; ', C'FILENAME="T',CURRDT, C'.CSV"', 80:X,/,C' ') .* BLANK LINE - NECESSARY //* //SMTP EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTOUT DD SYSOUT=(C,SMTP44) //SYSIN DD DSN=SYSPL.CTLLIB(PB#COPYS),DISP=SHR //SORTIN DD * HELO SMTP.XXX.COM MAIL FROM: RCPT TO: DATA TO: FROM: // DD DISP=(OLD,DELETE),DSN=&&SUBJLINE // DD * MIME-VERSION: 1.0 CONTENT-TYPE: MULTIPART/MIXED; BOUNDARY=NEXTBITSTRING_8765R443 --NEXTBITSTRING_8765R443 CONTENT-TYPE: TEXT/PLAIN PLEASE REMEMBER TO SAVE THIS CSV FILE AS XLS WHEN YOU ARE DONE. THIS EMAIL WAS AUTOMATICALLY SENT BY MAINFRAME JOB PRUPB.R0101.JCL(P422849U). --NEXTBITSTRING_8765R443 CONTENT-TYPE: APPLICATION/EXCEL; CHARSET="US-ASCII" // DD DISP=(OLD,DELETE),DSN=&&CSVNAME // DD DISP=SHR,DSN=PRUPB.AD.P&OPRNUM..CSV // DD * --NEXTBITSTRING_8765R443-- // //STP030 EXEC PGM=SORT //SYSOUT DD SYSOUT=* //SORTIN DD DISP=SHR,DSN=PRDPB.PROD.TABLES(QTRANMAP) //SORTOUT DD DSN=&&OTCSEL, // UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE), // DISP=(,PASS,DELETE) //SYSIN DD * INCLUDE COND=(65,1,CH,EQ,C'Y') SORT FIELDS=COPY OUTFIL FNAMES=SORTOUT, OUTREC=(C' C''',1,4,C''',C''Y'',',80:X) //* //DEL105 EXEC PGM=IKJEFT01, // PARM=' DEL ''PRUPB.AD.P1664645.SORTCTL.TPOCX''' //SYSTSIN DD DUMMY //SYSTSPRT DD SYSOUT=* //* //STP105 EXEC PGM=SORT BUILD SORTCTL //SYSOUT DD SYSOUT=* //SYSIN DD * SORT FIELDS=COPY //SORTIN DD * INCLUDE COND=(46,8,CH,GE,BEGDT,AND,46,8,CH,LT,NXTDT, AND,108,1,CH,EQ,C'Y') * (155,4,CH,EQ,C'0902',OR,114,2,CH,NE,C'AD')) T902 OR NON-AD * * -- T=0902 INREC IFTHEN=(WHEN=(155,4,CH,EQ,C'0902'), * ADD 0 TO #OTC ADD 1 TO #902 BUILD=(84,5,99,8,BEGDT,46,8,X'000000000C',X'000000001C', * 62,6,68,6, BEGTIME,ENDTIME * * -- ELAPSED SECONDS = (STOP TIME) - (START TIME) * -- SECONDS = (3600*EHH+60*EMM+ESS) - (3600*BHH+60*BMM+BSS) (68,2,ZD,MUL,+3600,ADD,(70,2,ZD,MUL,+60),ADD,72,2,ZD),SUB, (62,2,ZD,MUL,+3600,ADD,(64,2,ZD,MUL,+60),ADD,66,2,ZD), TO=PD,LENGTH=5, C'Y')), .* SELECT FOR REPORT * * -- ALL OTHER TRANSACTIONS (OTC'S ARE MARKED Y FOR SELECTION) IFTHEN=(WHEN=NONE, * ADD 1 TO #OTC ADD 0 TO #902 BUILD=(84,5,99,8,BEGDT,46,8,X'000000001C',X'000000000C', * MOVE 0 TO ELAPSED X'000000000C', * * -- CONVERT TXN TO SELECTOR 155,4,CHANGE=(1, // DD DISP=SHR,DSN=&&OTCSEL // DD * C'9999',C'N'), NOMATCH=(C'N'))) (N=NON OTC. SKIP LATER) * SORT FIELDS=(1,5,CH,A,6,8,CH,A,14,8,CH,A, GLAU,TELLERID,BEGDT 22,8,CH,A, TRANDATE 45,1,CH,A) SELECTOR SUM FIELDS=(30,5,PD,35,5,PD,40,5,PD) * OUTFIL FNAMES=SORTOUT, INCLUDE=(45,1,CH,EQ,C'Y'), INCLUDE SELECTED ONLY OUTREC=(1,5,6,8, GLAU,TELLERID 14,8,22,8, BEGDT,TRANDATE 30,5,35,5, #-OTC,#-902 40,5, TOTAL SECONDS * * -- COMPUTE AVG CSTIME = SECONDS / #-902 / 60 40,5,PD,MUL,+100,DIV,35,5,PD,DIV,+60,TO=PD,LENGTH=5) //SORTOUT DD DSN=PRUPB.AD.P1664645.SORTCTL.TPOCX, // UNIT=SYSDA,SPACE=(TRK,(1,1),RLSE), // RECFM=FB,LRECL=80,BLKSIZE=0, // DISP=(,CATLG,DELETE) //*