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