IBM Mainframe Forum

05  WK-P1.                                 
  10  WK-RC            PIC    X(0002).     
  10  WK-KBN           PIC    X(0001).     
  10  FILLER           PIC    X(0001).     
  10  WK-NUMBER        PIC    9(0003)  COMP.
05  WK-P2.                                 
  10  WK-BEFORE        PIC    X(0510).     
05  WK-P3.                                 
  10  WK-AFTER         PIC    X(0510).     
05  WK-P4.                                 
  10  WK-CANNOT-CODE   PIC    X(0002).     

CALL WK-PGMNAME  USING WK-P1
                       WK-P2
                       WK-P3
                       WK-P4

/* REXX exec to get a description of a SQLCODE                        */
/*** trace ?r ***************************************************** \| *
* SQLCODE is a REXX exec to display the description of an SQLCODE in a *
* pop-up panel. The description is obtained by invoking DSNTIAR.       *
***********************************************************************/
arg sqlcode

sqlcode = x2c(d2x(sqlcode, 8))

sqlca   = 'SQLCA   '          ||,
          x2c(00000088)       ||,
          sqlcode             ||,
          x2c(0000)           ||,
          copies(' ', 78)     ||,
          copies(x2c(00), 24) ||,
          copies(' ', 16)

tiar_msg = d2c(512) || copies(' ', 512)
text_len = x2c(00000050)

address attchpgm "dsntiar sqlca tiar_msg text_len"

p = pos('DSNT408I ', tiar_msg)
if p = 0 then
  p = 4
else
  p = p + 9

parse value tiar_msg with =(p) db2_msg 'DSNT415I' .

zerralrm = 'NO'
zerrsm   = ''
zerrhm   = '*'
zerrlm   = strip(space(db2_msg))
"ispexec setmsg msg(isrz002)"
exit

/***********************************************************************
* PL/I structure of SQLCA                                              *
************************************************************************
dcl 1 sqlca,
      2 sqlcaid    char       (8),
      2 sqlcabc    fixed bin (31),
      2 sqlcode    fixed bin (31),
      2 sqlerrm    char      (70) var,
      2 sqlerrp    char       (8),
      2 sqlerrd(6) fixed bin (31),
      2 sqlwarn,
        3 sqlwarn0 char       (1),
        3 sqlwarn1 char       (1),
        3 sqlwarn2 char       (1),
        3 sqlwarn3 char       (1),
        3 sqlwarn4 char       (1),
        3 sqlwarn5 char       (1),
        3 sqlwarn6 char       (1),
        3 sqlwarn7 char       (1),
      2 sqlext,
        3 sqlwarn8 char       (1),
        3 sqlwarn9 char       (1),
        3 sqlwarna char       (1),
        3 sqlstate char       (5);
***********************************************************************/

pgm_rc      = copies(' ',2) 
conv_type   = '1'           
reserved    = copies(' ',1) 
data_char#  = d2c(1,2)       
data_before = copies(' ',510)
data_after  = copies(' ',510)
data_unconv = copies(' ',2) 
...
do i = 10000 to 10003                                   
   hex_val = hex_array.i                                                               
   cmd = "data_before = '"hex_val"'x"                   
   interpret cmd                                       
                                                       
   parm1 = pgm_rc||conv_type||reserved||data_char#     
   parm2 = data_before                                 
   parm3 = data_after                                   
   parm4 = data_unconv                                 
                                                       
   address attchpgm "SNAC2000 parm1 parm2 parm3 parm4" 
   say rc                                               
   say pgm_rc                                           
end