midrange.com code scratchpad
Name:
Carsten Flensburg
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
01/18/2014 10:04:29 am
IP:
Logged
Description:
QMHRTVM API wrapped in subprocedure RtvMsgTxt()
Code:
  1. **-- API error data structure:                                  
  2. D ERRC0100        Ds                  Qualified                 
  3. D  BytPrv                       10i 0 Inz( %Size( ERRC0100 ))   
  4. D  BytAvl                       10i 0                           
  5. D  MsgId                         7a                             
  6. D                                1a                             
  7. D  MsgDta                      128a                             
  8. **-- Retrieve message:                                            
  9. D RtvMsg          Pr                  ExtPgm( 'QMHRTVM' )         
  10. D  RcvVar                    32767a          Options( *VarSize )  
  11. D  RcvVarLen                    10i 0 Const                       
  12. D  FmtNam                       10a   Const                       
  13. D  MsgId                         7a   Const                       
  14. D  MsgFq                        20a   Const                       
  15. D  MsgDta                      512a   Const  Options( *VarSize )  
  16. D  MsgDtaLen                    10i 0 Const                       
  17. D  RplSubVal                    10a   Const                       
  18. D  RtnFmtChr                    10a   Const                       
  19. D  Error                     32767a          Options( *VarSize )  
  20. D  RtvOpt                       10a   Const  Options( *NoPass )   
  21. D  CvtCcsId                     10i 0 Const  Options( *NoPass )   
  22. D  RplCcsId                     10i 0 Const  Options( *NoPass )   
  23. **-- Retrieve message text:                                     
  24. D RtvMsgTxt       Pr          1024a   Varying                   
  25. D  PxMsgId                       7a   Value                     
  26. D  PxMsgFil                     10a   Value                     
  27. D  PxMsgFilLib                  10a   Value                     
  28. D  PxMsgDta                   1024a   Const  Varying            
  29. D                                     Options( *NoPass: *Trim ) 
  30. **-- Retrieve message text:                                      
  31. P RtvMsgTxt       B                   Export                     
  32. D                 Pi          1024a   Varying                    
  33. D  PxMsgId                       7a   Value                      
  34. D  PxMsgFil                     10a   Value                      
  35. D  PxMsgFilLib                  10a   Value                      
  36. D  PxMsgDta                   1024a   Const  Varying             
  37. D                                     Options( *NoPass: *Trim )  
  38.                                                                  
  39. **-- Local variables:                                            
  40. D MsgDta          s           1024a   Varying                    
  41. **-- Local constants:                                            
  42. D NULL            c                   ''                         
  43. D RPL_SUB_VAL     c                   '*YES'                     
  44. D IGN_FMT_CTL     c                   '*NO'                      
  45. D JOB_CCSID       c                   0                          
  46. **-- Return structure:                                           
  47. D RTVM0100        Ds                  Qualified                  
  48. D  BytRtn                       10i 0                            
  49. D  BytAvl                       10i 0                            
  50. D  RtnMsgLen                    10i 0   
  51. D  RtnMsgAvl                    10i 0   
  52. D  RtnHlpLen                    10i 0   
  53. D  RtnHlpAvl                    10i 0   
  54. D  Msg                        1024a     
  55.                                         
  56.  /Free                                  
  57.                                         
  58.    If  %Parms >= 4;                     
  59.      MsgDta = PxMsgDta;                 
  60.    EndIf;                               
  61.                                         
  62.    RtvMsg( RTVM0100                     
  63.          : %Size( RTVM0100 )            
  64.          :'RTVM0100'                    
  65.          : PxMsgId                      
  66.          : PxMsgFil + PxMsgFilLib       
  67.          : MsgDta                       
  68.          : %Len( MsgDta )               
  69.          : RPL_SUB_VAL                  
  70.          : IGN_FMT_CTL                                         
  71.          : ERRC0100                                            
  72.          );                                                    
  73.                                                                
  74.    If  ERRC0100.BytAvl = *Zero;                                
  75.      Return  %SubSt( RTVM0100.Msg: 1: RTVM0100.RtnMsgLen );    
  76.                                                                
  77.    Else;                                                       
  78.      Return  NULL;                                             
  79.    EndIf;                                                      
  80.                                                                
  81.  /End-Free                                                     
  82.                                                                
  83. P RtvMsgTxt       E                                            
  84.  
  85. Example:
  86.  
  87. To retrieve message ID UTL1204 from message file FILENAME in library *LIBL, you then simply code:             
  88.               
  89. MsgTxt = RtvMsgTxt( 'UTL2004': 'FILENAME': '*LIBL' );
  90.  
  91.  
  92.  
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css