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