Freeware Page

This is a first cut of this sample PL/I module which is a copy of COB2JOB and needs improvements; please do not hesitate to give me your comments and updates. Thank you.

//GILBERTJ JOB (ACCT#),PLI2JOB,
// NOTIFY=&SYSUID,
// CLASS=A,MSGCLASS=X,COND=(4,LT)
//PLI EXEC PGM=IBMZPLI,PARM=(OPTIONS,SOURCE,NOLIST),REGION=64M
//STEPLIB  DD DSN=IEL330.SIBMZCMP,DISP=SHR
//SYSPRINT DD SYSOUT=*
//SYSUT1   DD UNIT=VIO
//SYSLIN   DD UNIT=VIO,DISP=(,PASS)
//SYSIN    DD *
 /********************************************************************/
 /*                                                                  */
 /*  MODULE NAME = PLI2JOB                                           */
 /*                                                                  */
 /*  DESCRIPTIVE NAME = Sample PL/I program to retrieve job-related  */
 /*                     information from MVS control blocks and      */
 /*                     display it on SYSPRINT.                      */
 /*                                                                  */
 /*  FUNCTION = This sample program demonstrates how to retrieve     */
 /*             JOB-related info about the job, TSO or STC address   */
 /*             space in which it is executed.                       */
 /*                                                                  */
 /*             The layout of the MVS control blocks is described    */
 /*             in the MVS Data Areas manuals, which can be found    */
 /*             on any MVS or OS/390 CD collection or viewed         */
 /*             on-line by going to:                                 */
 /*          http://www.s390.ibm.com/bookmgr-cgi/bookmgr.cmd/library */
 /*             and searching for:  MVS DATA AREAS                   */
 /*                                                                  */
 /*  AUTHOR   =  Gilbert Saint-Flour                  */
 /*              http://gsf-soft.com/Freeware/                       */
 /*                                                                  */
 /********************************************************************/
     PLI2JOB: Procedure Options(MAIN);

       DCL cb1(256) based(addr_cb1) Pointer;
       DCL cb1_text based(addr_cb1) Char(1024);
       DCL cb2(256) based(addr_cb2) Pointer;
       DCL cb2_text based(addr_cb2) Char(1024);
       DCL four_bytes Char(4),
           full_word Fixed Bin(31,0) based(Addr(four_bytes)),
           ptr4 Pointer based(Addr(four_bytes));
       DCL ptr0 Pointer;
       DCL eight_bytes Char(8),
           double_word Fixed Bin(31,0) based(addr(eight_bytes));
       DCL 1 Results,
             2 job_name  Char(8),
             2 proc_step Char(8),
             2 step_name Char(8),
             2 program_name Char(8),
             2 program_name2 Char(8),
             2 job_number Char(8),
             2 job_class Char(1),
             2 msg_class Char(1),
             2 acct1 Char(32),
             2 programmer_name Char(20),
             2 batch_or_cics Char(5),
             2 micro_seconds Fixed Dec(12,0),
             2 user_id Char(8),
             2 group_name Char(8),
             2 user_name Char(20);

       four_bytes='00000000'X; ptr0=ptr4;                   /* PTR0=0 */

       addr_cb1=ptr0;                                         /* PSA  */
       addr_cb1=cb1(136);                                     /* TCB  */
       eight_bytes=SUBSTR(cb1_text,317,8);
       micro_seconds=double_word/4096;

       addr_cb2=cb1(4);                                       /* TIOT */
       job_name=SUBSTR(cb2_text,1,8);
      step_name=SUBSTR(cb2_text,9,8);
      proc_step=SUBSTR(cb2_text,17,8);

       addr_cb2=cb1(46);                                      /* JSCB */
      program_name=SUBSTR(cb2_text,361,8);

       addr_cb2=cb2(80);                                      /* SSIB */
      job_number=SUBSTR(cb2_text,13,8);

       addr_cb2=cb1(1);                                       /* PRB  */
      program_name2=SUBSTR(cb2_text,97,8);

      PUT FILE(SYSPRINT) SKIP EDIT(' JOB=',job_name,
                                   ' STEP=',step_name,
                                   ' PROCSTEP=',proc_step,
                                   ' PGM=',program_name,
                                   ' PGM2=',program_name2,
                                   ' ',micro_seconds)      (A);

       addr_cb2=cb1(46);                                      /* JSCB */
       addr_cb2=cb2(66);                                      /* JCT  */
      job_class=SUBSTR(cb2_text,48,1);
      msg_class=SUBSTR(cb2_text,23,1);

      four_bytes='00'X || SUBSTR(cb2_text,57,3);
      addr_cb2=ptr4;                                          /* ACT  */
      programmer_name=SUBSTR(cb2_text,25,20);
      four_bytes='000000'X || SUBSTR(cb2_text,49,1);
      acct1=SUBSTR(cb2_text,50,full_word);

      addr_cb2=cb1(53);                                       /* EXT2 */
      If SUBSTR(cb2_text,21,4) = '00000000'X THEN             /* CAUF */
        batch_or_cics='BATCH';
      Else
        batch_or_cics='CICS ';

      PUT FILE(SYSPRINT) SKIP EDIT(' ',batch_or_cics,
                                   ' JNUM=',job_number,
                                   ' CLASS=',job_class,
                                   ' MSGCLASS=',msg_class,
                                   " PGMR='",programmer_name,"'",
                                   ' ACCT=',acct1,
                                                    ' ') (A);

      addr_cb1=ptr0;                                          /* PSA  */
      addr_cb1=cb1(138);                                      /* ASCB */
      addr_cb2=cb1(28);                                       /* ASXB */
      user_id=SUBSTR(cb2_text,193,8);
      addr_cb2=cb2(51);                                       /* ACEE */
      group_name=SUBSTR(cb2_text,31,8);
      addr_cb1=cb2(26);                                       /* UNAM */
      user_name=SUBSTR(cb1_text,2,20);
      PUT FILE(SYSPRINT) SKIP EDIT(' USERID=',user_id,
                                   ' GROUP=',group_name,
                                   " USER='",user_name,"'",
                                                    ' ') (A);

     END PLI2JOB;
/*
//PROC2 PROC
//GO    EXEC PGM=LOADER,PARM=PRINT
//SYSLIN DD DSN=*.PLI.SYSLIN,DISP=(OLD,DELETE)
//SYSLIB DD DSN=CEE.SCEELKED,DISP=SHR
//SYSLOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//CEEDUMP DD SYSOUT=*
//      PEND
//*
//PSTEP1 EXEC PROC2
//