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 //