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:
- first, the headers need to be setup in WORKING-STORAGE
- second, the code to write the headers must be included in the PROCEDURE
DIVISION.
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