1     IDENTIFICATION DIVISION.
 2     PROGRAM-ID.   INCLASS1.
 3     AUTHOR.  GROCER.
 4    *Assignment:
 5    *There are two parts to this assignment:  (1) start at
 6    *the beginning of the procedure division as if you were the
 7    *computer and step through the program listing the line number
 8    *that you are executing each time you move to a new instruction.
 9    *(2) show a listing of the output that would be produced.
10    *
11     ENVIRONMENT DIVISION.
12     INPUT-OUTPUT SECTION.
13     FILE-CONTROL.
14         SELECT COURSE-FILE
15             ASSIGN TO "A:\COURSE.DAT".
16         SELECT PRINT-FILE
17             ASSIGN TO PRINTER.
18     DATA DIVISION.
19     FILE SECTION.
20     FD  COURSE-FILE
21         DATA RECORD IS COURSE-REC.
22     01  COURSE-REC.
23         05  COURSE-ID                    PIC X(5).
24         05  COURSE-NAME                  PIC X(25).
25         05  DEPT-CODE                    PIC XX.
26         05  DEPT-NAME                    PIC X(20).
27         05  INSTRUCTOR-NAME              PIC X(15).
28     FD  PRINT-FILE
29         DATA RECORD IS PRINTZ.
30     01  PRINTZ.
31         05  FILLER                       PIC X.
32         05  COURSE-ID-PR                PIC X(5).
33         05  FILLER                       PIC X.
34         05  COURSE-NAME-PR               PIC X(25).
35         05  FILLER                       PIC X(3).
36         05  INSTRUCTOR-NAME-PR           PIC X(15).
37         05  FILLER                       PIC X(5).
38         05  DEPT-NAME-PR                 PIC X(20).
39         05  FILLER                       PIC X(2).
40         05  DEPT-CODE-PR                 PIC X(2).
41         05  FILLER                       PIC X.
42     WORKING-STORAGE SECTION.
43     01  INDICATORS.
44         05  NO-MORE-RECORDS        PIC XXX      VALUE "NO ".
45     PROCEDURE DIVISION.
46     MAIN-PROGRAM.
47         PERFORM A-100-START-UP.
48         PERFORM B-100-PROCESS-FILE.
49         PERFORM C-100-WRAP-UP.
50         STOP RUN.
51     A-100-START-UP.
52         OPEN INPUT COURSE-FILE
53              OUTPUT PRINT-FILE.
54     B-100-PROCESS-FILE.
55         READ COURSE-FILE
56             AT END
57                MOVE "YES" TO NO-MORE-RECORDS.
58         PERFORM B-200-PROCESS-RECORD
59             UNTIL NO-MORE-RECORDS = "YES".
60     B-200-PROCESS-RECORD.
61         MOVE SPACES TO PRINTZ.
62         MOVE COURSE-ID TO COURSE-ID-PR.
63         MOVE COURSE-NAME TO COURSE-NAME-PR.
64         MOVE INSTRUCTOR-NAME TO INSTRUCTOR-NAME-PR.
65         MOVE DEPT-CODE TO DEPT-CODE-PR.
66         MOVE DEPT-NAME TO DEPT-NAME-PR.
67         WRITE PRINTZ
68             AFTER ADVANCING 1 LINE.
69         READ COURSE-FILE
70             AT END
71                MOVE "YES" TO NO-MORE-RECORDS.
72     C-100-WRAP-UP.
73         CLOSE COURSE-FILE
74                 PRINT-FILE.
      *
      *Note: An * in col 7 makes the line a comment.  I have cut and
      *pasted the data from the input file into the end of the program
      *as comments.  I did this so you could conveniently see the data.
      *The input file being processed by this program contains the
      *following FOUR records.  Remember the * is simply denoting 
      *a comment, so the data record process as if the first character
      *in the record was the first character after the *.  In the first
      *record the first character of the record is a C, the second 
      *character is a I etc.  The line numbers in the rows above the
      *data are to try and help you see the data layout better.
      *
      *         1111111111222222222233333333334444444444555555555566666666
      *1234567890123456789012345678901234567890123456789012345678901234567
      *
      *CIS11INTRO TO CIS             CICOMPUTER INFO SYSTEMARRUDA
      *CIS12INTRO TO PROGRAMMING     CICOMPUTER INFO SYSTEMGROCER
      *CIS53OPERATING SYSTEMS        CICOMPUTER INFO SYSTEMSANFORD
      *ACCIIINTRO TO ACCOUNTING      BUBUSINESS            GARAND
      *
      *The output that results from running this program is: