DB2: Check if a program is bound to package using a REXX program.

The below REXX program verifies if a program was BIND to a package. To achieve that it carries out following tasks

1. It gets the list of program names from the PGM file
2. It receives the collection name from the SYSIN file
3. For each program from the PGM file, it retrieves the consistency token from the DBRM library allocated to the DDname DBRM and then it tries to match the consistency token with all the packages found under the collection for that program. If there is match is found,  it generates "Package found", otherwise "Package not found" messages along with the program name in the SYSOUT.
4. If the program is not found in the DBRM library, then it generates "Not found in the DBRM" message along with the program name.

/* REXX */
/*---------------------------------------------------------------------
THIS REXX TAKES THE PROGRAMS AND GETS THE CONSISTENCY TOKEN FROM THE
DBRM PDS AND CHECKS IF THE CONSISTENCY TOKEN IN THE PACKAGE
MATCHES
---------------------------------------------------------------------*/
 ADDRESS TSO
 "EXECIO * DISKR PGM (STEM LINES1.  FINIS "
 ADDRESS TSO
 "EXECIO * DISKR SYSIN (STEM COLL.  FINIS "
 COLL = SUBSTR(COLL.1,1,8)
 SAY 'COLLECTION IS: ' COLL
/* FIRST CHECK TO SEE WHETHER THE REXX/DB2 COMMAND ENVIRONMENT IS
   AVAILABLE. IF IT IS NOT, THEN ESTABLISH IT */
ADDRESS TSO "SUBCOM DSNREXX"
/*THE PREVIOUS COMMAND IS TO CHECK WHETHER THE REXX/DB2 COMMAND
  ENVIRONMENT IS AVAILABLE TO YOU. IF IT IS NOT AVAILABLE THEN
  YOU NEED TO ISSUE THE NEXT COMMAND, IE RXSUBCOM, TO ESTABLISH
  THE ENVIRONMENT. AFTER YOU ESTABLISH YOUR ENVIRONMENT YOU CAN
  CONNECT TO YOUR DESIRED DB2 SUBSYSTEM                  */
IF RC THEN
   DO
   S_RC =RXSUBCOM('ADD ','DSNREXX','DSNREXX')
   IF S_RC=0 THEN
       RXSTATUS = 'ADDED'
   ELSE RXSTATUS = 'ISNOTADDED'
   END
ADDRESS 'DSNREXX '
/*SSID='<YOUR DB2SUBSYSTEM THAT YOU WANT TO ACCESS>' */
SSID='DB1T'
"CONNECT" SSID
IF SQLCODE <> "0" THEN
   DO
    SAY "FAILED TO CONNECT TO THE DATABASE"
    SAY SQLCODE
    EXIT 8
   END
ELSE
  DO
    SAY "CONNECT TO THE DATABASE SUCCESS"
 END
SAY ""
SAY "=============  REPORT SECTION  STARTS ========================="
SAY ""
DO I = 1 TO LINES1.0
 PGM=SUBSTR(LINES1.I,1,8)
 CALL DBRMSEARCH
 SQLSTM = "SELECT COLLID,NAME,CONTOKEN,PDSNAME FROM SYSIBM.SYSPACKAGE",
          "WHERE NAME = '"PGM"' AND COLLID = '"COLL"'" ,
          "ORDER BY BINDTIME DESC"
   "EXECSQL DECLARE C1 CURSOR FOR S1"
    CALL CHECKSQLCODE
   "EXECSQL PREPARE S1 INTO :SQLDA01 FROM :SQLSTM"
    CALL CHECKSQLCODE
   "EXECSQL OPEN C1"
    CALL CHECKSQLCODE
 IF SQLCODE = 0 THEN
 DO
   OK = 0
   DO UNTIL SQLCODE == +100 | OK == 1
     "EXECSQL FETCH C1 USING DESCRIPTOR :SQLDA01"
     CALL CHECKSQLCODE
     IF SQLCODE =0 THEN
     DO
       CNTKOLD=C2X(SQLDA01.3.SQLDATA X)
       CNTKOLD=SUBSTR(CNTKOLD,1,16)
       STR1 = SUBSTR(CNTKOLD,9,8)
       STR2 = SUBSTR(CNTKOLD,1,8)
       CNTKNEW =  STR1 || STR2
       IF POS(CNTKOLD,HEX,1)>0 THEN OK=1
       IF POS(CNTKNEW,HEX,1)>0 THEN OK=1
     END
   END
   IF LMFINDRC == 0 THEN DO
      IF OK THEN DO
          DBRM_FL = 'PACKAGE FOUND '
      END
      IF ^OK THEN DO
          DBRM_FL = 'PACKAGE NOT FOUND '
      END
      SAY PGM ||" "|| DBRM_FL
   END
 END
 "EXECSQL CLOSE C1"
 CALL CHECKSQLCODE
END
SAY " "
SAY " "
SAY "=============  REPORT SECTION  ENDS ============================="
SAY " "
SAY " "
SAY " "
SAY " "
SAY " "
/* DISCONNECT FROM YOUR DATABASE */
ADDRESS 'DSNREXX '
"DISCONNECT" 'SSID'
ADDRESS DSNREXX "DISCONNECT"
/* REMOVE THE HOST COMMAND ENVIRONMENT */
IF RXSTATUS = 'ADDED'  THEN
S_RC =RXSUBCOM('DELETE','DSNREXX','DSNREXX')
EXIT 0
DBRMSEARCH:
/**********************************************************************/
/* READ DBRM LIBRARIES THROUGH LM-SERVICES                            */
/**********************************************************************/
OK=0
ADDRESS ISPEXEC "LMINIT DATAID(DD2) DDNAME(DBRM) ENQ(SHR)"
IF RC^=0 THEN DO
    SAY'LMINIT1 RC= 'RC' -->EXIT'
    EXIT
END
ADDRESS ISPEXEC "LMOPEN DATAID("DD2") OPTION(INPUT)"
IF RC^=0 THEN DO
    SAY'LMOPEN1 RC= 'RC' -->EXIT'
    EXIT
END
LMFINDRC=0
ADDRESS ISPEXEC "LMMFIND DATAID("DD2") MEMBER("PGM")"
IF RC^=0 THEN DO
    SAY PGM ' NOT FOUND IN THE DBRM '
    LMFINDRC=RC
    ADDRESS ISPEXEC "LMCLOSE DATAID("DD2")"
    ADDRESS ISPEXEC "LMFREE DATAID("DD2")"
    RETURN
END
ADDRESS ISPEXEC "LMGET DATAID("DD2") MODE(INVAR) DATALOC(RECORD)",
    "DATALEN(LEN) MAXLEN(28000)"
IF RC=0 THEN DO
    HEX=C2X(RECORD)
END
ADDRESS ISPEXEC "LMCLOSE DATAID("DD2")"
ADDRESS ISPEXEC "LMFREE DATAID("DD2")"
RETURN

CHECKSQLCODE:
  IF(SQLCODE <> 0) THEN
  DO
     IF(SQLCODE =100) THEN
       NOP
     ELSE
      DO
       SAY   "SQLCODE         "  SQLCODE
       SAY   "SQLERRMC      "  SQLERRMC
       SAY   "SQLERRP         "  SQLERRP
       SAY   "SQLERRD1      "  SQLERRD.1
       SAY   "SQLERRD2      "  SQLERRD.2
       SAY   "SQLERRD3      "  SQLERRD.3
       SAY   "SQLERRD4      "  SQLERRD.4
       SAY   "SQLERRD5      "  SQLERRD.5
       SAY   "SQLERRD6      "  SQLERRD.6
       EXIT 8
      END
  END
RETURN

Jcl to execute the above REXX program is given below

//STEP010  EXEC PGM=IKJEFT1A
//SYSTSPRT DD SYSOUT=*
//SYSEXEC  DD DSN=....
//* SUPPLY THE DBRM HERE
//DBRM     DD DISP=SHR,DSN=.....
//* SUPPLY THE COLLECTION NAME HERE
//SYSIN DD *
Collection id
/*
//* SUPPLY THE LIST OF PROGRAMS HERE
//PGM      DD *
PGM1
PGM2
PGM3
//*
//*
//SYSHELP  DD DUMMY
//ISPLLIB  DD DSN=....
//ISPPLIB  DD DSN=....
//ISPMLIB  DD DSN=....
//ISPSLIB  DD DSN=....
//ISPTLIB  DD DSN=....
//SYSEDIT  DD SPACE=(CYL,(1,5)),UNIT=SYSDA
//SYSEDIT2 DD SPACE=(CYL,(1,5)),UNIT=SYSDA
//SYSUT1   DD SPACE=(CYL,(1,1)),UNIT=SYSDA
//SYSUT2   DD SPACE=(CYL,(1,1)),UNIT=SYSDA
//SYSUT3   DD SPACE=(CYL,(1,1)),UNIT=SYSDA
//SYSUT4   DD SPACE=(CYL,(1,1)),UNIT=SYSDA
//ISPPROF  DD DSN=....
//ISPLOG DD SYSOUT=*,
// DCB=(DSORG=PS,RECFM=FB,LRECL=120,BLKSIZE=2400),
// SPACE=(TRK,(5,0))
//SYSTSIN  DD *
ISPSTART CMD(BINDCHK)
/*
//*