[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 Creating a Variable Format File with Occurs Depending On

Creating a Variable Format File with Occurs Depending On in a COBOL program


24. Creating a Variable Format File with Occurs Depending On

VARODOW1.
This program, VARODOW1 will create essentially the same file as the program VARWRIT1, but it will use an Occurs Depending On counter instead of the literals “SHORT”, “MEDIUM” and “LONG” to show which type of record is being created. Otherwise, it will do the same thing as VARWRIT1.
Occurs Depending On involves data items whose length can actually change dynamically during the program’s execution. The data item contains an Occurs clause, but the number of times it actually occurs is determined when the program is running.

Your Occurs clause in the program specifies a number, for example, ITEM-1 OCCURS 100 TIMES. This number is a MAXIMUM number of occurrences. Not to exceed this number! But it can occur fewer times, down to 0, that’s zero occurrences (that means that the item occurs no times, so it has zero length, and has disappeared into the nearest space-warp.)

It gets better. Every time, during the program’s execution, that you refer to the item with the Occurs Depending On, the COBOL compiler looks at the Occurs Depending On counter to see how many times it actually occurs. Then and only then does it know how many bytes it has to move or examine.

The main thing to remember is this: move a valid number to the Occurs Depending On counter BEFORE you refer in any way to the item. (When in doubt about what number to move to the Occurs Depending On counter, move the maximum number first, then the correct number later.) If you don’t do it BEFORE, you may have an item of the wrong length. Not good. You may lose data or even worse, pick up data you didn’t want.

Other than that it’s very simple.

You'll need to read this program's output file with the program VARODOR1, shown next. The JCL will be shown with the next program, VARODOR1.
Here is the program VARODOW1:

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



000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. VARODOW1.
000400* the input file is fixed format
000500* the output file is variable format
000600*     with three record lengths: 20, 40, 60
000700* this will create variable format records
000800* using occurs depending on
001100*
001200 ENVIRONMENT DIVISION.
001300 CONFIGURATION SECTION.
001400 INPUT-OUTPUT SECTION.
001500 FILE-CONTROL.
001600     SELECT INFILE  ASSIGN FIXEDINP.
002000     SELECT OUTFILE ASSIGN VAROUT.
002400 DATA DIVISION.
002500 FILE SECTION.
002600 FD  INFILE
002610     RECORDING MODE IS F
003000     RECORD CONTAINS 80 CHARACTERS.
003100 01  IN-RECORD.
006100*     all records are same length - so space wasted
006200      05  IN-RECORD-TYPE PIC X(10).
006300      05  IN-NAME-1      PIC X(10).
006400      05  IN-NAME-2      PIC X(10).
006500      05  IN-NAME-3      PIC X(10).
006600      05  IN-NAME-4      PIC X(10).
006700      05  IN-NAME-5      PIC X(10).
006800      05  FILLER         PIC X(20).
003200
003300 FD  OUTFILE
003310     RECORDING MODE IS V
003500*     MVS adds 4 to the maximum record length you put here
003600*     so 64 is really the maximum record length.
003700*     don't put  64 here, because MVS would make it 68...
003800*     if you use the LRECL parameter in JCL, it must be 64 , not
003900*     (the minimum record length means nothing -
004000*           you could put 0, 1, or 59...they all work the same)
004100     RECORD CONTAINS 20 to 60 CHARACTERS.
004400
004500*     before actually writing out the record,
004600*     the compiler looks to see what the odo counter is
004700*     then calculates the length of out-record
004800*     then writes out only as many characters
004900*     as the length of the record
005000 01  OUT-RECORD.
005100     05 ODO-COUNTER  PIC 9(5) VALUE 5.
005200     05 FILLER       PIC X(5) VALUE SPACES.
005300     05 OUTPUT-NAME  PIC X(10)
005400        OCCURS 5 TIMES DEPENDING ON ODO-COUNTER.
005500
005600 WORKING-STORAGE SECTION.
005700 01  SWITCHES.
005800      05  FILE-AT-END     PIC X  VALUE 'N'.
005900
007000 01  WS-short-RECORD.
007100*     record is only 20 characters long
007200      05  SHORT-RECORD-TYPE PIC X(10).
007300      05  SHORT-NAME-1      PIC X(10).
007400*   that's all, no fillers
007500
007600 01  WS-medium-RECORD.
007700*     record is only 40 characters long
007800      05  MEDIUM-RECORD-TYPE PIC X(10).
007900      05  MEDIUM-NAME-1      PIC X(10).
008000      05  MEDIUM-NAME-2      PIC X(10).
008100      05  MEDIUM-NAME-3      PIC X(10).
008200*   that's all, no fillers
008300
008400 01  WS-long-RECORD.
008500**     record is only 60 characters long
008600     05  LONG-RECORD-TYPE PIC X(10).
008700      05  LONG-NAME-1     PIC X(10).
008800      05  LONG-NAME-2     PIC X(10).
008900      05  LONG-NAME-3     PIC X(10).
009000      05  LONG-NAME-4     PIC X(10).
009100      05  LONG-NAME-5     PIC X(10).
009200*   that's all, no fillers
009300
009400 PROCEDURE DIVISION.
009500     PERFORM INITIALIZATION
009600     PERFORM PROCESS-ALL
009700**       UPPER CASE Y, PLEASE
009800         UNTIL FILE-AT-END = 'Y'
009900     PERFORM TERMINATION
010000     GOBACK.
010100
010200 INITIALIZATION.
010300     OPEN INPUT INFILE
010400          OUTPUT OUTFILE
010500     PERFORM READ-PAR.
010600
010700 PROCESS-ALL.
010800*    don't really need to move spaces as in next line
010900*    except on microfocus cobol workbench
011000      MOVE SPACES TO OUT-RECORD
011100      EVALUATE IN-RECORD-TYPE
011200       WHEN 'SHORT'  PERFORM WRITE-SHORT-RECORD
011300       WHEN 'MEDIUM' PERFORM WRITE-MEDIUM-RECORD
011400       WHEN 'LONG'   PERFORM WRITE-LONG-RECORD
011500       END-EVALUATE
011600
011700     PERFORM READ-PAR.
011800
011900 WRITE-SHORT-RECORD.
012000*      of course, there are other more sophisticated
012100*      ways to do it, but I'm trying to keep it simple
012200*      be sure to move the number to the counter first
012300        MOVE 1 TO ODO-COUNTER
012400        MOVE IN-NAME-1 TO OUTPUT-NAME (1)
012500*      let's not do a write FROM
012600*      because this way is simpler
012700*      if you wrote FROM something, that thing
012800*      would need its own odo counter, so more complexity
012900        WRITE OUT-RECORD.
013000
013100 WRITE-MEDIUM-RECORD.
013200*      be sure to move the number to the counter first
013300        MOVE 3 TO ODO-COUNTER
013400        MOVE IN-NAME-1 TO OUTPUT-NAME (1)
013500        MOVE IN-NAME-2 TO OUTPUT-NAME (2)
013600        MOVE IN-NAME-3 TO OUTPUT-NAME (3)
013700        WRITE OUT-RECORD.
013800
013900 WRITE-LONG-RECORD.
014000*      be sure to move the number to the counter first
014100        MOVE 5 TO ODO-COUNTER
014200        MOVE IN-NAME-1 TO OUTPUT-NAME (1)
014300        MOVE IN-NAME-2 TO OUTPUT-NAME (2)
014400        MOVE IN-NAME-3 TO OUTPUT-NAME (3)
014500        MOVE IN-NAME-4 TO OUTPUT-NAME (4)
014600        MOVE IN-NAME-5 TO OUTPUT-NAME (5)
014700        WRITE OUT-RECORD.
014900 TERMINATION.
015000     CLOSE INFILE OUTFILE.
015100
015200 READ-PAR.
015300     READ INFILE 
015400         AT END MOVE 'Y' TO FILE-AT-END
015500     END-READ.


Compliments of Gabe Gargiulo, author of several recent books on programming and modern languages, available at Amazon.com.
Here is the input data file FIXEDINP: (the next two lines are a column ruler) 1 2 3 4 5 6 123456789.123456789.123456789.123456789.123456789.123456789.12345678 MEDIUM BETH KELLY ANTHONY LONG LAURA RICK NANCY MARIA ELLEN SHORT MOE MEDIUM NORMA DENISE JEAN LONG MAURA NICK SALLY MARIO ELLIE

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 |