misi01
Advanced
Joined: 02 Dec 2002
Posts: 629
Topics: 176
Location: Stockholm, Sweden
|
 Posted: Fri Nov 28, 2014 8:13 am Post subject: Calling DSNTIAR from Rexx |
 |
|
This can be found here and there, but I thought I'd append how I've solved it so the results look quite similar to those you'd get with the same error in SPUFI.
The "nice" formatting with leading blanks is thanks to a guy called Ken Tomiak who showed how to format the ISPF long message with line breaks.
For those of you not in Scandinavia, you might need to change the !! to ||
| Code: |
/**********************************************************************
Call DSNTIAR and format the results so they look like the error
messages shown in SPUFI
**********************************************************************/
db2err_rpt:
/* say 'In db2err_rpt in 'rname ; trace ?a */
SQLC = X2C(D2X(SQLCODE,8)) ;
SQLCA = 'SQLCA 'X2C(00000088)SQLC!!X2C(0000)!!COPIES(' ',78)!!,
COPIES(X2C(00),24)COPIES(' ',16) ;
TIAR_MSG = X2C(0190)COPIES(' ',400) ;
TEXT_LEN = X2C(00000050) ;
address ATTCHPGM 'DSNTIAR SQLCA TIAR_MSG TEXT_LEN'
msg_lines.0 = 0
error_text = 'ERROR: '
hx00 = '00'x
if pos(error_text,tiar_msg) <> 0 then
do
parse var tiar_msg part1 (error_text) part2
/* Replace double blanks in part2 with the arguments found
in sqlerrmc (which, if it contains multiple arguments
will have them separated by a 'FF'x) */
z = ''
do while sqlerrmc <> ''
parse var part2 next_bit ' ' part2
parse var sqlerrmc next_arg 'FF'x sqlerrmc
if sqlerrmc = '' & z = '' then
/* Only one argument, always (?) first in text */
z = z!!next_arg!!next_bit
else
z = z!!next_bit' 'next_arg' '
end
parse var part2 rest_msg 'DSNT' .
/* Get rid of multiple blanks in rest_msg */
rest_msg = space(rest_msg,1)
tmp = substr(part1,4) /* Ignore length plus blank */
tmp = tmp!!error_text!!z!!strip(rest_msg)
/* Now to format it, a total of 77 characters per line.
75 characters per line is "text". We also add a
a leading and trailing hex zero on each line.
For some reason, having BOTH leading/trailing zeroes
means that ISPF DOESN'T chop leading blanks */
/* This code assumes that the main message "fits" on 2 lines */
select
when length(tmp) <= 75 then
do
/* say 'Short message' */
tiar_msg = hx00!!left(tmp,75)!!hx00
end
when substr(tmp,74,1) = ' ' then
do
/* pos 1-74 ends in a complete word */
/* say 'Second option' */
tiar_msg = hx00!!left(tmp,75)!!hx00!!,
hx00!!copies(' ',9),
!!left(strip(substr(tmp,76)),66)!!hx00
end
otherwise
do
/* Splits on a word - get last blank before pos 75 */
/* say 'Otherwise option' */
z = pos(' ',reverse(left(tmp,75)))
tmp1 = substr(tmp,(75-z)+1)
tmp1 = strip(tmp1)
tmp = left(tmp,75-z)
tiar_msg = hx00!!left(tmp,75)!!hx00!!,
hx00!!copies(' ',9)!!left(tmp1,66)!!hx00
end
end
end
sqlerrd = sqlerrd.1","!!sqlerrd.2","!!sqlerrd.3","!!,
sqlerrd.4","!!sqlerrd.5","!!sqlerrd.6
tiar_msg = tiar_msg!!,
hx00!!left('DSNT418I SQLSTATE = 'sqlstate,75)!!hx00,
hx00!!left('DSNT415I SQLERRP = 'sqlerrp ,75)!!hx00,
hx00!!left('DSNT416I SQLERRD = 'sqlerrd ,75)!!hx00,
rc = SQL_error(tiar_msg)
return 1
/**********************************************************************
SQL error
**********************************************************************/
SQL_error:
parse arg sql_string
zedsmsg = ""
zedlmsg = sql_string
rc = ISPFMSG()
return 0
/**********************************************************************
Show info/error messages to user
**********************************************************************/
ISPFMSG:
zcmd = ''
Address ISPEXEC 'VPUT (ZCMD,ZEDSMSG,ZEDLMSG)'
Address ISPEXEC 'SETMSG MSG(ISRZ001)'
Return 0
|
_________________
Michael |
|
FAQ
Search
Quick Manuals
Register
Profile
Log in to check your private messages
Log in
