Forum Index
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 Forum Index -> TSO and ISPF
View previous topic :: View next topic  
Author Message

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 ||

 Call DSNTIAR and format the results so they look like the error       
 messages shown in SPUFI                                               
/* 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                           
    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                               
        z = z!!next_bit' 'next_arg' '                           
    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 */     
      when length(tmp) <= 75 then                           
          /* say 'Short message' */                         
          tiar_msg = hx00!!left(tmp,75)!!hx00               
      when substr(tmp,74,1) = ' ' then                     
          /* pos 1-74 ends in a complete word */               
          /* say 'Second option' */                             
          tiar_msg = hx00!!left(tmp,75)!!hx00!!,               
                     hx00!!copies(' ',9),                       
          /* 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   
sqlerrd = sqlerrd.1","!!sqlerrd.2","!!sqlerrd.3","!!,           
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                                                             
parse arg sql_string                                                   
zedsmsg = ""                                                           
zedlmsg = sql_string                                                   
rc = ISPFMSG()                                                         
return 0                                                               
 Show info/error messages to user                                     
zcmd = ''                                                             
Address ISPEXEC 'VPUT (ZCMD,ZEDSMSG,ZEDLMSG)'                         
Address ISPEXEC 'SETMSG MSG(ISRZ001)'                                 
Return 0                                                               

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 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

Powered by phpBB © 2001, 2005 phpBB Group