[USflag] The American Programmer [USflag]


Home
Books on Mainframe Programming
Mainframe Manuals and Tutorials
System Abend codes, Sqlcodes, VSAM/QSAM codes
Everything about the IBM AS/400 Midrange Computer - iSeries
Everything about CICS
Cobol programs, manuals, books
  Sample Cobol code: The Simple, Single File COBOL Program
  Sample Cobol code: The Simple, Single File Report COBOL Program with Record Count or Final Totals
  Sample Cobol code: The Simple, Single File Report COBOL Program with Record Count or Final Totals
  Sample Cobol code: The Sequence Check COBOL Program
  Sample Cobol code: The Record Selection COBOL Program
  Sample Cobol code: The Edit or Validate COBOL Program
  Sample Cobol code: The The One Level Subtotal (Control Break) COBOL Program
  Sample Cobol code: The Three Level Subtotal (Control Break) COBOL Program
  Sample Cobol code: The Sequential File, Batch Update COBOL Program
  Sample Cobol code: The COBOL Sort
  Sample Cobol code: The CASE Structure: COBOL EVALUATE
  Sample Cobol code: Direct Subscripting in COBOL
  Sample Cobol code: The Sequential, or Serial Search in COBOL
  Sample Cobol code: The Binary Search in COBOL
  Sample Cobol code: Loading a Table from a Sequential File in a COBOL program
  Sample Cobol code: The VSAM File Read Sequentially in a COBOL program
  Sample Cobol code: The VSAM KSDS, Read Randomly in a COBOL program
  Sample Cobol code: The VSAM File, Read Randomly in a COBOL program
  Sample Cobol code: VSAM Initial Load in a COBOL program
  Sample Cobol code: VSAM File Maintenance (Add, Change, Delete) in a COBOL program
  Sample Cobol code: VSAM Read Sequentially, with START, in a COBOL program
  Sample Cobol code: Creating a Variable Format File in a COBOL program
  Sample Cobol code: Reading a Variable Format File in a COBOL program
  Sample Cobol code: Creating a Variable Format File with Occurs Depending On in a COBOL program
  Sample Cobol code: COBOL Reading a Variable Format File with Occurs Depending On, in a COBOL program
  Sample Cobol code: COBOL The Table Load with Occurs Depending On
  Sample Cobol/DB2 code: Singleton Select
  Manuals on the COBOL programming language.
  Books on Cobol
  Abend Codes from Cobol programs
Everything about DB2 and SQL
Everything about IMS
Everything about Java and JavaScript
Everything about JCL and JES
Everything about REXX
Everything about zOS, VSAM, Tivoli, Assembler
Everything about TSO, ISPF, Spufi
Site Map and Site Search

           Home   > COBOL   > COBOL program the CASE Structure: EVALUATE

The CASE Structure: COBOL EVALUATE


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:

Compliments of Gabe Gargiulo, author of several recent books on programming and modern languages, available at Amazon.com.



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.

Compliments of Gabe Gargiulo, author of several recent books on programming and modern languages, available at Amazon.com.
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
[Books Computer]

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