DB2 - L

Db2 z/OS - Rexx to call SYSPROC.ADMIN_INFO_SYSPARM 

Sep 26, 2021 07:16 PM

//MISPSRX JOB 30,'PETER SCHWARCZ',
// CLASS=P,REGION=0M,MSGCLASS=X,NOTIFY=MISPS,MSGLEVEL=(1,1)
//*
// SET SSID=DBP1
//*
//REXGEN EXEC PGM=IEBGENER,COND=(4,LT)
//SYSIN DD DUMMY
//SYSPRINT DD SYSOUT=*
//SYSUT2 DD DSN=&&TEMPPDS(ZPARMBAT),DISP=(,PASS),
// UNIT=SYSDA,SPACE=(TRK,(1,1,1),RLSE),DCB=(RECFM=FB,LRECL=80)
//SYSUT1 DD *
/* REXX */
/*-----------------------------------------------------------------*/
/* PROCEDURE TO LIST DB2 ZPARM VALUES */
/*-----------------------------------------------------------------*/
/*-----------------------------------------------------------------*/
/* 1.00.00 PSS INITIAL VERSION 26/02/2013 */
/*-----------------------------------------------------------------*/
ZPATM10I :

ARG SSID

IF SSID = '' THEN DO
SAY 'YOU MUST ENTER THE NAME OF THE DB2 SUBSYSTEM'
EXIT 20
END

RETURN_CODE = 0;
AR="<->"
MSG = ' ';
MSGIND = 0 ;
RCIND = 0 ;
SYSIND = -1 ;
PROCNAME = 'SYSPROC.ADMIN_INFO_SYSPARM'
PADSTR = ' ';
SEPLINE = '---------------------------------------------------' ||,
'---------------------------------------------------' ||,
'---------------------------------------------------' ||,
'---------------------------------------------------' ||,
'---------------------------------------------------';


/* LOAD REXX */
CALL IA_CONNECT_DB2
CALL GET_VARIABLE

/*--CALL PROCEDURE SYSPROC.ADMIN_INFO_SYSPARM */

SQLSTMT = 'EXECSQL CALL SYSPROC.ADMIN_INFO_SYSPARM' || ,
'(:SSID :SYSIND, :RETURN_CODE :RCIND, :MSG :MSGIND)';
ADDRESS DSNREXX SQLSTMT ;
IF SQLCODE <> +466 THEN DO;
CALL SQLCA_CHECK ;
RETURN;
END;

/*--SET UP LOCATOR VARIABLE FOR THE RESULT SET */
SQLSTMT = 'EXECSQL ASSOCIATE LOCATOR ( :RS_LOC1 ) ' || ,
' WITH PROCEDURE SYSPROC.ADMIN_INFO_SYSPARM' ;
ADDRESS DSNREXX SQLSTMT ;
IF SQLCODE <> 0 THEN DO;
CALL SQLCA_CHECK ;
RETURN;
END;

/* SET UP CURSOR TO READ RESULT SET FROM STORED PROCEDURE */
SQLSTMT = 'EXECSQL ALLOCATE C101 CURSOR FOR RESULT SET :RS_LOC1';
ADDRESS DSNREXX SQLSTMT ;
IF SQLCODE <> 0 THEN DO;
CALL SQLCA_CHECK ;
RETURN;
END;

ZPRMLINE = LEFT(SEPLINE,132) ;
PUSH ZPRMLINE
"EXECIO 1 DISKW ZPRMLIST (OPEN" ;

/* BULID HEADER LINE */

ZPRMLINE = LEFT('MACRO | PARAMETER | VALUE',71);
ZPRMLINE = ZPRMLINE || LEFT('| SSID | VERSION | DATE',31);
ZPRMLINE = ZPRMLINE || '| TIMESTAMP |';
PUSH ZPRMLINE
"EXECIO 1 DISKW ZPRMLIST (OPEN" ;

ZPRMLINE = LEFT(SEPLINE,132) ;
PUSH ZPRMLINE
"EXECIO 1 DISKW ZPRMLIST (OPEN" ;

DO I = 1 TO 500 ;

FETCH = 'EXECSQL FETCH C101 INTO :ROWNUM,:MACRO,:PARAMETER,'||,
':INSTALL_PANEL :INSTALL_PANEL_IND,' ||,
':INSTALL_FIELD :INSTALL_FIELD_IND,' ||,
':INSTALL_LOCATION :INSTALL_LOCATION_IND,' ||,
':VALUE,' ||,
':ADDITIONAL_INFO :ADDITIONAL_INFO_IND';
ADDRESS DSNREXX FETCH ;

IF SQLCODE = 100
THEN DO;
IF I = 1 THEN DO;
ZPRMLINE = 'NO ZPRM DATA FOUND FOR SUB-SYSTEM ' ;
ZPRMLINE = ZPRMLINE || SSID ;
PUSH ZPRMLINE
"EXECIO 1 DISKW ZPRMLIST (OPEN" ;
SIGNAL ZPRMEMPTY; /* GO TO THE END */
END;
LEAVE I;
END;
IF SQLCODE <> 0 THEN DO;
CALL SQLCA_CHECK ;
LEAVE I;
END;


VALUE = LEFT(OVERLAY(VALUE,PADSTR),31) ;
ZPRMLINE = LEFT(MACRO,8) || ' | ' ;
ZPRMLINE = ZPRMLINE || LEFT(PARAMETER,25) || ' | ' || VALUE || ' | '
ZPRMLINE = ZPRMLINE || LEFT(HVSSID,4) || ' | ' || HVVER || ' | ';
ZPRMLINE = ZPRMLINE || HVDT || ' | ' || HVTS || ' | ';
PUSH ZPRMLINE
"EXECIO 1 DISKW ZPRMLIST (OPEN" ;

END ; /* END DO */

ZPRMEMPTY:
ADDRESS DSNREXX "EXECSQL CLOSE C101" ;
IF SQLCODE <> 0 THEN CALL SQLCA_CHECK ;

ZPRMLINE = LEFT(SEPLINE,132) ;
PUSH ZPRMLINE
"EXECIO 1 DISKW ZPRMLIST (OPEN" ;

"EXECIO 0 DISKW ZPRMLIST(FINIS"

RETURN;

GET_VARIABLE:
SQLSTMT = "SELECT GETVARIABLE('SYSIBM.SSID') AS DB2SSID " || ,
" , GETVARIABLE('SYSIBM.VERSION') AS VERSION " || ,
" , CHAR(CURRENT DATE,ISO) AS CDT " || ,
" , CURRENT TIMESTAMP AS CTS " || ,
"FROM SYSIBM.SYSDUMMY1 " ;

ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM :SQLSTMT" ;
IF SQLCODE <> 0 THEN CALL SQLCA_CHECK ;

ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1" ;
IF SQLCODE <> 0 THEN CALL SQLCA_CHECK ;

ADDRESS DSNREXX "EXECSQL OPEN C1" ;
IF SQLCODE <> 0 THEN CALL SQLCA_CHECK ;

ADDRESS DSNREXX "EXECSQL FETCH C1 INTO :HVSSID, :HVVER, :HVDT, :HVTS"
IF SQLCODE <> 0 THEN CALL SQLCA_CHECK ;

ADDRESS DSNREXX "EXECSQL CLOSE C1" ;
IF SQLCODE <> 0 THEN CALL SQLCA_CHECK ;

RETURN

IA_CONNECT_DB2 :

"SUBCOM DSNREXX"
IF RC THEN S_RC = RXSUBCOM('ADD','DSNREXX','DSNREXX')
/*---------------------------------------------------------------*/
/* DESTROY ANY EXISTING CONNECTION. IGNORE ALL ERRORS */

ADDRESS DSNREXX "DISCONNECT"
/*---------------------------------------------------------------*/
ADDRESS DSNREXX "CONNECT " SSID
IF SQLCODE <> 0 THEN DO
SAY ("ZPATM10B 03.")(AR)("connect failed")(AR)
EXIT SQLCODE
END

ADDRESS DSNREXX "EXECSQL CONNECT"

ADDRESS DSNREXX "EXECSQL SET CURRENT PACKAGESET = 'DSNREXUR'"
IF SQLCODE <> 0 THEN CALL YZX_FATAL_SQL

RETURN ;

/*********************************************************************/
CA_PRINT_IT:
PARSE ARG X9
EXPLINE = X9
PUSH ZPRMLINE
"EXECIO 1 DISKW ZPRMLIST (OPEN" ;
RETURN

/**********/
SQLCA_CHECK:
/***********/
SQLCA = ( 'SQLCA ' )( X2C(00000088) ) /* SQLCABC = 136 */
CDE = D2X(SQLCODE,8)
CDE = X2C(CDE) /* SQLCODE IN BINARY */
SQLCA = ( SQLCA )( CDE )
ERRM = LEFT( SQLERRMC, 70) /* SQLERRM AS 70 BYTES */
SQLCA = ( SQLCA )( X2C(0046) )( ERRM ) /* SQLERRML = 70 */
SQLCA = ( SQLCA )( LEFT( SQLERRP,8 ) ) /* SQLERRMP */
X1 = D2X( SQLERRD.1,8) ; X1=X2C(X1) /* SQLERRD.1 IN BINARY */
X2 = D2X( SQLERRD.2,8) ; X2=X2C(X2) /* SQLERRD.2 IN BINARY */
X3 = D2X( SQLERRD.3,8) ; X3=X2C(X3) /* SQLERRD.3 IN BINARY */
X4 = D2X( SQLERRD.4,8) ; X4=X2C(X4) /* SQLERRD.4 IN BINARY */
X5 = D2X( SQLERRD.5,8) ; X5=X2C(X5) /* SQLERRD.5 IN BINARY */
X6 = D2X( SQLERRD.6,8) ; X6=X2C(X6) /* SQLERRD.6 IN BINARY */
SQLCA = ( SQLCA )( X1 )( X2 )( X3 )( X4 )( X5 )( X6 )
X = ( SQLWARN.0 )( SQLWARN.1 )( SQLWARN.2)
X = (X)( SQLWARN.3 )( SQLWARN.4 )( SQLWARN.5)
X = (X)( SQLWARN.6 )( SQLWARN.7 )( SQLWARN.8)
X = (X)( SQLWARN.9 )( SQLWARN.10 )
SQLCA = ( SQLCA )( X ) /* SQWARN 0 TO 10 */
SQLCA = ( SQLCA )( SQLSTATE )
TIAR_MSG = X2C(02D0)COPIES(' ',720)
TEXT_LEN = X2C(00000048)
ADDRESS ATTCHPGM 'DSNTIAR SQLCA TIAR_MSG TEXT_LEN'
DO ERR_WK = 3 BY 72 UNTIL ERR_WK > 720
IF SUBSTR( TIAR_MSG, ERR_WK, 72 ) <> ' ' THEN ,
SAY SUBSTR( TIAR_MSG, ERR_WK, 72 )
END

RETURN
/*
//JS10 EXEC PGM=IRXJCL,PARM='ZPARMBAT &SSID'
//STEPLIB DD DSN=SYS1.DB2.&SSID..SDSNEXIT,DISP=SHR
// DD DSN=SYS1.DB2.&SSID..SDSNLOAD,DISP=SHR
//SYSEXEC DD DSN=&&TEMPPDS,DISP=(OLD,DELETE)
//SYSTSPRT DD SYSOUT=*
//SYSTSIN DD DUMMY,BLKSIZE=80
//ZPRMLIST DD SYSOUT=*

Attachment(s)
txt file
ZPARMBAT.txt   18 KB   1 version
Uploaded - Sep 26, 2021

Related Entries and Links

No Related Resource entered.