How to Input Variable Length Record File 2

rasETL · Oct 28, 2003

I have a COBOL process running in IBM Z/OS.

I have a process where I would like to allow file(s) with any record length to be input. I have left the "RECORD CONTAINS" clause out of the program, and by specifiying the LRECL in the JCL, can get File(s) in no prblem.

The problem, however, is when reading the records. I have set up the FD area as PIC X(2000) so records up to that length can be processed. This causes COBOL to return 2000 bytes of information for each record, regardless of their length.

Example, if the record is 100 bytes long, the 1st READ brings in the first 20 records, the 2nd READ bring in records 2-21, the 3rd brings in 3-22, etc. You will notice the program recognizes the records, but bring in additional data to fill the 2000 bytes.

We have tried READ...INTO and READ FD then MOVE, and both have the same bad result.

Does anyone know how to eliminate this from happening without knowing the actual Record Length?

MarcLodge · Oct 28, 2003

See thread209-668219 for a full and detailed discussion of how to deal with variable length files.
Marc

rasETL · Oct 28, 2003

Thanks for pointing me to that thread. There is some very interesting information there, but, unfortunately, nothing that I want to implement in my situation.

webrabbit · Oct 28, 2003

Platform and compiler?

If it is IBM mainframe, specify RECORD CONTAINS 0.

slade · Oct 28, 2003

Hi Rs,

Are you sure you define the LRECL, BLKSIZE, RECFM in your JCL? Leaving out the rec contains clause should default the LRECL to 80. Rec contains 0 allows any LRECL for the rec as WR points out, but the JCL should be used to define its true length.

Regards, Jack.

Crox · Oct 28, 2003

Hi, Rsaanders,

As said before, also in other threads, in the FD

Code:

RECORD 0

does it all.

Why do you say "nothing that I want to implement in my situation" about this? Did you try it and why doesn't this fit your needs? It should!

Regards,

Crox

rasETL · Oct 29, 2003

Yes, using "Record contains 0" allows Files of different record lengths to be processed by the program.

I need to note that the files are FB, not VB, which may be the reason I will not be able to get around the problem.

As stated initially, the problem, however, is when reading the records. I have set up the FD area as PIC X(2000) so records up to that length can be processed. This causes COBOL to return 2000 bytes of information for each record, regardless of their length.

Example, if the record is 100 bytes long, the 1st READ brings in the first 20 records of data, the 2nd READ bring in records 2-21, the 3rd brings in 3-22, etc. You will notice the program recognizes the records as 100 bytes, but brings in additional data to match the 2000 bytes.

I have tried to eliminate the Pic clause in the FD 01 entry, but the Program will not compile.

Maybe I'm missing something, but that's the problem I was trying to get around.

slade · Oct 29, 2003

Rs,

What JCL values for LRECL, BLKSIZE, RECFM are you using? If you defined it 100 x 20 FB, You're probably seeing the buffer in your PIC X(2000) field, because when you use the FD field for the record, the system maps your FD def over the buffers. If you used FD PIC x(100) you'd only see the 1st 100 chars of the buffers in your pgm.

You'll notice that the data in the PIC X(2000) field is bumped a hundred bytes for each read. That's the way the system presents data in the buffers to the pgm.

The difference here is that your FD rec len doesn't match the rec len of the rec you're reading. This is not a problem. Just ignore everything from pos 101 to 2k.

You didn't tell us in any detail what your ultimate goal is, but how do you plan to map the record field names for each file you plan to process or do you just plan to copy the files?

Please, you have to answer these questions to give us a better idea of what your situation is.

Regards, Jack.

Crox · Oct 29, 2003

Slade is right. Use READ ... INTO WS-REC and you don't get too much data.

Regards,

Crox

slade · Oct 30, 2003

Hi Rs,

What Crox suggests is absolutely correct but is not going to help much unless you are certain that the last byte of each record is a non blank character. The READ INTO will move the 100 byte rec to the INTO field and pad it with 1900 spaces.

Sooo, that leaves you with the task of finding a way to determine the LRECL of the file you are currently reading.

Which brings us back to Marc's suggestion.

Regards, Jack.

rasETL · Oct 30, 2003

slade

The BLKSIZE of the FB file is set to "half-track" blocking,
so that is the reson the buffer brings back that much data.

I don't want to be tied to having the BLKSIZE = LRECL since that is a waste of space, and in MVS shops is not S.O.P.

Thanks anyway.

webrabbit · Oct 30, 2003

What is the purpose of this process? If you don't know what the record length is, how can you process the data.

slade · Oct 30, 2003

Rs,

Who said anything about BLKSIZE = LRECL? I think you're missing the point.

After each READ the system is pointing you to the next record in the block. Because you've defined the FD rec length larger than the length of the actual rec read, you see a portion of the buffer that you would not normally see.

The sticking point here is that for each run of the pgm the length of the actual recs read will change, but the FD rec length will not. So you have to devise a scheme to determine what the actual rec length of the current file is.

Regards, Jack.

rasETL · Oct 31, 2003

webrabbit

The purpose is to process any file - pertinent information regarding the data is stored in meta data tables. I wanted to avoid the "hassle" of having to store the record length in the meta data, but it seems I cannot. I have already implemented a solution where the record length is in a meta data table, and the program issues a...

MOVE IN-REC (1:REC-LENGTH) TO WS-IN-REC

slade

Your last sentence states the exact subject of the thread.
I was hoping there was a way the program could determine the record length on its own, and do it easily. That appears unlikely, so I implemented the solution above.

Thanks anyway.

slade · Oct 31, 2003

Rs,

It would have been nice to mention that in your 1st post. You wasted a lot of people's time.

slade · Oct 31, 2003

Here's a copy of some code that, among other things, will provide the LRECL from the DCB. See pgraph DCB-INFO for how to find LRECLs.

It's a shame that the author didn't provide his/her name, so I can't give credit where it's due.

Code:

       ID DIVISION.
       PROGRAM-ID.   COBPTR.
       AUTHOR.       USCS.
       DATE-WRITTEN. 08/22/01.
       DATE-COMPILED.
      *---------------------------------------------------------------*
      *    VS COBOL II POINTER FEATURE EXAMPLE                        *
      *    USING MVS CONTROL BLOCKS                                   *
      *---------------------------------------------------------------*
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT TEST-FILE ASSIGN TO DD1.
       DATA DIVISION.
       FILE SECTION.
       FD  TEST-FILE
           LABEL RECORDS STANDARD
           RECORDING MODE IS F
           BLOCK CONTAINS 0 RECORDS
           DATA RECORD IS TEST-REC.
       01  TEST-REC PIC X(80).
      /
       WORKING-STORAGE SECTION.

TEST***01  WS-TEST                            PIC S9(9) COMP VALUE ZERO.
       01  WS-WORK                             PIC S9(9) COMP.
       01  WS-RIGHT-HEX-DIGIT                  PIC S9(4) COMP.
       01  WS-LEN                              PIC S9(4) COMP.
       01  WS-LENGTH REDEFINES WS-LEN          PIC X(02).
       01  WS-FLAG                             PIC S9(4) COMP.
       01  WS-FLAG1 REDEFINES WS-FLAG          PIC X(02).

       01  WS-TCB-ADDRESS-POINTER.
           05  WS-TCB-ADDR-POINTER             USAGE IS POINTER.

       01  WS-TIOT-SEG-POINT.
           05  WS-TIOT-SEG-POINTER             USAGE IS POINTER.
           05  WS-TIOT-SEG-PNT REDEFINES WS-TIOT-SEG-POINTER
                                               PIC S9(9) COMP.

       01  WS-JFCB-POINT.
           05  WS-JFCB-POINTER                 USAGE IS POINTER.
           05  WS-JFCB-PTR REDEFINES WS-JFCB-POINTER
                                               PIC S9(9) COMP.
           05  WS-JFCB-POINT-RED REDEFINES  WS-JFCB-PTR.
               07  FILLER                      PIC X.
               07  WS-JFCB-LOW-3               PIC X(3).

       01  WS-POINT.
           05  WS-POINTER                      USAGE IS POINTER.
           05  WS-PTR REDEFINES WS-POINTER
                                               PIC S9(9) COMP.
           05  WS-POINT-RED REDEFINES WS-PTR.
               07  FILLER                      PIC X.
               07  WS-LOW-3                    PIC X(3).

       01  WS-SWA-POINT.
           05  WS-SWA-POINTER                  USAGE IS POINTER.
           05  WS-SWA-PTR REDEFINES WS-SWA-POINTER
                                               PIC S9(9) COMP.
           05  WS-SWA-POINT-RED REDEFINES WS-SWA-PTR.
               07  FILLER                      PIC X.
               07  WS-SWA-LOW-3                PIC X(3).

       01  WS-QMAT-POINT.
           05  WS-QMAT-POINTER                 USAGE IS POINTER.
           05  WS-QMAT-PTR REDEFINES WS-QMAT-POINTER
                                               PIC S9(9) COMP.
      /
       01  WS-UCB-POINT.
           05  WS-UCB-POINTER                  USAGE IS POINTER.
           05  WS-UCB-POINT-RED REDEFINES WS-UCB-POINTER.
               07  FILLER                      PIC X.
               07  WS-UCB-LOW-3                PIC X(3).

       01  WS-DEB-POINT.
           05  WS-DEB-POINTER                  USAGE IS POINTER.
           05  WS-DEB-POINT-RED REDEFINES WS-DEB-POINTER.
               07  FILLER                      PIC X.
               07  WS-DEB-LOW-3                PIC X(3).

       01  WS-DCB-POINT.
           05  WS-DCB-POINTER                  USAGE IS POINTER.
           05  WS-DCB-POINT-RED REDEFINES WS-DCB-POINTER.
               07  FILLER                      PIC X.
               07  WS-DCB-LOW-3                PIC X(3).

       01  WS-CVT-ADDRESS-POINTER.
           05  WS-CVT-ADDR-POINTER             USAGE IS POINTER.

       01  WS-ASCB-ADDRESS-POINTER.
           05  WS-ASCB-ADDR-POINTER            USAGE IS POINTER.

       01  WS-ASSB-ADDRESS-POINTER.
           05  WS-ASSB-ADDR-POINTER            USAGE IS POINTER.

       01  WS-JSAB-ADDRESS-POINTER.
           05  WS-JSAB-ADDR-POINTER            USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      * PUT THE STATEMENTS BELOW IN AN ASSEMBLER PROGRAM TO LOCATE    *
      * THE DISPLACEMENTS OF THE SYMBOLS.  THESE LINES WERE SHIFTED   *
      * TO THE RIGHT TO MAKE COBOL COMMENTS.  SHIFT THEM BACK TO THE  *
      * LEFT SO THAT THE WORD 'TITLE' IS IN COLUMN 10.                *
      *---------------------------------------------------------------*
      *              TITLE 'PREFIX STORAGE AREA'                      *
      *              IHAPSA LIST=YES                                  *
      *              TITLE 'TASK CONTROL BLOCK'                       *
      *              IKJTCB LIST=YES                                  *
      *              TITLE 'SECONDARY TASK CONTROL BLOCK'             *
      *              IHASTCB LIST=YES                                 *
      *              TITLE 'DATA EXTENT BLOCK'                        *
      *              IEZDEB LIST=YES                                  *
      *              TITLE 'DATA CONTROL BLOCK'                       *
      *     DCBDS    DSECT                                            *
      *              DCBD  DSORG=PS                                   *
      *              TITLE 'UNIT CONTROL BLOCK'                       *
      *     UCBDS    DSECT                                            *
      *              IEFUCBOB                                         *
      *              TITLE 'TASK I/O TABLE'                           *
      *     TIOTDS   DSECT                                            *
      *              IEFTIOT1                                         *
      *              TITLE 'JOB FILE CONTROL BLOCK'                   *
      *     JFCBDS   DSECT                                            *
      *              IEFJFCBN LIST=YES                                *
      *              TITLE 'COMMUNICATION VECTOR TABLE'               *
      *              CVT DSECT=YES,LIST=YES                           *
      *              TITLE 'SUBSYSTEM COMMUNICATION VECTOR TABLE'     *
      *              IEFJSCVT                                         *
      *              TITLE 'JOB STEP CONTROL BLOCK'                   *
      *              IEZJSCB                                          *
      *              TITLE 'SWA QUEUE AREA'                           *
      *              IEFQMNGR                                         *
      *              TITLE 'JES COMMUNICATION TABLE'                  *
      *              IEFJESCT                                         *
      *              TITLE 'JSAB'                                     *
      *              IAZJSAB DSECT=YES,LIST=YES                       *
      *              TITLE 'ASCB'                                     *
      *              IHAASCB DSECT=YES,LIST=YES                       *
      *              TITLE 'ASSB'                                     *
      *              IHAASSB LIST=YES                                 *
      *              TITLE 'VSAM ACB'                                 *
      *              IFGACB DSECT=YES                                 *
      *              TITLE 'REMOTE AREAS'                             *
      *---------------------------------------------------------------*
      /
       LINKAGE SECTION.
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IHAPSA)  X'21C' = DECIMAL 540                  *
      *                         X'224' = DECIMAL 548                  *
      *---------------------------------------------------------------*
       01  PSA.
           05  FILLER             PIC X(540).
           05  TCB-PTR                      USAGE IS POINTER.
           05  FILLER             PIC X(04).
           05  ASCB-PTR                     USAGE IS POINTER.
       01  PSA-ASM REDEFINES PSA.
           05  FILLER             PIC X(540).
           05  PSATOLD                      USAGE IS POINTER.
           05  FILLER             PIC X(04).
           05  PSAAOLD                      USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IKJTCB)  HAS A 32 BYTE PREFIX AREA             *
      *---------------------------------------------------------------*
       01  TCB-POINTER                      USAGE IS POINTER.
       01  TCB.
           05  FILLER             PIC X(08).
           05  DEB-ADDR                     USAGE IS POINTER.
           05  TIOT-POINTER                 USAGE IS POINTER.
           05  FILLER             PIC X(164).
           05  JSCB-POINTER                 USAGE IS POINTER.
           05  FILLER             PIC X(128).
           05  STCB-POINTER                 USAGE IS POINTER.
       01  TCB-ASM REDEFINES TCB.
           05  FILLER             PIC X(08).
           05  TCBDEB                       USAGE IS POINTER.
           05  TCBTIO                       USAGE IS POINTER.
           05  FILLER             PIC X(164).
           05  TCBJSCB                      USAGE IS POINTER.
           05  FILLER             PIC X(128).
           05  TCBSTCB                      USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(CVT)                                           *
      *---------------------------------------------------------------*
       01  CVT-POINTER                      USAGE IS POINTER.
       01  CVT.
           05  FILLER             PIC X(296).
           05  JESCT-POINTER                USAGE IS POINTER.
       01  CVT-ASM REDEFINES CVT.
           05  FILLER             PIC X(296).
           05  CVTJESCT                     USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFJESCT)                                      *
      *---------------------------------------------------------------*
       01  JESCT.
           05  FILLER             PIC X(24).
           05  JESSSCVT-POINTER             USAGE IS POINTER.
       01  JESCT-ASM REDEFINES JESCT.
           05  FILLER             PIC X(24).
           05  JESSSCT                      USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFJSCVT)                                      *
      *---------------------------------------------------------------*
       01  SSCVT.
           05  SSCVT-EYE-CATCHER  PIC X(04).
           05  NEXT-SSCVT                   USAGE IS POINTER.
           05  SUBSYSTEM-NAME     PIC X(04).
       01  SSCVT-ASM  REDEFINES SSCVT.
           05  SSCTID             PIC X(04).
           05  SSCTSCTA                     USAGE IS POINTER.
           05  SSCTSNAM           PIC X(04).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFTIOT1)                                      *
      *---------------------------------------------------------------*
       01  TIOT.
           05  JOB-NAME           PIC X(08).
           05  JOB-PROC           PIC X(08).
           05  JOB-STEP           PIC X(08).
       01  TIOT-ASM REDEFINES TIOT.
           05  TIOCSTPN           PIC X(08).
           05  TIOCPSTN           PIC X(08).
           05  TIOCSJSTN          PIC X(08).

       01  TIOT-SEG.
           05  TIO-LEN            PIC X.
           05  FILLER             PIC X(03).
           05  DD-NAME            PIC X(08).
           05  SWA-V-ADDR         PIC X(03).
           05  FILLER             PIC X(02).
           05  UCB-ADDR           PIC X(03).
       01  TIOENTRY REDEFINES TIOT-SEG.
           05  TIOELNGH           PIC X.
           05  FILLER             PIC X(03).
           05  TIOEDDNM           PIC X(08).
           05  TIOEJFCB           PIC X(03).
           05  FILLER             PIC X(02).
           05  TIOEFSRT           PIC X(03).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFJFCBN)                                      *
      *---------------------------------------------------------------*
       01  JFCB.
           05  DS-NAME            PIC X(44).
           05  FILLER             PIC X(74).
           05  VOL-SER            PIC X(06).
       01  JFCB-ASM REDEFINES JFCB.
           05  JFCBDSNM           PIC X(44).
           05  FILLER             PIC X(74).
           05  JFCBVOLS           PIC X(06).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEZDEB)  DEB HAS A 36 BYTE PREFIX AREA         *
      *---------------------------------------------------------------*
       01  DEB.
           05  FILLER             PIC X(05).
           05  NEXT-DEB-ADDR      PIC X(03).
           05  FILLER             PIC X(17).
           05  DCB-ADDR           PIC X(03).
       01  DEB-ASM REDEFINES DEB.
           05  FILLER             PIC X(05).
           05  DEBDEBB            PIC X(03).
           05  FILLER             PIC X(17).
           05  DEBDCB             PIC X(03).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(DCBD)                                          *
      *---------------------------------------------------------------*
       01  DCB.
           05  FILLER             PIC X(17).
           05  DEVICE-TYPE        PIC X.
               88  DISK-3380-X2E  VALUE X'2E'.
               88  DISK-3390-X2F  VALUE X'2F'.
           05  FILLER             PIC X(08).
           05  DSORG              PIC X(02).
           05  FILLER             PIC X(08).
           05  RECFM              PIC X(02).
           05  FILLER             PIC X(02).
           05  DDNAME             PIC X(08).
           05  FILLER             PIC X(14).
           05  BLKSIZE            PIC S9(4) COMP.
           05  FILLER             PIC X(18).
           05  LRECL              PIC S9(4) COMP.
       01  DCB-ASM REDEFINES DCB.
           05  FILLER             PIC X(17).
           05  DCBDEVT            PIC X.
           05  FILLER             PIC X(08).
           05  DCBDSORG           PIC X(02).
           05  FILLER             PIC X(08).
           05  DCBRECFM           PIC X(02).
           05  FILLER             PIC X(02).
           05  DCBDDNAM           PIC X(08).
           05  FILLER             PIC X(14).
           05  DCBBLKSI           PIC S9(4) COMP.
           05  FILLER             PIC X(18).
           05  DCBLRECL           PIC S9(4) COMP.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEZJSCB)                                       *
      *---------------------------------------------------------------*
       01  JSCB.
           05  FILLER             PIC X(244).
           05  QMPL-POINTER       USAGE IS POINTER.
       01  JSCB-ASM REDEFINES JSCB.
           05  FILLER             PIC X(244).
           05  JSCBQMPI           USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFQMNGR)                                      *
      *---------------------------------------------------------------*
       01  QMPL.
           05  FILLER             PIC X(24).
           05  QMAT-POINTER       USAGE IS POINTER.
       01  QMPL-ASM REDEFINES QMPL.
           05  FILLER             PIC X(24).
           05  QMADD              USAGE IS POINTER.

       01  QMAT.
           05  FILLER             PIC X(12).
           05  QMAT-NEXT-POINTER  USAGE IS POINTER.

       01  SWA.
           05  JFCB-ADDR          USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MODGEN(IHASTCB)                                       *
      *---------------------------------------------------------------*
       01  STCB.
           05  FILLER             PIC X(188).
           05  JSAB-POINTER       USAGE IS POINTER.
       01  STCB-ASM REDEFINES STCB.
           05  FILLER             PIC X(188).
           05  STCBJSAB           USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IAZJSAB)                                       *
      *---------------------------------------------------------------*
       01  JSAB.
           05  JSAB-EYE-CATCHER   PIC X(04).
           05  JSAB-NEXT-PTR      USAGE IS POINTER.
           05  FILLER             PIC X(05).
           05  JSAB-FLAG1         PIC X.
           05  FILLER             PIC X(02).
           05  COMPONENT          PIC X(04).
           05  JOB-ID             PIC X(08).
           05  JOB-NBR            PIC X(08).
           05  FILLER             PIC X(08).
           05  USERID             PIC X(08).
       01  JSAB-ASM REDEFINES JSAB.
           05  JSABID             PIC X(04).
           05  JSABNEXT           USAGE IS POINTER.
           05  FILLER             PIC X(05).
           05  JSABFLG1           PIC X.
           05  FILLER             PIC X(02).
           05  JSABSCID           PIC X(04).
           05  JSABJBID           PIC X(08).
           05  JSABJBNM           PIC X(08).
           05  FILLER             PIC X(08).
           05  JSABUSID           PIC X(08).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IHAASCB)                                       *
      *---------------------------------------------------------------*
       01  ASCB-POINTER                     USAGE IS POINTER.
       01  ASCB.
           05  FILLER             PIC X(336).
           05  ASSB-POINTER       USAGE IS POINTER.
       01  ASCB-ASM REDEFINES ASCB.
           05  FILLER             PIC X(336).
           05  ASCBASSB           USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IHAASSB)                                       *
      *---------------------------------------------------------------*
       01  ASSB.
           05  FILLER             PIC X(168).
           05  JSAB-POINTER       USAGE IS POINTER.
       01  ASSB-ASM REDEFINES ASSB.
           05  FILLER             PIC X(168).
           05  ASSBJSAB           USAGE IS POINTER.
      /
       PROCEDURE DIVISION.
           PERFORM JOB-STEP-NAME.
           PERFORM SUBSYSTEM-NAMES.
           PERFORM JFCB-INFO.
           PERFORM DCB-INFO.
           PERFORM JSAB-INFO.

           GOBACK.
      /
       JOB-STEP-NAME.
      *---------------------------------------------------------------*
      *    JOB NAME AND STEP NAME                                     *
      *      PSA + X'21C' -> TCB -> TIOT                              *
      *---------------------------------------------------------------*
           MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
           SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB TO TCB-POINTER.
           SET ADDRESS OF TIOT TO TIOT-POINTER.
           DISPLAY 'JOB NAME=' JOB-NAME
                   '  JOB PROC=' JOB-PROC
                   '  JOB STEP=' JOB-STEP.
           DISPLAY '         '.
      /
       SUBSYSTEM-NAMES.
      *---------------------------------------------------------------*
      *    DISPLAY SUBSYSTEM NAMES FROM SSCVT CHAIN                   *
      *    CVT -> JSECT -> SSCVT                                      *
      *---------------------------------------------------------------*
           MOVE X'00000010' TO WS-CVT-ADDRESS-POINTER.
           SET ADDRESS OF CVT-POINTER TO WS-CVT-ADDR-POINTER.
           SET ADDRESS OF CVT TO CVT-POINTER.
           SET ADDRESS OF JESCT TO JESCT-POINTER.
           SET ADDRESS OF SSCVT TO JESSSCVT-POINTER.
           DISPLAY 'SUBSYSTEM NAME=' SUBSYSTEM-NAME.
           PERFORM UNTIL NEXT-SSCVT IS = NULL
               SET ADDRESS OF SSCVT TO NEXT-SSCVT
               DISPLAY 'SUBSYSTEM NAME=' SUBSYSTEM-NAME
           END-PERFORM.
           DISPLAY '         '.
      /
       JFCB-INFO.
      *---------------------------------------------------------------
      *    FIND DDNAMES AND ASSOCIATED DSNAMES
      *    PSA+X'21C' -> TCB -> TIOT -> TIOT SEG -> SWAREQ(SVA) -> JFCB
      *---------------------------------------------------------------
           MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
           SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB TO TCB-POINTER.
           SET ADDRESS OF TIOT TO TIOT-POINTER.
           SET WS-TIOT-SEG-POINTER TO TIOT-POINTER.
           ADD 24 TO WS-TIOT-SEG-PNT.
           SET ADDRESS OF TIOT-SEG TO WS-TIOT-SEG-POINTER.
           PERFORM UNTIL TIO-LEN = LOW-VALUES
               MOVE ALL LOW-VALUES TO WS-POINT
               MOVE ALL LOW-VALUES TO WS-JFCB-POINT
               MOVE ALL LOW-VALUES TO WS-SWA-POINT
               MOVE SWA-V-ADDR TO WS-SWA-LOW-3
               PERFORM SWAREQ
               SET ADDRESS OF JFCB TO  WS-POINTER
               DISPLAY 'DDNAME=' DD-NAME
               DISPLAY 'DSNAME=' DS-NAME
               DISPLAY 'VOL=SER=' VOL-SER
               DISPLAY '********************************************'
               MOVE ZERO TO WS-LEN
               MOVE TIO-LEN TO WS-LENGTH(2:1)
               ADD WS-LEN TO WS-TIOT-SEG-PNT
               SET ADDRESS OF TIOT-SEG TO WS-TIOT-SEG-POINTER
           END-PERFORM.
      /
       SWAREQ.
           DIVIDE WS-SWA-PTR BY 16
               GIVING WS-WORK
               REMAINDER WS-RIGHT-HEX-DIGIT.

           IF WS-RIGHT-HEX-DIGIT NOT = 15
               COMPUTE WS-PTR = WS-SWA-PTR + 16
           ELSE
               MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER
               SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER
               SET ADDRESS OF TCB TO TCB-POINTER
               SET ADDRESS OF JSCB TO JSCB-POINTER
               SET ADDRESS OF QMPL TO QMPL-POINTER
               SET ADDRESS OF QMAT TO QMAT-POINTER
               SET WS-QMAT-POINTER TO QMAT-POINTER
               PERFORM UNTIL WS-SWA-PTR <= 65536
                   SET WS-QMAT-POINTER TO QMAT-NEXT-POINTER
                   SET ADDRESS OF QMAT TO QMAT-NEXT-POINTER
                   COMPUTE WS-SWA-PTR = WS-SWA-PTR - 65536
               END-PERFORM
               COMPUTE WS-PTR = WS-SWA-PTR + WS-QMAT-PTR + 1
               SET ADDRESS OF SWA TO WS-POINTER
               SET WS-POINTER TO JFCB-ADDR
               COMPUTE WS-PTR = WS-PTR + 16
            END-IF.
      /
       DCB-INFO.
      *---------------------------------------------------------------*
      *    DISPLAY DCB INFORMATION                                    *
      *    PSA+X'21C' - > TCB -> DEB -> DCB                           *
      *---------------------------------------------------------------*
           OPEN INPUT TEST-FILE.
           MOVE ALL LOW-VALUES TO WS-DEB-POINT.
           MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
           SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB TO TCB-POINTER.
           SET WS-DEB-POINTER TO DEB-ADDR.
           PERFORM UNTIL WS-DEB-POINTER IS = NULL
               SET ADDRESS OF DEB TO WS-DEB-POINTER
               MOVE ALL LOW-VALUES TO WS-DCB-POINT
               MOVE DCB-ADDR TO WS-DCB-LOW-3
               SET ADDRESS OF DCB TO WS-DCB-POINTER
TEST***********DISPLAY 'DCB-PTR=' WS-DCB-POINTER
               DISPLAY ' DDNAME=' DDNAME
               DISPLAY '  DSORG=' DSORG
               DISPLAY '  RECFM=' RECFM
               DISPLAY 'BLKSIZE=' BLKSIZE
               DISPLAY '  LRECL=' LRECL
               IF DISK-3380-X2E
                   DISPLAY 'DEVICE-TYPE=3380'
                   DISPLAY '**************************************'
               ELSE IF DISK-3390-X2F
                       DISPLAY 'DEVICE-TYPE=3390'
                       DISPLAY '**************************************'
                    ELSE
                       DISPLAY 'DEVICE-TYPE=????'
                       DISPLAY 'DEVICE-TYPE=' DEVICE-TYPE
                       DISPLAY '**************************************'
                    END-IF
               END-IF
TEST***********DIVIDE WS-LEN BY WS-TEST GIVING WS-WORK
               MOVE NEXT-DEB-ADDR TO WS-DEB-LOW-3
           END-PERFORM.
           CLOSE TEST-FILE.
      /
       JSAB-INFO.
           SET WS-JSAB-ADDR-POINTER TO NULL.
      *---------------------------------------------------------------*
      *    DISPLAY JSAB INFORMATION                                   *
      *    PSA+X'21C' - > TCB -> STCB -> JSAB                         *
      *---------------------------------------------------------------*
           MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
           SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB TO TCB-POINTER.
           SET ADDRESS OF STCB TO STCB-POINTER.
           IF JSAB-POINTER OF STCB IS NOT = NULL
               SET ADDRESS OF JSAB TO JSAB-POINTER OF STCB
               SET WS-JSAB-ADDR-POINTER TO JSAB-POINTER OF STCB
           END-IF.
      *---------------------------------------------------------------*
      *    PSA+X'224' - > ASCB -> ASSB -> JSAB                        *
      *---------------------------------------------------------------*
           IF WS-JSAB-ADDR-POINTER IS = NULL
               MOVE X'00000224' TO WS-ASCB-ADDRESS-POINTER
               SET ADDRESS OF ASCB-POINTER TO WS-ASCB-ADDR-POINTER
               SET ADDRESS OF ASCB TO ASCB-POINTER
               IF ASSB-POINTER IS NOT = NULL
                   SET ADDRESS OF ASSB TO ASSB-POINTER
                   SET WS-ASSB-ADDR-POINTER TO ASSB-POINTER
                   IF JSAB-POINTER OF ASSB IS NOT = NULL
                       SET ADDRESS OF JSAB TO JSAB-POINTER OF ASSB
                       SET WS-JSAB-ADDR-POINTER TO JSAB-POINTER OF ASSB
                   END-IF
               END-IF
           END-IF.
      *---------------------------------------------------------------*
      *    IF JSAB-FLAG1 > 127 THE JSAB IS INVALID                    *
      *---------------------------------------------------------------*
           IF WS-JSAB-ADDR-POINTER IS = NULL
               CONTINUE
           ELSE
               MOVE ZERO TO WS-FLAG
               MOVE JSAB-FLAG1 TO WS-FLAG1(2:1)
               PERFORM UNTIL WS-FLAG <= 127 OR
                             WS-JSAB-ADDR-POINTER IS = NULL OR
                             JSAB-EYE-CATCHER NOT = 'JSAB'
                   SET WS-JSAB-ADDR-POINTER TO JSAB-NEXT-PTR
                   SET ADDRESS OF JSAB TO WS-JSAB-ADDR-POINTER
                   MOVE ZERO TO WS-FLAG
                   MOVE JSAB-FLAG1 TO WS-FLAG1(2:1)
               END-PERFORM
           END-IF.

           IF WS-JSAB-ADDR-POINTER IS NOT = NULL
               DISPLAY 'EYE-CATCHER=' JSAB-EYE-CATCHER
               DISPLAY '  COMPONENT=' COMPONENT
               DISPLAY '     JOB ID=' JOB-ID
               DISPLAY ' JOB NUMBER=' JOB-ID
               DISPLAY '     USERID=' USERID
           ELSE
               DISPLAY 'JSAB INFORMATION NOT FOUND'
           END-IF.

slade · Oct 31, 2003

Here's a copy of some code that, among other things, will provide the LRECL from the DCB. See pgraph DCB-INFO for how to find LRECLs.

It's a shame that the author didn't provide his/her name, so I can't give credit where it's due.

Code:

       ID DIVISION.
       PROGRAM-ID.   COBPTR.
       AUTHOR.       USCS.
       DATE-WRITTEN. 08/22/01.
       DATE-COMPILED.
      *---------------------------------------------------------------*
      *    VS COBOL II POINTER FEATURE EXAMPLE                        *
      *    USING MVS CONTROL BLOCKS                                   *
      *---------------------------------------------------------------*
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT TEST-FILE ASSIGN TO DD1.
       DATA DIVISION.
       FILE SECTION.
       FD  TEST-FILE
           LABEL RECORDS STANDARD
           RECORDING MODE IS F
           BLOCK CONTAINS 0 RECORDS
           DATA RECORD IS TEST-REC.
       01  TEST-REC PIC X(80).
      /
       WORKING-STORAGE SECTION.

TEST***01  WS-TEST                            PIC S9(9) COMP VALUE ZERO.
       01  WS-WORK                             PIC S9(9) COMP.
       01  WS-RIGHT-HEX-DIGIT                  PIC S9(4) COMP.
       01  WS-LEN                              PIC S9(4) COMP.
       01  WS-LENGTH REDEFINES WS-LEN          PIC X(02).
       01  WS-FLAG                             PIC S9(4) COMP.
       01  WS-FLAG1 REDEFINES WS-FLAG          PIC X(02).

       01  WS-TCB-ADDRESS-POINTER.
           05  WS-TCB-ADDR-POINTER             USAGE IS POINTER.

       01  WS-TIOT-SEG-POINT.
           05  WS-TIOT-SEG-POINTER             USAGE IS POINTER.
           05  WS-TIOT-SEG-PNT REDEFINES WS-TIOT-SEG-POINTER
                                               PIC S9(9) COMP.

       01  WS-JFCB-POINT.
           05  WS-JFCB-POINTER                 USAGE IS POINTER.
           05  WS-JFCB-PTR REDEFINES WS-JFCB-POINTER
                                               PIC S9(9) COMP.
           05  WS-JFCB-POINT-RED REDEFINES  WS-JFCB-PTR.
               07  FILLER                      PIC X.
               07  WS-JFCB-LOW-3               PIC X(3).

       01  WS-POINT.
           05  WS-POINTER                      USAGE IS POINTER.
           05  WS-PTR REDEFINES WS-POINTER
                                               PIC S9(9) COMP.
           05  WS-POINT-RED REDEFINES WS-PTR.
               07  FILLER                      PIC X.
               07  WS-LOW-3                    PIC X(3).

       01  WS-SWA-POINT.
           05  WS-SWA-POINTER                  USAGE IS POINTER.
           05  WS-SWA-PTR REDEFINES WS-SWA-POINTER
                                               PIC S9(9) COMP.
           05  WS-SWA-POINT-RED REDEFINES WS-SWA-PTR.
               07  FILLER                      PIC X.
               07  WS-SWA-LOW-3                PIC X(3).

       01  WS-QMAT-POINT.
           05  WS-QMAT-POINTER                 USAGE IS POINTER.
           05  WS-QMAT-PTR REDEFINES WS-QMAT-POINTER
                                               PIC S9(9) COMP.
      /
       01  WS-UCB-POINT.
           05  WS-UCB-POINTER                  USAGE IS POINTER.
           05  WS-UCB-POINT-RED REDEFINES WS-UCB-POINTER.
               07  FILLER                      PIC X.
               07  WS-UCB-LOW-3                PIC X(3).

       01  WS-DEB-POINT.
           05  WS-DEB-POINTER                  USAGE IS POINTER.
           05  WS-DEB-POINT-RED REDEFINES WS-DEB-POINTER.
               07  FILLER                      PIC X.
               07  WS-DEB-LOW-3                PIC X(3).

       01  WS-DCB-POINT.
           05  WS-DCB-POINTER                  USAGE IS POINTER.
           05  WS-DCB-POINT-RED REDEFINES WS-DCB-POINTER.
               07  FILLER                      PIC X.
               07  WS-DCB-LOW-3                PIC X(3).

       01  WS-CVT-ADDRESS-POINTER.
           05  WS-CVT-ADDR-POINTER             USAGE IS POINTER.

       01  WS-ASCB-ADDRESS-POINTER.
           05  WS-ASCB-ADDR-POINTER            USAGE IS POINTER.

       01  WS-ASSB-ADDRESS-POINTER.
           05  WS-ASSB-ADDR-POINTER            USAGE IS POINTER.

       01  WS-JSAB-ADDRESS-POINTER.
           05  WS-JSAB-ADDR-POINTER            USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      * PUT THE STATEMENTS BELOW IN AN ASSEMBLER PROGRAM TO LOCATE    *
      * THE DISPLACEMENTS OF THE SYMBOLS.  THESE LINES WERE SHIFTED   *
      * TO THE RIGHT TO MAKE COBOL COMMENTS.  SHIFT THEM BACK TO THE  *
      * LEFT SO THAT THE WORD 'TITLE' IS IN COLUMN 10.                *
      *---------------------------------------------------------------*
      *              TITLE 'PREFIX STORAGE AREA'                      *
      *              IHAPSA LIST=YES                                  *
      *              TITLE 'TASK CONTROL BLOCK'                       *
      *              IKJTCB LIST=YES                                  *
      *              TITLE 'SECONDARY TASK CONTROL BLOCK'             *
      *              IHASTCB LIST=YES                                 *
      *              TITLE 'DATA EXTENT BLOCK'                        *
      *              IEZDEB LIST=YES                                  *
      *              TITLE 'DATA CONTROL BLOCK'                       *
      *     DCBDS    DSECT                                            *
      *              DCBD  DSORG=PS                                   *
      *              TITLE 'UNIT CONTROL BLOCK'                       *
      *     UCBDS    DSECT                                            *
      *              IEFUCBOB                                         *
      *              TITLE 'TASK I/O TABLE'                           *
      *     TIOTDS   DSECT                                            *
      *              IEFTIOT1                                         *
      *              TITLE 'JOB FILE CONTROL BLOCK'                   *
      *     JFCBDS   DSECT                                            *
      *              IEFJFCBN LIST=YES                                *
      *              TITLE 'COMMUNICATION VECTOR TABLE'               *
      *              CVT DSECT=YES,LIST=YES                           *
      *              TITLE 'SUBSYSTEM COMMUNICATION VECTOR TABLE'     *
      *              IEFJSCVT                                         *
      *              TITLE 'JOB STEP CONTROL BLOCK'                   *
      *              IEZJSCB                                          *
      *              TITLE 'SWA QUEUE AREA'                           *
      *              IEFQMNGR                                         *
      *              TITLE 'JES COMMUNICATION TABLE'                  *
      *              IEFJESCT                                         *
      *              TITLE 'JSAB'                                     *
      *              IAZJSAB DSECT=YES,LIST=YES                       *
      *              TITLE 'ASCB'                                     *
      *              IHAASCB DSECT=YES,LIST=YES                       *
      *              TITLE 'ASSB'                                     *
      *              IHAASSB LIST=YES                                 *
      *              TITLE 'VSAM ACB'                                 *
      *              IFGACB DSECT=YES                                 *
      *              TITLE 'REMOTE AREAS'                             *
      *---------------------------------------------------------------*
      /
       LINKAGE SECTION.
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IHAPSA)  X'21C' = DECIMAL 540                  *
      *                         X'224' = DECIMAL 548                  *
      *---------------------------------------------------------------*
       01  PSA.
           05  FILLER             PIC X(540).
           05  TCB-PTR                      USAGE IS POINTER.
           05  FILLER             PIC X(04).
           05  ASCB-PTR                     USAGE IS POINTER.
       01  PSA-ASM REDEFINES PSA.
           05  FILLER             PIC X(540).
           05  PSATOLD                      USAGE IS POINTER.
           05  FILLER             PIC X(04).
           05  PSAAOLD                      USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IKJTCB)  HAS A 32 BYTE PREFIX AREA             *
      *---------------------------------------------------------------*
       01  TCB-POINTER                      USAGE IS POINTER.
       01  TCB.
           05  FILLER             PIC X(08).
           05  DEB-ADDR                     USAGE IS POINTER.
           05  TIOT-POINTER                 USAGE IS POINTER.
           05  FILLER             PIC X(164).
           05  JSCB-POINTER                 USAGE IS POINTER.
           05  FILLER             PIC X(128).
           05  STCB-POINTER                 USAGE IS POINTER.
       01  TCB-ASM REDEFINES TCB.
           05  FILLER             PIC X(08).
           05  TCBDEB                       USAGE IS POINTER.
           05  TCBTIO                       USAGE IS POINTER.
           05  FILLER             PIC X(164).
           05  TCBJSCB                      USAGE IS POINTER.
           05  FILLER             PIC X(128).
           05  TCBSTCB                      USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(CVT)                                           *
      *---------------------------------------------------------------*
       01  CVT-POINTER                      USAGE IS POINTER.
       01  CVT.
           05  FILLER             PIC X(296).
           05  JESCT-POINTER                USAGE IS POINTER.
       01  CVT-ASM REDEFINES CVT.
           05  FILLER             PIC X(296).
           05  CVTJESCT                     USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFJESCT)                                      *
      *---------------------------------------------------------------*
       01  JESCT.
           05  FILLER             PIC X(24).
           05  JESSSCVT-POINTER             USAGE IS POINTER.
       01  JESCT-ASM REDEFINES JESCT.
           05  FILLER             PIC X(24).
           05  JESSSCT                      USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFJSCVT)                                      *
      *---------------------------------------------------------------*
       01  SSCVT.
           05  SSCVT-EYE-CATCHER  PIC X(04).
           05  NEXT-SSCVT                   USAGE IS POINTER.
           05  SUBSYSTEM-NAME     PIC X(04).
       01  SSCVT-ASM  REDEFINES SSCVT.
           05  SSCTID             PIC X(04).
           05  SSCTSCTA                     USAGE IS POINTER.
           05  SSCTSNAM           PIC X(04).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFTIOT1)                                      *
      *---------------------------------------------------------------*
       01  TIOT.
           05  JOB-NAME           PIC X(08).
           05  JOB-PROC           PIC X(08).
           05  JOB-STEP           PIC X(08).
       01  TIOT-ASM REDEFINES TIOT.
           05  TIOCSTPN           PIC X(08).
           05  TIOCPSTN           PIC X(08).
           05  TIOCSJSTN          PIC X(08).

       01  TIOT-SEG.
           05  TIO-LEN            PIC X.
           05  FILLER             PIC X(03).
           05  DD-NAME            PIC X(08).
           05  SWA-V-ADDR         PIC X(03).
           05  FILLER             PIC X(02).
           05  UCB-ADDR           PIC X(03).
       01  TIOENTRY REDEFINES TIOT-SEG.
           05  TIOELNGH           PIC X.
           05  FILLER             PIC X(03).
           05  TIOEDDNM           PIC X(08).
           05  TIOEJFCB           PIC X(03).
           05  FILLER             PIC X(02).
           05  TIOEFSRT           PIC X(03).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFJFCBN)                                      *
      *---------------------------------------------------------------*
       01  JFCB.
           05  DS-NAME            PIC X(44).
           05  FILLER             PIC X(74).
           05  VOL-SER            PIC X(06).
       01  JFCB-ASM REDEFINES JFCB.
           05  JFCBDSNM           PIC X(44).
           05  FILLER             PIC X(74).
           05  JFCBVOLS           PIC X(06).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEZDEB)  DEB HAS A 36 BYTE PREFIX AREA         *
      *---------------------------------------------------------------*
       01  DEB.
           05  FILLER             PIC X(05).
           05  NEXT-DEB-ADDR      PIC X(03).
           05  FILLER             PIC X(17).
           05  DCB-ADDR           PIC X(03).
       01  DEB-ASM REDEFINES DEB.
           05  FILLER             PIC X(05).
           05  DEBDEBB            PIC X(03).
           05  FILLER             PIC X(17).
           05  DEBDCB             PIC X(03).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(DCBD)                                          *
      *---------------------------------------------------------------*
       01  DCB.
           05  FILLER             PIC X(17).
           05  DEVICE-TYPE        PIC X.
               88  DISK-3380-X2E  VALUE X'2E'.
               88  DISK-3390-X2F  VALUE X'2F'.
           05  FILLER             PIC X(08).
           05  DSORG              PIC X(02).
           05  FILLER             PIC X(08).
           05  RECFM              PIC X(02).
           05  FILLER             PIC X(02).
           05  DDNAME             PIC X(08).
           05  FILLER             PIC X(14).
           05  BLKSIZE            PIC S9(4) COMP.
           05  FILLER             PIC X(18).
           05  LRECL              PIC S9(4) COMP.
       01  DCB-ASM REDEFINES DCB.
           05  FILLER             PIC X(17).
           05  DCBDEVT            PIC X.
           05  FILLER             PIC X(08).
           05  DCBDSORG           PIC X(02).
           05  FILLER             PIC X(08).
           05  DCBRECFM           PIC X(02).
           05  FILLER             PIC X(02).
           05  DCBDDNAM           PIC X(08).
           05  FILLER             PIC X(14).
           05  DCBBLKSI           PIC S9(4) COMP.
           05  FILLER             PIC X(18).
           05  DCBLRECL           PIC S9(4) COMP.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEZJSCB)                                       *
      *---------------------------------------------------------------*
       01  JSCB.
           05  FILLER             PIC X(244).
           05  QMPL-POINTER       USAGE IS POINTER.
       01  JSCB-ASM REDEFINES JSCB.
           05  FILLER             PIC X(244).
           05  JSCBQMPI           USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IEFQMNGR)                                      *
      *---------------------------------------------------------------*
       01  QMPL.
           05  FILLER             PIC X(24).
           05  QMAT-POINTER       USAGE IS POINTER.
       01  QMPL-ASM REDEFINES QMPL.
           05  FILLER             PIC X(24).
           05  QMADD              USAGE IS POINTER.

       01  QMAT.
           05  FILLER             PIC X(12).
           05  QMAT-NEXT-POINTER  USAGE IS POINTER.

       01  SWA.
           05  JFCB-ADDR          USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MODGEN(IHASTCB)                                       *
      *---------------------------------------------------------------*
       01  STCB.
           05  FILLER             PIC X(188).
           05  JSAB-POINTER       USAGE IS POINTER.
       01  STCB-ASM REDEFINES STCB.
           05  FILLER             PIC X(188).
           05  STCBJSAB           USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IAZJSAB)                                       *
      *---------------------------------------------------------------*
       01  JSAB.
           05  JSAB-EYE-CATCHER   PIC X(04).
           05  JSAB-NEXT-PTR      USAGE IS POINTER.
           05  FILLER             PIC X(05).
           05  JSAB-FLAG1         PIC X.
           05  FILLER             PIC X(02).
           05  COMPONENT          PIC X(04).
           05  JOB-ID             PIC X(08).
           05  JOB-NBR            PIC X(08).
           05  FILLER             PIC X(08).
           05  USERID             PIC X(08).
       01  JSAB-ASM REDEFINES JSAB.
           05  JSABID             PIC X(04).
           05  JSABNEXT           USAGE IS POINTER.
           05  FILLER             PIC X(05).
           05  JSABFLG1           PIC X.
           05  FILLER             PIC X(02).
           05  JSABSCID           PIC X(04).
           05  JSABJBID           PIC X(08).
           05  JSABJBNM           PIC X(08).
           05  FILLER             PIC X(08).
           05  JSABUSID           PIC X(08).
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IHAASCB)                                       *
      *---------------------------------------------------------------*
       01  ASCB-POINTER                     USAGE IS POINTER.
       01  ASCB.
           05  FILLER             PIC X(336).
           05  ASSB-POINTER       USAGE IS POINTER.
       01  ASCB-ASM REDEFINES ASCB.
           05  FILLER             PIC X(336).
           05  ASCBASSB           USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IHAASSB)                                       *
      *---------------------------------------------------------------*
       01  ASSB.
           05  FILLER             PIC X(168).
           05  JSAB-POINTER       USAGE IS POINTER.
       01  ASSB-ASM REDEFINES ASSB.
           05  FILLER             PIC X(168).
           05  ASSBJSAB           USAGE IS POINTER.
      /
       PROCEDURE DIVISION.
           PERFORM JOB-STEP-NAME.
           PERFORM SUBSYSTEM-NAMES.
           PERFORM JFCB-INFO.
           PERFORM DCB-INFO.
           PERFORM JSAB-INFO.

           GOBACK.
      /
       JOB-STEP-NAME.
      *---------------------------------------------------------------*
      *    JOB NAME AND STEP NAME                                     *
      *      PSA + X'21C' -> TCB -> TIOT                              *
      *---------------------------------------------------------------*
           MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
           SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB TO TCB-POINTER.
           SET ADDRESS OF TIOT TO TIOT-POINTER.
           DISPLAY 'JOB NAME=' JOB-NAME
                   '  JOB PROC=' JOB-PROC
                   '  JOB STEP=' JOB-STEP.
           DISPLAY '         '.
      /
       SUBSYSTEM-NAMES.
      *---------------------------------------------------------------*
      *    DISPLAY SUBSYSTEM NAMES FROM SSCVT CHAIN                   *
      *    CVT -> JSECT -> SSCVT                                      *
      *---------------------------------------------------------------*
           MOVE X'00000010' TO WS-CVT-ADDRESS-POINTER.
           SET ADDRESS OF CVT-POINTER TO WS-CVT-ADDR-POINTER.
           SET ADDRESS OF CVT TO CVT-POINTER.
           SET ADDRESS OF JESCT TO JESCT-POINTER.
           SET ADDRESS OF SSCVT TO JESSSCVT-POINTER.
           DISPLAY 'SUBSYSTEM NAME=' SUBSYSTEM-NAME.
           PERFORM UNTIL NEXT-SSCVT IS = NULL
               SET ADDRESS OF SSCVT TO NEXT-SSCVT
               DISPLAY 'SUBSYSTEM NAME=' SUBSYSTEM-NAME
           END-PERFORM.
           DISPLAY '         '.
      /
       JFCB-INFO.
      *---------------------------------------------------------------
      *    FIND DDNAMES AND ASSOCIATED DSNAMES
      *    PSA+X'21C' -> TCB -> TIOT -> TIOT SEG -> SWAREQ(SVA) -> JFCB
      *---------------------------------------------------------------
           MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
           SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB TO TCB-POINTER.
           SET ADDRESS OF TIOT TO TIOT-POINTER.
           SET WS-TIOT-SEG-POINTER TO TIOT-POINTER.
           ADD 24 TO WS-TIOT-SEG-PNT.
           SET ADDRESS OF TIOT-SEG TO WS-TIOT-SEG-POINTER.
           PERFORM UNTIL TIO-LEN = LOW-VALUES
               MOVE ALL LOW-VALUES TO WS-POINT
               MOVE ALL LOW-VALUES TO WS-JFCB-POINT
               MOVE ALL LOW-VALUES TO WS-SWA-POINT
               MOVE SWA-V-ADDR TO WS-SWA-LOW-3
               PERFORM SWAREQ
               SET ADDRESS OF JFCB TO  WS-POINTER
               DISPLAY 'DDNAME=' DD-NAME
               DISPLAY 'DSNAME=' DS-NAME
               DISPLAY 'VOL=SER=' VOL-SER
               DISPLAY '********************************************'
               MOVE ZERO TO WS-LEN
               MOVE TIO-LEN TO WS-LENGTH(2:1)
               ADD WS-LEN TO WS-TIOT-SEG-PNT
               SET ADDRESS OF TIOT-SEG TO WS-TIOT-SEG-POINTER
           END-PERFORM.
      /
       SWAREQ.
           DIVIDE WS-SWA-PTR BY 16
               GIVING WS-WORK
               REMAINDER WS-RIGHT-HEX-DIGIT.

           IF WS-RIGHT-HEX-DIGIT NOT = 15
               COMPUTE WS-PTR = WS-SWA-PTR + 16
           ELSE
               MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER
               SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER
               SET ADDRESS OF TCB TO TCB-POINTER
               SET ADDRESS OF JSCB TO JSCB-POINTER
               SET ADDRESS OF QMPL TO QMPL-POINTER
               SET ADDRESS OF QMAT TO QMAT-POINTER
               SET WS-QMAT-POINTER TO QMAT-POINTER
               PERFORM UNTIL WS-SWA-PTR <= 65536
                   SET WS-QMAT-POINTER TO QMAT-NEXT-POINTER
                   SET ADDRESS OF QMAT TO QMAT-NEXT-POINTER
                   COMPUTE WS-SWA-PTR = WS-SWA-PTR - 65536
               END-PERFORM
               COMPUTE WS-PTR = WS-SWA-PTR + WS-QMAT-PTR + 1
               SET ADDRESS OF SWA TO WS-POINTER
               SET WS-POINTER TO JFCB-ADDR
               COMPUTE WS-PTR = WS-PTR + 16
            END-IF.
      /
       DCB-INFO.
      *---------------------------------------------------------------*
      *    DISPLAY DCB INFORMATION                                    *
      *    PSA+X'21C' - > TCB -> DEB -> DCB                           *
      *---------------------------------------------------------------*
           OPEN INPUT TEST-FILE.
           MOVE ALL LOW-VALUES TO WS-DEB-POINT.
           MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
           SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB TO TCB-POINTER.
           SET WS-DEB-POINTER TO DEB-ADDR.
           PERFORM UNTIL WS-DEB-POINTER IS = NULL
               SET ADDRESS OF DEB TO WS-DEB-POINTER
               MOVE ALL LOW-VALUES TO WS-DCB-POINT
               MOVE DCB-ADDR TO WS-DCB-LOW-3
               SET ADDRESS OF DCB TO WS-DCB-POINTER
TEST***********DISPLAY 'DCB-PTR=' WS-DCB-POINTER
               DISPLAY ' DDNAME=' DDNAME
               DISPLAY '  DSORG=' DSORG
               DISPLAY '  RECFM=' RECFM
               DISPLAY 'BLKSIZE=' BLKSIZE
               DISPLAY '  LRECL=' LRECL
               IF DISK-3380-X2E
                   DISPLAY 'DEVICE-TYPE=3380'
                   DISPLAY '**************************************'
               ELSE IF DISK-3390-X2F
                       DISPLAY 'DEVICE-TYPE=3390'
                       DISPLAY '**************************************'
                    ELSE
                       DISPLAY 'DEVICE-TYPE=????'
                       DISPLAY 'DEVICE-TYPE=' DEVICE-TYPE
                       DISPLAY '**************************************'
                    END-IF
               END-IF
TEST***********DIVIDE WS-LEN BY WS-TEST GIVING WS-WORK
               MOVE NEXT-DEB-ADDR TO WS-DEB-LOW-3
           END-PERFORM.
           CLOSE TEST-FILE.
      /
       JSAB-INFO.
           SET WS-JSAB-ADDR-POINTER TO NULL.
      *---------------------------------------------------------------*
      *    DISPLAY JSAB INFORMATION                                   *
      *    PSA+X'21C' - > TCB -> STCB -> JSAB                         *
      *---------------------------------------------------------------*
           MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.
           SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.
           SET ADDRESS OF TCB TO TCB-POINTER.
           SET ADDRESS OF STCB TO STCB-POINTER.
           IF JSAB-POINTER OF STCB IS NOT = NULL
               SET ADDRESS OF JSAB TO JSAB-POINTER OF STCB
               SET WS-JSAB-ADDR-POINTER TO JSAB-POINTER OF STCB
           END-IF.
      *---------------------------------------------------------------*
      *    PSA+X'224' - > ASCB -> ASSB -> JSAB                        *
      *---------------------------------------------------------------*
           IF WS-JSAB-ADDR-POINTER IS = NULL
               MOVE X'00000224' TO WS-ASCB-ADDRESS-POINTER
               SET ADDRESS OF ASCB-POINTER TO WS-ASCB-ADDR-POINTER
               SET ADDRESS OF ASCB TO ASCB-POINTER
               IF ASSB-POINTER IS NOT = NULL
                   SET ADDRESS OF ASSB TO ASSB-POINTER
                   SET WS-ASSB-ADDR-POINTER TO ASSB-POINTER
                   IF JSAB-POINTER OF ASSB IS NOT = NULL
                       SET ADDRESS OF JSAB TO JSAB-POINTER OF ASSB
                       SET WS-JSAB-ADDR-POINTER TO JSAB-POINTER OF ASSB
                   END-IF
               END-IF
           END-IF.
      *---------------------------------------------------------------*
      *    IF JSAB-FLAG1 > 127 THE JSAB IS INVALID                    *
      *---------------------------------------------------------------*
           IF WS-JSAB-ADDR-POINTER IS = NULL
               CONTINUE
           ELSE
               MOVE ZERO TO WS-FLAG
               MOVE JSAB-FLAG1 TO WS-FLAG1(2:1)
               PERFORM UNTIL WS-FLAG <= 127 OR
                             WS-JSAB-ADDR-POINTER IS = NULL OR
                             JSAB-EYE-CATCHER NOT = 'JSAB'
                   SET WS-JSAB-ADDR-POINTER TO JSAB-NEXT-PTR
                   SET ADDRESS OF JSAB TO WS-JSAB-ADDR-POINTER
                   MOVE ZERO TO WS-FLAG
                   MOVE JSAB-FLAG1 TO WS-FLAG1(2:1)
               END-PERFORM
           END-IF.

           IF WS-JSAB-ADDR-POINTER IS NOT = NULL
               DISPLAY 'EYE-CATCHER=' JSAB-EYE-CATCHER
               DISPLAY '  COMPONENT=' COMPONENT
               DISPLAY '     JOB ID=' JOB-ID
               DISPLAY ' JOB NUMBER=' JOB-ID
               DISPLAY '     USERID=' USERID
           ELSE
               DISPLAY 'JSAB INFORMATION NOT FOUND'
           END-IF.

WMK · Nov 1, 2003

FYI - a "better" (IMHO) solution to the actual programming problem is to have VB (or V) rather than FB (or F) input files.

Then by using the RECORD VAYING IN SIZE option in the FD, one can ALWAYS tell (for each record read) exactly how big the individual record is.

PHILOSOPHICALLY, the ANSI/ISO COBOL Standard really, REALLY, wants you to "tell the truth" about how big your input files will be when you write your source code. There is little or no support for "dynamically" changing this information at run-time.

There has been a request to "add" dynamic changes in a future Standard - and SOME compilers do support this as an "extension".

***

NOTE:
Any members of SHARE who are interested in a related "topic" may also want to vote on the curent SHARE requirement:

SSLNGC03003 Compiler option to make BLOCK CONTAINS clause SMS sensitive

If you do not currently have a SHARE userid (but ARE a member of a SHARE organization) see:

http://www.share.org/share/website/...d84e1cb707541ed686256bf90066b343?OpenDocument

for getting such an ID

Bill Klein

slade · Nov 1, 2003

Hi Bill,

Why not adopt a standard feature for F/FB files similar to the "varying depending on" clause used by V/VB files? Then there's no reason to "lie" and we get the rec len for any file we process in COBOL.

Creating a "variable lenth record file" whose recs are all the same size is a bit of a "fib", don't you think.

Regards, Jack.

WMK · Nov 1, 2003

I don't think that there will be a change to the STANDARD for this in the "short-" to "Medium-term" - but if you are interested in IBM providing such an EXTENSION,

Why not create and submit a SHARE requirement for it?

Bill Klein

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

How to Input Variable Length Record File 2

IS-IT--Management

Programmer

IS-IT--Management

MIS

Programmer

Programmer

IS-IT--Management

Programmer

Programmer

Programmer

IS-IT--Management

MIS

Programmer

IS-IT--Management

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor