[USflag] The American Programmer [USflag]
Home Programming Books for Computer Professionals Privacy Terms
           Home   > Programming   > COBOL Book   > COBOL program chapter 11 The CASE Structure: EVALUATE

The CASE Structure: EVALUATE


Top of Page

11. The CASE Structure: EVALUATE

EVAL1.
This program illustrates a possible use for EVALUATE. It reads a file containing part number but no part name. It uses EVALUATE to make the decisions that will supply the missing part name. A table lookup would be more realistic for this application, but this is here to illustrate EVALUATE, not table lookup!

I suggest looking up the section on EVALUATE in your COBOL book

Here is the program EVAL1:



000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. EVAL1.
000400* Read a regular file
000500* checks each record to see if it has a valid part number
000600* uses evaluate to replace blank part name with part name
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 INPUT-OUTPUT SECTION.
001000 FILE-CONTROL.
001100* INPUT FILE PARTS1
001200     SELECT INFILE ASSIGN PARTS1.
001500 DATA DIVISION.
001600 FILE SECTION.
001700
001800 FD  INFILE
001900     RECORDING MODE IS F
002210     RECORD CONTAINS 80 CHARACTERS.
002300 01  INFILE-RECORD.
003100      05  PART-NUMBER     PIC X(6).
003200      05  PART-NAME       PIC X(30).
003300      05  QTY-ON-HAND     PIC 9(3).
003400      05  QTY-ON-ORDER    PIC 9(3).
003500      05  QTY-ON-RESERVE  PIC 9(3).
003600      05  PART-PRICE      PIC 9(3)V99.
003700      05  UNUSED          PIC X(30).
002400
002500 WORKING-STORAGE SECTION.
002600 01 SWITCHES.
002700      05  INFILE-AT-END     PIC X  VALUE 'N'.
002800      05  VALID-SW          PIC X  VALUE 'Y'.
002900
003900 PROCEDURE DIVISION.
004000     PERFORM INITIALIZATION
004100     PERFORM PROCESS-ALL
004200         UNTIL INFILE-AT-END = 'Y'
004300     PERFORM TERMINATION
004400     GOBACK.
004500
004600 INITIALIZATION.
004700     OPEN INPUT INFILE
004800     PERFORM READ-PAR.
004900
005000 PROCESS-ALL.
005100     MOVE 'Y' TO VALID-SW
005200     PERFORM EVALUATE-PARTS
005300     IF VALID-SW = 'Y'
005400     THEN DISPLAY INFILE-RECORD
005500*       Not doing anything else in this program
005600*       but you could write out records,
005700*       print lines in report, etc
005800     ELSE DISPLAY 'BAD RECORD' INFILE-RECORD
005900     END-IF
006000     PERFORM READ-PAR.
006100
006200 TERMINATION.
006300     CLOSE INFILE.
006400
006500 READ-PAR.
006600     READ INFILE 
006700         AT END MOVE 'Y' TO INFILE-AT-END
006800     END-READ.
006900
007000 EVALUATE-PARTS.
007100     EVALUATE PART-NUMBER
007200         WHEN 'PART01' MOVE 'WIDGETS'
007300          TO PART-NAME
007400         WHEN 'PART03' MOVE 'LEAD WINGED GLIDERS'
007500          TO PART-NAME
007600         WHEN 'PART04' MOVE 'LEFT FOOT REEBOCKS'
007700          TO PART-NAME
007800         WHEN 'PART06' MOVE '286 COMPUTERS W 4K HARD DISK'
007900          TO PART-NAME
008000     WHEN OTHER
008100         MOVE 'UNKNOWN' TO PART-NAME
008200         MOVE 'N' TO VALID-SW
008300     END-EVALUATE.


Here is the input data file PARTS1: (the next two lines are a column ruler)

         1         2         3         4         5         6
123456789.123456789.123456789.123456789.123456789.123456789.12345678

PART01                                003 007 002 10022
PART02                                004 006 001 14054
PART04                                021 002 004 04323
PART06                                043 077 012 00042
Here is sample JCL:

//STEP1    EXEC PGM=EVAL1
//STEPLIB DD DSN=your.executable.program.library.goes.here,DISP=SHR
//*OF COURSE, THE NEXT LIBRARY NAME MAY BE DIFFERENT AT YOUR COMPANY
//PARTS1    DD   DSN=userid.COBBOOK.DATA(PARTS1),DISP=SHR
//SYSOUT    DD   SYSOUT=*
//SYSUDUMP  DD   SYSOUT=*



Top of Page

Your email and other personal information will not be given to anyone and will be used only to communicate with you about your order.
[Books Computer]

Home Programming Books for Computer Professionals Privacy Terms Contact |
Site Map and Site Search Programming Manuals and Tutorials The REXX Files Top of Page |

[link page]