000010* C:\tutorials\TstSQL\cbl\RPT1.CBL 000020 IDENTIFICATION DIVISION. RPT1 000030 PROGRAM-ID. RPT1. RPT1 000040 AUTHOR. JAZZUSR (Using Jazz from Visual Studio) RPT1 000050 DATE-WRITTEN. 24/11/2021 6:35:12 AM RPT1 000060 ENVIRONMENT DIVISION. RPT1 000070*# Last Updated by JAZZUSR at 24/11/2021 6:35:12 AM RPT1 000080*PROGRAM RPT1 BATCH; RPT1 000090** You may need to edit these statements RPT1 000100*COPY PERSNL; RPT1 000110*PROCESS PERSNL WHERE PERSNL.GROSS >= 500 RPT1 000120* ORDER(PERSNL.DEPT BREAK, PERSNL.GROSS DESC); RPT1 000130* COPY JZSMth; RPT1 000140* PRINT (PERSNL.EMPNAME,PERSNL.DEPT,PERSNL.GROSS SUM) ; RPT1 000150*END PROCESS PERSNL; RPT1 000160******************************************************************RPT1 000170** **RPT1 000180** INPUT-OUTPUT Section/File-Control **RPT1 000190** **RPT1 000200******************************************************************RPT1 000210 INPUT-OUTPUT Section. RPT1 000220 FILE-CONTROL. RPT1 000230 SELECT PERSNL ASSIGN TO PERSNL RPT1 000240 FILE STATUS IS PERSNL-STATUS. RPT1 000250 SELECT SORTWORK ASSIGN TO SORTWK01. RPT1 000260 SELECT RepNbr1 ASSIGN TO RepNbr1 RPT1 000270 FILE STATUS IS RepNbr1-STATUS. RPT1 000280******************************************************************RPT1 000290** **RPT1 000300** Data Division **RPT1 000310** **RPT1 000320******************************************************************RPT1 000330 DATA DIVISION. RPT1 000340******************************************************************RPT1 000350** **RPT1 000360** File Section. **RPT1 000370** **RPT1 000380******************************************************************RPT1 000390 File SECTION. RPT1 000400******************************************************************RPT1 000410** **RPT1 000420** PERSNL **RPT1 000430** **RPT1 000440******************************************************************RPT1 000450 FD PERSNL RPT1 000460 RECORDING MODE F. RPT1 000470* RPT1 000480 01 JZ-PERSNL. RPT1 000490 03 FILLER PIC X(8). RPT1 000500 03 EMPNbr PIC 99999. RPT1 000510 03 FILLER PIC XXX. RPT1 000520 03 EMPNAME PIC X(8). RPT1 000530 03 FILLER PIC X(69). RPT1 000540 03 GROSS PIC S9(5)V9(2) COMP-3. RPT1 000550 03 DEPT PIC 999. RPT1 000560 03 FILLER PIC X(50). RPT1 000570******************************************************************RPT1 000580** **RPT1 000590** SORTWORK **RPT1 000600** **RPT1 000610******************************************************************RPT1 000620* RPT1 000630 SD SORTWORK. RPT1 000640* RPT1 000650 01 JZ-SORTWORK. RPT1 000660 03 EMPNAME PIC X(8). RPT1 000670 03 GROSS PIC S9(5)V9(2) COMP-3. RPT1 000680 03 DEPT PIC 999. RPT1 000690******************************************************************RPT1 000700** **RPT1 000710** RepNbr1 **RPT1 000720** **RPT1 000730******************************************************************RPT1 000740 FD RepNbr1 RPT1 000750 RECORDING MODE F. RPT1 000760* RPT1 000770 01 JZ-RepNbr1 PIC X(132). RPT1 000780******************************************************************RPT1 000790** **RPT1 000800** Working Storage Section: General Program Data **RPT1 000810** **RPT1 000820******************************************************************RPT1 000830* RPT1 000840 WORKING-STORAGE SECTION. RPT1 000850******************************************************************RPT1 000860** **RPT1 000870** General Program Information **RPT1 000880** **RPT1 000890******************************************************************RPT1 000900* RPT1 000910* Status Flags and control data RPT1 000920 01 JZ-FileControl. RPT1 000930 03 SORTWORK-ENDFILE PIC X VALUE 'N'. RPT1 000940 03 PERSNL-ENDFILE PIC X VALUE 'N'. RPT1 000950 03 PERSNL-STATUS PIC XX VALUE '00'. RPT1 000960 03 RepNbr1-STATUS PIC XX VALUE '00'. RPT1 000970 03 RepNbr1-PageNbr PIC 99999 COMP-3 VALUE 0. RPT1 000980 03 RepNbr1-LineCount PIC 9999 COMP VALUE 1000. RPT1 000990 03 RepNbr1-Space PIC 9999 COMP VALUE 1. RPT1 001000* RPT1 001010 01 JZ-TODAY. RPT1 001020 05 JZ-DATETIMEGMT. RPT1 001030 10 JZ-DATETIME PIC 9(16). RPT1 001040 10 JZ-GMTDIFF PIC S9(4). RPT1 001050 05 JZ-DATETIME-1 REDEFINES JZ-DATETIMEGMT. RPT1 001060 10 JZ-DATE PIC 9(8). RPT1 001070 10 JZ-TIME PIC 9(8). RPT1 001080 10 FILLER PIC S9(4). RPT1 001090 05 JZ-DATETIME-2 REDEFINES JZ-DATETIMEGMT. RPT1 001100 10 JZ-YEAR PIC 9(4). RPT1 001110 10 JZ-MONTH PIC 9(2). RPT1 001120 10 JZ-DAY PIC 9(2). RPT1 001130 10 JZ-HOUR PIC 9(2). RPT1 001140 10 JZ-MINUTE PIC 9(2). RPT1 001150 10 JZ-SECOND PIC 9(2). RPT1 001160 10 JZ-MS PIC 9(2). RPT1 001170 10 FILLER PIC S9(4). RPT1 001180 05 JZ-DATETIME-3 REDEFINES JZ-DATETIMEGMT. RPT1 001190 10 FILLER PIC 9(12). RPT1 001200 10 JZ-SECONDS PIC 99V99. RPT1 001210 10 FILLER PIC S9(4). RPT1 001220* Report Time Stamp RPT1 001230* RPT1 001240 01 JZ-ReportTS. RPT1 001250 10 JZ-DAY PIC 9(2). RPT1 001260 10 FILLER PIC X VALUE SPACE. RPT1 001270 10 JZ-MONTH-NAME PIC X(3). RPT1 001280 10 FILLER PIC X VALUE SPACE. RPT1 001290 10 JZ-YEAR PIC 9(4). RPT1 001300 10 JZ-COMMA PIC XX VALUE ', '. RPT1 001310 10 JZ-HOUR PIC 9(2). RPT1 001320 10 JZ-SEPCHAR1 PIC X VALUE ':'. RPT1 001330 10 JZ-MINUTE PIC 9(2). RPT1 001340 10 JZ-SEPCHAR2 PIC X VALUE ':'. RPT1 001350 10 JZ-SECOND PIC 9(2). RPT1 001360* RPT1 001370 01 JZ-ReportTimeStamp REDEFINES JZ-ReportTS PIC X(21). RPT1 001380* RPT1 001390 LOCAL-STORAGE SECTION. RPT1 001400******************************************************************RPT1 001410** **RPT1 001420** RepNbr1 Print Lines **RPT1 001430** **RPT1 001440******************************************************************RPT1 001450* RPT1 001460* Save line while headings are printed RPT1 001470 01 JZ-RepNbr1-Save PIC X(132). RPT1 001480* RPT1 001490* Page Header and footer RPT1 001500 01 JZ-RepNbr1-Heading. RPT1 001510 03 Filler PIC X(11) Value 'Printed at '. RPT1 001520 03 DateTime PIC X(21). RPT1 001530 03 Filler PIC X(1) VALUE SPACES. RPT1 001540 03 Filler PIC X(7) VALUE 'RepNbr1'. RPT1 001550 03 Filler PIC X(1) VALUE SPACES. RPT1 001560 03 Filler PIC XXXX VALUE 'Page'. RPT1 001570 03 PageNbr PIC ZZZ9. RPT1 001580* RPT1 001590* Column Headings RPT1 001600 01 RepNbr1-L1-H. RPT1 001610 03 FILLER PIC X(132) VALUE '*EMPNAME DEPT *-----GROSS-----* RPT1 001620- ' RPT1 001630- ' '. RPT1 001640* RPT1 001650* Data line RPT1 001660 01 RepNbr1-L1-D. RPT1 001670 03 EMPNAME PIC X(8). RPT1 001680 03 FILLER PIC X(1) VALUE SPACES. RPT1 001690 03 FILLER PIC X(1) VALUE SPACE. RPT1 001700 03 DEPT PIC 999. RPT1 001710 03 FILLER PIC X(1) VALUE SPACES. RPT1 001720 03 GROSS PIC $$$$,$$$,$$9.99CR. RPT1 001730 03 FILLER PIC X(100) VALUE SPACES. RPT1 001740* RPT1 001750* Print line for Totals RPT1 001760 01 RepNbr1-L1-T. RPT1 001770 03 FILLER PIC X(9) VALUE SPACES. RPT1 001780 03 FILLER PIC X(1) VALUE SPACE. RPT1 001790 03 DEPT PIC 999. RPT1 001800 03 FILLER PIC X(1) VALUE SPACES. RPT1 001810 03 GROSS PIC $$$$,$$$,$$9.99CR. RPT1 001820 03 DESCRIPTION PIC X(14) VALUE SPACES. RPT1 001830******************************************************************RPT1 001840** **RPT1 001850** JZ - Jazz Sundry fields **RPT1 001860** **RPT1 001870******************************************************************RPT1 001880* RPT1 001890 01 JZ. RPT1 001900 03 JZ-AL PIC S9(4) COMP VALUE ZERO. RPT1 001910 03 JZ-ALIM PIC S9(4) COMP VALUE ZERO. RPT1 001920 03 JZ-NOFML PIC S9(4) COMP VALUE ZERO. RPT1 001930 03 JZ-INDEX PIC S9(4) COMP VALUE ZERO. RPT1 001940 03 JZ-INDEX2 PIC S9(4) COMP VALUE ZERO. RPT1 001950 03 JZ-IXMth PIC S9(4) COMP VALUE ZERO. RPT1 001960 03 IX1 PIC S9(4) COMP VALUE ZERO. RPT1 001970 03 IX2 PIC S9(4) COMP VALUE ZERO. RPT1 001980 03 IX3 PIC S9(4) COMP VALUE ZERO. RPT1 001990 03 IX4 PIC S9(4) COMP VALUE ZERO. RPT1 002000 03 IX5 PIC S9(4) COMP VALUE ZERO. RPT1 002010 03 IX6 PIC S9(4) COMP VALUE ZERO. RPT1 002020 03 IX7 PIC S9(4) COMP VALUE ZERO. RPT1 002030 03 JZ-ST PIC S9(4) COMP VALUE ZERO. RPT1 002040 03 JZ-SL PIC S9(4) COMP VALUE ZERO. RPT1 002050 03 JZ-BLANK PIC XXXX VALUE SPACES. RPT1 002060 03 JZ-CHAR80 PIC X(80) VALUE SPACES. RPT1 002070 03 JZ-FNAME PIC X(30) VALUE SPACES. RPT1 002080 03 JZ-KL PIC S9(4) COMP VALUE ZERO. RPT1 002090 03 JZ-MLTH PIC S9(4) COMP VALUE ZERO. RPT1 002100 03 JZ-INT PIC S9(9) COMP VALUE ZERO. RPT1 002110 03 JZ-TRUEFALSE PIC XXXXX VALUE SPACES. RPT1 002120 03 JZ-TinyNbr PIC S9(9) COMP VALUE ZERO. RPT1 002130 03 JZ-TinyGr REDEFINES JZ-TinyNbr. RPT1 002140 05 FILLER PIC XXX. RPT1 002150 05 JZ-Tiny PIC X. RPT1 002160 03 JZ-Error PIC X VALUE 'N'. RPT1 002170 03 JZ-NBR1 PIC 9999 VALUE ZERO. RPT1 002180 03 JZ-NBR1X REDEFINES JZ-NBR1 PIC XXXX. RPT1 002190 03 JZ-NBR2 PIC 9999 VALUE ZERO. RPT1 002200 03 JZ-NBR2X REDEFINES JZ-NBR2 PIC XXXX. RPT1 002210 03 JZ-SUBVAL PIC ZZZZZ9 VALUE ZERO. RPT1 002220 03 JZ-SUBVALR REDEFINES JZ-SUBVAL PIC X(6). RPT1 002230 03 JZ-SUBDIGIT PIC S9(4) COMP VALUE ZERO. RPT1 002240 03 JZ-INDEXES OCCURS 7 INDEXED BY JZIX1 PIC X(6) VALUE RPT1 002250 SPACES. RPT1 002260 03 JZ-INDEXPR PIC X(6) VALUE SPACES. RPT1 002270******************************************************************RPT1 002280** **RPT1 002290** PERSNL-WS **RPT1 002300** **RPT1 002310******************************************************************RPT1 002320* RPT1 002330 01 PERSNL-WS. RPT1 002340 03 DEDUCTIONS PIC S9(5)V9(2) COMP-3 VALUE ZERO. RPT1 002350 03 NET-PAY PIC S9(5)V9(2) COMP-3 VALUE ZERO. RPT1 002360******************************************************************RPT1 002370** **RPT1 002380** Break **RPT1 002390** **RPT1 002400******************************************************************RPT1 002410* RPT1 002420 01 Break. RPT1 002430 03 Level PIC S9(4) COMP VALUE ZERO. RPT1 002440 03 Sub PIC S9(4) COMP VALUE ZERO. RPT1 002450 03 Rec-Count PIC S9(4) COMP VALUE ZERO. RPT1 002460 03 DEPT PIC 999 VALUE ZERO. RPT1 002470******************************************************************RPT1 002480** **RPT1 002490** JZSMth **RPT1 002500** **RPT1 002510******************************************************************RPT1 002520* RPT1 002530 01 JZSMth. RPT1 002540 03 SMth PIC S9(4) COMP VALUE ZERO. RPT1 002550******************************************************************RPT1 002560** **RPT1 002570** RepNbr1-CBD **RPT1 002580** **RPT1 002590******************************************************************RPT1 002600* RPT1 002610 01 RepNbr1-CBD. RPT1 002620 03 Description1. RPT1 002630 05 DEPT PIC X(14) VALUE ' DEPT Subtotal'. RPT1 002640 05 JZGrandTotal PIC X(14) VALUE ' Grand Total'. RPT1 002650 03 Description2 REDEFINES Description1 OCCURS 2 INDEXED BY RPT1 002660 JZIX2. RPT1 002670 05 Descriptions PIC X(14). RPT1 002680******************************************************************RPT1 002690** **RPT1 002700** Sums **RPT1 002710** **RPT1 002720******************************************************************RPT1 002730* RPT1 002740 01 Sums. RPT1 002750 03 GROSS OCCURS 3 INDEXED BY JZIX3 PIC S9(9)V9(2) COMP-3 RPT1 002760 VALUE ZERO. RPT1 002770******************************************************************RPT1 002780** **RPT1 002790** Code Tables **RPT1 002800** **RPT1 002810******************************************************************RPT1 002820* RPT1 002830* JZSMth.SMth RPT1 002840 01 JZCodes-JZSMth-SMth. RPT1 002850 03 JZValues. RPT1 002860 05 FILLER PIC X(3) VALUE 'Jan'. RPT1 002870 05 FILLER PIC X(3) VALUE 'Feb'. RPT1 002880 05 FILLER PIC X(3) VALUE 'Mar'. RPT1 002890 05 FILLER PIC X(3) VALUE 'Apr'. RPT1 002900 05 FILLER PIC X(3) VALUE 'May'. RPT1 002910 05 FILLER PIC X(3) VALUE 'Jun'. RPT1 002920 05 FILLER PIC X(3) VALUE 'Jul'. RPT1 002930 05 FILLER PIC X(3) VALUE 'Aug'. RPT1 002940 05 FILLER PIC X(3) VALUE 'Sep'. RPT1 002950 05 FILLER PIC X(3) VALUE 'Oct'. RPT1 002960 05 FILLER PIC X(3) VALUE 'Nov'. RPT1 002970 05 FILLER PIC X(3) VALUE 'Dec'. RPT1 002980 03 JZTABLE REDEFINES JZValues. RPT1 002990 05 ITEM-VALUES OCCURS 12 INDEXED BY JZIX-JZSMth-SMth. RPT1 003000 07 CODE-VALUE PIC X(3). RPT1 003010 03 FILLER. RPT1 003020 05 SEARCH-FOR PIC S9(4) COMP. RPT1 003030 05 FOUND-VALUE PIC X(3) VALUE '***'. RPT1 003040******************************************************************RPT1 003050** **RPT1 003060** Procedure Division. **RPT1 003070** **RPT1 003080******************************************************************RPT1 003090* RPT1 003100 PROCEDURE DIVISION. RPT1 003110 MOVE FUNCTION CURRENT-DATE TO JZ-DATETIMEGMT OF JZ-TODAY. RPT1 003120 PERFORM JZDT01. RPT1 003130 OPEN INPUT PERSNL. RPT1 003140 IF PERSNL-Status IS NOT = '00' AND PERSNL-Status IS NOT = '41RPT1 003150- '' AND PERSNL-Status IS NOT = '97' RPT1 003160 DISPLAY 'PROGRAM TERMINATED. Invalid Status Code on OPEN RPT1 003170- 'PERSNL. CODE=' PERSNL-Status RPT1 003180 GOBACK RPT1 003190 END-IF . RPT1 003200 Move ZERO TO EMPNbr OF JZ-PERSNL. RPT1 003210 Move SPACES TO EMPNAME OF JZ-PERSNL. RPT1 003220 Move ZERO TO GROSS OF JZ-PERSNL. RPT1 003230 Move ZERO TO DEPT OF JZ-PERSNL. RPT1 003240 MOVE JZ-ReportTimeStamp TO DateTime OF JZ-RepNbr1-Heading. RPT1 003250 OPEN OUTPUT RepNbr1. RPT1 003260 IF RepNbr1-Status IS NOT = '00' AND RepNbr1-Status IS NOT = 'RPT1 003270- '41' AND RepNbr1-Status IS NOT = '97' RPT1 003280 DISPLAY 'PROGRAM TERMINATED. Invalid Status Code on OPEN RPT1 003290- 'RepNbr1. CODE=' RepNbr1-Status RPT1 003300 GOBACK RPT1 003310 END-IF . RPT1 003320* Main Program Logic RPT1 003330 PERFORM JZ-Main-Program-Logic. RPT1 003340* RPT1 003350 JZ-Normal-Exit. RPT1 003360 PERFORM RepNbr1-L1-SUBTOTAL VARYING Sub OF Break FROM 1 BY 1 RPT1 003370 UNTIL Sub OF Break > 2. RPT1 003380 Move '* * * END OF RepNbr1 * * *' TO JZ-RepNbr1. RPT1 003390 WRITE JZ-RepNbr1. RPT1 003400* Logical end-of-program RPT1 003410 GOBACK. RPT1 003420******************************************************************RPT1 003430** **RPT1 003440** Main Program Logic **RPT1 003450** **RPT1 003460******************************************************************RPT1 003470* RPT1 003480 JZ-Main-Program-Logic. RPT1 003490* PROCESS PERSNL WHERE PERSNL.GROSS >= 500 RPT1 003500* ORDER(PERSNL.DEPT BREAK, PERSNL.GROSS DESC); RPT1 003510 SORT SORTWORK RPT1 003520 ON ASCENDING KEY DEPT OF JZ-SORTWORK RPT1 003530 ON DESCENDING KEY GROSS OF JZ-SORTWORK RPT1 003540 INPUT PROCEDURE IS JZ-11-PROCESSGroup-INPUT RPT1 003550 OUTPUT PROCEDURE IS JZ-11-PROCESSGroup-OUTPUT. RPT1 003560* RPT1 003570 JZ-11-PROCESSGroup-INPUT. RPT1 003580 PERFORM JZ-11-PROCESSGroup-INPUT1 UNTIL PERSNL-ENDFILE = 'Y'.RPT1 003590* RPT1 003600 JZ-11-PROCESSGroup-INPUT1. RPT1 003610 READ PERSNL NEXT RECORD AT END MOVE 'Y' TO PERSNL-ENDFILE. RPT1 003620 IF PERSNL-STATUS IS NOT = '00' AND PERSNL-STATUS IS NOT = '10RPT1 003630- '' RPT1 003640 DISPLAY 'PROGRAM TERMINATED. STATUS CODE NOT 00 FOR READ RPT1 003650- 'PERSNL. Code=' PERSNL-STATUS RPT1 003660 MOVE 'Y' TO PERSNL-ENDFILE RPT1 003670 END-IF. RPT1 003680 IF PERSNL-ENDFILE = 'N' AND GROSS OF JZ-PERSNL >= 500 RPT1 003690* Move referenced fields to Sortwork RPT1 003700 Move EMPNAME OF JZ-PERSNL TO EMPNAME OF JZ-SORTWORK RPT1 003710 Move GROSS OF JZ-PERSNL TO GROSS OF JZ-SORTWORK RPT1 003720 Move DEPT OF JZ-PERSNL TO DEPT OF JZ-SORTWORK RPT1 003730 RELEASE JZ-SORTWORK RPT1 003740 END-IF. RPT1 003750* RPT1 003760 JZ-11-PROCESSGroup-OUTPUT. RPT1 003770 PERFORM JZ-11-PROCESSGroup-OUTPUT1 UNTIL SORTWORK-ENDFILE = 'RPT1 003780- 'Y'. RPT1 003790* RPT1 003800 JZ-11-PROCESSGroup-OUTPUT1. RPT1 003810 RETURN SORTWORK AT END MOVE 'Y' TO SORTWORK-ENDFILE RPT1 003820 END-RETURN. RPT1 003830 IF SORTWORK-ENDFILE = 'N' RPT1 003840* Move referenced fields back from Sortwork RPT1 003850 Move EMPNAME OF JZ-SORTWORK TO EMPNAME OF JZ-PERSNL RPT1 003860 Move GROSS OF JZ-SORTWORK TO GROSS OF JZ-PERSNL RPT1 003870 Move DEPT OF JZ-SORTWORK TO DEPT OF JZ-PERSNL RPT1 003880* PRINT (PERSNL.EMPNAME,PERSNL.DEPT,PERSNL.GROSS SUM) ; RPT1 003890 PERFORM JZ-15-Print RPT1 003900* END PROCESS PERSNL; RPT1 003910 CONTINUE RPT1 003920 END-IF. RPT1 003930* RPT1 003940 JZ-15-Print. RPT1 003950* PRINT (PERSNL.EMPNAME,PERSNL.DEPT,PERSNL.GROSS SUM) ; RPT1 003960* Control break Processing RPT1 003970 PERFORM RepNbr1-CBreak. RPT1 003980* Print Detail Line RPT1 003990 MOVE EMPNAME OF JZ-PERSNL TO EMPNAME OF RepNbr1-L1-D. RPT1 004000 IF Level OF Break >= 1 OR RepNbr1-LineCount < 1 OR RPT1 004010 RepNbr1-LineCount >= 54 RPT1 004020 MOVE DEPT OF JZ-PERSNL TO DEPT OF RepNbr1-L1-D RPT1 004030 ELSE RPT1 004040 MOVE SPACES TO RepNbr1-L1-D(10:4) RPT1 004050 END-IF. RPT1 004060 MOVE GROSS OF JZ-PERSNL TO GROSS OF RepNbr1-L1-D. RPT1 004070 ADD GROSS OF JZ-PERSNL TO GROSS OF Sums(1). RPT1 004080 MOVE RepNbr1-L1-D TO JZ-RepNbr1. RPT1 004090 PERFORM RepNbr1-Print. RPT1 004100******************************************************************RPT1 004110** **RPT1 004120** Code Conversion Routines **RPT1 004130** **RPT1 004140******************************************************************RPT1 004150* RPT1 004160* Convert JZSMth-SMth code to value RPT1 004170 JZCvt-JZSMth-SMth. RPT1 004180* Input: SEARCH-FOR OF JZCodes-JZSMth-SMth RPT1 004190* Output: FOUND-VALUE OF JZCodes-JZSMth-SMth RPT1 004200* If Invalid, FOUND-VALUE will be set to '****', RPT1 004210* field JZ-CHAR80 will contain an error message RPT1 004220 SET JZIX-JZSMth-SMth TO SEARCH-FOR OF JZCodes-JZSMth-SMth. RPT1 004230 IF JZIX-JZSMth-SMth < 1 OR JZIX-JZSMth-SMth > 12 RPT1 004240 MOVE 'Outside Code Range' TO JZ-CHAR80 RPT1 004250 MOVE '***' TO FOUND-VALUE OF JZCodes-JZSMth-SMth RPT1 004260 ELSE RPT1 004270 MOVE CODE-Value OF JZCodes-JZSMth-SMth(JZIX-JZSMth-SMth) RPT1 004280 TO FOUND-VALUE OF JZCodes-JZSMth-SMth RPT1 004290 END-IF. RPT1 004300******************************************************************RPT1 004310** **RPT1 004320** Print Routine **RPT1 004330** **RPT1 004340******************************************************************RPT1 004350* RPT1 004360 RepNbr1-PRINT. RPT1 004370 IF RepNbr1-LineCount >= 54 RPT1 004380 MOVE JZ-RepNbr1 TO JZ-RepNbr1-Save RPT1 004390 IF RepNbr1-PageNbr > ZERO RPT1 004400 Write JZ-RepNbr1 FROM JZ-RepNbr1-HEADING AFTER RPT1 004410 ADVANCING 2 LINES RPT1 004420 END-IF RPT1 004430 Move 0 TO RepNbr1-LineCount RPT1 004440 Add 1 TO RepNbr1-PageNbr RPT1 004450 MOVE RepNbr1-PageNbr TO PageNbr OF JZ-RepNbr1-HEADING RPT1 004460 Write JZ-RepNbr1 FROM JZ-RepNbr1-HEADING AFTER ADVANCING RPT1 004470 PAGE RPT1 004480 WRITE JZ-RepNbr1 FROM RepNbr1-L1-H AFTER ADVANCING 2 LINESRPT1 004490 WRITE JZ-RepNbr1 FROM JZ-RepNbr1-SAVE AFTER ADVANCING 2 RPT1 004500 LINES RPT1 004510 ELSE RPT1 004520 WRITE JZ-RepNbr1 AFTER ADVANCING RepNbr1-SPACE LINES RPT1 004530 END-IF. RPT1 004540 ADD RepNbr1-SPACE TO RepNbr1-LineCount. RPT1 004550 MOVE 1 TO RepNbr1-SPACE. RPT1 004560******************************************************************RPT1 004570** **RPT1 004580** Sundry Routines **RPT1 004590** **RPT1 004600******************************************************************RPT1 004610* RPT1 004620* Format Date for reports RPT1 004630 JZDT01. RPT1 004640* Move Corresponding JZ-DATETIME-2 TO JZ-ReportTS RPT1 004650 MOVE JZ-DAY OF JZ-DateTIME-2 TO JZ-DAY OF JZ-ReportTS. RPT1 004660 MOVE JZ-YEAR OF JZ-DateTIME-2 TO JZ-YEAR OF JZ-ReportTS. RPT1 004670 MOVE JZ-HOUR OF JZ-DateTIME-2 TO JZ-HOUR OF JZ-ReportTS. RPT1 004680 MOVE JZ-MINUTE OF JZ-DateTIME-2 TO JZ-MINUTE OF JZ-ReportTS. RPT1 004690 MOVE JZ-SECOND OF JZ-DateTIME-2 TO JZ-SECOND OF JZ-ReportTS. RPT1 004700* Format Month RPT1 004710 MOVE JZ-MONTH TO SMth OF JZSMth. RPT1 004720 MOVE SMth OF JZSMth TO SEARCH-FOR OF JZCodes-JZSMth-SMth. RPT1 004730 PERFORM JZCvt-JZSMth-SMth. RPT1 004740 MOVE FOUND-VALUE OF JZCodes-JZSMth-SMth TO JZ-MONTH-NAME. RPT1 004750* RPT1 004760 RepNbr1-L1-SUBTOTAL. RPT1 004770* Print Subtotals, then Roll up to next level RPT1 004780 MOVE SPACE TO RepNbr1-L1-T. RPT1 004790 MOVE GROSS OF Sums(SUB OF Break) TO GROSS OF RepNbr1-L1-T. RPT1 004800 IF SUB OF Break <= 1 RPT1 004810 MOVE DEPT OF Break TO DEPT OF RepNbr1-L1-T RPT1 004820 END-IF. RPT1 004830 Move Descriptions OF RepNbr1-CBD (SUB OF Break) TO RPT1 004840 Description OF RepNbr1-L1-T. RPT1 004850 Move RepNbr1-L1-T TO JZ-RepNbr1. RPT1 004860 PERFORM RepNbr1-Print. RPT1 004870* Roll count and totals to next level RPT1 004880 ADD GROSS OF Sums(SUB OF Break) TO GROSS OF Sums(SUB OF BreakRPT1 004890 + 1). RPT1 004900 MOVE 0 TO GROSS OF Sums(SUB OF Break). RPT1 004910* RPT1 004920 RepNbr1-CBreak. RPT1 004930* 1. Set LEVEL OF Break RPT1 004940 Add 1 TO Rec-Count OF Break. RPT1 004950 IF Rec-Count OF Break = 1 RPT1 004960* 1st Record, just set control fields. Level already 0 RPT1 004970 MOVE DEPT OF JZ-PERSNL TO DEPT OF Break RPT1 004980 ELSE RPT1 004990 IF DEPT OF JZ-PERSNL IS NOT = DEPT OF Break RPT1 005000 MOVE 1 TO Level OF Break RPT1 005010 ELSE RPT1 005020 MOVE 0 TO Level OF Break RPT1 005030 END-IF RPT1 005040 END-IF. RPT1 005050* 2. IF level of control break > 0, Print and roll up RPT1 005060* subtotals to current levelRPT1 005070 IF Level OF Break > 0 RPT1 005080 PERFORM RepNbr1-L1-SUBTOTAL VARYING Sub OF Break FROM 1 RPT1 005090 BY 1 UNTIL Sub OF Break > Level OF Break RPT1 005100 Move 2 TO RepNbr1-SPACE RPT1 005110 END-IF. RPT1 005120* 3. Reset for new control break RPT1 005130 IF Level OF Break >= 1 RPT1 005140 MOVE DEPT OF JZ-PERSNL TO DEPT OF Break RPT1 005150 END-IF. RPT1