IDENTIFICATION DIVISION.
       PROGRAM-ID.    SAMPLE.
       AUTHOR.        NANCY STERN.
      *********************************************************
      *   THIS PROGRAM SORTS A FILE INTO TERR AREA DEPT ORDER *
      *   AND ALSO INCLUDES AN INPUT AND OUTPUT PROCEDURE     *
      *********************************************************
      *** This program has no date procedures so it is Y2K compliant **
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT IN-FILE ASSIGN TO DISK 'DAT146'.
           SELECT SORT-FILE ASSIGN TO DISK 'SORT1'.
           SELECT OUT-FILE ASSIGN TO DISK 'OUT146'.
      *
       DATA DIVISION.
       FILE SECTION.
       FD  IN-FILE
           LABEL RECORDS ARE STANDARD.
       01  IN-REC                        PIC X(28).
       SD  SORT-FILE.
       01  SORT-REC.
           05  TERR                      PIC XX.
           05  AREAX                     PIC XXX.
           05  DEPT                      PIC XXX.
           05  LAST-NAME                 PIC X(12).
           05  FIRST-NAME                PIC X(8).
       FD  OUT-FILE
           LABEL RECORDS ARE STANDARD.
       01  OUT-REC                       PIC X(28).
       WORKING-STORAGE SECTION.
       01  STORED-AREAS.
           05  ARE-THERE-MORE-RECORDS    PIC X(3) VALUE 'YES'.
               88  NO-MORE-RECORDS                VALUE 'NO '.
           05  COUNT1                    PIC 999  VALUE ZERO.
       PROCEDURE DIVISION.
      *******************************************************
      *   THIS IS THE MAIN MODULE OF THE PROGRAM.           *
      *   WITH COBOL 74, SEPARATE SECTIONS ARE REQUIRED     *
      *******************************************************
       100-MAIN-MODULE.
           SORT SORT-FILE
              ASCENDING KEY TERR
              ASCENDING KEY AREAX
              ASCENDING KEY DEPT
            INPUT PROCEDURE IS 200-COUNT1-INPUT
            OUTPUT PROCEDURE IS 300-ELIM-BLANK-TERR
            DISPLAY COUNT1
            STOP RUN.
      *******************************************************
      *   THIS IS THE INPUT PROCEDURE                       *
      *******************************************************
       200-COUNT1-INPUT.
      *******************************************************
      *   OPENS THE INPUT FILE, READS RECORDS, COUNTS THEM  *
      *        AND RELEASES THEM TO THE SORT FILE           *
      *******************************************************
           OPEN INPUT IN-FILE.
           PERFORM UNTIL NO-MORE-RECORDS
               READ IN-FILE
                  AT END
                    MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
                  NOT AT END
                    PERFORM 250-CALC-RTN
               END-READ
           END-PERFORM
           CLOSE IN-FILE.
       250-CALC-RTN.
           ADD 1 TO COUNT1
           RELEASE SORT-REC FROM IN-REC.
      *****************************************************
      *     THIS IS THE OUTPUT PROCEDURE                  *
      *****************************************************
       300-ELIM-BLANK-TERR.
      *****************************************************
      *   OPENS THE OUTPUT FILE, RETURNS RECORDS FROM     *
      *   THE SORT FILE, ELIMINATES RECORDS WITH BLANK    *
      *   TERR, AND WRITES RECORDS TO THE OUTPUT FILE     *
      *****************************************************
           OPEN OUTPUT OUT-FILE
           MOVE 'YES' TO ARE-THERE-MORE-RECORDS
           PERFORM UNTIL TERR IS NOT EQUAL TO SPACES
                 OR NO-MORE-RECORDS
              RETURN SORT-FILE
                AT END
                   MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
                NOT AT END
                   CONTINUE
              END-RETURN
           END-PERFORM
           PERFORM UNTIL NO-MORE-RECORDS
               RETURN SORT-FILE
                 AT END
                   MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
                 NOT AT END
                   WRITE OUT-REC FROM SORT-REC
               END-RETURN
           END-PERFORM
           CLOSE OUT-FILE.