[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 Table Load with Occurs Depending On

COBOL The Table Load with Occurs Depending On


26. The Table Load with Occurs Depending On

LOADODO1.
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:

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


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'.
004810      05  TABLE-OVERFLOW        PIC X  VALUE 'N'.
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.
015700 INFILE-READ-PAR.
015800     READ INFILE 
015900         AT END MOVE 'Y' TO infILE-AT-END
016000     END-READ.

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.

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 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.COBBOOK.DATA(PARTTABL),DISP=SHR //SYSOUT DD SYSOUT=* //SYSUDUMP DD SYSOUT=*


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 |