Tip

Display program information with API QCLRPGMI

You may be aware that the command DSPPGM allows only * or *PRINT for the command output.

It is very difficult to find out, within a given library, which programs are running under the owner authority instead of user authority.

Therefore I've written the program RTVPGMINF, which can be called by any other program, and returns in variable &USRPFROPT:

O if program runs under owner authority
U if program runs under user authority

The PGM (DSPPGMLIB) is an example how to list for a specific library all program having USER=*OWNER.

RTVPGMINF source:

 
           PGM        PARM(&PGMNAME &LIBNAME &USRPRFOPT &ERRORID)

/* VARIABLES */

             DCL        VAR(&RECEIVER) TYPE(*CHAR) LEN(220)
             DCL        VAR(&RCVLEN) TYPE(*CHAR) LEN(4)
             DCL        VAR(&FORMAT) TYPE(*CHAR) LEN(8)

             /* TOTAL LENGHT ERROR STRUCTURE     */
             DCL        VAR(&ERROR) TYPE(*CHAR) LEN(96)

             DCL        VAR(&LENGTH) TYPE(*DEC) LEN(15 0)
             DCL        VAR(&LENGTHA) TYPE(*CHAR) LEN(4)

             DCL        VAR(&PGMNAME) TYPE(*CHAR) LEN(10)
             DCL        VAR(&LIBNAME) TYPE(*CHAR) LEN(10)
             DCL        VAR(&QUALPGMNME) TYPE(*CHAR) LEN(20)

             DCL        VAR(&USRPRFOPT) TYPE(*CHAR) LEN(1)
             DCL        VAR(&ERRORID) TYPE(*CHAR) LEN(7)
/* SET VARIABLES */
             CHGVAR     VAR(&QUALPGMNME) VALUE(&PGMNAME *CAT +
                          &LIBNAME)

             CHGVAR     VAR(&LENGTH) VALUE(220)
             CHGVAR     VAR(%BIN(&RCVLEN)) VALUE(&LENGTH)

             CHGVAR     VAR(&FORMAT) VALUE('PGMI0100')

             /* ERROR STRUCTURE AVAILABLE LENGTH   */
             CHGVAR     VAR(&LENGTH) VALUE(88)
             CHGVAR     VAR(%BIN(&LENGTHA)) VALUE(&LENGTH)
             CHGVAR     VAR(%SST(&ERROR 1 4)) VALUE(&LENGTHA)

             /* THE VALID ERROR LENGTH WILL BE SET BY THE API */
             CHGVAR     VAR(&LENGTH) VALUE(0)
             CHGVAR     VAR(%BIN(&LENGTHA)) VALUE(&LENGTH)
             CHGVAR     VAR(%SST(&ERROR 5 4)) VALUE(&LENGTHA)

             CALL       PGM(QCLRPGMI) PARM(&RECEIVER &RCVLEN &FORMAT +
                          &QUALPGMNME &ERROR)
             MONMSG     MSGID(CPF0000)

          /* DUE TO FACT THAT THE FIELDS DESCRIBED IN THE          */
          /* DOCUMENT BEGIN AT POSITION ZERO YOU HAVE TO ADD +1 TO */
          /* THE GIVEN POSITION TO GET THE DATA CORRECTLY          */
             CHGVAR     VAR(&USRPRFOPT) VALUE(%SST(&RECEIVER 106 1))
             CHGVAR     VAR(&ERRORID) VALUE(%SST(&ERROR 9 7))

 ENDE:       RETURN

             ENDPGM
DSPPGMLIB source:

             PGM        PARM(&LIBRARY)
             DCLF       FILE(QSYS/QADSPOBJ)
             DCL        VAR(&LIBRARY) TYPE(*CHAR) LEN(10)
             DCL        VAR(&USRPRFOPT) TYPE(*CHAR) LEN(1)
             DCL        VAR(&ERRORID) TYPE(*CHAR) LEN(7)
             DSPOBJD    OBJ(&LIBRARY/*ALL) OBJTYPE(*PGM) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPPGMDALL)
             MONMSG     MSGID(CPF0000)
             OVRDBF     FILE(QADSPOBJ) TOFILE(QTEMP/DSPPGMDALL)
 READ:       RCVF
             MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(#PGMEND)) /* +
                          eof */
             CALL       PGM(RTVPGMINF) PARM(&ODOBNM &LIBRARY +
                          &USRPRFOPT &ERRORID)
             IF         COND(&ERRORID *NE '       ') THEN(DO)
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) +
                          MSGDTA('Error-id ' *CAT &ERRORID *CAT ' +
                          received by calling API QCLRPGMI, please +
                          check joblog for further details') +
                          MSGTYPE(*INFO)
             ENDDO
             ELSE       CMD(DO)
             IF         COND(&USRPRFOPT *EQ 'O') THEN(DO)

             SNDUSRMSG  MSG('PGM : ' *CAT &ODOBNM *BCAT 'runs under +
                          USER=*OWNER) MSGTYPE(*INFO) TOMSGQ(QSYSOPR)

             ENDDO
             ENDDO

             GOTO       CMDLBL(READ)

#PGMEND:
ENDPGM 

==================================
MORE INFORMATION ON THIS TOPIC
==================================

The Best Web Links: tips, tutorials and more.

Ask your programming questions--or help out your peers by answering them--in our live discussion forums.

Ask the Experts yourself: Our application development gurus are waiting to answer your programming questions.


This was first published in November 2002

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.