[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 Loading a Table from a Sequential File

Loading a Table from a Sequential File in a COBOL program


15. Loading a Table from a Sequential File

LOADTBL1.
The sequential and binary searches you have just seen used a hard coded table. In a hard coded table you type in the data when you type in the program. If you want to change anything in the table, you must recompile the entire program and the new program may not be available for use in production for several hours! A more realistic approach is to put the table data in a file, or MVS library member, then read the data into the programís table. This allows you to change the data without recompiling the program.

Typically, the table data is a member in an MVS library. Someone is assigned the job of keeping this table file up to date. The data will be current and up to date the moment this person saves it and exits from the editor.

The logic to load a table is very similar to that of the first model program presented, the single file program. I will show you that example first: LOADTBL1. Bear in mind that this example does nothing but load the table. Nothing else is done with it.

The second example, LOADTBL2 will do a SEARCH ALL with the table that was just loaded. The program is going to read and do a binary search on a regular (non-table) file. I have coded this program in such a way that the load logic will be very distinct from the logic used to read the regular file.

One point Iíd like to make, that is easily missed in all the coding: When doing a binary search, if your table is sorted in ascending order youíll need to set all the unused entries in the table to high-values. High-values are the highest data value possible in alphanumeric (character datatype) fields. Nothing can be greater than high-values. If you donít set the unused entries to high-values they are set to low-values by default and your binary search wonít work! This is shown in the programs LOADTBL1 and LOADTBL2.

Just be aware that this makes high-values a valid data value on the table. If you do a table lookup with a data item (from the input record, usually) that contains high-values it will be marked valid! If you donít want that, you might want to check for high-values in a separate IF statement and reject them.

There are a few things to think about. Later that evening your program will be running in production, at a time when all good programmers should be sound asleep and dreaming of the slopes (snow-covered slopes, not mathematical graph slopes.) Are there more records in the table file than the COBOL OCCURS clause allows? Count the records in the table file. Look at the COBOL OCCURS. Which has a bigger number? It had better be the OCCURS, or you wonít get a chance to do any dreaming.

Here is the program LOADTBL1:

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



000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. LOADTBL1.
000400* LOAD A TABLE FROM A SEQUENTIAL FILE
000500* JUST LOAD - DON'T DO ANYTHING ELSE
000600* SEE PROGRAM LOADTBL2 FOR A PROGRAM THAT LOADS AND SEARCHES.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 INPUT-OUTPUT SECTION.
001000 FILE-CONTROL.
001100*   INPUT FILE PARTTABL
001200     SELECT TABLE-FILE ASSIGN PARTTABL.
001600 DATA DIVISION.
001700 FILE SECTION.
001800 FD  TABLE-FILE
001810     RECORDING MODE IS F
002000     RECORD CONTAINS 80 CHARACTERS.
002900 01  TABLE-RECORD.
002910      05  WS-TR-PART-NUMBER     PIC X(6).
003000      05  WS-TR-PART-DESC       PIC X(30).
003010      05  FILLER                PIC X(44).
003020
003030 WORKING-STORAGE SECTION.
003050 01 SWITCHES.
003060     05  TABLE-FILE-AT-END     PIC X  VALUE 'N'.
003070     05  SOMETHING-IN-TABLE       VALUE 'N'       PIC X.
003080     05  TABLE-OVERFLOW           VALUE 'N'       PIC X.
003090
003400 01  PART-TABLE.
003500*    THE 100 USED HERE IS ARBITRARY.
003600*    USE WHATEVER NUMBER YOU NEED FOR THE SIZE OF YOUR TABLE
003700     05  EACH-PART-INFO    OCCURS 100 TIMES
003900         ASCENDING KEY IS EACH-PART-NUMBER
003910         INDEXED BY PART-INDEX.
004000         10  EACH-PART-NUMBER      PIC X(6).
004100         10  EACH-PART-DESCRIPTION PIC X(30).
004200*    THE VALUE OF THE NEXT ITEM MUST BE THE SAME AS THE OCCURS AB
004300 01  PART-TABLE-MAX-OCCURS PIC S9(5) BINARY VALUE +100.
004400
004500 PROCEDURE DIVISION.
004600     PERFORM TABLE-INITIALIZATION
004700     PERFORM TABLE-PROCESS-ALL
004800         UNTIL TABLE-FILE-AT-END = 'Y'
005000     PERFORM TABLE-TERMINATION
005100     GOBACK.
005200
005300 TABLE-INITIALIZATION.
005400* MOVE HIGH-VALUES SO THAT ALL ENTRIES WILL HAVE THE HIGHEST
005500* VALUE POSSIBLE (LETS SEARCH ALL WORK RIGHT)
005600     MOVE HIGH-VALUES TO PART-TABLE
005700     SET PART-INDEX TO 1
005800     OPEN INPUT TABLE-FILE
005900     PERFORM TABLE-READ-PAR.
006000
006100 TABLE-PROCESS-ALL.
006110      IF PART-INDEX > PART-TABLE-MAX-OCCURS
006120      THEN
006130         MOVE 'Y' TO TABLE-FILE-AT-END
006140         MOVE 'Y' TO TABLE-OVERFLOW
006150           DISPLAY 'INDEX GT MAX'
006160      ELSE
006170         MOVE TABLE-RECORD TO EACH-PART-INFO(PART-INDEX)
006180         MOVE 'Y' TO SOMETHING-IN-TABLE
006190         SET PART-INDEX UP BY 1
006191*********  DISPLAY 'INDEX NOT GT MAX'
006192         PERFORM TABLE-READ-PAR
006193     END-IF.
006500
006600 TABLE-TERMINATION.
006700*    AT THIS POINT CHECK TO SEE IF THE TABLE
006800*    WAS PROPERLY LOADED
006910     IF TABLE-OVERFLOW = 'Y'
006920     THEN
006930        DISPLAY 'MORE RECORDS THAN TABLE ENTRIES'
006940        GO TO ERROR-EXIT
006950     END-IF
006960
006970     IF SOMETHING-IN-TABLE = 'Y'
006980     THEN
006990        DISPLAY 'TABLE APPEARS TO BE LOADED OK'
006991     ELSE
006992        DISPLAY 'NOTHING LOADED IN TABLE'
006993        GO TO ERROR-EXIT
006994     END-IF
006995
006998*    NO ONE SAYS YOU HAVE TO DO THIS
006999*    IT DISPLAYS ALL THE ENTRIES IN THE TABLE - JUST TO SHOW
007000*    IF IT WORKED PROPERLY
007001     DISPLAY 'HERE IS THE TABLE AFTER LOADING'
007002     PERFORM
007003         VARYING PART-INDEX FROM 1 BY 1
007004         UNTIL   PART-INDEX > PART-TABLE-MAX-OCCURS
007005
007006         DISPLAY EACH-PART-NUMBER (PART-INDEX)
007007                 EACH-PART-DESCRIPTION (PART-INDEX)
007008     END-PERFORM
007009
007800      CLOSE TABLE-FILE.
007900
008000 TABLE-READ-PAR.
008100     READ TABLE-FILE 
008200         AT END MOVE 'Y' TO TABLE-FILE-AT-END
008300     END-READ.
008310
008400 ERROR-EXIT.
008500*    DISPLAY MESSAGES IF NEEDED
008700*    END THE PROGRAM
008800     GOBACK.

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

         1         2         3         4         5         6
123456789.123456789.123456789.123456789.123456789.123456789.12345678

PART01 LEFT HANDED WIDGET WRENCHES
PART02 LEAD-WINGED GLIDERS
PART04 LEFT FOOT REEBOKS
PART06 286 COMPUTERS W 4K HARD DISK

Here is sample JCL:

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



Here is the program LOADTBL2: 000200 IDENTIFICATION DIVISION. 000300 PROGRAM-ID. LOADTBL2. 000400* Load a table from a sequential file 000500* read a regular file 000600* check each record to see if it has a valid part number 000700 ENVIRONMENT DIVISION. 000800 CONFIGURATION SECTION. 000900 INPUT-OUTPUT SECTION. 001000 FILE-CONTROL. 001100* TABLE FILE PARTTABL 001200 SELECT TABLE-FILE ASSIGN PARTTABL. 001600* REGULAR INPUT FILE PARTS1 001700 SELECT INFILE ASSIGN PARTS1. 002100 DATA DIVISION. 002200 FILE SECTION. 002300 FD TABLE-FILE 002310 RECORDING MODE IS F 002700 RECORD CONTAINS 80 CHARACTERS. 002800 01 TABLE-RECORD. 004500 05 WS-TR-PART-NUMBER PIC X(6). 004600 05 WS-TR-PART-DESC PIC X(30). 004700 05 FILLER PIC X(44). 004800 003000 FD INFILE 003010 RECORDING MODE IS F 003410 RECORD CONTAINS 80 CHARACTERS. 003500 01 INFILE-RECORD. 005000* PICTURES MUST CORRESPOND TO THE ACTUAL INPUT FILE 005100 05 PART-NUMBER PIC X(6). 005200 05 PART-DESCR PIC X(30). 005300 05 QTY-ON-HAND PIC 9(3). 005400 05 QTY-ON-ORDER PIC 9(3). 005500 05 QTY-ON-RESERVE PIC 9(3). 005600 05 PART-PRICE PIC 9(3)V99. 005700 05 UNUSED PIC X(30). 005800 003700 WORKING-STORAGE SECTION. 003800 01 SWITCHES. 003900 05 TABLE-FILE-AT-END PIC X VALUE 'N'. 004000 05 INFILE-AT-END PIC X VALUE 'N'. 004100 05 VALID-SW PIC X VALUE 'Y'. 004210 05 SOMETHING-IN-TABLE VALUE 'N' PIC X. 004220 05 TABLE-OVERFLOW VALUE 'N' PIC X. 004300 005900 01 PART-TABLE. 006000* The 100 used here is arbitrary. 006010 05 EACH-PART-INFO OCCURS 100 TIMES 006020 ASCENDING KEY IS EACH-PART-NUMBER 006030 INDEXED BY PART-INDEX. 006040 10 EACH-PART-NUMBER PIC X(6). 006050 10 EACH-PART-DESCRIPTION PIC X(30). 006060* THE VALUE OF THE NEXT ITEM MUST BE THE SAME AS THE OCCURS AB 006070 01 PART-TABLE-MAX-OCCURS PIC S9(5) BINARY VALUE +100. 006900 007000 PROCEDURE DIVISION. 007100 PERFORM TABLE-INITIALIZATION 007200 PERFORM TABLE-PROCESS-ALL 007300 UNTIL TABLE-FILE-AT-END = 'Y' 007500 PERFORM TABLE-TERMINATION 007600 PERFORM INFILE-INITIALIZATION 007700 PERFORM INFILE-PROCESS-ALL 007800 UNTIL INFILE-AT-END = 'Y' 007900 PERFORM INFILE-TERMINATION 008000 GOBACK. 008100 008200 TABLE-INITIALIZATION. 008300* See text for explanation of next move 008400 MOVE HIGH-VALUES TO PART-TABLE 008500* Absolutely must set the index to 1 008600* an index does not have a default initial value 008700* and you are not allowed to set an index to 0 008800 SET PART-INDEX TO 1 008900 OPEN INPUT TABLE-FILE 009000 PERFORM TABLE-READ-PAR. 009100 009200 TABLE-PROCESS-ALL. 009300 IF PART-INDEX > PART-TABLE-MAX-OCCURS 009400 THEN 009500 MOVE 'Y' TO TABLE-FILE-AT-END 009600 MOVE 'Y' TO TABLE-OVERFLOW 009610 DISPLAY 'INDEX GT MAX' 009620 ELSE 009630 MOVE TABLE-RECORD TO EACH-PART-INFO(PART-INDEX) 009640 MOVE 'Y' TO SOMETHING-IN-TABLE 009650 SET PART-INDEX UP BY 1 009660********* DISPLAY 'INDEX NOT GT MAX' 009670 PERFORM TABLE-READ-PAR 009680 END-IF. 009800 TABLE-TERMINATION. 009900* AT THIS POINT CHECK TO SEE IF THE TABLE 010000* WAS PROPERLY LOADED 010100 IF TABLE-OVERFLOW = 'Y' 010200 THEN 010300 DISPLAY 'MORE RECORDS THAN TABLE ENTRIES' 010400 GO TO ERROR-EXIT 010500 END-IF 010700 IF SOMETHING-IN-TABLE = 'Y' 010800 THEN 010900 DISPLAY 'TABLE APPEARS TO BE LOADED OK' 011000 ELSE 011100 DISPLAY 'NOTHING LOADED IN TABLE' 011200 GO TO ERROR-EXIT 011210 END-IF 011230* DISPLAY 'READ ' INPUT-RECORD-COUNT 'RECORDS' 011250* NO ONE SAYS YOU HAVE TO DO THIS 011260* IT DISPLAYS ALL THE ENTRIES IN THE TABLE - JUST TO SHOW 011270* IF IT WORKED PROPERLY 011280 DISPLAY 'HERE IS THE TABLE AFTER LOADING' 011290 PERFORM 011291 VARYING PART-INDEX FROM 1 BY 1 011292 UNTIL PART-INDEX > PART-TABLE-MAX-OCCURS 011294 DISPLAY EACH-PART-NUMBER (PART-INDEX) 011295 EACH-PART-DESCRIPTION (PART-INDEX) 011296 END-PERFORM 011307 011308 CLOSE TABLE-FILE. 011310 011400 TABLE-READ-PAR. 011500 READ TABLE-FILE 011600 AT END MOVE 'Y' TO TABLE-FILE-AT-END 011700 END-READ. 011800 011900 INFILE-INITIALIZATION. 012000 OPEN INPUT INFILE 012100 PERFORM INFILE-READ-PAR. 012200 012300 INFILE-PROCESS-ALL. 012400 MOVE 'Y' TO VALID-SW 012500 PERFORM TABLE-LOOKUP 012600 IF VALID-SW = 'Y' 012700* Not doing much of anything here in this program 012800* but you could write out records, 012900* print lines in report, etc 013000 DISPLAY 'GOOD RECORD' INFILE-RECORD 013100 ELSE 013200 DISPLAY 'BAD RECORD' INFILE-RECORD 013300 END-IF 013400 PERFORM infile-READ-PAR. 013500 013600 INFILE-TERMINATION. 013700 CLOSE INFILE. 013800 013900 INFILE-READ-PAR. 014000 READ INFILE 014100 AT END MOVE 'Y' TO infile-AT-END 014200 END-READ. 014300 014400 TABLE-LOOKUP. 014500* This is a binary search, but a sequential search could have bee 014600 014700 IF PART-NUMBER IS EQUAL TO HIGH-VALUES 014800 THEN MOVE 'N' TO VALID-SW 014900 ELSE 015000 SEARCH ALL EACH-PART-INFO 015100 AT END 015200* DISPLAY INPUT-PART 'NOT FOUND' 015300 MOVE 'N' TO VALID-SW 015400 WHEN EACH-PART-NUMBER(PART-INDEX) = PART-NUMBER 015500* DISPLAY INPUT-STATE 'FOUND' 015600 MOVE EACH-PART-DESCRIPTION(PART-INDEX) 015700 TO PART-DESCR 015900 END-SEARCH 016000 END-IF. 016100 016200 ERROR-EXIT. 016300* DISPLAY MESSAGES IF NEEDED 016400* END THE PROGRAM 016500 GOBACK.

Compliments of Gabe Gargiulo, author of several recent books on programming and modern languages, available at Amazon.com.
Here is the input data file PARTTABL: (the next two lines are a column ruler) 1 2 3 4 5 6 123456789.123456789.123456789.123456789.123456789.123456789.12345678 PART01 LEFT HANDED WIDGET WRENCHES PART02 LEAD-WINGED GLIDERS PART04 LEFT FOOT REEBOKS PART06 286 COMPUTERS W 4K HARD DISK 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=LOADTBL2 //STEPLIB DD DSN=your.executable.program.library.goes.here,DISP=SHR //*OF COURSE, THE NEXT LIBRARY NAME MAY BE DIFFERENT AT YOUR COMPANY //PARTTABL DD DSN=userid.COBBOOK.DATA(PARTTABL),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 |