The table load program LOADTBL2 works very well, but has a problem. It wastes time. This is because the table in LOADTBL2 always occurs the maximum number of times, 100 in this example. Every time you do a SEARCH, it assumes that there are 100 occurrences (which there are!) and searches through empty occurrences. In order to get usable results with LOADTBL2 we had to place high-values in the empty occurrences. Not too swift.

Occurs Depending On to the rescue! By using this facility we can shorten the search time, since the empty occurrences will not be there - the Occurs Depending On will make them vanish! As with everything concerning Occurs Depending On, be careful. You must move a valid number to the Occurs Depending On counter before you use the data item.

In this program the table will occur only as many times as there are entries in the table. This will make the SEARCH verb sharply cut back its search: it will search only the occurrences that have something in them. Because of that we don’t need to put high-values in the unused entries in the table.

Here is the program LOADODO1:

000200 IDENTIFICATION DIVISION.

000300 PROGRAM-ID. LOADODO1.

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* uses occurs depending on to shorten the length of the table

000800* there are only two differences between this and LOADTBL2

000900* the occurs depending on clause in the table

001000* and the set PART-TABLE-MAX-OCCURS

001100* to the index, in the table-termination paragraph

001200*

001300 ENVIRONMENT DIVISION.

001400 CONFIGURATION SECTION.

001500 INPUT-OUTPUT SECTION.

001600 FILE-CONTROL.

001700* TABLE FILE PARTTABL

001800 SELECT TABLE-FILE ASSIGN PARTTABL.

002200* REGULAR INPUT FILE PARTS1

002300 SELECT INFILE ASSIGN PARTS1.

002700 DATA DIVISION.

002800 FILE SECTION.

002900 FD TABLE-FILE

002910 RECORDING MODE IS F

003300 RECORD CONTAINS 80 CHARACTERS.

003400 01 TABLE-RECORD.

003410 05 WS-TR-PART-NUMBER PIC X(6).

003420 05 WS-TR-PART-DESC PIC X(30).

003440 05 FILLER PIC X(44).

003500

003600 FD INFILE

003610 RECORDING MODE IS F

004000 RECORD CONTAINS 80 CHARACTERS.

004100 01 INFILE-RECORD.

004110* PICTURES MUST CORRESPOND TO THE ACTUAL INPUT FILE

004120 05 PART-NUMBER PIC X(6).

004130 05 PART-DESCR PIC X(30).

004140 05 QTY-ON-HAND PIC 9(3).

004150 05 QTY-ON-ORDER PIC 9(3).

004160 05 QTY-ON-RESERVE PIC 9(3).

004170 05 PART-PRICE PIC 9(3)V99.

004180 05 UNUSED PIC X(30).

004190

004300 WORKING-STORAGE SECTION.

004400 01 SWITCHES.

004500 05 TABLE-FILE-AT-END PIC X VALUE 'N'.

004600 05 INFILE-AT-END PIC X VALUE 'N'.

004700 05 VALID-SW PIC X VALUE 'Y'.

004800 05 SOMETHING-ON-TABLE PIC X VALUE 'N'.

004900

006500 01 PART-TABLE.

006600* The 100 used here is arbitrary.

006700* use whatever number you need for the size of your table

006800 05 EACH-PART-INFO OCCURS 100 TIMES

006900 DEPENDING ON PART-TABLE-MAX-LOADED

007100 ASCENDING KEY IS EACH-PART-NUMBER

007110 INDEXED BY PART-INDEX.

007200 10 EACH-PART-NUMBER PIC X(6).

007300 10 EACH-PART-DESCRIPTION PIC X(30).

007400* The value of the next item must be the same as the occurs

007800 01 PART-TABLE-MAX-OCCURS pic S9(5) BINARY VALUE +100.

007500* notice: the next item

007600* after loading the table - will contain the number

007700* of actual entries you placed in the table

* however, initialize it the same as the previous

007800 01 PART-TABLE-MAX-LOADED pic S9(5) BINARY VALUE +100.

007900

008000 PROCEDURE DIVISION.

008100 PERFORM TABLE-INITIALIZATION

008200 PERFORM TABLE-PROCESS-ALL

008300 UNTIL TABLE-FILE-AT-END = 'Y'

008600 PERFORM TABLE-TERMINATION

008700* from now on, part-table-max-loaded contains

008800** the actual number of occurences

008900 PERFORM INFILE-INITIALIZATION

009000 PERFORM INFILE-PROCESS-ALL

009100 UNTIL INFILE-AT-END = 'Y'

009200 PERFORM INFILE-TERMINATION

009300 GOBACK.

009400

009500 TABLE-INITIALIZATION.

009600* don't need to move high-values to part-table

009700* Absolutely must set the index to 1

009800* an index does not have a default initial value

009900* and you are not allowed to set an index to 0

010000 SET PART-INDEX TO 1

010100 OPEN INPUT TABLE-FILE

010200 PERFORM TABLE-READ-PAR.

010300

010400 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

SET part-table-max-loaded to PART-INDEX

006192 PERFORM TABLE-READ-PAR

006193 END-IF.

010900

011000 TABLE-TERMINATION.

013000

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

006996* DISPLAY 'READ ' INPUT-RECORD-COUNT 'RECORDS'

* DISPLAY 'loaded ' part-table-max-loaded

006997

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.

013100

013200 TABLE-READ-PAR.

013300 READ TABLE-FILE

013400 AT END MOVE 'Y' TO TABLE-FILE-AT-END

013500 END-READ.

013600

013700 INFILE-INITIALIZATION.

013800 OPEN INPUT INFILE

013900 PERFORM INFILE-READ-PAR.

014000

014100 INFILE-PROCESS-ALL.

014200 MOVE 'Y' TO VALID-SW

014300 PERFORM TABLE-LOOKUP

014400 IF VALID-SW = 'Y'

014500* Not doing much of anything here in this program

014600* but you could write out records,

014700* print lines in report, etc

014800 DISPLAY 'GOOD RECORD' INFILE-RECORD

014900 ELSE

015000 DISPLAY 'BAD RECORD' INFILE-RECORD

015100 END-IF

015200 PERFORM infilE-READ-PAR.

015300

015400 INFILE-TERMINATION.

015500 CLOSE INFILE.

015600

015700 INFILE-READ-PAR.

015800 READ INFILE

015900 AT END MOVE 'Y' TO infILE-AT-END

016000 END-READ.

016100

016200 TABLE-LOOKUP.

016300* This is a binary search

016400

016500 SEARCH ALL EACH-PART-INFO

016600 AT END

016700* DISPLAY INPUT-PART 'NOT FOUND'

016800 MOVE 'N' TO VALID-SW

016900 WHEN EACH-PART-NUMBER(PART-INDEX) = PART-NUMBER

017000* DISPLAY INPUT-STATE 'FOUND'

017100 MOVE EACH-PART-DESCRIPTION(PART-INDEX) TO PART-DESCR

017200 MOVE 'Y' TO VALID-SW

017300 END-SEARCH.

017400

017500 ERROR-EXIT.

017600 DISPLAY 'PROGRAM IS BEING TERMINATED'

017700 DISPLAY 'PROBLEM WITH LOADING TABLE'

017800 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 003 007 002 10022

PART02 LEAD-WINGED GLIDERS 004 006 001 14054

PART04 LEFT FOOT REEBOKS 021 002 004 04323

PART06 286 COMPUTERS W 4K HARD DISK 043 077 012 00042

Here is sample JCL:

//STEP1 EXEC PGM=LOADODO1

//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.CLASS.DATA(PARTTABL),DISP=SHR

//SYSOUT DD SYSOUT=*

//SYSUDUMP DD SYSOUT=*