IDENTIFICATION DIVISION. PROGRAM-ID. SAMPLE. ************************************************************ * SAMPLE - THIS IS AN EXAMPLE OF A DOUBLE-LEVEL * * CONTROL BREAK. THE MAJOR FIELD IS * * DEPT AND THE MINOR FIELD IS TERR * ************************************************************ ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT IN-EMPLOYEE-FILE ASSIGN TO 'DATA1012'. SELECT OUT-REPORT-FILE ASSIGN TO PRINTER. * DATA DIVISION. FILE SECTION. FD IN-EMPLOYEE-FILE LABEL RECORDS ARE STANDARD. 01 IN-EMPLOYEE-REC. 05 IN-DEPT PIC XX. 05 IN-TERR PIC XX. 05 IN-EMPLOYEE-NO PIC X(3). 05 IN-EMPLOYEE-NAME PIC X(20). 05 IN-ANNUAL-SALARY PIC 9(5). FD OUT-REPORT-FILE LABEL RECORDS ARE OMITTED. 01 OUT-REPORT-REC PIC X(132). WORKING-STORAGE SECTION. 01 WS-WORK-AREAS. 05 ARE-THERE-MORE-RECORDS PIC X(3) VALUE 'YES'. 88 MORE-RECORDS VALUE 'YES'. 88 NO-MORE-RECORDS VALUE 'NO '. 05 FIRST-RECORD PIC X(3) VALUE 'YES'. 05 WS-LINE-CTR PIC 99 VALUE ZEROS. 05 WS-PAGE-CTR PIC 999 VALUE ZEROS. 05 WS-DEPT-SALARY PIC 9(7)V99 VALUE ZEROS. 05 WS-TERR-SALARY PIC 9(6)V99 VALUE ZEROS. 05 WS-DEPT-HOLD PIC XX VALUE ZEROS. 05 WS-TERR-HOLD PIC XX VALUE ZEROS. 05 WS-TOTAL-SALARY PIC 9(8)V99 VALUE ZEROS. 05 WS-T-DATE. 10 WS-IN-YR PIC XXXX. 10 WS-IN-MO PIC XX. 10 WS-IN-DAY PIC XX. 01 HL-HEADING1. 05 PIC X(23) VALUE SPACES. 05 PIC X(44) VALUE 'A L P H A D E P A R T M E N T S T O R E'. 05 PIC X(5) VALUE 'PAGE '. 05 HL-OUT-PAGE PIC ZZ9. 05 PIC X(57) VALUE SPACES. 01 HL-HEADING2. 05 PIC X(29) VALUE SPACES. 05 PIC X(24) VALUE 'PAYROLL FOR THE WEEK OF'. 05 HL-TODAYS-DATE. 10 HL-OUT-MO PIC XX. 10 PIC X VALUE '/'. 10 HL-OUT-DAY PIC XX. 10 PIC X VALUE '/'. 10 HL-OUT-YR PIC XXXX. 05 PIC X(70) VALUE SPACES. 01 HL-HEADING3. 05 PIC X(17) VALUE SPACES. 05 PIC X(15) VALUE 'EMPLOYEE NUMBER'. 05 PIC X(9) VALUE SPACES. 05 PIC X(13) VALUE 'EMPLOYEE NAME'. 05 PIC X(8) VALUE SPACES. 05 PIC X(13) VALUE 'ANNUAL SALARY'. 05 PIC X(57) VALUE SPACES. 01 DL-SALARY-LINE. 05 PIC X(28) VALUE SPACES. 05 DL-OUT-EMPLOYEE-NO PIC X(3). 05 PIC X(10) VALUE SPACES. 05 DL-OUT-EMPLOYEE-NAME PIC X(20). 05 PIC XX VALUE SPACES. 05 DL-OUT-ANNUAL-SALARY PIC $$$,$$$.99. 05 PIC X(59) VALUE SPACES. 01 DL-TERRITORY-TOTAL-LINE. 05 PIC X(28) VALUE SPACES. 05 PIC X(34) VALUE 'TOTAL SALARY FOR TERRITORY IS '. 05 DL-OUT-TERR-SALARY PIC $$$$,$$$.99. 05 PIC X(59) VALUE SPACES. 01 DL-DEPARTMENT-TOTAL-LINE. 05 PIC X(37) VALUE SPACES. 05 PIC X(31) VALUE 'TOTAL SALARY FOR DEPARTMENT IS '. 05 DL-OUT-DEPT-SALARY PIC $$,$$$,$$$.99. 05 PIC X(51) VALUE SPACES. 01 DL-FINAL-TOTAL-LINE. 05 PIC X(40) VALUE SPACES. 05 PIC X(25) VALUE 'TOTAL OF ALL SALARIES IS '. 05 DL-OUT-TOT-ANN-SALARY PIC $$$,$$$,$$$.99. 05 PIC X(53) VALUE SPACES. 01 DL-DEPT-HEADING. 05 PIC X(14) VALUE SPACES. 05 PIC X(13) VALUE 'DEPARTMENT - '. 05 DL-OUT-DEPT PIC XX. 05 PIC X(103) VALUE SPACES. 01 DL-TERR-HEADING. 05 PIC X(14) VALUE SPACES. 05 PIC X(12) VALUE 'TERRITORY - '. 05 DL-OUT-TERR PIC XX. 05 PIC X(104) VALUE SPACES. 01 HL-HEADING-FINAL. 05 PIC X(9) VALUE SPACES. 05 PIC X(13) VALUE 'END OF REPORT'. 05 PIC X(110) VALUE SPACES. * PROCEDURE DIVISION. **************************************************************** * 100-MAIN-MODULE - CONTROLS DIRECTION OF PROGRAM LOGIC * **************************************************************** 100-MAIN-MODULE. PERFORM 800-INITIALIZATION-RTN. PERFORM 200-DATE-ACCEPT-RTN. PERFORM UNTIL NO-MORE-RECORDS READ IN-EMPLOYEE-FILE AT END MOVE 'NO ' TO ARE-THERE-MORE-RECORDS NOT AT END PERFORM 400-CALC-RTN END-READ END-PERFORM PERFORM 500-DEPT-BREAK PERFORM 700-END-PROGRAM-RTN PERFORM 900-END-OF-JOB-RTN STOP RUN. *********************************************************** * 200-DATE-ACCEPT-RTN - PERFORMED FROM 100-MAIN-MODULE. * * GETS THE CURRENT DATE FROM THE OPERATING SYSTEM. * *********************************************************** ************************************************************ **TO MAKE THIS PROGRAM Y2K COMPLIANT YOU CAN: ** **A) HAVE THE USER INPUT A DATE WITH A 4-DIGIT YEAR ** WHICH YOU THEN STORE IN A 4-DIGIT YEAR FIELD. ** **B) USE THE CURRENT-DATE FUNCTION ** MOVE FUNCTION CURRENT-DATE TO DATE-AND-TIME ** WHICH IS A 21-POSITION FIELD AS FOLLOWS: ** 01 DATE-AND-TIME. ** 05 FOUR-DIGIT-YEAR PIC 9999. ** 05 T-MONTH PIC 99. ** 05 T-DAY PIC 99. ** SEE PAGE 266 OF THE TEXT. NOTE THAT THIS ** PROCEDURE IS ONLY AVAILABLE WITH COMPILERS ** LIKE MICROFOCUS THAT ACCEPT INTRINSIC FUNCTIONS. ** **C) IF YOU KNOW THAT THE DATE HAS A YEAR < 2000 ** MOVE 19 TO THE LEFTMOST TWO DIGITS OF A ** FOUR-DIGIT YEAR. THAT IS, DEFINE FOUR-DIGIT-YEAR ** AS A GROUP ITEM SUBDIVIDED INTO TWO ELEMENTARY ** ITEMS AND MOVE 19 TO THE HIGH-ORDER OR LEFTMOST ** DIGITS. IF YOU KNOW THAT THE DATE HAS A YEAR >= ** 1999 MOVE 20 (FOR THE NEXT MILLENIUM) TO THE ** HIGH-ORDER OR LEFTMOST TWO-DIGITS. ** ALTERNATIVELY, YOU CAN DEFINE ALL TWO-DIGIT ** YEARS > 25 AS BEING TWENTIETH CENTURY DATES ** AND ALL TWO-DIGIT YEARS <= 25 AS BEING TWENTY- ** FIRST CENTURY YEARS, WHERE 25 IS AN ARBITRARY ** CUT-OFF POINT. FOR EXAMPLE: ** IF YEAR <= 25 ** MOVE 20 TO CENTURY-YEAR OF FOUR-DIGIT-YEAR ** ELSE ** MOVE 19 TO CENTURY-YEAR OF FOUR-DIGIT-YEAR ** END-IF ** MOVE YEAR TO TWO-DIGIT-YEAR. ** ** WHERE THE FOUR-DIGIT YEAR IS DEFINED AS: ** 05 FOUR-DIGIT-YEAR. ** 10 CENTURY-YEAR PIC 99. ** 10 TWO-DIGIT-YEAR PIC 99. ********************************************************* * THE DATE ROUTINE BELOW IS Y2K COMPLIANT 200-DATE-ACCEPT-RTN. * ACCEPT WS-T-DATE FROM DATE - NON Y2K COMPLIANT MOVE FUNCTION CURRENT-DATE TO WS-T-DATE. MOVE WS-IN-MO TO HL-OUT-MO MOVE WS-IN-YR TO HL-OUT-YR MOVE WS-IN-DAY TO HL-OUT-DAY. *********************************************************** * 300-HEADING-RTN PERFORMED FROM 100-MAIN-MODULE, * * 400-CALC-RTN, 500-DEPT-BREAK AND * * 600-TER--BREAK. PRINTS THE HEADINGS * * ON A NEW PAGE * *********************************************************** 300-HEADING-RTN. ADD 1 TO WS-PAGE-CTR. MOVE WS-PAGE-CTR TO HL-OUT-PAGE MOVE WS-TERR-HOLD TO DL-OUT-TERR MOVE WS-DEPT-HOLD TO DL-OUT-DEPT MOVE 0 TO WS-LINE-CTR WRITE OUT-REPORT-REC FROM HL-HEADING1 AFTER ADVANCING PAGE WRITE OUT-REPORT-REC FROM HL-HEADING2 AFTER ADVANCING 2 LINES WRITE OUT-REPORT-REC FROM DL-DEPT-HEADING AFTER ADVANCING 2 LINES WRITE OUT-REPORT-REC FROM DL-TERR-HEADING AFTER ADVANCING 2 LINES WRITE OUT-REPORT-REC FROM HL-HEADING3 AFTER ADVANCING 2 LINES. ********************************************************** * 400-CALC-RTN - PERFORMED FROM 100-MAIN-MODULE * * CONTROLS TERR AND DEPT BREAKS * * PRINTS OUT EMPLOYEE INFORMATION * ********************************************************** 400-CALC-RTN. EVALUATE TRUE WHEN FIRST-RECORD = 'YES' MOVE IN-DEPT TO WS-DEPT-HOLD MOVE IN-TERR TO WS-TERR-HOLD PERFORM 300-HEADING-RTN MOVE 'NO ' TO FIRST-RECORD WHEN IN-DEPT NOT = WS-DEPT-HOLD PERFORM 500-DEPT-BREAK WHEN IN-TERR NOT = WS-TERR-HOLD PERFORM 600-TERR-BREAK END-EVALUATE IF WS-LINE-CTR IS GREATER THAN 25 PERFORM 300-HEADING-RTN END-IF MOVE IN-EMPLOYEE-NO TO DL-OUT-EMPLOYEE-NO MOVE IN-EMPLOYEE-NAME TO DL-OUT-EMPLOYEE-NAME MOVE IN-ANNUAL-SALARY TO DL-OUT-ANNUAL-SALARY WRITE OUT-REPORT-REC FROM DL-SALARY-LINE AFTER ADVANCING 2 LINES ADD IN-ANNUAL-SALARY TO WS-TERR-SALARY ADD 1 TO WS-LINE-CTR. ********************************************************* * 500-DEPT-BREAK - PERFORMED FROM 100-MAIN-MODULE AND * * 400-CALC-RTN, FORCES A TERR BREAK * * THEN PRINTS DEPT TOTALS * ********************************************************* 500-DEPT-BREAK. PERFORM 600-TERR-BREAK. ADD WS-DEPT-SALARY TO WS-TOTAL-SALARY MOVE WS-DEPT-SALARY TO DL-OUT-DEPT-SALARY WRITE OUT-REPORT-REC FROM DL-DEPARTMENT-TOTAL-LINE AFTER ADVANCING 3 LINES ADD 1 TO WS-LINE-CTR IF MORE-RECORDS MOVE ZEROS TO WS-DEPT-SALARY MOVE IN-DEPT TO WS-DEPT-HOLD PERFORM 300-HEADING-RTN END-IF. ******************************************************** * 600-TERR-BREAK - PERFORMED FROM 400-CALC-RTN AND * * 500-DEPT-BREAK, CONTROLS TERR * * BREAK AND PRINTS TERR TOTALS * ******************************************************** 600-TERR-BREAK. ADD WS-TERR-SALARY TO WS-DEPT-SALARY MOVE WS-TERR-SALARY TO DL-OUT-TERR-SALARY WRITE OUT-REPORT-REC FROM DL-TERRITORY-TOTAL-LINE AFTER ADVANCING 3 LINES ADD 1 TO WS-LINE-CTR IF MORE-RECORDS MOVE IN-TERR TO WS-TERR-HOLD MOVE ZEROS TO WS-TERR-SALARY END-IF IF MORE-RECORDS AND IN-DEPT IS EQUAL TO WS-DEPT-HOLD PERFORM 300-HEADING-RTN END-IF. ************************************************************ * 700-END-PROGRAM-RTN - PERFORMED FROM 100-MAIN-MODULE * * PRINTS TOTAL OF ALL SALARIES * ************************************************************ 700-END-PROGRAM-RTN. MOVE WS-TOTAL-SALARY TO DL-OUT-TOT-ANN-SALARY WRITE OUT-REPORT-REC FROM DL-FINAL-TOTAL-LINE AFTER ADVANCING 3 LINES WRITE OUT-REPORT-REC FROM HL-HEADING-FINAL AFTER ADVANCING 2 LINES. ************************************************************ * 800-INITIALIZATION-RTN - PERFORMED FROM 100-MAIN-MODULE * * CONTROLS OPENING OF FILES * ************************************************************ 800-INITIALIZATION-RTN. OPEN INPUT IN-EMPLOYEE-FILE OUTPUT OUT-REPORT-FILE. *********************************************************** * 900-END-OF-JOB-RTN - PERFORMED FROM 100-MAIN-MODULE * * CLOSES THE FILES * *********************************************************** 900-END-OF-JOB-RTN. CLOSE IN-EMPLOYEE-FILE OUT-REPORT-FILE.