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