      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. JOBINFO.
       AUTHOR. Kevin Ferguson.
       INSTALLATION. Abbydale Systems LLC.
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
      * ------------------------------------------------------------- *
       INPUT-OUTPUT SECTION.
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
       01 JOB-NAME             PIC X(8).
       01 PROGRAM-NAME         PIC X(8).
       01 STEP-NAME            PIC X(8).
       01 LPAR-NAME            PIC X(8).
       01 JOB-NUMBER           PIC X(8).
       01 USER-ID              PIC X(8).
      * ------------------------------------------------------------- *
       LINKAGE SECTION.
      * ------------------------------------------------------------- *
       01  CVT-ADRS                     USAGE IS POINTER.
       01 PSA.
          05 FILLER     PIC X(16).
          05 CVTADDR    POINTER.
          05 FILLER     PIC X(520).
          05 PSATOLD    POINTER.
          05 FILLER     PIC X(4).
          05 PSAAOLD    POINTER.
       01 TCB.
          05 FILLER     PIC X(12).
          05 TCBTIO     POINTER.
          05 FILLER     PIC X(164).
          05 TCBJSCBB   POINTER.
       01 TIOT.
          05 TIOCNJOB   PIC X(8).
          05 TIOCSTPN   PIC X(8).
       01 JSCB.
          05 FILLER     PIC X(316).
          05 SSIBPNTR   POINTER.
          05 FILLER     PIC X(40).
          05 JSCBPGMN   PIC X(8).
       01 SSIB.
          05 FILLER     PIC X(12).
          05 SSJOBNUM   PIC X(8).
       01 CVT.
          05 FILLER     PIC X(140).
          05 ECVTPNTR   POINTER.
       01 ECVT.
          05 FILLER     PIC X(344).
          05 ECVTLPAR   PIC X(8).
       01 ASCB.
          05 FILLER     PIC X(108).
          05 ASCBASXB   POINTER.
       01 ASXB.
          05 FILLER     PIC X(200).
          05 ASXBSENV   POINTER.
       01 ACEE.
          05 FILLER     PIC X(21).
          05 USERID     PIC X(8).
      * ------------------------------------------------------------- *
       PROCEDURE DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       A-MAIN SECTION.
      * ------------------------------------------------------------- *
      *    Address PSA
           SET ADDRESS OF PSA TO NULL
      *    Address CVT
           SET ADDRESS OF CVT TO CVTADDR.
      *    Address ECVT
           SET ADDRESS OF ECVT TO ECVTPNTR.
           MOVE ECVTLPAR TO LPAR-NAME
      *    Address TCB
           SET ADDRESS OF TCB TO PSATOLD
      *    Address TIOT
           SET ADDRESS OF TIOT TO TCBTIO
           MOVE TIOCNJOB TO JOB-NAME
           MOVE TIOCSTPN TO STEP-NAME
      *    Address JSCB
           SET ADDRESS OF JSCB TO TCBJSCBB
           SET ADDRESS OF SSIB TO SSIBPNTR
      *    Address ASCB
           SET ADDRESS OF ASCB TO PSAAOLD IN PSA.
           SET ADDRESS OF ASXB TO ASCBASXB IN ASCB.
           SET ADDRESS OF ACEE TO ASXBSENV IN ASXB.
           MOVE USERID TO USER-ID.
           MOVE JSCBPGMN TO PROGRAM-NAME
           SET ADDRESS OF SSIB TO SSIBPNTR
           MOVE SSJOBNUM TO JOB-NUMBER
           MOVE ECVTLPAR TO LPAR-NAME
           DISPLAY 'JOB NAME     = ' JOB-NAME '<==='
           DISPLAY 'STEP NAME    = ' STEP-NAME
           DISPLAY 'PROGRAM NAME = ' PROGRAM-NAME
           DISPLAY 'JOB NUMBER   = ' JOB-NUMBER
           DISPLAY 'Running on   = ' LPAR-NAME
           DISPLAY 'Userid       = ' USER-ID
           STOP RUN.
