Retrieve Program Information
d ritorno s 1000
d len s 10i 0
d formato s 8 inz('PGMI0100')
d pgmx s 20
d errori s 20
d pgmi s 10
d gruppo s 30
c *entry plist
c parm pgmi
c parm gruppo
c*
c movel pgmi pgmx
c move '*LIBL ' pgmx
c eval len=%len(ritorno)
c clear errori
c call 'QCLRPGMI'
c parm ritorno
c parm len
c parm formato
c parm pgmx
c parm errori
c*
c eval gruppo=%subst(ritorno:369:%len(gruppo))
c eval *inlr=*on
c return
Thanks to Marco Facchinetti
And here an US/UK version ;-)
*
* Program Info
*
d SDS
d @PGM 001 010
d @PARMS 037 039 0
d @JOB 244 253
d @USER 254 263
d @JOB# 264 269 0
*==============================================
* QCLRPGMI API to Retrieve program info
*==============================================
*
* Standard API error data structure
*
d APIERR DS INZ
d AEBYPR 1 4B 0
d AEBYAV 5 8B 0
d AEEXID 9 15
d AEEXDT 16 116
*
* Standard parameters for QCLRPGMI API
* (Retrieve Program Information) API
*
d RP_PARM DS INZ
d RP_RCV 1 416 RECEIVER VARIABLE
d RP_PGMNAME 9 18 PROGRAM NAME
d RP_PGMLIB 19 28 PROGRAM LIBRARY
d RP_PGMATTR 39 48 PROGRAM ATTRIBUTE
d RP_TEXT 111 160 TEXT DESCRIPTION
d RP_MODULES 413 416B 0 NUMBER OF MODULES
d RP_RCV_LEN 417 420B 0 LENGTH OF RCV VAR
d RP_FORMAT 421 428 FORMAT NAME
d RP_PGM_LIB 429 448 PGM NAME & LIBRARY
d RP_PGM 429 438 PROGRAM NAME
d RP_LIB 439 448 PROGRAM LIBRARY
*
* Define Variables
*
d InLibrary S 10
d InProgram S 10
*
c clear RP_parm
c eval RP_RCV_LEN = 416
c eval RP_FORMAT = 'PGMI0100'
c eval RP_PGM = InProgram
c eval RP_LIB = InLibrary
c clear APIERR
c eval AEBYPR = 116
*
c call 'QCLRPGMI'
c parm RP_RCV
c parm RP_RCV_LEN
c parm RP_FORMAT
c parm RP_PGM_LIB
c parm APIERR
*
c eval *INLR = *On
*
*==============================================
* *Inzsr - Initial onetime subroutine
*==============================================
csr *Inzsr begsr
*
c *Entry Plist
c parm InLibrary
c parm InProgram
*
c endsr
*==============================================
阅读(779) | 评论(0) | 转发(0) |
