COBOL has been in the news quite a lot recently and I have been reading that there are still huge amounts of COBOL code running and being written. This led me to wonder why this language was still being used. I therefore decided to look at a few sites about COBOL and see what they said was good about the language. The main benefits appeared to be that it is portable and self-documenting. Indeed, I often read about how COBOL programmers say that they can go to code written 10-15 years ago and still easily understand what is happening.

In 1994, while at college, I did a year of COBOL. I haven’t touched it since that time, and have barely even thought about it. I therefore thought that this would be a good test. I admit that the premise above, about the ease of understanding code written a long time ago, refers to people with more COBOL experience than I. However, I was curious to see how much I would understand.

The code I have chosen was originally written to run under MS-DOS, but unfortunately I can’t remember which compiler was used. It probably isn’t the best COBOL code ever written, but I hope that it will help me to explore how easy it is to return to old code. At times throughout this article I may well refer to things by the wrong name, please bear in mind that the purpose of the article is to test the premise “Is COBOL really understandable after 14 years?”, not to teach COBOL.

I have put the full code, associated data file, example output and instructions on how to compile and run the program at the bottom of this article.

Analysis of the code

After taking a quick look at the code I remember that COBOL is split into DIVISIONs, SECTIONs and paragraphs. I will go through each DIVISION in turn and try to explain what is happening. I have purposely not looked up anything while doing this to try and test the premise fully.

The IDENTIFICATION DIVISION

This is fairly unremarkable and is just used to identify what the code is and who wrote it.

IDENTIFICATION DIVISION.
PROGRAM-ID. ASSIGN1.
AUTHOR. xxxxxxxxxx
* Assignment 1 for COBOL.

The ENVIRONMENT DIVISION

This DIVISION is used to specify the environment in which the code will run. The power of this DIVISION is that you can easily change the environment in which the program is running just by making alterations here.

ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TAG2-FILE ASSIGN TO "TAG2.DAT".
SELECT REP-FILE ASSIGN TO "PRN".

Within the above DIVISION we can see the INPUT-OUTPUT SECTION and within that we can see the FILE-CONTROL paragraph. This is telling the program what names to use to refer to the files and what those files are called. I can see from this that we have a file called TAG2.DAT and another called PRN. Under MS-DOS, PRN referred to the printer. However when this is run under Linux it will just create a file called PRN.

The DATA DIVISION

This DIVISION specifies how data is stored and structured.

DATA DIVISION.
FILE SECTION.
FD TAG2-FILE.
01 TAG2-RCD.
  03 TAG2-ORD-NBR  PIC 9(4).
  03 TAG2-ACC-NBR  PIC A9(7)A.
  03 TAG2-COLOUR   PIC A(3).
  03 TAG2-PRN      PIC A(2).
  03 TAG2-QTY      PIC 9(2).
  03 TAG2-TAG      PIC A(20).
  03 TAG2-DATE     PIC X(6).

FD REP-FILE.
01 REP-RCD.
  03 REP-ACC-NBR   PIC A9(7)A.
  03 FILLER        PIC X(7)       VALUE SPACES.
  03 REP-TAG       PIC A(20).
  03 FILLER        PIC X(9)       VALUE SPACES.
  03 REP-PRN       PIC AA.
  03 FILLER        PIC X(6)       VALUE SPACES.
  03 REP-QTY       PIC Z9.
  03 FILLER        PIC X(6)       VALUE SPACES.

The first SECTION here is the FILE SECTION, which is specifying how the files assigned in the ENVIRONMENT DIVISION to TAG2-FILE and REP-FILE are structured.

If we take TAG2-FILE we can see that it’s biggest structure is TAG2-RCD which is representing a record. This record is split into 7 fields. The PIC statements after the names of the field specify the format of the field. For TAG2-ORD-NBR this is 9(4) representing 4 numeric characters. For TAG2-ACC-NBR this is A9(7)A representing an alphabetical character then 7 numeric characters then an alphabetical character. Finally TAG2-DAT has X(6) representing 6 characters of any type.

WORKING-STORAGE SECTION.
   01 WS1-AREA.
      03 WS1-LCNT  PIC 99 VALUE 70.

      03 WS1-DATE.
         05 WS1-YR   PIC XX.
         05 WS1-MT   PIC XX.
         05 WS1-DY   PIC XX.

      03 WS1-HDR-AREA.
         05 WS1-DAY       PIC XX.
         05 FILLER        PIC X VALUE '/'.
         05 WS1-MTH       PIC XX.
         05 FILLER        PIC X VALUE '/'.
         05 WS1-YER       PIC XX.
         05 FILLER        PIC X(10) VALUE SPACES.
         05 FILLER        PIC X(19) VALUE 'NAME TAG REPORT - 2'.
         05 FILLER        PIC X(15) VALUE SPACES.
         05 FILLER        PIC X(4)  VALUE 'PAGE'.
         05 FILLER        PIC X(1)  VALUE SPACES.
         05 WS1-PAGE-NBR  PIC Z9.

     03 WS1-PAGE-EDIT    PIC 99 VALUE 0.

     03 WS1-SUB-HDR.
        05 FILLER        PIC X(19) VALUE SPACES.
        05 FILLER        PIC X(9)  VALUE 'COLOUR - '.
        05 SUB-COLOUR    PIC X(5)  VALUE SPACES.

     03 WS1-SUB-HDR2.
        05 FILLER        PIC X(9)  VALUE 'Acct.Nbr.'.
        05 FILLER        PIC X(7)  VALUE SPACES.
        05 FILLER        PIC X(11) VALUE 'Name on Tag'.
        05 FILLER        PIC X(18) VALUE SPACES.
        05 FILLER        PIC X(4)  VALUE 'Type'.
        05 FILLER        PIC X(4)  VALUE SPACES.
        05 FILLER        PIC X(4)  VALUE 'Qty.'.

     03 WS1-COLOR-CHECK PIC A(3)   VALUE SPACES.

     03 WS1-RESULT1.
        05 FILLER        PIC X(5)  VALUE SPACES.
        05 FILLER        PIC X(23) VALUE
                              'RED.........QUANTITY - '.
        05 WS1-RED-TOTAL PIC ZZZ9.
        05 FILLER        PIC X(7)  VALUE SPACES.
        05 FILLER        PIC X(4)  VALUE 'COST'.
        05 FILLER        PIC X     VALUE SPACE.
        05 WS1-RED-COST  PIC $$$$9.99.

     03 WS1-RESULT2.
        05 FILLER        PIC X(5)  VALUE SPACES.
        05 FILLER        PIC X(23) VALUE
                              'BLUE........QUANTITY - '.
        05 WS1-BLU-TOTAL PIC ZZZ9.
        05 FILLER        PIC X(7)  VALUE SPACES.
        05 FILLER        PIC X(4)  VALUE 'COST'.
        05 FILLER        PIC X     VALUE SPACE.
        05 WS1-BLU-COST  PIC $$$$9.99.

     03 WS1-RESULT3.
        05 FILLER        PIC X(5)  VALUE SPACES.
        05 FILLER        PIC X(23) VALUE
                              'BLACK.......QUANTITY - '.
        05 WS1-BLA-TOTAL PIC ZZZ9.
        05 FILLER        PIC X(7)  VALUE SPACES.
        05 FILLER        PIC X(4)  VALUE 'COST'.
        05 FILLER        PIC X     VALUE SPACE.
        05 WS1-BLA-COST  PIC $$$$9.99.

     03 RESULT-CALC.
        05 WS1-BLU-ADD   PIC 9999 VALUE 0.
        05 WS1-RED-ADD   PIC 9999 VALUE 0.
        05 WS1-BLA-ADD   PIC 9999 VALUE 0.
        05 WS1-BLU-TOT   PIC 9(5)V99 VALUE 0.
        05 WS1-RED-TOT   PIC 9(5)V99 VALUE 0.
        05 WS1-BLA-TOT   PIC 9(5)V99 VALUE 0.

     03 WS1-CONTROL-HDR.
        05 FILLER        PIC X(19) VALUE SPACES.
        05 FILLER        PIC X(9)  VALUE 'CONTROLS'.
        05 FILLER        PIC X(4)  VALUE SPACES.

The next section is the WORKING-STORAGE SECTION. This is where the variables are specified. The variables are set out in the same way as the files. If we look at RESULT-CALC we can see that it is made up of 6 fields each with an initial value of 0. The V used in the last 3 PIC statements represents a decimal point.

The variables can be referred to by any of the names specified above and will include each of the subdivisions of that name. So you can refer to RESULT-CALC and it will also automatically be referring to each of its fields as well, or you can just refer to the fields directly e.g. WS1-BLU-ADD. There is no need to refer to the fields by way of the record. Which does mean that you have to be careful about not reusing names.

The PROCEDURE DIVISION

This is the DIVISION where all the processing gets done. It can be split into SECTIONs so that you can have subroutines. However, this piece of code doesn’t have any SECTIONs within the PROCEDURE DIVISION.

PROCEDURE DIVISION.
     OPEN INPUT TAG2-FILE.
     OPEN OUTPUT REP-FILE.

* Get the Date
     ACCEPT WS1-DATE FROM DATE.
     MOVE WS1-YR TO WS1-YER.
     MOVE WS1-MT TO WS1-MTH.
     MOVE WS1-DY TO WS1-DAY.

This is opening the files mentioned earlier for INPUT and OUTPUT. Then today’s date is put into WS1-DATE. After that, the fields in WS1-DATE are specified directly, e.g. WS1-YR. These fields are moved into fields from WS1-HDR-AREA, e.g. WS1-YER. Note the Y2K problem here as it is only using a 6 byte date.

A01-OP-LINE.
   READ TAG2-FILE AT END GO TO A90-END.

A01-OP-LINE is a paragraph label that is used to form a loop. The next line reads a record from TAG2-FILE and if the end of file is reached it jumps to the paragraph A90-END.

* Put Correct Colour Name in Sub Heading
     IF TAG2-COLOUR = 'BLU'
     THEN MOVE SPACES TO SUB-COLOUR
          MOVE 'BLUE' TO SUB-COLOUR
     ELSE IF TAG2-COLOUR = 'RED'
          THEN MOVE SPACES TO SUB-COLOUR
               MOVE 'RED' TO SUB-COLOUR
          ELSE MOVE SPACES TO SUB-COLOUR
               MOVE 'BLACK' TO SUB-COLOUR.

This puts the colour of the tag record read in from the TAG2-FILE into SUB-COLOUR which is a field of WS1-SUB-HDR.

* If the number of lines printed > 57 then put up the page heading
     IF WS1-LCNT > 57
     THEN ADD 1 TO WS1-PAGE-EDIT
          MOVE "  " TO WS1-PAGE-NBR
          MOVE WS1-PAGE-EDIT TO WS1-PAGE-NBR
          WRITE REP-RCD FROM WS1-HDR-AREA AFTER ADVANCING PAGE
          MOVE ZERO TO WS1-LCNT
* Output Colour Sub Heading
          MOVE SPACES TO WS1-COLOR-CHECK
          MOVE TAG2-COLOUR TO WS1-COLOR-CHECK
          WRITE REP-RCD FROM WS1-SUB-HDR AFTER ADVANCING 3 LINES
          WRITE REP-RCD FROM WS1-SUB-HDR2 AFTER ADVANCING 1 LINE
          ADD 4 TO WS1-LCNT
          MOVE SPACES TO REP-RCD.

This prints a header for the page if more than 57 lines have been printed and also prints a heading for the current colour table. WS1-LCNT is initialised with the value of 70 in the WORKING-STORAGE SECTION, so a header is printed on the first page. The code if fairly self explanatory. The MOVE statements copy the literal or variable being referred to into the variable specified. SPACES represent a full field of space characters. ZERO is the numerical literal 0. WRITE REP-RCD… writes the record specified by FROM to the file REP-FILE which is associated with REP-RCD. The THEN statement will execute everything up to the period, this is called a sentence.

IF WS1-COLOR-CHECK = TAG2-COLOUR
THEN NEXT SENTENCE
ELSE MOVE SPACES TO WS1-COLOR-CHECK
    MOVE TAG2-COLOUR TO WS1-COLOR-CHECK
    WRITE REP-RCD FROM WS1-SUB-HDR AFTER ADVANCING 3 LINES
    WRITE REP-RCD FROM WS1-SUB-HDR2 AFTER ADVANCING 1 LINE
    ADD 4 TO WS1-LCNT
    MOVE SPACES TO REP-RCD.

This checks if the record just read from TAG2-FILE is a different colour from the current table colour. If the colour is the same then it skips to the NEXT SENTENCE, i.e. after the period. Otherwise it prints a heading for the table. The AFTER ADVANCING 3 LINES outputs 3 newlines to the file before writing the record.

MOVE TAG2-ACC-NBR TO REP-ACC-NBR.
MOVE TAG2-TAG TO REP-TAG.
MOVE TAG2-PRN TO REP-PRN.
MOVE TAG2-QTY TO REP-QTY.
WRITE REP-RCD AFTER ADVANCING 1 LINE.

This copies some of the fields of the record TAG2-RCD read in from TAG2-FILE to some of the fields of the record REP-RCD. The REP-RCD record is then written to the associated REP-FILE. If you look at REP-RCD in the FILE SECTION you will see that each field is seperated by FILLER spaces. This is so that a neat table can be built for output.

* Add up Tag Quantity for each Colour
     IF TAG2-COLOUR = 'BLU'
     THEN ADD TAG2-QTY TO WS1-BLU-ADD
     ELSE IF TAG2-COLOUR = 'RED'
          THEN ADD TAG2-QTY TO WS1-RED-ADD
          ELSE ADD TAG2-QTY TO WS1-BLA-ADD.

This determines which colour the current record is from TAG2-COLOUR, then adds the quantity of the current record to the relevant variable. E.g. for the case of TAG2-COLOUR = ‘BLU’ the quantity TAG2-QTY is added to the variable WS1-BLU-ADD.

* Add up Tag Cost for each Colour
     IF TAG2-COLOUR = 'BLU' AND TAG2-QTY = 24
     THEN ADD 2.25 TO WS1-BLU-TOT
     ELSE IF TAG2-COLOUR = 'BLU' AND TAG2-QTY = 36
          THEN ADD 3.00 TO WS1-BLU-TOT.

     IF TAG2-COLOUR = 'RED' AND TAG2-QTY = 24
     THEN ADD 2.25 TO WS1-RED-TOT
     ELSE IF TAG2-COLOUR = 'RED' AND TAG2-QTY = 36
          THEN ADD 3.00 TO WS1-RED-TOT.

     IF TAG2-COLOUR = 'BLA' AND TAG2-QTY = 24
     THEN ADD 2.25 TO WS1-BLA-TOT
     ELSE IF TAG2-COLOUR = 'BLA' AND TAG2-QTY = 36
          THEN ADD 3.00 TO WS1-BLA-TOT.

This determines the cost to add to each colour’s total. There are a choice of two quantities than can be ordered. Either 24 or 36. It can be seen that here the code should be re-written to have the costs for each quantity stored as a variable for each colour.

ADD 1 TO WS1-LCNT.
   GO TO A01-OP-LINE.
A90-END.

This adds 1 to the line count (WS1-LCNT). Then jumps back to paragraph label A01-OP-LINE. A90-END is a paragraph label which is used near the start of the code to jump to when the end of the file TAG2-FILE is reached.

* Print Control Report
     MOVE WS1-BLU-ADD TO WS1-BLU-TOTAL.
     MOVE WS1-RED-ADD TO WS1-RED-TOTAL.
     MOVE WS1-BLA-ADD TO WS1-BLA-TOTAL.
     MOVE WS1-BLU-TOT TO WS1-BLU-COST.
     MOVE WS1-RED-TOT TO WS1-RED-COST.
     MOVE WS1-BLA-TOT TO WS1-BLA-COST.
     WRITE REP-RCD FROM WS1-CONTROL-HDR AFTER ADVANCING 4 LINES.
     WRITE REP-RCD FROM WS1-RESULT1 AFTER ADVANCING 1 LINE.
     WRITE REP-RCD FROM WS1-RESULT2 AFTER ADVANCING 1 LINE.
     WRITE REP-RCD FROM WS1-RESULT3 AFTER ADVANCING 1 LINE.
     CLOSE TAG2-FILE REP-FILE.
     STOP RUN.

The code finishes by copying the running cost and quantity totals to the fields in the records WS1-RESULT1, WS1-RESULT2, WS1-RESULT3. Then writing a header to REP-FILE using WS-CONTROL-HDR, and writing the quantity and cost for each colour. The files are then closed and the program is stopped.

Summary of the program

The program reads in name tag records from TAG2.DAT and outputs a report to PRN.

Conclusion

Once I had remembered how COBOL is set out, I found this program easy to understand and believe that it would be easy to maintain and expand. I admit that this is only a trivial example, but then I haven’t used COBOL for a long time, so I think it is a fair investigation. I can see from the code why COBOL is so good at processing transactions and in particular batch processing. A similar program written in Java, the new standard in the business world, would be considerably more complex and difficult to understand. That said, I do recognise that while most of the added complexity would be with the code to read in the structured input file, the output report writing would be considerably easier by just using formatted strings.

Afterwards

After writing this article I decided to look at COBOL in more depth. My main conclusion is that COBOL has advanced quite considerably since this code was written. In fact I think that the style of COBOL we were taught in 1994 was already quite dated. I have enjoyed this trip down memory lane, but now want to see if COBOL can offer anything for the present and into the future. The most recent advance in COBOL appear to be an object orientated standard, which offers some considerable improvements while maintaining backwards compatibility. Unfortunately the uptake on this seems to be slow. COBOL does have a bad press, and after looking at modern COBOL, most of the complaints refer to problems that have been fixed over 30 years ago. If COBOL is to halt its decline it needs more vocal advocates to show why it is so good and to help explain the COBOL mindset. One further problem COBOL has long had is the lack of free compilers. There are a couple of projects out there but they need support. The most advanced project for Linux appears to be OpenCOBOL. Another project which, though incomplete, should offer a great compiler in the long term is Cobol for GCC. I wish these projects well, and hope that COBOL can regain the respect it deserves.


The full code (ASSIGN1.CBL)

     IDENTIFICATION DIVISION.
     PROGRAM-ID. ASSIGN1.
     AUTHOR. Lawrence Woodman
    * Assignment 1 for COBOL.

     ENVIRONMENT DIVISION.
     INPUT-OUTPUT SECTION.
     FILE-CONTROL.
     SELECT TAG2-FILE ASSIGN TO "TAG2.DAT".
     SELECT REP-FILE ASSIGN TO "PRN".

     DATA DIVISION.
     FILE SECTION.
     FD TAG2-FILE.
     01 TAG2-RCD.
        03 TAG2-ORD-NBR  PIC 9(4).
        03 TAG2-ACC-NBR  PIC A9(7)A.
        03 TAG2-COLOUR   PIC A(3).
        03 TAG2-PRN      PIC A(2).
        03 TAG2-QTY      PIC 9(2).
        03 TAG2-TAG      PIC A(20).
        03 TAG2-DATE     PIC X(6).

     FD REP-FILE.
     01 REP-RCD.
        03 REP-ACC-NBR   PIC A9(7)A.
        03 FILLER        PIC X(7)       VALUE SPACES.
        03 REP-TAG       PIC A(20).
        03 FILLER        PIC X(9)       VALUE SPACES.
        03 REP-PRN       PIC AA.
        03 FILLER        PIC X(6)       VALUE SPACES.
        03 REP-QTY       PIC Z9.
        03 FILLER        PIC X(6)       VALUE SPACES.

      WORKING-STORAGE SECTION.
         01 WS1-AREA.
            03 WS1-LCNT  PIC 99 VALUE 70.

            03 WS1-DATE.
               05 WS1-YR   PIC XX.
               05 WS1-MT   PIC XX.
               05 WS1-DY   PIC XX.

            03 WS1-HDR-AREA.
               05 WS1-DAY       PIC XX.
               05 FILLER        PIC X VALUE '/'.
               05 WS1-MTH       PIC XX.
               05 FILLER        PIC X VALUE '/'.
               05 WS1-YER       PIC XX.
               05 FILLER        PIC X(10) VALUE SPACES.
               05 FILLER        PIC X(19) VALUE 'NAME TAG REPORT - 2'.
               05 FILLER        PIC X(15) VALUE SPACES.
               05 FILLER        PIC X(4)  VALUE 'PAGE'.
               05 FILLER        PIC X(1)  VALUE SPACES.
               05 WS1-PAGE-NBR  PIC Z9.

           03 WS1-PAGE-EDIT    PIC 99 VALUE 0.

           03 WS1-SUB-HDR.
              05 FILLER        PIC X(19) VALUE SPACES.
              05 FILLER        PIC X(9)  VALUE 'COLOUR - '.
              05 SUB-COLOUR    PIC X(5)  VALUE SPACES.

           03 WS1-SUB-HDR2.
              05 FILLER        PIC X(9)  VALUE 'Acct.Nbr.'.
              05 FILLER        PIC X(7)  VALUE SPACES.
              05 FILLER        PIC X(11) VALUE 'Name on Tag'.
              05 FILLER        PIC X(18) VALUE SPACES.
              05 FILLER        PIC X(4)  VALUE 'Type'.
              05 FILLER        PIC X(4)  VALUE SPACES.
              05 FILLER        PIC X(4)  VALUE 'Qty.'.

           03 WS1-COLOR-CHECK PIC A(3)   VALUE SPACES.

           03 WS1-RESULT1.
              05 FILLER        PIC X(5)  VALUE SPACES.
              05 FILLER        PIC X(23) VALUE
                                    'RED.........QUANTITY - '.
              05 WS1-RED-TOTAL PIC ZZZ9.
              05 FILLER        PIC X(7)  VALUE SPACES.
              05 FILLER        PIC X(4)  VALUE 'COST'.
              05 FILLER        PIC X     VALUE SPACE.
              05 WS1-RED-COST  PIC $$$$9.99.

           03 WS1-RESULT2.
              05 FILLER        PIC X(5)  VALUE SPACES.
              05 FILLER        PIC X(23) VALUE
                                    'BLUE........QUANTITY - '.
              05 WS1-BLU-TOTAL PIC ZZZ9.
              05 FILLER        PIC X(7)  VALUE SPACES.
              05 FILLER        PIC X(4)  VALUE 'COST'.
              05 FILLER        PIC X     VALUE SPACE.
              05 WS1-BLU-COST  PIC $$$$9.99.

           03 WS1-RESULT3.
              05 FILLER        PIC X(5)  VALUE SPACES.
              05 FILLER        PIC X(23) VALUE
                                    'BLACK.......QUANTITY - '.
              05 WS1-BLA-TOTAL PIC ZZZ9.
              05 FILLER        PIC X(7)  VALUE SPACES.
              05 FILLER        PIC X(4)  VALUE 'COST'.
              05 FILLER        PIC X     VALUE SPACE.
              05 WS1-BLA-COST  PIC $$$$9.99.

           03 RESULT-CALC.
              05 WS1-BLU-ADD   PIC 9999 VALUE 0.
              05 WS1-RED-ADD   PIC 9999 VALUE 0.
              05 WS1-BLA-ADD   PIC 9999 VALUE 0.
              05 WS1-BLU-TOT   PIC 9(5)V99 VALUE 0.
              05 WS1-RED-TOT   PIC 9(5)V99 VALUE 0.
              05 WS1-BLA-TOT   PIC 9(5)V99 VALUE 0.

           03 WS1-CONTROL-HDR.
              05 FILLER        PIC X(19) VALUE SPACES.
              05 FILLER        PIC X(9)  VALUE 'CONTROLS'.
              05 FILLER        PIC X(4)  VALUE SPACES.

     PROCEDURE DIVISION.
         OPEN INPUT TAG2-FILE.
         OPEN OUTPUT REP-FILE.

    * Get the Date
         ACCEPT WS1-DATE FROM DATE.
         MOVE WS1-YR TO WS1-YER.
         MOVE WS1-MT TO WS1-MTH.
         MOVE WS1-DY TO WS1-DAY.

     A01-OP-LINE.
         READ TAG2-FILE AT END GO TO A90-END.

    * Put Correct Colour Name in Sub Heading
         IF TAG2-COLOUR = 'BLU'
         THEN MOVE SPACES TO SUB-COLOUR
              MOVE 'BLUE' TO SUB-COLOUR
         ELSE IF TAG2-COLOUR = 'RED'
              THEN MOVE SPACES TO SUB-COLOUR
                   MOVE 'RED' TO SUB-COLOUR
              ELSE MOVE SPACES TO SUB-COLOUR
                   MOVE 'BLACK' TO SUB-COLOUR.

    * If the number of lines printed > 57 then put up the page heading
         IF WS1-LCNT > 57
         THEN ADD 1 TO WS1-PAGE-EDIT
              MOVE "  " TO WS1-PAGE-NBR
              MOVE WS1-PAGE-EDIT TO WS1-PAGE-NBR
              WRITE REP-RCD FROM WS1-HDR-AREA AFTER ADVANCING PAGE
              MOVE ZERO TO WS1-LCNT
    * Output Colour Sub Heading
              MOVE SPACES TO WS1-COLOR-CHECK
              MOVE TAG2-COLOUR TO WS1-COLOR-CHECK
              WRITE REP-RCD FROM WS1-SUB-HDR AFTER ADVANCING 3 LINES
              WRITE REP-RCD FROM WS1-SUB-HDR2 AFTER ADVANCING 1 LINE
              ADD 4 TO WS1-LCNT
              MOVE SPACES TO REP-RCD.

         IF WS1-COLOR-CHECK = TAG2-COLOUR
         THEN NEXT SENTENCE
         ELSE MOVE SPACES TO WS1-COLOR-CHECK
              MOVE TAG2-COLOUR TO WS1-COLOR-CHECK
              WRITE REP-RCD FROM WS1-SUB-HDR AFTER ADVANCING 3 LINES
              WRITE REP-RCD FROM WS1-SUB-HDR2 AFTER ADVANCING 1 LINE
              ADD 4 TO WS1-LCNT
              MOVE SPACES TO REP-RCD.

         MOVE TAG2-ACC-NBR TO REP-ACC-NBR.
         MOVE TAG2-TAG TO REP-TAG.
         MOVE TAG2-PRN TO REP-PRN.
         MOVE TAG2-QTY TO REP-QTY.
         WRITE REP-RCD AFTER ADVANCING 1 LINE.

    * Add up Tag Quantity for each Colour
         IF TAG2-COLOUR = 'BLU'
         THEN ADD TAG2-QTY TO WS1-BLU-ADD
         ELSE IF TAG2-COLOUR = 'RED'
              THEN ADD TAG2-QTY TO WS1-RED-ADD
              ELSE ADD TAG2-QTY TO WS1-BLA-ADD.

    * Add up Tag Cost for each Colour
         IF TAG2-COLOUR = 'BLU' AND TAG2-QTY = 24
         THEN ADD 2.25 TO WS1-BLU-TOT
         ELSE IF TAG2-COLOUR = 'BLU' AND TAG2-QTY = 36
              THEN ADD 3.00 TO WS1-BLU-TOT.

         IF TAG2-COLOUR = 'RED' AND TAG2-QTY = 24
         THEN ADD 2.25 TO WS1-RED-TOT
         ELSE IF TAG2-COLOUR = 'RED' AND TAG2-QTY = 36
              THEN ADD 3.00 TO WS1-RED-TOT.

         IF TAG2-COLOUR = 'BLA' AND TAG2-QTY = 24
         THEN ADD 2.25 TO WS1-BLA-TOT
         ELSE IF TAG2-COLOUR = 'BLA' AND TAG2-QTY = 36
              THEN ADD 3.00 TO WS1-BLA-TOT.

         ADD 1 TO WS1-LCNT.
         GO TO A01-OP-LINE.
     A90-END.
    * Print Control Report
         MOVE WS1-BLU-ADD TO WS1-BLU-TOTAL.
         MOVE WS1-RED-ADD TO WS1-RED-TOTAL.
         MOVE WS1-BLA-ADD TO WS1-BLA-TOTAL.
         MOVE WS1-BLU-TOT TO WS1-BLU-COST.
         MOVE WS1-RED-TOT TO WS1-RED-COST.
         MOVE WS1-BLA-TOT TO WS1-BLA-COST.
         WRITE REP-RCD FROM WS1-CONTROL-HDR AFTER ADVANCING 4 LINES.
         WRITE REP-RCD FROM WS1-RESULT1 AFTER ADVANCING 1 LINE.
         WRITE REP-RCD FROM WS1-RESULT2 AFTER ADVANCING 1 LINE.
         WRITE REP-RCD FROM WS1-RESULT3 AFTER ADVANCING 1 LINE.
         CLOSE TAG2-FILE REP-FILE.
         STOP RUN.

Uuencode data file (TAG2.DAT)

begin-base64 644 TAG2.DAT
MDAwMWEwMDAwMDAxYVJFRFNDMjRKaiAgICAgICAgICAgICAgICAgIDk0MTEy
MjAwMDJhMDAwMDAwMmFSRURTQzM2RC5Ccm93biAgICAgICAgICAgICA5NDEx
MjIwMDAzYTAwMDAwMDNhUkVEU1QyNFQuSm9uZXMgICAgICAgICAgICAgOTQx
MTIyMDAwNGEwMDAwMDA0YVJFRFNUMzZSLlRhbGJvdCAgICAgICAgICAgIDk0
MTEyMjAwMDVhMDAwMDAwNWFCTFVTQzI0Ui5KICAgICAgICAgICAgICAgICA5
NDExMjIwMDA2YTAwMDAwMDZhQkxVU0MzNkguTCAgICAgICAgICAgICAgICAg
OTQxMTIyMDAwN2EwMDAwMDA3YUJMVVNUMjRSLlAgICAgICAgICAgICAgICAg
IDk0MTEyMjAwMDhhMDAwMDAwOGFCTFVTVDM2Si5LICAgICAgICAgICAgICAg
ICA5NDExMjIwMDA5YTAwMDAwMDlhQkxBU0MyNFIuUCAgICAgICAgICAgICAg
ICAgOTQxMTIyMDAxMGEwMDAwMDEwYUJMQVNDMzZQLlAgICAgICAgICAgICAg
ICAgIDk0MTEyMjAwMTFhMDAwMDAxMWFCTEFTVDI0US5RICAgICAgICAgICAg
ICAgICA5NDExMjIwMDEyYTAwMDAwMTJhQkxBU1QzNk8uTyAgICAgICAgICAg
ICAgICAgOTQxMTIyCg==
====

Compiling and running the program

  • To compile this code I am using OpenCOBOL under Linux. I compile it to en executable using: cobc -x ASSIGN1.CBL
  • To create the TAG2.DAT file that is needed copy the uuencoded data above to a file, say tag2.uue. Then run: uudecode tag2.uue
  • To execute the program, make sure that TAG2.DAT is in the same directory as the executable ASSIGN1. Then run ./ASSIGN1

After running the program you should find a file called PRN has been created which contains the report.

Example report (PRN)

26/08/08          NAME TAG REPORT - 2               PAGE  1  


               COLOUR - RED                              
Acct.Nbr.       Name on Tag                  Type    Qty.    
a0000001a       Jj                           SC      24      
a0000002a       D.Brown                      SC      36      
a0000003a       T.Jones                      ST      24      
a0000004a       R.Talbot                     ST      36      


               COLOUR - BLUE                             
Acct.Nbr.       Name on Tag                  Type    Qty.    
a0000005a       R.J                          SC      24      
a0000006a       H.L                          SC      36      
a0000007a       R.P                          ST      24      
a0000008a       J.K                          ST      36      


               COLOUR - BLACK                            
Acct.Nbr.       Name on Tag                  Type    Qty.    
a0000009a       R.P                          SC      24      
a0000010a       P.P                          SC      36      
a0000011a       Q.Q                          ST      24      
a0000012a       O.O                          ST      36      



               CONTROLS                                  
 RED.........QUANTITY -  120       COST   $10.50         
 BLUE........QUANTITY -  120       COST   $10.50         
 BLACK.......QUANTITY -  120       COST   $10.50