QP0LROR & QlgLstat & QSPRILSP

QP0LROR: Retrieve object references
QlgLstat : Get file or link information
QSPRILSP : Retrieve identity of last spooled file created
** Program . . : CBX116
** Description : Display IFS object locks
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : March 25, 2004
**
**
** Program summary
** --------------- **
** Unix type APIs:
** QP0LROR Retrieve object For specific IFS objects access
** references or lock information is retrieved.
**
** This information includes the
** type of lock or access as well
** as a list of the jobs holding the
** lock(s).
**
** An IFS object can, however, be
** flagged as "in use" without a
** specific job being identified
** as currently holding a lock.
**
** Likewise, the browsing of an IFS
** stream file does not necessarily
** generate a lock or set the object
** in use indicator.
**
** QlgLstat Get file or link Gets status information about the
** information specified directory entry and puts
** it in the structure pointed to by
** the pBuf parameter.
**
** The path name parameter includes
** NLS attributes (National Language
** Support) enabling the API to take
** these into account when resolving
** the actual IFS object.
**
** Spooled file API:
** QSPRILSP Retrieve identity of Returns the subset of spooled file
** last spooled file attributes that uniquely identifies
** created the last spooled file created in
** the current job. ** ** Work management APIs:
** QUSRJOBI Retrieve job Retrieves a variety of specific
** information information about a job.
**
** The information is grouped in the
** various formats available.
**
** Message handling API:
** QMHSNDPM Send program message Sends a message to a program stack
** entry (current, previous, etc.) or
** an external message queue.
**
** Both messages defined in a message
** file and immediate messages can be
** used. For specific message types
** only one or the other is allowed.
**
** C library function: ** system Run system command Executes a system command. In the
** event of an resulting error the ** error message ID is exported in
** the _EXCP_MSGID variable.
**
** Sequence of events:
** 1. The existence of the specified IFS object is verified using
** the lstat unix function and if an error is returned during
** this process, an escape message is sent back to the caller.
**
** 2. Storage is allocated for the Retrieve object reference API return
** variable and the API is called. If there's more object reference
** information available than allocated, sufficient storage is
** reallocated and the API is called again.
**
** 3. The retrieved information is formatted and written to the printer
** file. The printer file is closed and the allocated storage is
** released.
**
** 4. If the command is running in batch or a printed list was requested,
** a completion message is sent to inform the caller that list is now
** available - otherwise the generated spooled file is displayed, and
** subsequently deleted.
**
**
** Programmer's notes:
** Both the QP0LROR (Retrieve object references) and QSPRILSP (Retrieve
** identity of last spooled file created) were introduced with V5R2 and
** this API example will therefore not be available to earlier releases. ** ** QP0LROR documentation and comprehensive usage notes can be found here:
**
**
** The QP0LROR return format RORO0100 is not used in this utility, but
** a sample of how to use it and retrieve its information is included
** in the non-referenced subroutine RtvObjRef1 and PrcObjRef1.
**
**
** Compile options:
**
** CrtRpgMod Module( CBX116 ) DbgView( *LIST )
**
** CrtPgm Pgm( CBX116 )
** Module( CBX116 )
**
**
**-- Control specification: --------------------------------------------**
H Option( *SrcStmt ) BndDir( 'QC2LE' )
**-- Printer file: -----------------------------------------------------**
FQSYSPRT O F    132                       Printer InfDs( PrtLinInf ) OflInd( *InOf )
F                                         UsrOpn
**-- Printer file information: -----------------------------------------**
D PrtLinInf     Ds
D PlOvfLin                    5i 0        Overlay( PrtLinInf: 188 )
D PlCurLin                    5i 0        Overlay( PrtLinInf: 367 )
D PlCurPag                    5i 0        Overlay( PrtLinInf: 369 )
**-- System information: -----------------------------------------------**
D             SDs
D PsPgmNam  *Proc
**-- Global declarations: ----------------------------------------------**
D Time        s               6s 0
D Idx         s              10u 0
D BytAlc      s              10u 0
D NbrRcds     s              10u 0
D MsgKey      s               4a
D ErrTxt      s             256a         Varying
**
D IfsObj      s             112a
D ObjUse      s               4a
D ChkUsr      s              10a
**
D CurCcsId    c                           0
D CurCtrId    c                           x'0000'
D CurLngId    c                           x'000000'
D ChrDlm1     c                           0
**-- Api error data structure: -----------------------------------------**
D ApiError      Ds
D AeBytPrv                   10i 0        Inz( %Size( ApiError ))
D AeBytAvl                   10i 0        Inz
D AeMsgId                     7a
D                             1a
D AeMsgDta                  128a
**-- system function error id: -----------------------------------------**
D SysError    s               7a          Import( '_EXCP_MSGID' )
**-- Api path: ---------------------------------------------------------**
D ApiPath       Ds
D ApCcsId                    10i 0        Inz( CurCcsId )
D ApCtrId                     2a          Inz( CurCtrId )
D ApLngId                     3a          Inz( CurLngId )
D                             3a          Inz( *Allx'00' )
D ApPthTypI                  10i 0        Inz( ChrDlm1 )
D ApPthNamLen                10i 0
D ApPthNamDlm                 2a          Inz( '/ ' )
D                            10a          Inz( *Allx'00' )
D ApPthNam                 1024a
**-- Object reference information: --------------------------------------**
D RORO0100      Ds                        Based( pObjRef )
D R1BytRtn                   10u 0
D R1BytAvl                   10u 0  
D R1OfsSmpRef                10u 0
D R1LenSmpRef                10u 0
D R1RefCnt                   10u 0
D R1InUseI                   10u 0
**
D RORO0200     Ds                         Based( pObjRef )
D R2BytRtn                   10u 0
D R2BytAvl                   10u 0
D R2RefCnt                   10u 0
D R2InUseI                   10u 0
D R2OfsSmpRef                10u 0
D R2LenSmpRef                10u 0
D R2Of***tRef                10u 0
D R2LenExtRef                10u 0
D R2OfsJobLst                10u 0
D R2NbrJobRtn                10u 0
D R2NbrJobAvl                10u 0
**-- Job using object structure: ---------------------------------------**
D JobUsgObj    Ds                        Based( pJobUsgObj )
D JuDplSmpRef                10u 0
D JuLenSmpRef                10u 0
D JuDplExtRef                10u 0
D JuLenExtRef                10u 0
D JuDplNxtJobE               10u 0
D JuJobNam                   10a
D JuJobUsr                   10a
D JuJobNbr                    6a
**-- Simple object reference types structure: --------------------------**
D SmpObjRef    Ds                       Based( pSmpObjRef )
D SoReadOnly                 10u 0
D SoWrtOnly                  10u 0
D SoReadWrt                  10u 0
D SoExecute                  10u 0
D SoShrRdOnly                10u 0
D SoShrWrtOnly               10u 0
D SoShrRdWrt                 10u 0
D SoShrNoRdWrt               10u 0
D SoAtrLck                   10u 0
D SoSavLck                   10u 0
D SoSavLckInt                10u 0
D SoLnkChgLck                10u 0
D SoChkOut                   10u 0
D SoChkOutUsrNm              10a
D                             2a
**-- Extended object reference types structure: ------------------------**
D ExtObjRef    Ds                      Based( pExtObjRef )
D XoRdOnShrRdOn              10u 0
D XoRdOnShrWtOn              10u 0
D XoRdOnShrRdWt              10u 0
D XoRdOnShrNoRW              10u 0
D XoWtOnShrRdOn              10u 0
D XoWtOnShrWtOn              10u 0
D XoWtOnShrRdWt              10u 0
D XoWtOnShrNoRW              10u 0
D XoRWonShrRdOn              10u 0
D XoRWonShrWtOn              10u 0
D XoRWonShrRdWt              10u 0
D XoRWonShrNoRW              10u 0
D XoExOnShrRdOn              10u 0
D XoExOnShrWtOn              10u 0
D XoExOnShrRdWt              10u 0
D XoExOnShrNoRW              10u 0
D XoXRonShrRdOn              10u 0
D XoXRonShrWtOn              10u 0
D XoXRonShrRdWt              10u 0
D XoXRonShrNoRW              10u 0
D XoAtrLck                   10u 0
D XoSavLck                   10u 0
D XoSavLckInt                10u 0
D XoLnkChgLck                10u 0
D XoCurDir                   10u 0
D XoRootDir                  10u 0
D XoFilSvrRef                10u 0
D XoFilSvrWrkDi              10u 0
D XoChkOut                   10u 0
D XoChkOutUsrNm              10a
D                             2a
**-- Spooled file information: -----------------------------------------**
D SPRL0100     Ds
D SiBytRtn                   10i 0
D SiBytAvl                   10i 0
D SiSplfNam                  10a
D SiJobNam                   10a
D SiUsrNam                   10a
D SiJobNbr                    6a
D SiSplfNbr                  10i 0
D SiJobSysNam                 8a
D SiSplfCrtDat                7a
D                             1a
D SiSplfCrtTim                6a
**-- File stat-structure: ----------------------------------------------**
D Buf         Ds                        Align
D st_mode                    10u 0
D st_ino                     10u 0
D st_nlink                    5u 0
D                             2a
D st_uid                     10u 0
D st_gid                     10u 0
D st_size                    10i 0
D st_atime                   10i 0
D st_mtime                   10i 0
D st_ctime                   10i 0
D st_dev                     10u 0
D st_blksize                 10u 0
D st_allocsize               10u 0
D st_objtype                 11a
D                             1a
D st_codepage                 5u 0
D st_reserv1                 62a
D st_ino_gen_id              10u 0
**
D pBuf       s                  *      Inz( %Addr( Buf ))
**-- Get file or link information: -------------------------------------**
D lstat      Pr              10i 0     ExtProc( 'QlgLstat' )
D PthStr                   4096a       Const Options( *VarSize )
D Buf                           *      Value
**-- Retrieve object references: ---------------------------------------** D
RtvObjRef    Pr                        ExtPgm( 'QP0LROR' )
D RoRcvVar                65535a       Options( *VarSize )
D RoRcvVarLen                10u 0     Const
D RoFmtNam                    8a       Const
D RoPthStr                 4096a       Const Options( *VarSize )
D RoError                 32767a       Options( *VarSize: *NoPass)
**-- Retrieve job information: -----------------------------------------**
D RtvJobInf  Pr                        ExtPgm( 'QUSRJOBI' )
D RiRcvVar                32767a       Options( *VarSize )
D RiRcvVarLen                10i 0     Const
D RiFmtNam                    8a       Const
D RiJobNamQ                  26a       Const
D RiJobIntId                 16a       Const
D RiError                 32767a       Options( *NoPass: *VarSize )
**-- Send program message: ---------------------------------------------**
D SndPgmMsg  Pr                        ExtPgm( 'QMHSNDPM' )
D SpMsgId                     7a       Const
D SpMsgFq                    20a       Const
D SpMsgDta                  128a       Const
D SpMsgDtaLen                10i 0     Const
D SpMsgTyp                   10a       Const
D SpCalStkE                  10a       Const Options( *VarSize )
D SpCalStkCtr                10i 0     Const
D SpMsgKey                    4a
D SpError                    10i 0     Const
**-- Retrieve last spooled file identity: ------------------------------**
D RtvLstSplfId Pr                      ExtPgm( 'QSPRILSP' )
D RsRcvVar                32767a       Options( *VarSize )
D RsRcvVarLen                10i 0     Const
D RsFmtNam                    8a       Const
D RsError                 32767a       Options( *VarSize )
**-- Run system command: -----------------------------------------------**
D system      Pr             10i 0     ExtProc( 'system' )
D command                       *      Value Options( *String )
**-- Get job type: -----------------------------------------------------**
D GetJobTyp   Pr              1a
**-- Send escape message: ----------------------------------------------**
D SndEscMsg   Pr             10i 0 
D PxMsgDta                  512a       Const Varying
**-- Send completion message: ------------------------------------------**
D SndCmpMsg   Pr             10i 0
D PxMsgDta                  512a       Const Varying
**-- Error identification: ---------------------------------------------**
D errno       Pr             10i 0
D strerror    Pr            128a       Varying
**-- Parameters: -------------------------------------------------------**
D PxPthNam    s             300a       Varying
D PxOutOpt    s               3a
**
C            *Entry Plist
C                   Parm PxPthNam
C                   Parm PxOutOpt
** **-- Mainline: ---------------------------------------------------------**
**
C            Eval   ApPthNam = PxPthNam
C            Eval   ApPthNamLen = %Len( PxPthNam )
**
C            If     lstat( ApiPath C : pBuf C ) = -1
**
C            CallP  SndEscMsg( %Char( Errno ) + ': ' + Strerror )
C            Else
**
C            Open   QSYSPRT
**
C            Eval   BytAlc = 65535
C            Eval   pObjRef = %Alloc( BytAlc )
**
C            DoU    R2BytAvl <= BytAlc
**
C            If     R2BytAvl > BytAlc
C            Eval   BytAlc = R2BytAvl
C            Eval   pObjRef = %ReAlloc( pObjRef: BytAlc )
C            EndIf
**
C            CallP(e) RtvObjRef( RORO0200 C : BytAlc C : 'RORO0200' C
                               : ApiPath  C : ApiError C )
**
C            If %Error
C            CallP SndEscMsg( 'Release must be V5R2 or higher.')
C            EndIf
C            EndDo
**
C            If AeBytAvl = *Zero C ExSr PrcObjRef2
C            EndIf
**
C            DeAlloc pObjRef
**
C            Close QSYSPRT
**
C            If PxOutOpt = 'DSP' And
C               GetJobTyp() = 'I'
C            ExSr DspLst
**
C            Else
C     ExSr   WrtLst
C            EndIf
C            EndIf
**
C            Eval *InLr = *On
C            Return
**
**-- Display list: -----------------------------------------------------**
C    DspLst     BegSr
**
C               CallP RtvLstSplfId( SPRL0100
C                             : %Size( SPRL0100 )
C                             : 'SPRL0100'
C                             : ApiError C )
C
**
C               CallP system( 'DSPSPLF ' + C 'FILE(' + %Trim( SiSplfNam ) + ') ' +
C                          'JOB(' + %Trim(SiJobNbr ) + '/' +
C                           %Trim( SiUsrNam ) + '/' +
C                           %Trim( SiJobNam ) + ') ' +
C                          'SPLNBR(' + %Char( SiSplfNbr ) + ')'
C                          )
**
C              CallP system( 'DLTSPLF ' +
C                         'FILE(' + %Trim( SiSplfNam ) + ') ' +
C                         'JOB(' + %Trim( SiJobNbr ) + '/' +
C                         %Trim( SiUsrNam ) + '/' +
C                         %Trim( SiJobNam ) + ') ' +
C                         'SPLNBR(' + %Char( SiSplfNbr ) + ')'
C                        )
**
C              EndSr
**-- Write list: -------------------------------------------------------**
C    WrtLst    BegSr
**
C              CallP SndCmpMsg( 'List has been printed.' )
**
C              EndSr
**-- Retrieve object references - format RORO0100: ---------------------**
C   RtvObjRef1 BegSr
**
**-- Not referenced - included only as a sample!
**
C              Eval BytAlc = 65535
C              Eval pObjRef = %Alloc( BytAlc )
**
C              DoU R1BytAvl <= BytAlc
**
C              If R1BytAvl > BytAlc
C              Eval BytAlc = R1BytAvl
C              Eval pObjRef = %ReAlloc( pObjRef: BytAlc )
C              EndIf
**
C              CallP RtvObjRef( RORO0100
C                             : BytAlc
C                             : 'RORO0100'
C                             : ApiPath
C                             : ApiError
C                             )
**
C              EndDo
** 
C              If AeBytAvl = *Zero
C              ExSr PrcObjRef1
C              EndIf
**
C              EndSr
**-- Process object references - format RORO0100: ----------------------**
C   PrcObjRef1 BegSr
**
C              If R1OfsSmpRef > *Zero And C R1LenSmpRef = %Size( SmpObjRef )
**
C              Eval pSmpObjRef = %Addr( RORO0100 ) +
C                                R1OfsSmpRef
**
C              EndIf
**
C              EndSr
**-- Process object references - format RORO0200: ----------------------**
C   PrcObjRef2 BegSr
**
C              Time Time
C              Except Header
**
C              If R2OfsSmpRef > *Zero And
C                 R2LenSmpRef = %Size( SmpObjRef )
**  
C              Eval pSmpObjRef = %Addr( RORO0200 ) +
C                                       R2OfsSmpRef
**
C              ExSr WrtLstHdr
C              EndIf
**
C              If R2Of***tRef > *Zero And
C                 R2LenExtRef = %Size( ExtObjRef )
**
C              Eval pExtObjRef = %Addr( RORO0200 ) +
C                                       R2Of***tRef
**
C              EndIf
**
C              If R2OfsJobLst > *Zero
**
C         ExSr PrcJobLst
C              EndIf
**
C              If NbrRcds = *Zero
C              Except NoRcds
C              EndIf
** C EndSr **-- Process job list: -------------------------------------------------**
C    PrcJobLst BegSr
**
C              Eval pJobUsgObj = %Addr( RORO0200 ) +
C                                       R2OfsJobLst
**
C              For Idx = 1 to R2NbrJobRtn
**
C              If JuDplSmpRef > *Zero
C              Eval pSmpObjRef = pJobUsgObj + JuDplSmpRef
**...
C              EndIf
**
C              If JuDplExtRef > *Zero
C              Eval pExtObjRef = pJobUsgObj + JuDplExtRef
**...
C              EndIf
**
C         ExSr WrtLckDtl
**
C              If Idx < R2NbrJobRtn C Eval pJobUsgObj += JuDplNxtJobE
C              EndIf
C              EndFor
**
C              EndSr
**-- Write IFS lock detail line: ---------------------------------------**
C    WrtLckDtl BegSr
**
C              If PlCurLin > PlOvfLin - 3
C              Except Header
C              Except DtlHdr
C              EndIf
**
C              Eval NbrRcds = NbrRcds + 1
C              Except LckDtl
**
C              EndSr
**-- Write list header: ------------------------------------------------**
C    WrtLstHdr BegSr
**
C              If ApPthNamLen > %Size( IfsObj )
C              EvalR IfsObj = ApPthNam
C              Eval %Subst( IfsObj: 1: 3 ) = '...'
C              Else
C              Eval IfsObj = ApPthNam
C              EndIf
**
C              If R2InUseI = 1 C Eval ObjUse = '*YES'
C              Else
C              Eval ObjUse = '*NO '
C              EndIf
**
C              If SoChkOutUsrNm > *Blanks
C              Eval ChkUsr = SoChkOutUsrNm
C              Else
C              Eval ChkUsr = '*NONE'
C              EndIf
**
C              Except LstHdr
C              Except DtlHdr
**
C              EndSr
**-- Printer file definition: ------------------------------------------**
OQSYSPRT    EF Header 2 2 O UDATE Y 8 O Time 18 ' : : ' O 70 'Display IFS object locks' O 107 'Program:' O PsPgmNam 118 O 126 'Page:' O PAGE + 1 OQSYSPRT EF LstHdr 1 O 18 'IFS object . . . :' O IfsObj 132 OQSYSPRT EF LstHdr 1 O 18 'Object in use . :' O ObjUse 24 OQSYSPRT EF LstHdr 1 O 18 'Check out user . :' O ChkUsr 30 OQSYSPRT EF DtlHdr 1 O 98 '------------- shared ------ O --------' OQSYSPRT EF DtlHdr 1 O 8 'Job name' O 20 'Job user' O 31 'Job nbr' O 40 'Rd only' O 49 'Wr only' O 56 'Rd/wr' O 62 'Exec' O 71 'Rd only' O 80 'Wr only' O 88 'Rd/wr' O 98 'No rd/wr' O 108 'Atr lock' O 119 'Save lock' **-- Write right->left (prevent overlay): OQSYSPRT EF LckDtl 1 O SoSavLck 3 115 O SoAtrLck 3 105 O SoShrNoRdWrt 3 95 O SoShrRdWrt 3 86 O SoShrWrtOnly 3 78 O SoShrRdOnly 3 69 O SoExecute 3 61 O SoReadWrt 3 54 O SoWrtOnly 3 47 O SoReadOnly 3 38 O JuJobNbr 30 O JuJobUsr 22 O JuJobNam 10 ** OQSYSPRT EF NoRcds 1 O 26 '(No IFS locks found)' **-- Get job type: -----------------------------------------------------**
P GetJobTyp B D Pi 1a ** D JOBI0400 Ds D J4BytRtn 10i 0 D J4BytAvl 10i 0 D J4JobNam 10a D J4UsrNam 10a D J4JobNbr 6a D J4JobIntId 16a D J4JobSts 10a D J4JobTyp 1a D J4JobSubTyp 1a ** C CallP RtvJobInf( JOBI0400 C : %Size( JOBI0400 ) C : 'JOBI0400' C : '*' C : *Blank C : ApiError C ) ** C If AeBytAvl > *Zero C Return *Blank ** C Else C Return J4JobTyp C EndIf ** P GetJobTyp E **-- Send escape message: ----------------------------------------------** P SndEscMsg B D Pi 10i 0 D PxMsgDta 512a Const Varying ** C CallP(e) SndPgmMsg( 'CPF9897' C : 'QCPFMSG *LIBL' C : PxMsgDta C : %Len( PxMsgDta ) C : '*ESCAPE' C : '*PGMBDY' C : 1 C : MsgKey C : *Zero C ) ** C If %Error C Return -1 ** C Else C Return 0 C EndIf ** P SndEscMsg E **-- Send completion message: ------------------------------------------** P SndCmpMsg B D Pi 10i 0 D PxMsgDta 512a Const Varying ** C CallP(e) SndPgmMsg( 'CPF9897' C : 'QCPFMSG *LIBL' C : PxMsgDta C : %Len( PxMsgDta ) C : '*COMP' C : '*PGMBDY' C : 1 C : MsgKey C : *Zero C ) ** C If %Error C Return -1 ** C Else C Return 0 C EndIf ** P SndCmpMsg E **-- Get runtime error number: -----------------------------------------** P Errno B D Pi 10i 0 ** D sys_errno Pr * ExtProc( '__errno' ) ** D Error s 10i 0 Based( pError ) NoOpt ** C Eval pError = sys_errno C Return Error ** P Errno E **-- Get runtime error text: -------------------------------------------** P Strerror B D Pi 128a Varying ** D sys_strerror Pr * ExtProc( 'strerror' ) D 10i 0 Value ** C Return %Str( sys_strerror( Errno )) ** P Strerror E /*-------------------------------------------------------------------*/ /* */ /* Compile options: */ /* */ /* CrtCmd Cmd( DSPIFSLCK ) */ /* Pgm( CBX116 ) */ /* SrcMbr( CBX116X ) */ /* HlpPnlGrp( CBX116H ) */ /* HlpId( *CMD ) */ /* */ /*-------------------------------------------------------------------*/ Cmd Prompt( 'Display IFS Object Locks' ) Parm IFSOBJ *Pname 300 + Min( 1 ) + Expr( *YES ) + Vary( *YES *INT2 ) + Case( *MIXED ) + Prompt( 'IFS object' ) Parm OUTPUT *Char 3 + Rstd( *YES ) + Dft( * ) + SpcVal(( * DSP ) ( *PRINT PRT )) + Prompt( 'Output' ) .*-----------------------------------------------------------------------** .* .* Compile options: .* .* CrtPnlGrp PnlGrp( CBX116H ) .* SrcFile( QPNLSRC ) .* SrcMbr( *PNLGRP ) .* .*-----------------------------------------------------------------------** :PNLGRP. :HELP NAME='DSPIFSLCK'.Display IFS Object Locks - Help :P. Displayes access and lock information for a specific IFS object. :P. This information includes the type of lock or access as well as a list of the jobs holding the lock(s). :P. The length of time it will take this command to complete depends on the number of jobs active on the system, and the number of jobs currently using objects through Integrated File System interfaces. :P. :NT. An IFS object can be flagged as "in use" without a specific job being identified as currently holding a lock. :P. Likewise, the browsing of an IFS stream file does not necessarily generate a lock or set the object in use indicator. :ENT. :NT. This command requires release V5R2 or higher to run. :ENT. :EHELP. :HELP NAME='DSPIFSLCK/IFSOBJ'.IFS object (IFSOBJ) - Help :XH3.IFS object (IFSOBJ) :P. Specify the path name to the IFS object whose lock and access information is to be displayed. :P. This is a required parameter. :P. :EHELP. :HELP NAME='DSPIFSLCK/OUTPUT'.Output (OUTPUT) - Help :XH3.Output (OUTPUT) :P. Specifies where the output from the command is sent. :P. The possible values are: :P. :PARML. :PT.:PK DEF.*:EPK. :PD. The output is displayed (if requested by an interactive job) or printed with the job's spooled output (if requested by a batch job). :PT.:PK.*PRINT:EPK. :PD. The output is printed with the job's spooled output. :EPARML. :EHELP. :EPNLGRP. Thanks to Carsten Flensburg and Club Tech iSeries Programming Tips Newsletter
 QSPRILSP with CLLE: PGM DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(70) DCL VAR(&RCVVARLEN) TYPE(*CHAR) LEN(4) DCL VAR(&ERRCODE) TYPE(*CHAR) LEN(8) /* FIELDS FROM FORMAT SPRL0100 */ DCL VAR(&BYTESRTN) TYPE(*DEC) LEN(10 0) DCL VAR(&BYTESAVL) TYPE(*DEC) LEN(10 0) DCL VAR(&SPLFNAME) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10) DCL VAR(&USERNAME) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6) DCL VAR(&SPLFNBR) TYPE(*DEC) LEN(6 0) DCL VAR(&SYSTEMNAME) TYPE(*CHAR) LEN(8) DCL VAR(&CREATEDATE) TYPE(*CHAR) LEN(7) DCL VAR(&CREATETIME) TYPE(*CHAR) LEN(6) CHGVAR VAR(%BIN(&ERRCODE 1 4)) VALUE(0) /* &RCVVARLEN NEEDS TO BE SET TO THE SIZE OF &RCVVAR. + IF YOU CHANGE THE SIZE OF &RCVVAR, CHANGE IT ON THE + LINE BELOW AS WELL! (CL HAS NO %SIZE BIF!!) */ CHGVAR VAR(%BIN(&RCVVARLEN 1 4)) VALUE(70) CALL PGM(QSPRILSP) PARM( &RCVVAR + &RCVVARLEN + 'SPRL0100' + &ERRCODE ) /* SINCE CL HAS NO SUCH THING AS A DATA STRUCTURE, I'VE + PUT ALL OF THE FIELDS INTO ONE BIG &RCVVAR FIELD, + AND WILL SPLIT IT INTO SUBFIELDS BELOW: */ CHGVAR VAR(&BYTESRTN) VALUE(%BIN(&RCVVAR 1 4)) CHGVAR VAR(&BYTESAVL) VALUE(%BIN(&RCVVAR 5 4)) CHGVAR VAR(&SPLFNAME) VALUE(%SST(&RCVVAR 9 10)) CHGVAR VAR(&JOBNAME) VALUE(%SST(&RCVVAR 19 10)) CHGVAR VAR(&USERNAME) VALUE(%SST(&RCVVAR 29 10)) CHGVAR VAR(&JOBNBR) VALUE(%SST(&RCVVAR 39 6)) CHGVAR VAR(&SPLFNBR) VALUE(%BIN(&RCVVAR 45 4)) CHGVAR VAR(&SYSTEMNAME) VALUE(%SST(&RCVVAR 49 8)) CHGVAR VAR(&CREATEDATE) VALUE(%SST(&RCVVAR 57 7)) CHGVAR VAR(&CREATETIME) VALUE(%SST(&RCVVAR 65 6)) /* THE FIELDS ABOVE NOW CONTAIN INFO ABOUT THE LAST + SPOOLED FILE CREATED IN THE JOB. */ ENDPGM Thanks to Scott Klement and Club Tech iSeries Programming Tips Newsletter