MVSFORUMS.com Forum Index MVSFORUMS.com
A Community of and for MVS Professionals
 
 FAQFAQ   SearchSearch   Quick Manuals   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Calling DSNTIAR from Rexx

 
Post new topic   Reply to topic   printer-friendly view    MVSFORUMS.com Forum Index -> TSO and ISPF
View previous topic :: View next topic  
Author Message
misi01
Advanced


Joined: 02 Dec 2002
Posts: 616
Topics: 171
Location: Stockholm, Sweden

PostPosted: Fri Nov 28, 2014 8:13 am    Post subject: Calling DSNTIAR from Rexx Reply with quote

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
Back to top
View user's profile Send private message Send e-mail
Display posts from previous:   
Post new topic   Reply to topic   printer-friendly view    MVSFORUMS.com Forum Index -> TSO and ISPF All times are GMT - 5 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


MVSFORUMS
Powered by phpBB © 2001, 2005 phpBB Group