IDENTIFICATION DIVISION.
       PROGRAM-ID. CH0601.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT PURCHASE-TRANS  ASSIGN TO 'CH6'.
           SELECT PURCHASE-REPORT ASSIGN TO PRINTER.
       DATA DIVISION.
       FILE SECTION.
       FD  PURCHASE-TRANS
           LABEL RECORDS ARE STANDARD
           RECORD CONTAINS 32 CHARACTERS.
       01  TRANS-REC-IN.
           05  CUST-NO-IN                      PIC X(5).
           05  CUST-NAME-IN                    PIC X(20).
           05  AMT-OF-PUR-IN                   PIC 9(5)V99.
       FD  PURCHASE-REPORT
           LABEL RECORDS ARE OMITTED
           RECORD CONTAINS 132 CHARACTERS.
       01  PRINT-REC                           PIC X(132).
       WORKING-STORAGE SECTION.
       01  WORK-AREAS.
           05  ARE-THERE-MORE-RECORDS          PIC XXX
                  VALUE 'YES'.
      *  WS-DATE must contain a 4-digit year to be Y2K compliant  **
           05  WS-DATE.
               10  WS-YEAR                     PIC 9999.
               10  WS-MONTH                    PIC 99.
               10  WS-DAY                      PIC 99.
		   10  WS-TIME                     PIC 9(13).
           05  WS-PAGE-CT                      PIC 99
                  VALUE ZERO.
           05  WS-LINE-CT                      PIC 99
                  VALUE ZERO.
       01  HDR1-OUT.
           05                                  PIC X(40)
                  VALUE SPACES.
           05                                  PIC X(20)
                  VALUE 'PURCHASE REPORT'.
           05  DATE-OUT.
               10  MONTH-OUT                   PIC 99.
               10                              PIC X
                  VALUE '/'.
               10  DAY-OUT                     PIC 99.
               10                              PIC X
                  VALUE '/'.
      *  Years must be 4-digits to be Y2K compliant  ***
               10  YEAR-OUT                    PIC 9999.
           05                                  PIC X(2)
                  VALUE SPACES.
           05                                  PIC X(5)
                  VALUE 'PAGE'.
           05  PAGE-OUT                        PIC Z9.
           05                                  PIC X(55)
                  VALUE SPACES.
       01  HDR2-OUT.
           05                                  PIC X(10)
                  VALUE SPACES.
           05                                  PIC X(27)
                  VALUE 'CUSTOMER NO   CUSTOMER NAME'.
           05                                  PIC X(13)
                  VALUE SPACES.
           05                                  PIC X(82)
                  VALUE 'AMOUNT OF PURCHASE'.
       01  DETAIL-REC-OUT.
           05                                  PIC X(13)
                  VALUE SPACES.
           05  CUST-NO-OUT                     PIC X(5).
           05                                  PIC X(6)
                  VALUE SPACES.
           05  CUST-NAME-OUT                   PIC X(20).
           05                                  PIC X(11)
                  VALUE SPACES.
           05  AMT-OF-PUR-OUT                  PIC Z(5).99.
           05                                  PIC X(69)
                  VALUE SPACES.
       PROCEDURE DIVISION.
      ****************************************************
      *     ALL PROGRAM LOGIC IS CONTROLLED BY THE       *
      *              MAIN-MODULE                         *
      ****************************************************
       100-MAIN-MODULE.
           OPEN INPUT  PURCHASE-TRANS
                OUTPUT PURCHASE-REPORT
      ********************************************************
      ****   TO MAKE THIS PROGRAM Y2K COMPLIANT YOU MUST
      ****  REPLACE ACCEPT WS-DATE FROM DATE WITH ONE OF THE FOLLOWING:
      ****   A)  HAVE THE USER INPUT A DATE WITH A 4-DIGIT YEAR WHICH
      ****             YOU STORE IN A 4-DIGIT WS-T-YR FIELD.
      ****   B) USE THE CURRENT-DATE FUNCTION:  MOVE FUNCTION 
      ****             CURRENT-DATE TO CURRENT-DATE-AND-TIME WHICH IS 
      ****             A 21-POSITION FIELD AS FOLLOWS:
      ****          01  WS-T-DATE.
      ****                05  WS-T-YR            PIC 9999.
      ****                05  WS-T-MONTH         PIC 99.
      ****                05  WS-T-DAY           PIC 99. 
      ****                05  WS-T-TIME          PIC X(13).
      ****        SEE P. 266 OF THE TEXT. WS-T-YR WILL BE FOUR DIGITS.  
      ****        NOTE  THAT THIS PROCEDURE IS ONLY AVAILABLE ON 
      ****        COMPILERS WHICH  ACCEPT INTRINSIC ROUTINES.  THE 
      ****        MICROFOCUS COMPILER WHICH CAN BE PURCHASED WITH 
      ****        THIS TEXT INCLUDES THIS FUNCTION BUT THE RM/COBOL  
      ****        COMPILER DOES NOT.
      ****  C) IF YOU KNOW THAT THE DATE HAS A YEAR < 2000 ADD '19' TO 
      ****     THE OUTPUT YEAR.  IF YOU KNOW THAT THE DATE HAS A 
      ****     YEAR > 1999 ADD '20' TO THE OUTPUT YEAR.
      *****************************************************************
      *    ACCEPT WS-DATE FROM DATE -NON Y2K COMPLIANT
           MOVE FUNCTION CURRENT-DATE TO WS-DATE
           MOVE WS-MONTH TO MONTH-OUT
           MOVE WS-DAY TO DAY-OUT
           MOVE WS-YEAR TO YEAR-OUT
           PERFORM 200-HDG-RTN.
           PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'NO '
               READ PURCHASE-TRANS
                    AT END
                       MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
                    NOT AT END
                       PERFORM 300-REPORT-RTN
               END-READ
           END-PERFORM
           CLOSE PURCHASE-TRANS
                 PURCHASE-REPORT
           STOP RUN.
      *******************************************************
      *   200-HDG-RTN IS EXECUTED ONCE FROM THE MAIN MODULE *
      *        AND THEN AGAIN AFTER 25 DETAIL LINES PRINT   *
      *******************************************************
       200-HDG-RTN.
           ADD 1 TO WS-PAGE-CT
           MOVE WS-PAGE-CT TO PAGE-OUT
           WRITE PRINT-REC FROM HDR1-OUT
                AFTER ADVANCING PAGE
           WRITE PRINT-REC FROM HDR2-OUT
                AFTER ADVANCING 2 LINES
           MOVE ZEROS TO WS-LINE-CT.
      *******************************************************
      *    300-REPORT-RTN IS EXECUTED FROM THE MAIN-MODULE  *
      *       UNTIL ALL INPUT RECORDS HAVE BEEN PROCESSED   *
      *******************************************************
       300-REPORT-RTN.
           IF WS-LINE-CT >= 25
               PERFORM 200-HDG-RTN
           END-IF
           MOVE SPACES TO DETAIL-REC-OUT
           MOVE CUST-NO-IN TO CUST-NO-OUT
           MOVE CUST-NAME-IN TO CUST-NAME-OUT
           MOVE AMT-OF-PUR-IN TO AMT-OF-PUR-OUT
           WRITE PRINT-REC FROM DETAIL-REC-OUT
               AFTER ADVANCING 2 LINES
           ADD 1 TO WS-LINE-CT.