code

Name
Astradyne (UK) Ltd
Scriptlanguage
Plain Text
Tabwidth
4
Date
Sun, 12 May 2013 15:19:48 +0000
IP
192.168.0.1

A simple sub-procedure that calls the QMHRTVM system API to retrieve a message description from a message file, populating any message data fields as required.

  1. PROTOTYPE COPY MEMBER
  2. =====================
  3.  
  4.     D/IF    NOT DEFINED(TBX_MSGTLS)
  5.     D/DEFINE TBX_MSGTLS           
  6.     D/ELSE                         
  7.     D/EOF                         
  8.     D/ENDIF                       
  9.  
  10.       *----------------------------------------------------- 
  11.       *  Common API Error Structure                           
  12.       *----------------------------------------------------- 
  13.                                                              
  14.     D/IF    NOT DEFINED(API_ERROR)                         
  15.     D/DEFINE API_ERROR                                       
  16.                                                              
  17.     D ApiError        DS                                     
  18.     D  ApiBytes                    10I 0 Inz(%Size(ApiError))
  19.     D  ApiBytesOut                10I 0                   
  20.     D  ApiErrID                    7A                     
  21.     D  ApiReserved                  1A                     
  22.     D  ApiErInDta                256A                     
  23.                                                              
  24.     D/ENDIF                                                 
  25.  
  26.       *-----------------------------------------------------
  27.       *  Message Handling Variables                       
  28.       *-----------------------------------------------------
  29.                                                            
  30.     D/IF    NOT DEFINED(MSG_VARS)                       
  31.     D/DEFINE MSG_VARS                                     
  32.                                                            
  33.     D MsgID          s              7a                   
  34.     D Msgf            s            10a                   
  35.     D MsgLib          s            10a                   
  36.     D MsgDta          s          1024a                   
  37.                                                            
  38.     D/ENDIF                                               
  39.                                                            
  40.       *-----------------------------------------------------   
  41.       *  Retreive Message                                       
  42.       *-----------------------------------------------------   
  43.                                                                
  44.     D RtvMsg          pr          1024a                       
  45.     D  iMsgID                        7a  Const               
  46.     D  iMsgf                        10a  Const Options(*NoPass)
  47.     D  iMsgLib                      10a  Const Options(*NoPass)
  48.     D  iMsgDta                    1024a  Const Options(*NoPass)
  49.  
  50.  
  51.  
  52. PROCEDURE DEFINITION
  53. ====================
  54.  
  55.     ** Procedure interface                                     
  56.     d RtvMsg          pi          1024a                       
  57.     d  iMsgId                        7a  Const               
  58.     d  iMsgF                        10a  Const Options(*NoPass)
  59.     d  iMsgLib                      10a  Const Options(*NoPass)
  60.     d  iMsgDta                    1024a  Const Options(*NoPass)
  61.                                                                
  62.     d RtvM0100        ds                                       
  63.     d  Byte_Rtn                      9b 0                     
  64.     d  Byte_Avl                      9b 0                     
  65.     d  Lgth_Msg_Rtn                  9b 0                     
  66.     d  Lgth_Msg_Avl                  9b 0                     
  67.     d  Lgth_Hlp_Rtn                  9b 0                     
  68.     d  Lgth_Hlp_Avl                  9b 0                     
  69.     d  Msg_Txt                    512                         
  70.                                                                  
  71.     d MsgFile        s            20a  Inz('SYSMSGF  *LIBL')
  72.     d MsgLgth        s              9b 0 Inz(%Size(RtvM0100)) 
  73.     d MsgFmt          s              8a  Inz('RTVM0100')       
  74.     d Subst          s            10a  Inz('*NO')           
  75.     d RtnFmt          s            10a  Inz('*NO')           
  76.     d Rep            s          1024a                         
  77.     d RepLgth        s              9b 0 Inz(%Size(Rep))       
  78.                                                                  
  79.     d wMsgID          s              7a                         
  80.     d                                                           
  81.                                                                  
  82.     c                  Reset                  ApiError       
  83.                                                                  
  84.     c                  Select                                 
  85.     c                  When      %Parms = 2 and iMsgF <> '*SAME'
  86.     c                  Eval      MsgFile = iMsgf + '*LIBL'     
  87.     c                  When      %Parms > 3 and iMsgF <> '*SAME'   
  88.     c                  Eval      MsgFile = iMsgf + iMsgLib         
  89.     c                  EndSl                                       
  90.                                                                      
  91.       * If substitution data is passed then we need to include it when
  92.       * retrieve the message description...                         
  93.     c                  If        %Parms = 4                       
  94.     c                  Eval      Rep = iMsgDta                     
  95.     c                  Eval      RepLgth = %Size(Rep)             
  96.     c                  Eval      Subst = '*YES'                   
  97.     c                  EndIf                                       
  98.                                                                      
  99.     c                  Eval      wMsgID = iMsgID                   
  100.                                                                      
  101.     c                  Call(e)  'QMHRTVM'                         
  102.     c                  Parm                    RtvM0100           
  103.     c                  Parm                    MsgLgth             
  104.     c                  Parm                    MsgFmt 
  105.     c                  Parm                    wMsgId 
  106.     c                  Parm                    MsgFile
  107.     c                  Parm                    Rep   
  108.     c                  Parm                    RepLgth
  109.     c                  Parm                    Subst 
  110.     c                  Parm                    RtnFmt 
  111.     c                  Parm                    ApiError
  112.                                                        
  113.     c                  Return    Msg_Txt             
  114.                                                        
  115.     p RtvMsg          e
  116.