IDENTIFICATION DIVISION.
       PROGRAM-ID.  SAMPLE16.
       AUTHOR. NANCY STERN.
      * This program has no date procedures so it is Y2K compliant **
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT EMPLOYEE-FILE ASSIGN TO DISK 'DISK16'.
           SELECT REPORT-FILE   ASSIGN TO PRINTER.
       DATA DIVISION.
       FILE SECTION.
       FD  EMPLOYEE-FILE
           LABEL RECORDS ARE STANDARD.
       01  EMPLOYEE-REC.
           05  SOC-SEC-NO                PIC X(9).
           05  EMPLOYEE-NAME             PIC X(20).
           05  EMPLOYEE-ADDRESS          PIC X(50).
       FD  REPORT-FILE
           LABEL RECORDS ARE OMITTED.
       01  REPORT-REC                    PIC X(132).
       WORKING-STORAGE SECTION.
       01  WORK-AREAS.
           05  ARE-THERE-MORE-RECORDS    PIC X(3)        VALUE 'YES'.
               88  NO-MORE-RECORDS                       VALUE 'NO '.
       01  DATA-TO-BE-SENT-TO-UNSTRING.
           05  EMPLOYEE-ADDRESS-STR      PIC X(50).
           05  DATA-UNSTRING.
               10  STREET-ADDRESS        PIC X(15).
               10  CITY                  PIC X(20).
               10  STATE                 PIC XX.
               10  ZIP-CODE              PIC X(5).
       01  HEADER1.
           05                            PIC X(50)       VALUE SPACES.
           05                            PIC X(32)
              VALUE 'E M P L O Y E E   A D D R E S S'.
           05                            PIC X(50)       VALUE SPACES.
       01  HEADER2.
           05                            PIC X(20)       VALUE SPACES.
           05                            PIC X(34)
              VALUE 'SOC. SEC. NO.        EMPLOYEE NAME'.
           05                            PIC X(28)       VALUE SPACES.
           05                            PIC X(16)
              VALUE 'EMPLOYEE ADDRESS'.
           05                            PIC X(34)       VALUE SPACES.
       01  DETAIL-LINE.
           05                            PIC X(22)       VALUE SPACES.
           05  SOC-SEC-NUMBER-OUT        PIC X(9).
           05                            PIC X(8)        VALUE SPACES.
           05  EMPLOYEE-NAME-OUT         PIC X(20).
           05                            PIC X(5)        VALUE SPACES.
           05  STREET-ADDRESS-OUT        PIC X(15).
           05                            PIC XX          VALUE SPACES.
           05  CITY-OUT                  PIC X(20).
           05                            PIC XX          VALUE SPACES.
           05  STATE-OUT                 PIC XX.
           05                            PIC XX          VALUE SPACES.
           05  ZIP-CODE-OUT              PIC X(5).
           05                            PIC X(20)       VALUE SPACES.
       PROCEDURE DIVISION.
       100-MAIN1.
           OPEN INPUT  EMPLOYEE-FILE
                OUTPUT REPORT-FILE
           PERFORM 300-HEADING-RTN
           PERFORM UNTIL NO-MORE-RECORDS
               READ EMPLOYEE-FILE
                   AT END
                      MOVE 'NO' TO ARE-THERE-MORE-RECORDS
                   NOT AT END
                      PERFORM 200-REPORT-RTN
               END-READ
           END-PERFORM
           CLOSE EMPLOYEE-FILE
                 REPORT-FILE
           STOP RUN.
       200-REPORT-RTN.
           MOVE EMPLOYEE-ADDRESS TO EMPLOYEE-ADDRESS-STR
           CALL 'UNSTR' USING DATA-TO-BE-SENT-TO-UNSTRING
           MOVE SOC-SEC-NO TO SOC-SEC-NUMBER-OUT
           MOVE EMPLOYEE-NAME TO EMPLOYEE-NAME-OUT
           MOVE STATE TO STATE-OUT
           MOVE CITY TO CITY-OUT
           MOVE ZIP-CODE TO ZIP-CODE-OUT
           MOVE STREET-ADDRESS TO STREET-ADDRESS-OUT
           WRITE REPORT-REC FROM DETAIL-LINE
                AFTER ADVANCING 2 LINES.
       300-HEADING-RTN.
           WRITE REPORT-REC FROM HEADER1
              AFTER ADVANCING PAGE
           WRITE REPORT-REC FROM HEADER2
              AFTER ADVANCING 4 LINES.