Previous Topic Next topic Print topic


Iterative Expressions - Sample Program

Restriction: This topic applies only when the AppMaster Builder AddPack has been installed, and applies only to Windows platforms.

This next program illustrates Report Writer structures and the use of iterative expressions.

Report Mock-up

=============================================================================================================================
                                                         EGAS,INC.

                                          XXXX YEAR-END PRODUCT SALES SUMMARY


                           ******************************************************************

                                                                                                                         PAGEZZZZ9
                                                  REGION:  XXXXXXXXX
                                             XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

              ----- 1-ST QUARTER -----  ----- 2-ND QUARTER -----  ----- 3-RD QUARTER ----- ----- 4-TH QUARTER -----
PRODUCT        JAN   FEB   MAR  TOTAL   APR   MAY   JUN  TOTAL    JUL   AUG   SEP  TOTAL    OCT   NOV   DEC  TOTAL   TOTAL
------------- ----- ----- ----- ------ ----- ----- ----- ------  ----- ----- ----- ------  ----- ----- ----- ------  --------
SALES OFFICE:  XXXXXXXXXXXXXXX
MANAGER:  XXXXXXXXXXXXXXXXXXXX

XXXXXXXXXXXX Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  $$$$,$$$

TOTAL FOR:    ----- ----- ----- ------ ----- ----- ----- ------  ----- ----- ----- ------  ----- ----- ----- ------  --------
XXXXXXXXXXXX  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9 Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  $$$$,$$$

TOTAL FOR:    ----- ----- ----- ------ ----- ----- ----- ------  ----- ----- ----- ------  ----- ----- ----- ------  --------
XXXXXXXXX     Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9 Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  $$$$,$$$
              ----- ----- ----- ------ ----- ----- ----- ------  ----- ----- ----- ------  ----- ----- ----- ------  --------
TOTAL         Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9 Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  Z,ZZ9 Z,ZZ9 Z,ZZ9 ZZ,ZZ9  $$$$,$$$

                            ******************************************************************


                                               EGAS! ANOTHER BANNER YEAR!
=================================================================================================================================

Program Painter Source

REM  READS DATA.EXTRACT AND GENERATES A SUMMARY
     REPORT BY REGION, OFFICE AND PRODUCT.
/*   *****************************************************
IO   EXTRACT-FILE                ASSIGN TO UT-S-EXTRACT   
IO   SALES-SUMMARY-FILE          ASSIGN TO UT-S-SUMMREPT  
IO   DEFINITION-FILE             ASSIGN TO UT-S-DEFS      
/*   *****************************************************

/*   IO EXTRACT-FILE                ASSIGN "EXTRACT"   
/*   IO SALES-SUMMARY-FILE          ASSIGN "SUMMREPT"  
/*   IO DEFINITION-FILE             ASSIGN "DEFS"      

FD   EXTRACT-FILE
     LABEL RECORDS ARE STANDARD
     RECORDING MODE IS F
     RECORD CONTAINS 90 CHARACTERS
     BLOCK CONTAINS 0 RECORDS.

01   EXTRACT-FILE-RECORD
     02  EXT-REGION              PIC X(9).
     02  EXT-OFFICE              PIC X(15).
     02  EXT-PRODUCT             PIC X(18).
     02  EXT-SALES-DOLLARS       PIC 9(4) OCCURS 12.

FD   SALES-SUMMARY-FILE
     LABEL RECORDS ARE STANDARD
     RECORDING MODE IS F
     RECORD CONTAINS 133 CHARACTERS
     BLOCK CONTAINS 0 RECORDS
     REPORT IS YEAR-END-SALES-SUMMARY.

FD   DEFINITION-FILE
     LABEL RECORDS ARE STANDARD
     RECORDING MODE IS F
     RECORD CONTAINS 38 CHARACTERS
     BLOCK CONTAINS 0 RECORDS.

01   DEFINITION-RECORD.
     02  DEFINITION-TYPE         PIC X(3).
     02  DEFINITION-REGION       PIC X(29).
     02  FILLER                  PIC X(6).

01   DEFINITION-RECORD-2.
     02  FILLER                  PIC X(3).
     02  DEFINITION-OFFICE       PIC X(35).

WS01 JJ                          PIC S9(4) COMP SYNC VALUE ZERO.
WS01 II                          PIC S9(4) COMP SYNC VALUE ZERO.
WS01 FIRST-FLG                   PIC X(1) VALUE 'T'.

WS01 REGION-DEFINITIONS.
     02  REGION-TABLE OCCURS 4 TIMES INDEXED BY REGION-IDX.
         03  REGION-NAME         PIC X(9).
         03  REGION-MANAGER      PIC X(20).

WS01 REGION                      PIC X(9).
WS01 REGION-MGR.
     02  REG-MGR OCCURS 20 TIMES
                                 INDEXED BY REG-MGR-IDX
                                 PIC X(1).

WS01 REG-MGR-MAX                 PIC S9(4) COMP SYNC VALUE +20.
WS01 REGION-MGR-FIELD.
     02  REGION-MGR-X OCCURS 30 TIMES INDEXED BY MGR-IDX
                                 PIC X(1).
WS01 REGION-MGR-FLD REDEFINES REGION-MGR-FIELD
                                 PIC X(30).
WS01 REGION-MGR-MAX              PIC S9(4) COMP SYNC VALUE +30.
WS01 MANAGER-WORD                PIC X(10) VALUE 'MANAGER:  '.
WS01 MANAGER-BY-CHAR REDEFINES MANAGER-WORD.
     02  MANAGER-LETTER OCCURS 10 TIMES
                                 INDEXED BY LETTER-IDX
                                 PIC X(1).
WS01 MANAGER-WORD-SIZE           PIC S9(4) COMP SYNC VALUE +10.

WS01 OFFICE-DEFINITIONS.
     02  OFFICE-TABLE OCCURS 14 TIMES INDEXED BY OFFICE-IDX.
         03  OFFICE-NAME         PIC X(15).
         03  OFFICE-MANAGER      PIC X(20).
WS01 OFFICE                      PIC X(15).
WS01 OFFICE-MGR                  PIC X(20).

WS01 QTR-1-SALES-DOLLARS         PIC 9(5) VALUE ZERO.
WS01 QTR-2-SALES-DOLLARS         PIC 9(5) VALUE ZERO.
WS01 QTR-3-SALES-DOLLARS         PIC 9(5) VALUE ZERO.
WS01 QTR-4-SALES-DOLLARS         PIC 9(5) VALUE ZERO.

WS01 YR-SALES-DOLLARS            PIC 9(6) VALUE ZERO.
WS01 CURRENT-DATE-X.
     02  CURRENT-YEAR            PIC 9(2).
     02  FILLER                  PIC X(4).
WS01 REPORT-YEAR.
     02  FILLER                  PIC 9(2) VALUE 20.
     02  REPORT-YEAR-X           PIC 9(2).

RED  YEAR-END-SALES-SUMMARY
     CONTROLS ARE FINAL REGION REGION-MGR-FLD OFFICE
     PAGE LIMIT IS 58 LINES
     FIRST DETAIL 9
     HEADING 1
     FOOTING 58.

MOCK SUMMARY

01   RH-YEAR-END-SALES-SUMMARY   TYPE IS REPORT HEADING
                                 NEXT GROUP IS NEXT PAGE.
     MOCKUP LINES 1 THRU 4
     LINE 25
     SOURCE REPORT-YEAR          PIC X(4).

01   PH-YEAR-END-SALES-SUMMARY   TYPE IS PAGE HEADING.
     MOCKUP LINES 10 THRU 17
     SOURCE PAGE-COUNTER         PIC ZZZZ9.
     SOURCE REGION               PIC X(9).
     SOURCE REGION-MGR-FLD       PIC X(30).

01   CH-REGION                   TYPE IS CONTROL HEADING
                                 REGION
                                 NEXT GROUP IS NEXT PAGE.

01   CH-OFFICE                  TYPE IS CONTROL HEADING
                                OFFICE.
     MOCKUP LINES 18 THRU 20
     SOURCE OFFICE              PIC X(15).
     SOURCE OFFICE-MGR          PIC X(20).

01   DE-YEAR-END-SALES-SUMMARY  TYPE IS DETAIL.
     MOCKUP LINE 21
     SOURCE EXT-PRODUCT                PIC X(8).
     SOURCE EXT-SALES-DOLLARS (#1/3)   PIC Z,ZZ9
     SOURCE QTR-1-SALES-DOLLARS        PIC ZZ,ZZ9
     SOURCE EXT-SALES-DOLLARS (#4/6)   PIC Z,ZZ9
     SOURCE QTR-2-SALES-DOLLARS        PIC ZZ,ZZ9
     SOURCE EXT-SALES-DOLLARS (#7/9)   PIC Z,ZZ9
     SOURCE QTR-3-SALES-DOLLARS        PIC ZZ,ZZ9
     SOURCE EXT-SALES-DOLLARS (#10/12) PIC Z,ZZ9
     SOURCE QTR-4-SALES-DOLLARS        PIC ZZ,ZZ9
     SOURCE YR-SALES-DOLLARS           PIC $$$$,$$$

01   PF-YEAR-END-SALES-SUMMARY  TYPE IS PAGE FOOTING
                                NEXT GROUP IS NEXT PAGE.
     MOCKUP LINE 32

01   RF-YEAR-END-SALES-SUMMARY  TYPE IS REPORT FOOTING.
     MOCKUP LINE 38
     LINE IS 25

01   CF-FINAL                   TYPE IS CONTROL FOOTING
                                FINAL.
     MOCKUP LINES 29 THRU 31
     SUM EXT-SALES-DOLLARS (#1/3)   PIC Z,ZZ9
     SUM QTR-1-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM EXT-SALES-DOLLARS (#4/6)   PIC Z,ZZ9
     SUM QTR-2-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM EXT-SALES-DOLLARS (#7/9)   PIC Z,ZZ9
     SUM QTR-3-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM EXT-SALES-DOLLARS (#10/12) PIC Z,ZZ9
     SUM QTR-4-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM YR-SALES-DOLLARS           PIC $$$$,$$$

01   CF-REGION                  TYPE IS CONTROL FOOTING
                                REGION.
     MOCKUP LINES 26 THRU 28
     SOURCE REGION                  PIC X(9)
     SUM EXT-SALES-DOLLARS (#1/3)   PIC Z,ZZ9
     SUM QTR-1-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM EXT-SALES-DOLLARS (#4/6)   PIC Z,ZZ9
     SUM QTR-2-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM EXT-SALES-DOLLARS (#7/9)   PIC Z,ZZ9
     SUM QTR-3-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM EXT-SALES-DOLLARS (#10/12) PIC Z,ZZ9
     SUM QTR-4-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM YR-SALES-DOLLARS           PIC $$$$,$$$

01   CF-OFFICE                   TYPE IS CONTROL FOOTING
                                 OFFICE.
     MOCKUP LINES 23 THRU 25
     SOURCE OFFICE                  PIC X(15)
     SUM EXT-SALES-DOLLARS (#1/3)   PIC Z,ZZ9
     SUM QTR-1-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM EXT-SALES-DOLLARS (#4/6)   PIC Z,ZZ9
     SUM QTR-2-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM EXT-SALES-DOLLARS (#7/9)   PIC Z,ZZ9
     SUM QTR-3-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM EXT-SALES-DOLLARS (#10/12) PIC Z,ZZ9
     SUM QTR-4-SALES-DOLLARS        PIC ZZ,ZZ9
     SUM YR-SALES-DOLLARS           PIC $$$$,$$$

DPAR SUPPRESS CH-REGION SECTION
     USE BEFORE REPORTING CH-REGION
DPAR SUPPRESS CH-REGION-PARA
     IF FIRST-FLG = TRUE
         SUPPRESS PRINTING

PROC
     ACCEPT CURRENT-DATE-X FROM DATE
     MOVE CURRENT-YEAR TO REPORT-YEAR-X
     PERFORM LOAD-DEFINITIONS
     OPEN INPUT EXTRACT-FILE
     OPEN OUTPUT SALES-SUMMARY-FILE
     INITIATE YEAR-END-SALES-SUMMARY
     MOVE ZERO TO PAGE-COUNTER
     REPEAT
         READ EXTRACT-FILE
     UNTIL AT END ON EXTRACT-FILE
         IF EXT-OFFICE NOT = OFFICE
             PERFORM LOCATE-MANAGERS
         ADD EXT-SALES-DOLLARS (1) TO QTR-1-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (2) TO QTR-1-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (3) TO QTR-1-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (4) TO QTR-2-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (5) TO QTR-2-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (6) TO QTR-2-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (7) TO QTR-3-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (8) TO QTR-3-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (9) TO QTR-3-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (10) TO QTR-4-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (11) TO QTR-4-SALES-DOLLARS
         ADD EXT-SALES-DOLLARS (12) TO QTR-4-SALES-DOLLARS
         REPEAT VARYING II FROM 1 BY 1
         UNTIL II > 12
             ADD EXT-SALES-DOLLARS (II) TO YR-SALES-DOLLARS
         GENERATE DE-YEAR-END-SALES-SUMMARY
         MOVE FALSE TO FIRST-FLG
         MOVE ZEROES TO QTR-1-SALES-DOLLARS
         ... QTR-2-SALES-DOLLARS QTR-3-SALES-DOLLARS
         ... QTR-4-SALES-DOLLARS YR-SALES-DOLLARS
     TERMINATE YEAR-END-SALES-SUMMARY
     CLOSE EXTRACT-FILE SALES-SUMMARY-FILE

PARA LOAD-DEFINITIONS.
     SET REGION-IDX TO 1
     SET REGION-IDX DOWN BY 1
     SET OFFICE-IDX TO 1
     SET OFFICE-IDX DOWN BY 1
     OPEN INPUT DEFINITION-FILE
     REPEAT
         READ DEFINITION-FILE
     UNTIL AT END ON DEFINITION-FILE
         IF DEFINITION-TYPE = 'REG'
             SET REGION-IDX UP BY 1
             MOVE DEFINITION-REGION TO REGION-TABLE (REGION-IDX)
         ELSE-IF DEFINITION-TYPE = 'OFF'
             SET OFFICE-IDX UP BY 1
             MOVE DEFINITION-OFFICE TO OFFICE-TABLE (OFFICE-IDX)
     CLOSE DEFINITION-FILE

PARA LOCATE-MANAGERS.
     SET REGION-IDX TO 1
     SEARCH REGION-TABLE
     WHEN EXT-REGION = REGION-NAME (REGION-IDX)
         MOVE REGION-MANAGER (REGION-IDX) TO REGION-MGR
     MOVE SPACES TO REGION-MGR-FLD
     SET REG-MGR-IDX TO REG-MGR-MAX
     WHILE REG-MGR (REG-MGR-IDX) = SPACE
     ... AND REG-MGR-IDX > ZERO
         SET REG-MGR-IDX DOWN BY 1
     SET JJ TO REG-MGR-IDX
     COMPUTE II =
     ... (REGION-MGR-MAX - MANAGER-WORD-SIZE - JJ) / 2
     ADD 1 TO II
     IF II <= ZERO
         MOVE 1 TO II
     SET REG-MGR-IDX TO 1
     SET LETTER-IDX TO 1
     REPEAT VARYING MGR-IDX FROM II BY 1
     UNTIL MGR-IDX > REGION-MGR-MAX
         IF LETTER-IDX <= MANAGER-WORD-SIZE
             MOVE MANAGER-LETTER (LETTER-IDX)
             ... TO REGION-MGR-X (MGR-IDX)
             SET LETTER-IDX UP BY 1
         ELSE-IF REG-MGR-IDX <= REG-MGR-MAX
             MOVE REG-MGR (REG-MGR-IDX)
             ... TO REGION-MGR-X (MGR-IDX)
             SET REG-MGR-IDX UP BY 1
         ELSE
             SET MGR-IDX TO REGION-MGR-MAX
             DISPLAY 'MANAGER INDEXES OUT OF RANGE: '
             ... EXTRACT-FILE-RECORD
     SET OFFICE-IDX TO 1
     SEARCH OFFICE-TABLE
     WHEN EXT-OFFICE = OFFICE-NAME (OFFICE-IDX)
         MOVE OFFICE-MANAGER (OFFICE-IDX) TO OFFICE-MGR
     MOVE EXT-REGION TO REGION
     MOVE EXT-OFFICE TO OFFICE

Generated Source

%   &AP-GEN-VER = 1719
%   &AP-PGM-ID = "SUMMARY"
%   &AP-GEN-DC-TARGET = "MVS"
%   &AP-GEN-DB-TARGET = "VSAM"
%   &AP-PROC-DIV-KYWD-SEEN = 1
%   &AP-FILE-CONTROL-SEEN = 1
%   &AP-SUBSCHEMA = ""
%   &AP-APPLICATION-ID = "GLGAP"
%   &AP-GEN-DATE = "861204"
%   &AP-GEN-TIME = "17142491"
IDENTIFICATION DIVISION.
PROGRAM-ID.                     SUMMARY.
AUTHOR.                         AP-SYSTEM GENERATED.
DATE-WRITTEN.                   861204.
DATE-COMPILED.                  &COMPILETIME.
*
*REMARKS.
*    READS DATA.EXTRACT AND GENERATES A SUMMARY
*    REPORT BY REGION, OFFICE AND PRODUCT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER.                &SYSTEM.
OBJECT-COMPUTER.                &SYSTEM.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
IO EXTRACT-FILE                ASSIGN "EXTRACT"   
IO SALES-SUMMARY-FILE          ASSIGN "SUMMREPT"  
IO DEFINITION-FILE             ASSIGN "DEFS"      
DATA DIVISION.
FILE SECTION.
FD  EXTRACT-FILE
    LABEL RECORDS ARE STANDARD
    RECORDING MODE IS F
    RECORD CONTAINS 90 CHARACTERS
    BLOCK CONTAINS 0 RECORDS.
01  EXTRACT-FILE-RECORD
    02  EXT-REGION              PIC X(9).
    02  EXT-OFFICE              PIC X(15).
    02  EXT-PRODUCT             PIC X(18).
    02  EXT-SALES-DOLLARS       PIC 9(4) OCCURS 12.
FD  SALES-SUMMARY-FILE
    LABEL RECORDS ARE STANDARD
    RECORDING MODE IS F
    RECORD CONTAINS 133 CHARACTERS
    BLOCK CONTAINS 0 RECORDS
    REPORT IS YEAR-END-SALES-SUMMARY.
FD  DEFINITION-FILE
    LABEL RECORDS ARE STANDARD
    RECORDING MODE IS F
    RECORD CONTAINS 38 CHARACTERS
    BLOCK CONTAINS 0 RECORDS.
01  DEFINITION-RECORD.
    02  DEFINITION-TYPE         PIC X(3).
    02  DEFINITION-REGION       PIC X(29).
    02  FILLER                  PIC X(6).
01  DEFINITION-RECORD-2.
    02  FILLER                  PIC X(3).
    02  DEFINITION-OFFICE       PIC X(35).

WORKING-STORAGE SECTION.
$TP-WS-MARKER
01  JJ                          PIC S9(4) COMP SYNC VALUE ZERO.
01  II                          PIC S9(4) COMP SYNC VALUE ZERO.
01  FIRST-FLG                   PIC X(1) VALUE 'T'.
01  REGION-DEFINITIONS.
    02  REGION-TABLE OCCURS 4 TIMES INDEXED BY REGION-IDX.
        03  REGION-NAME         PIC X(9).
        03  REGION-MANAGER      PIC X(20).
01  REGION                      PIC X(9).
01  REGION-MGR.
    02  REG-MGR OCCURS 20 TIMES
                                INDEXED BY REG-MGR-IDX
                                PIC X(1).
01  REG-MGR-MAX                 PIC S9(4) COMP SYNC VALUE +20.
01  REGION-MGR-FIELD.
    02  REGION-MGR-X OCCURS 30 TIMES INDEXED BY MGR-IDX
                                PIC X(1).
01  REGION-MGR-FLD REDEFINES REGION-MGR-FIELD
                                PIC X(30).
01  REGION-MGR-MAX              PIC S9(4) COMP SYNC VALUE +30.
01  MANAGER-WORD                PIC X(10) VALUE 'MANAGER:  '.
01  MANAGER-BY-CHAR REDEFINES MANAGER-WORD.
    02  MANAGER-LETTER OCCURS 10 TIMES
                                INDEXED BY LETTER-IDX
                                PIC X(1).
1  MANAGER-WORD-SIZE            PIC S9(4) COMP SYNC VALUE +10.
01  OFFICE-DEFINITIONS.
    02  OFFICE-TABLE OCCURS 14 TIMES INDEXED BY OFFICE-IDX.
        03  OFFICE-NAME         PIC X(15).
        03  OFFICE-MANAGER      PIC X(20).
01  OFFICE                      PIC X(15).
01  OFFICE-MGR                  PIC X(20).

01  QTR-1-SALES-DOLLARS         PIC 9(5) VALUE ZERO.
01  QTR-2-SALES-DOLLARS         PIC 9(5) VALUE ZERO.
01  QTR-3-SALES-DOLLARS         PIC 9(5) VALUE ZERO.
01  QTR-4-SALES-DOLLARS         PIC 9(5) VALUE ZERO.
01  YR-SALES-DOLLARS            PIC 9(6) VALUE ZERO.
01  CURRENT-DATE-X.
    02  CURRENT-YEAR            PIC 9(2).
    02  FILLER                  PIC X(4).
01  REPORT-YEAR.
    02  FILLER                  PIC 9(2) VALUE 20.
    02  REPORT-YEAR-X           PIC 9(2).
REPORT SECTION.
RED YEAR-END-SALES-SUMMARY
    CONTROLS ARE FINAL REGION REGION-MGR-FLD OFFICE
    PAGE LIMIT IS 58 LINES
    FIRST DETAIL 9
    HEADING 1
    FOOTING 58.
01  RH-YEAR-END-SALES-SUMMARY   TYPE IS REPORT HEADING
                                NEXT GROUP IS NEXT PAGE.
MOCKUP LINES 1 THRU 4
LINE 25
SOURCE REPORT-YEAR          PIC X(4).
01  PH-YEAR-END-SALES-SUMMARY   TYPE IS PAGE HEADING.
MOCKUP LINES 10 THRU 17
SOURCE PAGE-COUNTER         PIC ZZZZ9.
SOURCE REGION               PIC X(9).
SOURCE REGION-MGR-FLD       PIC X(30).
01  CH-REGION               TYPE IS CONTROL HEADING
                            REGION
                            NEXT GROUP IS NEXT PAGE.
01  CH-OFFICE               TYPE IS CONTROL HEADING
                            OFFICE.
MOCKUP LINES 18 THRU 20
SOURCE OFFICE               PIC X(15).
SOURCE OFFICE-MGR           PIC X(20).
01  DE-YEAR-END-SALES-SUMMARY  TYPE IS DETAIL.
MOCKUP LINE 21
SOURCE EXT-PRODUCT                 PIC X(8).
SOURCE EXT-SALES-DOLLARS (#1/3)    PIC Z,ZZ9
SOURCE QTR-1-SALES-DOLLARS         PIC ZZ,ZZ9
SOURCE EXT-SALES-DOLLARS (#4/6)    PIC Z,ZZ9
SOURCE QTR-2-SALES-DOLLARS         PIC ZZ,ZZ9
SOURCE EXT-SALES-DOLLARS (#7/9)    PIC Z,ZZ9
SOURCE QTR-3-SALES-DOLLARS         PIC ZZ,ZZ9
SOURCE EXT-SALES-DOLLARS (#10/12)  PIC Z,ZZ9
SOURCE QTR-4-SALES-DOLLARS         PIC ZZ,ZZ9
SOURCE YR-SALES-DOLLARS            PIC $$$$,$$$
01  PF-YEAR-END-SALES-SUMMARY  TYPE IS PAGE FOOTING
                               NEXT GROUP IS NEXT PAGE.
MOCKUP LINE 32
01  RF-YEAR-END-SALES-SUMMARY  TYPE IS REPORT FOOTING.
MOCKUP LINE 38
LINE IS 25
01  CF-FINAL                   TYPE IS CONTROL FOOTING
                               FINAL.
MOCKUP LINES 29 THRU 31
SUM EXT-SALES-DOLLARS (#1/3)       PIC Z,ZZ9
SUM QTR-1-SALES-DOLLARS            PIC ZZ,ZZ9
SUM EXT-SALES-DOLLARS (#4/6)       PIC Z,ZZ9
SUM QTR-2-SALES-DOLLARS            PIC ZZ,ZZ9
SUM EXT-SALES-DOLLARS (#7/9)       PIC Z,ZZ9
SUM QTR-3-SALES-DOLLARS            PIC ZZ,ZZ9
SUM EXT-SALES-DOLLARS (#10/12)     PIC Z,ZZ9
SUM QTR-4-SALES-DOLLARS            PIC ZZ,ZZ9
SUM YR-SALES-DOLLARS               PIC $$$$,$$$ 
01  CF-REGION                  TYPE IS CONTROL FOOTING
                               REGION.
MOCKUP LINES 26 THRU 28
SOURCE REGION                      PIC X(9)
SUM EXT-SALES-DOLLARS (#1/3)       PIC Z,ZZ9
SUM QTR-1-SALES-DOLLARS            PIC ZZ,ZZ9

SUM EXT-SALES-DOLLARS (#4/6)       PIC Z,ZZ9
SUM QTR-2-SALES-DOLLARS            PIC ZZ,ZZ9
SUM EXT-SALES-DOLLARS (#7/9)       PIC Z,ZZ9
SUM QTR-3-SALES-DOLLARS            PIC ZZ,ZZ9
SUM EXT-SALES-DOLLARS (#10/12)     PIC Z,ZZ9
SUM QTR-4-SALES-DOLLARS            PIC ZZ,ZZ9
SUM YR-SALES-DOLLARS               PIC $$$$,$$$
01  CF-OFFICE                  TYPE IS CONTROL FOOTING
                               OFFICE.
MOCKUP LINES 23 THRU 25
SOURCE OFFICE                      PIC X(15)
SUM EXT-SALES-DOLLARS (#1/3)       PIC Z,ZZ9
SUM QTR-1-SALES-DOLLARS            PIC ZZ,ZZ9
SUM EXT-SALES-DOLLARS (#4/6)       PIC Z,ZZ9
SUM QTR-2-SALES-DOLLARS            PIC ZZ,ZZ9
SUM EXT-SALES-DOLLARS (#7/9)       PIC Z,ZZ9
SUM QTR-3-SALES-DOLLARS            PIC ZZ,ZZ9
SUM EXT-SALES-DOLLARS (#10/12)     PIC Z,ZZ9
SUM QTR-4-SALES-DOLLARS            PIC ZZ,ZZ9
SUM YR-SALES-DOLLARS               PIC $$$$,$$$

PROCEDURE DIVISION.
DECLARATIVES.
SUPPRESS CH-REGION SECTION.
    USE BEFORE REPORTING CH-REGION
SUPPRESS CH-REGION-PARA.
    IF FIRST-FLG = TRUE
        SUPPRESS PRINTING
END DECLARATIVES.
    ACCEPT CURRENT-DATE-X FROM DATE
    MOVE CURRENT-YEAR TO REPORT-YEAR-X
    PERFORM LOAD-DEFINITIONS
    OPEN INPUT EXTRACT-FILE
    OPEN OUTPUT SALES-SUMMARY-FILE
    INITIATE YEAR-END-SALES-SUMMARY
    MOVE ZERO TO PAGE-COUNTER
    REPEAT
        READ EXTRACT-FILE
    UNTIL AT END ON EXTRACT-FILE
        IF EXT-OFFICE NOT = OFFICE
            PERFORM LOCATE-MANAGERS
        ADD EXT-SALES-DOLLARS (1) TO QTR-1-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (2) TO QTR-1-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (3) TO QTR-1-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (4) TO QTR-2-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (5) TO QTR-2-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (6) TO QTR-2-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (7) TO QTR-3-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (8) TO QTR-3-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (9) TO QTR-3-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (10) TO QTR-4-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (11) TO QTR-4-SALES-DOLLARS
        ADD EXT-SALES-DOLLARS (12) TO QTR-4-SALES-DOLLARS
        REPEAT VARYING II FROM 1 BY 1
        UNTIL II > 12 
            ADD EXT-SALES-DOLLARS (II) TO YR-SALES-DOLLARS
        GENERATE DE-YEAR-END-SALES-SUMMARY
        MOVE FALSE TO FIRST-FLG 
        MOVE ZEROES TO QTR-1-SALES-DOLLARS
        ... QTR-2-SALES-DOLLARS QTR-3-SALES-DOLLARS
        ... QTR-4-SALES-DOLLARS YR-SALES-DOLLARS
    TERMINATE YEAR-END-SALES-SUMMARY
    CLOSE EXTRACT-FILE SALES-SUMMARY-FILE

LOAD-DEFINITIONS.
    SET REGION-IDX TO 1
    SET REGION-IDX DOWN BY 1 
    SET OFFICE-IDX TO 1 
    SET OFFICE-IDX DOWN BY 1
    OPEN INPUT DEFINITION-FILE
    REPEAT 
        READ DEFINITION-FILE 
    UNTIL AT END ON DEFINITION-FILE
       IF DEFINITION-TYPE = 'REG'
            SET REGION-IDX UP BY 1
            MOVE DEFINITION-REGION TO REGION-TABLE (REGION-IDX)
 
        ELSE-IF DEFINITION-TYPE = 'OFF'
            SET OFFICE-IDX UP BY 1
            MOVE DEFINITION-OFFICE TO OFFICE-TABLE (OFFICE-IDX)
    CLOSE DEFINITION-FILE

LOCATE-MANAGERS.
    SET REGION-IDX TO 1 
    SEARCH REGION-TABLE 
    WHEN EXT-REGION = REGION-NAME (REGION-IDX) 
        MOVE REGION-MANAGER (REGION-IDX) TO REGION-MGR 
    MOVE SPACES TO REGION-MGR-FLD 
    SET REG-MGR-IDX TO REG-MGR-MAX
    WHILE REG-MGR (REG-MGR-IDX) = SPACE
    ... AND REG-MGR-IDX > ZERO
        SET REG-MGR-IDX DOWN BY 1
    SET JJ TO REG-MGR-IDX 
    COMPUTE II = 
    ... (REGION-MGR-MAX - MANAGER-WORD-SIZE - JJ) / 2
    ADD 1 TO II 
    IF II <= ZERO 
        MOVE 1 TO II 
    SET REG-MGR-IDX TO 1 
    SET LETTER-IDX TO 1 
    REPEAT VARYING MGR-IDX FROM II BY 1 
    UNTIL MGR-IDX > REGION-MGR-MAX 
        IF LETTER-IDX <= MANAGER-WORD-SIZE 
            MOVE MANAGER-LETTER (LETTER-IDX)
            ... TO REGION-MGR-X (MGR-IDX) 
            SET LETTER-IDX UP BY 1 
        ELSE-IF REG-MGR-IDX <= REG-MGR-MAX 
            MOVE REG-MGR (REG-MGR-IDX) 
            ... TO REGION-MGR-X (MGR-IDX)
            SET REG-MGR-IDX UP BY 1 
        ELSE 
            SET MGR-IDX TO REGION-MGR-MAX 
            DISPLAY 'MANAGER INDEXES OUT OF RANGE: ' 
            ... EXTRACT-FILE-RECORD 
    SET OFFICE-IDX TO 1 
    SEARCH OFFICE-TABLE 
    WHEN EXT-OFFICE = OFFICE-NAME (OFFICE-IDX) 
        MOVE OFFICE-MANAGER (OFFICE-IDX) TO OFFICE-MGR 
    MOVE EXT-REGION TO REGION 
    MOVE EXT-OFFICE TO OFFICE 
Previous Topic Next topic Print topic