This next program illustrates Report Writer structures and the use of iterative expressions.
=============================================================================================================================
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!
=================================================================================================================================
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
% &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