zOs/REXX/IFICOMCA

/* REXX */                                                              00010000
/*                                                                   */ 00020000
/* Sample Caller Program for a DB2 Stored Procedure                  */ 00030000
/* (from the Application programming guide)                          */ 00040000
/*                                                                   */ 00050000
/* 'CALLRX01' in A979074.TSO.EXEC is a sample caller program         */ 00060000
/*            for Stored Procedure 'COMMAND', as defined in          */ 00070000
/*            'COMMAND' in A979074.TSO.EXEC                          */ 00080000
/*                                                                   */ 00090000
/* call from ISPF: TSO CALLRX01 DBTF -DIS GROUP                      */ 00100000
/*                                                                   */ 00110000
/* check that WLM Environment DB2DSNR is AVAILABLE on the SYSPLEX    */ 00120000
/*   DISPLAY WLM,APPLENV=DB2DSNR                                     */ 00130000
/*   VARY WLM,APPLENV=DB2DSNR,RESUME or REFRESH                      */ 00140000
/*                                                                   */ 00150000
/* check that procedure is started on the target DB2                 */ 00160000
/*   -DIS PROCEDURE SYSPROC.COMMAND SCOPE(GROUP)                     */ 00170000
/*   -STA PROCEDURE SYSPROC.COMMAND SCOPE(GROUP)                     */ 00180000
/*                                                                   */ 00190000
PARSE ARG a_ssid a_cmd                 /* Get the SSID to connect to */ 00200000
                                       /* and the DB2 command to be  */ 00210000
                                       /* executed                   */ 00220000
                                                                        00230000
debug=0                                                                 00240000
debug=1                                                                 00250000
                                                                        00260000
rzid  = sysvar(sysnode)                                                 00270000
if debug then say "   .. rzid="rzid                                     00280000
                                                                        00290000
address tso;                                                            00300000
netid     = 'CHSKA000'                                                  00310000
default_schema = 'SYSPROC'                                              00320000
if rzid = 'RZ1' then conn_ssid = 'DBAF';                                00330000
if rzid = 'RZ2' then conn_ssid = 'DBOF';                                00340000
if rzid = 'RZ4' then conn_ssid = 'DB2I';                                00350000
if rzid = 'RR2' then conn_ssid = 'DBOF';                                00360000
if rzid = 'RR4' then conn_ssid = 'DB2I';                                00370000
                                                                        00380000
                                                                        00390000
target_ssid=strip(a_ssid)                                               00400000
if debug then say 'Target SSID='target_ssid', length='length(ssid)      00410000
target_loc=netid || target_ssid                                         00420000
target_loc_string=target_loc || '.' || default_schema || '.'            00430000
                                                                        00440000
target_cmd=strip(a_cmd)                                                 00450000
if debug then say 'DB2 CMD='target_cmd                                  00460000
                                                                        00470000
                                                                        00480000
/****************************************************************/      00490000
/* Set up the host command environment for SQL calls.           */      00500000
/****************************************************************/      00510000
"SUBCOM DSNREXX" /* Host cmd env available? */                          00520000
URC=RC                                                                  00530000
if debug then say 'RC from SUBCOM='urc                                  00540000
IF URC THEN /* No--make one */                                          00550000
   S_RC = RXSUBCOM('ADD','DSNREXX','DSNREXX')                           00560000
                                                                        00570000
                                                                        00580000
/****************************************************************/      00590000
/* CAF Connect to the Primary Connection DB2 subsystem.         */      00600000
/****************************************************************/      00610000
if debug then say 'CONNECT to 'conn_ssid                                00620000
ADDRESS DSNREXX "CONNECT "conn_ssid                                     00630000
IF SQLCODE <> 0 THEN CALL SQLCA                                         00640000
if debug then say 'Connection to 'conn_ssid' established'               00650000
                                                                        00660000
                                                                        00670000
ST_PROC = 'COMMAND'                                                     00680000
                                                                        00690000
if target_ssid <> conn_ssid then do                                     00700000
   if debug then say 'DRDA CONNECT to 'target_loc                       00710000
   ADDRESS DSNREXX "EXECSQL CONNECT to "target_loc                      00720000
   IF SQLCODE < 0 THEN CALL SQLCA                                       00730000
   if debug then say 'DRDA CONNECTION TO 'target_loc' established'      00740000
end                                                                     00750000
if debug then say 'Stored Procedure = 'ST_PROC                          00760000
                                                                        00770000
RESULTSIZE = 32703                                                      00780000
RESULT = LEFT(' ',RESULTSIZE,' ')                                       00790000
                                                                        00800000
/****************************************************************/      00810000
/* Call the stored procedure that executes the DB2 command.     */      00820000
/* The input variable (COMMAND) contains the DB2 command.       */      00830000
/* The output variable (RESULT) will contain the return area    */      00840000
/* from the IFI COMMAND call after the stored procedure         */      00850000
/* executes.                                                    */      00860000
/****************************************************************/      00870000
                                                                        00880000
ADDRESS DSNREXX "EXECSQL SET CURRENT SQLID='S100447'";                  00890000
IF SQLCODE < 0 THEN CALL SQLCA                                          00900000
                                                                        00910000
ADDRESS DSNREXX "EXECSQL" ,                                             00920000
  "CALL" ST_PROC "(:TARGET_CMD, :RESULT)"                               00930000
                                                                        00940000
IF SQLCODE < 0 THEN CALL SQLCA                                          00950000
                                                                        00960000
if debug then do                                                        00970000
  SAY 'RETCODE ='RETCODE                                                00980000
  SAY 'SQLCODE ='SQLCODE                                                00990000
  SAY 'SQLERRMC ='SQLERRMC                                              01000000
  SAY 'SQLERRP ='SQLERRP                                                01010000
  SAY 'SQLERRD ='SQLERRD.1',',                                          01020000
  || SQLERRD.2',',                                                      01030000
  || SQLERRD.3',',                                                      01040000
  || SQLERRD.4',',                                                      01050000
  || SQLERRD.5',',                                                      01060000
  || SQLERRD.6                                                          01070000
  SAY 'SQLWARN ='SQLWARN.0',',                                          01080000
  || SQLWARN.1',',                                                      01090000
  || SQLWARN.2',',                                                      01100000
  || SQLWARN.3',',                                                      01110000
  || SQLWARN.4',',                                                      01120000
  || SQLWARN.5',',                                                      01130000
  || SQLWARN.6',',                                                      01140000
  || SQLWARN.7',',                                                      01150000
  || SQLWARN.8',',                                                      01160000
  || SQLWARN.9',',                                                      01170000
  || SQLWARN.10                                                         01180000
  SAY 'SQLSTATE='SQLSTATE                                               01190000
  SAY C2X(RESULT) "'"||RESULT||"'"                                      01200000
end                                                                     01210000
                                                                        01220000
/****************************************************************/      01230000
/* Display the IFI return area in hexadecimal.                  */      01240000
/****************************************************************/      01250000
OFFSET = 4+1                                                            01260000
TOTLEN = LENGTH(RESULT)                                                 01270000
DO WHILE ( OFFSET < TOTLEN )                                            01280000
   LEN = C2D(SUBSTR(RESULT,OFFSET,2))                                   01290000
   SAY SUBSTR(RESULT,OFFSET+4,LEN-4-1)                                  01300000
   OFFSET = OFFSET + LEN                                                01310000
END                                                                     01320000
                                                                        01330000
                                                                        01340000
/****************************************************************/      01350000
/* Get information about result sets returned by the            */      01360000
/* stored procedure.                                            */      01370000
/****************************************************************/      01380000
ADDRESS DSNREXX "EXECSQL DESCRIBE PROCEDURE :PROC INTO :SQLDA"          01390000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01400000
                                                                        01410000
say ' '                                                                 01420000
say ' '                                                                 01430000
say ' '                                                                 01440000
say ' '                                                                 01450000
DO I = 1 TO SQLDA.SQLD                                                  01460000
   SAY "SQLDA."I".SQLNAME ="SQLDA.I.SQLNAME";"                          01470000
   SAY "SQLDA."I".SQLTYPE ="SQLDA.I.SQLTYPE";"                          01480000
   SAY "SQLDA."I".SQLLOCATOR ="SQLDA.I.SQLLOCATOR";"                    01490000
   SAY "SQLDA."I".SQLESTIMATE="SQLDA.I.SQLESTIMATE";"                   01500000
END I                                                                   01510000
                                                                        01520000
                                                                        01530000
/****************************************************************/      01540000
/* Set up a cursor to retrieve the rows from the result         */      01550000
/* set.                                                         */      01560000
/****************************************************************/      01570000
ADDRESS DSNREXX                                                         01580000
"EXECSQL ASSOCIATE LOCATOR (:RESULT) WITH PROCEDURE :PROC"              01590000
                                                                        01600000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01610000
                                                                        01620000
SAY RESULT                                                              01630000
ADDRESS DSNREXX "EXECSQL ALLOCATE C101 CURSOR FOR RESULT SET :RESULT"   01640000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01650000
                                                                        01660000
CURSOR = 'C101'                                                         01670000
ADDRESS DSNREXX "EXECSQL DESCRIBE CURSOR :CURSOR INTO :SQLDA"           01680000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01690000
                                                                        01700000
                                                                        01710000
/****************************************************************/      01720000
/* Retrieve and display the rows from the result set, which */          01730000
/* contain the command output message text. */                          01740000
/****************************************************************/      01750000
DO UNTIL(SQLCODE <> 0)                                                  01760000
   ADDRESS DSNREXX "EXECSQL FETCH C101 INTO :SEQNO, :TEXT"              01770000
   IF SQLCODE = 0 THEN DO                                               01780000
      SAY TEXT                                                          01790000
   END                                                                  01800000
END                                                                     01810000
                                                                        01820000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01830000
ADDRESS DSNREXX "EXECSQL CLOSE C101"                                    01840000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01850000
                                                                        01860000
ADDRESS DSNREXX "EXECSQL COMMIT"                                        01870000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01880000
                                                                        01890000
                                                                        01900000
/****************************************************************/      01910000
/* Disconnect from the DB2 subsystem. */                                01920000
/****************************************************************/      01930000
ADDRESS DSNREXX "DISCONNECT"                                            01940000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01950000
                                                                        01960000
                                                                        01970000
/****************************************************************/      01980000
/* Delete the host command environment for SQL. */                      01990000
/****************************************************************/      02000000
S_RC = RXSUBCOM('DELETE','DSNREXX','DSNREXX') /* REMOVE CMD ENV */      02010000
RETURN                                                                  02020000
                                                                        02030000
                                                                        02040000
/****************************************************************/      02050000
/* Routine to display the SQLCA */                                      02060000
/****************************************************************/      02070000
SQLCA:                                                                  02080000
  TRACE O                                                               02090000
  SAY 'SQLCODE ='SQLCODE                                                02100000
  SAY 'SQLERRMC ='SQLERRMC                                              02110000
  SAY 'SQLERRP ='SQLERRP                                                02120000
  SAY 'SQLERRD ='SQLERRD.1',',                                          02130000
  || SQLERRD.2',',                                                      02140000
  || SQLERRD.3',',                                                      02150000
  || SQLERRD.4',',                                                      02160000
  || SQLERRD.5',',                                                      02170000
  || SQLERRD.6                                                          02180000
  SAY 'SQLWARN ='SQLWARN.0',',                                          02190000
  || SQLWARN.1',',                                                      02200000
  || SQLWARN.2',',                                                      02210000
  || SQLWARN.3',',                                                      02220000
  || SQLWARN.4',',                                                      02230000
  || SQLWARN.5',',                                                      02240000
  || SQLWARN.6',',                                                      02250000
  || SQLWARN.7',',                                                      02260000
  || SQLWARN.8',',                                                      02270000
  || SQLWARN.9',',                                                      02280000
  || SQLWARN.10                                                         02290000
  SAY 'SQLSTATE='SQLSTATE ;                                             02300000
EXIT;                                                                   02310000