Portal | Manuals | References | Downloads | Info | Programs | JCLs | Mainframe wiki | Quick Ref
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Profile Log in to check your private messages Log in
 
How to obtain the physical name of a data set

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming
View previous topic :: :: View next topic  
Author Message
finnesard_mark

New User


Joined: 07 Feb 2006
Posts: 3

PostPosted: Tue Feb 07, 2006 7:50 pm    Post subject: How to obtain the physical name of a data set
Reply with quote

How can I obtain the Physical name of a Data Set assigned in the JCL from within a Cobol program
Back to top
View user's profile Send private message

Gautam512

Active User


Joined: 05 Oct 2005
Posts: 309
Location: Vizag / US

PostPosted: Wed Feb 08, 2006 5:11 pm    Post subject: Re: How to obtain the physical name of a data set
Reply with quote

Hi,

Using the DD name used in the cobol program , with that dd name we can get the Dataset name from the JCL.
Back to top
View user's profile Send private message
finnesard_mark

New User


Joined: 07 Feb 2006
Posts: 3

PostPosted: Wed Feb 08, 2006 7:48 pm    Post subject:
Reply with quote

I am looking for an Assembler sub-routine that can retrieve the File Name to be included in an E-Mail to the end user. This is to tell them were they may find the results of a JAVA application that triggers a batch DB2/IMS job.
Back to top
View user's profile Send private message
DavidatK

Active Member


Joined: 22 Nov 2005
Posts: 700
Location: Troy, Michigan USA

PostPosted: Wed Feb 08, 2006 9:49 pm    Post subject: Re: How to obtain the physical name of a data set
Reply with quote

finnesard_mark,

I remembered a post addressing this subject, looked around and found it.
I tried this code and it does work, at least at the software level I'm currently at. Take a look at the link below.

Previous Post

Best of luck,

Dave
Back to top
View user's profile Send private message
mmwife

Super Moderator


Joined: 30 May 2003
Posts: 1592

PostPosted: Thu Feb 09, 2006 8:31 am    Post subject:
Reply with quote

Hi Mark,

The code below was submitted by Charlie Hottle. The code in the JFCB-INFO pgraph is what you're looking for.
Code:

       ID DIVISION.
       PROGRAM-ID.   COBPTR.
       AUTHOR.       CHARLIE HOTTEL.
       DATE-WRITTEN. 08/22/01.
       DATE-COMPILED.
      *---------------------------------------------------------------*
      *    VS COBOL II POINTER FEATURE EXAMPLE                        *
      *    USING MVS CONTROL BLOCKS                                   *
      *---------------------------------------------------------------*
      *    BASED ON ARTICLE "THE POINTER FEATURE OF VS COBOL II" BY   *
      *    ANNE PETICOLAS IN ENTERPRISE SYSTEMS JOURNAL, MARCH 1991.  *
      *---------------------------------------------------------------*
       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.
      /
       01  F-TEMP PIC S999V9.
       01  C-TEMP PIC S999V9.
       01  EF-TEMP PIC -ZZ9.9.
       01  EC-TEMP PIC -ZZ9.9.
      /
      *---------------------------------------------------------------*
      * 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 'ASXB'                                     *
      *              IHAASXB                                          *
      *              TITLE 'ACEE'                                     *
      *              IHAACEE                                          *
      *              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(108).
           05  ASXB-POINTER       USAGE IS POINTER.
           05  FILLER             PIC X(224).
           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.
      /
      *---------------------------------------------------------------*
      *    SYS1.MODGEN(IHAASXB)                                       *
      *---------------------------------------------------------------*
       01  ASXB.
           05  FILLER             PIC X(200).
           05  ACEE-POINTER       USAGE IS POINTER.
      /
      *---------------------------------------------------------------*
      *    SYS1.MACLIB(IHAACEE)                                       *
      *---------------------------------------------------------------*
       01  ACEE.
           05  FILLER             PIC X(021).
           05  ACEEUSRI           PIC X(008).
      /
       PROCEDURE DIVISION.
           PERFORM JOB-STEP-NAME.
           PERFORM SUBSYSTEM-NAMES.
           PERFORM JFCB-INFO.
           PERFORM DCB-INFO.
           PERFORM JSAB-INFO.
           PERFORM DEGREE-TABLE.

           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                        *
      *                        -> ASXB -> ACEE                        *
      *---------------------------------------------------------------*
           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 ASXB-POINTER IS NOT = NULL
                   SET ADDRESS OF ASXB TO ASXB-POINTER
                   SET ADDRESS OF ACEE TO ACEE-POINTER
                   DISPLAY 'USERID FROM ACEE = ' ACEEUSRI
                   DISPLAY '**************************************'
               END-IF
               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.
      /
       DEGREE-TABLE.
           DISPLAY '**************************************'
           DISPLAY 'FARENHEIT    CENTIGRADE'
           PERFORM VARYING F-TEMP FROM -20  BY 1
                   UNTIL F-TEMP > 105
               COMPUTE C-TEMP = (5 * (F-TEMP - 32)) / 9
               MOVE F-TEMP TO EF-TEMP
               MOVE C-TEMP TO EC-TEMP
               DISPLAY EF-TEMP '       ' EC-TEMP
           END-PERFORM.
Back to top
View user's profile Send private message
finnesard_mark

New User


Joined: 07 Feb 2006
Posts: 3

PostPosted: Fri Feb 10, 2006 7:01 pm    Post subject:
Reply with quote

Thank You all for your help. I am testing the DDNAME program (DAVEatK linked to) and making minor enhancements.
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts Copy 4 byte of data from the last rec... arunsoods DFSORT/ICETOOL 9 Fri Oct 06, 2017 12:15 pm
No new posts opening a dataset after reading it fr... arunsoods DFSORT/ICETOOL 5 Wed Oct 04, 2017 3:54 pm
This topic is locked: you cannot edit posts or make replies. PS file data should be passed as symb... d_sarlie JCL & VSAM 15 Tue Oct 03, 2017 5:18 am
No new posts File Aid tool to compare numeric data balaji81_k Compuware & Other Tools 2 Tue Sep 26, 2017 3:35 am
No new posts Question related to Data dictionary f... rexx77 SYNCSORT 3 Thu Aug 31, 2017 7:23 am

Facebook
Back to Top
 
Job Vacancies | Forum Rules | Bookmarks | Subscriptions | FAQ | Polls | Contact Us