PROGRAM WITH HEADERS

This program modifies the first sample program to include headers above the columns in the printed report (if the report has multiple pages, this program will only print the headers on the first page - later we will deal with headers on every page). There are two things that need to be coded to accomplish this:

Setup of headers:

The code below shows the headers set up in the WORKING-STORAGE SECTION. Notice that each of the fields on the header has a value clause to establish an initial value. The initial value can either be characters you want to print or spaces to assure the area is empty. As we look at the VALUE clause, it should be note that with one unique usage exception the VALUE CLAUSE CAN NOT BE USED IN THE FILE SECTION, but it is heavily used in the WORKING-STORAGE SECTION. This makes sense when you think about it. The FILE SECTION is reserved for data coming in from an external file or going out to an external file so the data is constantly changing and the need for the VALUE clause is limited.

For the PAGE-HDR, I wanted to center the header in the middle of the line - this is done by putting matching (or close to matching) FILLERs at the beginning and end of the line. The FILLER in the middle contains the literal that I want to print. Notice that the literal after VALUE is enclosed in quotes because it is a non-numeric literal and the rule is that all NON-NUMERIC LITERALS ARE ENCLOSED IN QUOTES. Again, please note that the word FILLER is not required in COBOL '85. I use it because I like the implied message that this is indeed filler.

For the COLUMN-HDR, I looked at the layout of the detail line that I am going to print (it is layed out in PRINTZ) and I set-up the fields in the column header so that the values that describe the column will be directly over the column. I did this by matching field for field in the example below. However this is reasonably time consuming and pencil heavy, so directly beneath the example, I have laid out a column header that accomplishes exactly the same thing but with less code. To do this I simply combined some of the FILLERS and their VALUES to accomplish the same thing.
	01  PAGE-HDR.
	    05  FILLER        PIC X(24)      VALUE SPACES.
	    05  FILLER        PIC X(32)
                              VALUE "CUSTOMER NAME AND ADDRESS REPORT".
	    05  FILLER        PIC X(24)      VALUE SPACES.
	01  COLUMN-HDR.
	    05  FILLER        PIC X      	VALUE SPACES.
	    05  FILLER        PIC X(4)   	VALUE "ID #".
	    05  FILLER        PIC X(2)   	VALUE SPACES.
	    05  FILLER        PIC X(13)  	VALUE "CUSTOMER NAME".
	    05  FILLER        PIC X(9)   	VALUE SPACES.
	    05  FILLER        PIC X(14)  	VALUE "STREET ADDRESS".
	    05  FILLER        PIC X(8)   	VALUE SPACES.
	    05  FILLER        PIC X(4)   	VALUE "CITY".
	    05  FILLER        PIC X(11)  	VALUE SPACES.
	    05  FILLER        PIC X(5)   	VALUE "STATE".
	    05  FILLER        PIC X      	VALUE SPACES.
	    05  FILLER        PIC X(3)   	VALUE "ZIP".
	    05  FILLER        PIC X(5)   	VALUE SPACES.
An alternative way to set up the COLUMN-HDR that will result in exactly the same output:
    01	COLUMN-HDR.
	05  FILLER	      PIC X(7)        VALUE " ID #  ".
	05  FILLER	      PIC X(13)      VALUE "CUSTOMER NAME".
	05  FILLER	      PIC X(9)        VALUE SPACES.
	05  FILLER	      PIC X(14)      VALUE "STREET ADDRESS".
	05  FILLER	      PIC X(23)      VALUE "        CITY           ".
	05  FILLER	      PIC X(14)      VALUE "STATE ZIP     ".
Note that in the first FILLER for PIC X(7) there is one space followed by ID followed by another space, followed by # followed by two more spaces for a total of 7. In the fifth FILLER, there are 8 spaces, followed by the word CITY, followed by 11 spaces for a total of 23. In the sixth FILLER, there is the word STATE followed by 1 space, followed by the word ZIP, followed by 5 spaces.

Code to write the headers:

Since this program only has headers appearing on the first page, they can be classified as part of the initializing or start-up code (later, we will look at the differences when we want to print a header on every page). This means that the code will appear in the paragraph called A-100-INITIALIZATION right after the files are OPENed. Remember the rule saying that all INPUT and OUTPUT must pass through the FILE SECTION. This means that when we WRITE a line to the printer, we must WRITE PRINTZ since PRINTZ is the dataname given the records in the printfile and the dataname defined on the 01 level of the FD. The headers that we want to write have been defined in the WORKING-STORAGE SECTION. This presents a minor problem that is easily resolved. What we will do is either move the header to PRINTZ and then write PRINTZ or use the WRITE FROM instruction which acts as if the data was moved. The two approaches are illustrated below using the COLUMN-HDR as the line to be written:
       MOVE COLUMN-HDR TO PRINTZ.
       WRITE PRINTZ	
           AFTER ADVANCING 2 LINES.
or alternatively:
       WRITE PRINTZ FROM COLUMN-HDR
	   AFTER ADVANCING 2 LINES.
In my sample program, I used the second approach.

There are a couple of more things involved in writing the headers. First, we want to write the PAGE-HDR at the top of the page. To do this we can use the reserved word PAGE in the AFTER ADVANCING clause. AFTER ADVANCING PAGE means that the line will be written after advancing to the top of a new page. Second, we want to leave a blank line between the PAGE-HDR and the COLUMN-HDR. This can be accomplished by using AFTER ADVANCING 2 LINES which moves the printer down two lines and writes on the second line. Third, we want to write a blank line. This can be done by moving SPACES (the reserved word) to PRINTZ and then writing PRINTZ which contains only spaces AFTER ADVANCING 1 LINES. This will write my line of blanks.
	A-100-INITIALIZATION.
	    OPEN INPUT CUSTOMER-FILE
                 OUTPUT CUSTOMER-REPORT.
	    WRITE PRINTZ FROM PAGE-HDR
                AFTER ADVANCING PAGE.
	    WRITE PRINTZ FROM COLUMN-HDR
		AFTER ADVANCING 2 LINES.
           MOVE SPACES TO PRINTZ.
           WRITE PRINTZ
                AFTER ADVANCING 1 LINES.
The entire program illustrated above is shown here:
       IDENTIFICATION DIVISION.
       PROGRAM-ID.   SAMPLE2.
       AUTHOR.  GROCER
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT CUSTOMER-FILE
               ASSIGN TO "C:\PCOBWIN\CIS12FST\C12FIRST.DAT".
           SELECT CUSTOMER-REPORT
               ASSIGN TO PRINTER.
       DATA DIVISION.
       FILE SECTION.
       FD  CUSTOMER-FILE
           DATA RECORD IS CUSTOMER-RECORD.
       01  CUSTOMER-RECORD.
           05  CUSTOMER-ID                  PIC X(4).
           05  CUSTOMER-NAME                PIC X(20).
           05  CUSTOMER-STREET              PIC X(20).
           05  CUSTOMER-CITY                PIC X(15).
           05  CUSTOMER-STATE               PIC X(2).
           05  CUSTOMER-ZIP                 PIC X(5).
           05  FILLER                       PIC X(10).
       FD  CUSTOMER-REPORT
           DATA RECORD IS PRINTZ.
       01  PRINTZ.
           05  FILLER                       PIC X.
           05  CUSTOMER-ID-PR               PIC X(4).
           05  FILLER                       PIC X(2).
           05  CUSTOMER-NAME-PR             PIC X(20).
           05  FILLER                       PIC X(2).
           05  CUSTOMER-STREET-PR           PIC X(20).
           05  FILLER                       PIC X(2).
           05  CUSTOMER-CITY-PR             PIC X(15).
           05  FILLER                       PIC X(2).
           05  CUSTOMER-STATE-PR            PIC X(2).
           05  FILLER                       PIC X(2).
           05  CUSTOMER-ZIP-PR              PIC X(5).
           05  FILLER                       PIC X(3).
       WORKING-STORAGE SECTION.
       01  INDICATORS.
           05  END-OF-FILE                  PIC XXX      VALUE "NO ".
       01  PAGE-HDR.
           05  FILLER        PIC X(24)      VALUE SPACES.
           05  FILLER        PIC X(32)
                             VALUE "CUSTOMER NAME AND ADDRESS REPORT".
           05  FILLER        PIC X(24)      VALUE SPACES.
       01  COLUMN-HDR.
           05  FILLER        PIC X      VALUE SPACES.
           05  FILLER        PIC X(4)   VALUE "ID #".
           05  FILLER        PIC X(2)   VALUE SPACES.
           05  FILLER        PIC X(13)  VALUE "CUSTOMER NAME".
           05  FILLER        PIC X(9)   VALUE SPACES.
           05  FILLER        PIC X(14)  VALUE "STREET ADDRESS".
           05  FILLER        PIC X(8)   VALUE SPACES.
           05  FILLER        PIC X(4)   VALUE "CITY".
           05  FILLER        PIC X(11)  VALUE SPACES.
           05  FILLER        PIC X(5)   VALUE "STATE".
           05  FILLER        PIC X      VALUE SPACES.
           05  FILLER        PIC X(3)   VALUE "ZIP".
           05  FILLER        PIC X(5)   VALUE SPACES.
       PROCEDURE DIVISION.
       MAIN-PROGRAM.
           PERFORM A-100-INITIALIZATION.
           PERFORM B-100-PROCESS-FILE.
           PERFORM C-100-WRAP-UP.
           STOP RUN.
       A-100-INITIALIZATION.
           OPEN INPUT CUSTOMER-FILE
                OUTPUT CUSTOMER-REPORT.
           WRITE PRINTZ FROM PAGE-HDR
                AFTER ADVANCING PAGE.
           WRITE PRINTZ FROM COLUMN-HDR
                AFTER ADVANCING 2 LINES.
           MOVE SPACES TO PRINTZ.
           WRITE PRINTZ
                AFTER ADVANCING 1 LINES.
       B-100-PROCESS-FILE.
           READ CUSTOMER-FILE
               AT END
                  MOVE "YES" TO END-OF-FILE.
           PERFORM B-200-PROCESS-RECORD
               UNTIL END-OF-FILE = "YES".
       B-200-PROCESS-RECORD.
           MOVE SPACES TO PRINTZ.
           MOVE CUSTOMER-ID TO CUSTOMER-ID-PR.
           MOVE CUSTOMER-NAME TO CUSTOMER-NAME-PR.
           MOVE CUSTOMER-STREET TO CUSTOMER-STREET-PR.
           MOVE CUSTOMER-CITY TO CUSTOMER-CITY-PR.
           MOVE CUSTOMER-STATE TO CUSTOMER-STATE-PR.
           MOVE CUSTOMER-ZIP TO CUSTOMER-ZIP-PR.
           WRITE PRINTZ
               AFTER ADVANCING 1 LINE.
           READ CUSTOMER-FILE
               AT END
                  MOVE "YES" TO END-OF-FILE.
       C-100-WRAP-UP.
           CLOSE CUSTOMER-FILE
                 CUSTOMER-REPORT.
      *
      *Note: An * in col 7 makes the line a comment.
      *The input file being processed by this program contains the
      *following three records:
      *
      *1234Jane Doe            123 Elm St          Fall River     MA02771
      *2345Ann Smith           45 Oak St           Braintree      MA02184
      *3456Susan Ash           234 Maple St        Weymouth       MA02180
      *
      *
      *
      *Output that was produced:
      *
      *                        CUSTOMER NAME AND ADDRESS REPORT
      *
      * ID #  CUSTOMER NAME         STREET ADDRESS        CITY           STATE ZIP
      *
      * 1234  Jane Doe              123 Elm St            Fall River       MA  02771
      * 2345  Ann Smith             45 Oak St             Braintree        MA  02184
      * 3456  Susan Ash             234 Maple St          Weymouth         MA  02180