QSYSOPR の未応答メッセージをチェックする (V7R1)

QSYSOPR にある未応答のメッセージをチェックしたい、という要望はよくありますよね。

QMHLSTM という System API でメッセージ待ち行列の中のメッセージをリストさせることができます。
もちろん QSYSOPR にもこの API は使用できますので、この要件を実装することが可能です。

今回は、QSYSOPR の未応答メッセージをチェックするプログラムのサンプルを紹介したいと思います。


Generic Header で可変リストを扱う

この QMHLSTM という API は「System API を使用するプログラムの二つのタイプ」のタイプ1 に属していますが、ただひとつ変わったところがあります。

今まで API を使ったコーディングで紹介してきたものでは、Generic Header から API の結果を格納したリスト構造へのオフセットを取得し、さらに Generic Header からそのリストのサイズを取得し、ポインタをサイズ毎に移動させる、という処理をしてきました。こちらの図が参考になるでしょう。

今回の API では、この「リストのサイズを取得し、ポインタをサイズ毎に移動させる」ということができません。
おそらくリストの個別要素ごとにサイズが変わるからなのだと思いますが、リストのサイズは Generic Header では 0 になっており、ポインタをサイズ毎に移動させることができないんです。

取得したリストの中に、次のリストへのオフセットの情報が存在するので、それを取得をしてポインタに加算する、というかたちになっています。

Generic Header から Input Parameter Section と Header Section の情報を取得する

今回は、この例にあるように、ついでに Input Parameter Section と Header Section の情報もあわせて取るようにしてみました。

今回のケースで言うと、Header Section には、未応答のメッセージが複数あった場合の最初のものと最後のものの日付・時間の情報がありますね。

QSYSOPR の未応答のメッセージをチェックする際の要件が、未応答のメッセージがいくつあるか、それはどの期間を探せば出てくるか、という情報がほしいだけだったとすれば、わざわざリストにアクセスする必要はありません。

未応答のメッセージがいくつあるか、は Generic Header でのリストの数からわかりますし、Header Section からの情報でその未応答のメッセージの存在する日付・時間の範囲がわかります。
リストそのものの情報にアクセスしないでもいいわけです。

Input Section には入力として使用されている情報が載っていますので、デバッグ時にとても役立ちます。


未応答のメッセージの数と発生した時間の範囲を取得する

ということで、まず、未応答のメッセージがいくつあるか、その最初と最後の日付・時間はいつか、の情報だけを取得するサンプル・プログラムがこちら ↓ です。

      *                                                                                             
      *  CRTRPGMOD MODULE(CHKNRPMSG) SRCFILE(QRPGLESRC)                                             
      *            DBGVIEW(*SOURCE)                                                                 
      *                                                                                             
      *                                                                                             
     D CrtUsrspcP      PR              *                                                            
     D  Name                         20a                                                            
      *                                                                                             
     D LstMsg          Pr                  ExtPgm( 'QMHLSTM' )                                      
     D  pUsrspcName                  20a   Const                                                    
     D  pFormatName                   8a   Const                                                    
     D  pMsgSltInfo                        Const                                                    
     D                                     like(MSLT0100)                                           
     D  pSizeOfMSI                   10i 0 Const                                                    
     D  pFmtOfMSI                     8a   Const                                                    
     D  ErrorCode                          like(APIErr)                                             
      *                                                                                             
     D GenericHeader   DS                  Qualified Based(usPtr)                                   
     D  userarea                     64a                                                            
     D  size                         10i 0                                                          
     D  releaselevel                  4                                                             
     D  formatname                    8                                                             
     D  APIused                      10                                                             
     D  DateCreated                  13                                                             
     D  InforSts                      1                                                             
     D  sizeUsed                     10i 0                                                          
     D  offsetInput                  10i 0                                                          
     D  sizeInput                    10i 0                                                          
     D  offsetHeader                 10i 0                                                          
     D  sizeHeader                   10i 0                                                          
     D  offsetList                   10i 0                                                          
     D  sizeList                     10i 0                                                          
     D  numberList                   10i 0                                                          
     D  sizeEntry                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D* cntryID                       2                                                             
     D* langID                        3                                                             
     D* subsetInd                     1                                                             
     D* rsvd                         42                                                             
     D  rsvd                       2048                                                             
      *                                                                                             
     D ipPtr           S               *                                                            
     D Input           DS                  Qualified Based(ipPtr)                                   
     D  UsrSpc                       10a                                                            
     D  UsrSpcLib                    10a                                                            
     D  Fmt                           8a                                                            
     D  FmtMSGSLT                     8a                                                            
     D  SizeMSGSLT                   10i 0                                                          
     D  MaxMsgReq                    10i 0                                                          
     D  LstDir                       10a                                                            
     D  SltCriteria                  10a                                                            
     D  SevCriteria                  10i 0                                                          
     D  MaxMsgLen                    10i 0                                                          
     D  MaxMsgHlpLen                 10i 0                                                          
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKeyStr                 10i 0                                                          
     D  NumMsgQ                      10i 0                                                          
     D  OfsFldRtn                    10i 0                                                          
     D  NumFldRtn                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  DTCriteria                   13a                                                            
      *                                                                                             
     D hdPtr           S               *                                                            
     D Header          DS                  Qualified Based(hdPtr)                                   
     D  UsrSpc                       10a                                                            
     D  UsrSpcLib                    10a                                                            
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKeyStr                 10i 0                                                          
     D  OfsMsgKeyEnd                 10i 0                                                          
     D  NumMsgQ                      10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  DatTim1st                    13a                                                            
     D  DatTimEnd                    13a                                                            
      *                                                                                             
     D jlPtr           S               *                                                            
     D LSTM0100        DS                  Qualified Based(jlPtr)                                   
     D  OfsNext                      10i 0                                                          
     D  OfsFldRtn                    10i 0                                                          
     D  NbrFldRtn                    10i 0                                                          
     D  MsgSev                       10i 0                                                          
     D  MsgID                         7a                                                            
     D  MsgType                       2a                                                            
     D  MsgKey                        4a                                                            
     D  MsgFilNam                    10a                                                            
     D  MsgFilLib                    10a                                                            
     D  MsgQ                         10a                                                            
     D  MsgQLib                      10a                                                            
     D  DateSent                      7a                                                            
     D  TimeSent                      6a                                                            
     D  MicroSec                      6a                                                            
      *                                                                                             
     D rfPtr           S               *                                                            
     D FieldInfo       DS                  Qualified Based(rfPtr)                                   
     D  FstLvlTxtLen          29     32i 0                                                          
     D  FstLvlTxt             33    144                                                             
      *                                                                                             
     D MSLT0100        DS                                                                           
     D  MaxMsgReq                    10i 0 inz(-1)                                                  
     D  LstDirection                 10a   inz('*NEXT')                                             
     D  SltCriteria                  10a   inz('*MNR')                                              
     D* SltCriteria                  10a   inz('*ALL')                                              
     D  SevCriteria                  10i 0 inz(0)                                                   
     D  MaxMsgLen                    10i 0 inz(112)                                                 
     D  MaxMsgHlpLen                 10i 0 inz(4)                                                   
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKey                    10i 0                                                          
     D  NbrOfMSGQ                    10i 0 inz(1)                                                   
     D  OfsFldRtn                    10i 0                                                          
     D  NbrFldRtn                    10i 0 inz(1)                                                   
     D  MsgQname                     20a                                                            
     D  MsgKey                        4a   inz(x'00000000')                                         
     D* RtnFldId                     10i 0 inz(302)                                                 
     D  RtnFldId                     10i 0 inz(201)                                                 
      *                                                                                             
     D pName           S             20a                                                            
     D usPtr           S               *                                                            
      *                                                                                             
     D APIErr          DS                  Qualified                                                
     D  ErrSize                      10i 0 inz(%size(APIErr))                                       
     D  ErrLen                       10i 0 inz(0)                                                   
     D  ErrID                         7a                                                            
     D  rsvd                          1a                                                            
     D  ErrData                   32767a                                                            
      *                                                                                             
     D i               S              5  0                                                          
     D Text            S             52a                                                            
      *                                                                                             
     D HandleErr       PR                                                                           
      *                                                                                             
      /Free                                                                                         

              MsgQname = 'QSYSOPR   QSYS      ' ;                                                   
              OfsMsgQ    = %addr(MsgQname) - %addr(MSLT0100) ;                                      
              OfsMsgKey  = %addr(MsgKey  ) - %addr(MSLT0100) ;                                      
              OfsFldRtn  = %addr(RtnFldId) - %addr(MSLT0100) ;                                      
                                                                                                    
              pName =    'LSTMSG    QTEMP     ' ;                                                   
              usPtr = CrtUsrspcP  (pName ) ;                                                        
                                                                                                    
              LstMsg    ( pName                                                                     
                         :'LSTM0100'                                                                
                         :MSLT0100                                                                  
                         :%size(MSLT0100)                                                           
                         :'MSLT0100'                                                                
                         :APIErr ) ;                                                                
                                                                                                    
              If APIErr.ErrLEN <> 0 ;                                                               
                HandleErr() ;                                                                       
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              If GenericHeader.numberList = 0 ;                                                     
                Text =                                                                              
                  '未応答のメッセージはありません。' ;                                                              
                dsply Text ;                                                                        
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              ipPtr = usPtr + GenericHeader.offsetInput ;                                           
              hdPtr = usPtr + GenericHeader.offsetHeader ;                                          
              jlPtr = usPtr + GenericHeader.offsetList ;                                            
                                                                                                    
              Text =                                                                                
                '未応答のメッセージが' +                                                                      
                %char(GenericHeader.numberList) +                                                   
                '個あります。' ;                                                                          
              dsply Text ;                                                                          
              Text =                                                                                
                '最初のものは' +                                                                          
                '20' + %subst(Header.DatTim1st:2:6) +                                               
                ' ' +                                                                               
                %subst(Header.DatTim1st:8:6) +                                                      
                'に送られています。' ;                                                                       
              dsply Text ;                                                                          
              Text =                                                                                
                '最後のものは' +                                                                          
                '20' + %subst(Header.DatTimEnd:2:6) +                                               
                ' ' +                                                                               
                %subst(Header.DatTimEnd:8:6) +                                                      
                'に送られています。' ;                                                                       
              dsply Text ;                                                                          
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
      *                                                                                             
     P HandleErr       B                                                                            
     D HandleErr       PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P HandleErr       E        

未応答のメッセージの数と発生した時間の範囲を取得し、コマンドを発行する

↑ では単に取得した情報を DSPLY しているだけですが、その情報を利用してコマンドの実行なども行えます。↓ の例では、取得した最初と最後のメッセージの日付・時間をもとに DSPLOG コマンドを実行させてみました。

      *                                                                                             
      *  CRTRPGMOD MODULE(CHKNRPMSG) SRCFILE(QRPGLESRC)                                             
      *            DBGVIEW(*SOURCE)                                                                 
      *                                                                                             
     D CrtUsrspcP      PR              *                                                            
     D  Name                         20a                                                            
      *                                                                                             
     D QCMDEXC         Pr                  ExtPgm( 'QCMDEXC' )                                      
     D  pCmd                      32702a   options(*varsize)                                        
     D                                     const                                                    
     D  pCmdLen                      15p 5 const                                                    
      *                                                                                             
     D LstMsg          Pr                  ExtPgm( 'QMHLSTM' )                                      
     D  pUsrspcName                  20a   Const                                                    
     D  pFormatName                   8a   Const                                                    
     D  pMsgSltInfo                        Const                                                    
     D                                     like(MSLT0100)                                           
     D  pSizeOfMSI                   10i 0 Const                                                    
     D  pFmtOfMSI                     8a   Const                                                    
     D  ErrorCode                          like(APIErr)                                             
      *                                                                                             
     D GenericHeader   DS                  Qualified Based(usPtr)                                   
     D  userarea                     64a                                                            
     D  size                         10i 0                                                          
     D  releaselevel                  4                                                             
     D  formatname                    8                                                             
     D  APIused                      10                                                             
     D  DateCreated                  13                                                             
     D  InforSts                      1                                                             
     D  sizeUsed                     10i 0                                                          
     D  offsetInput                  10i 0                                                          
     D  sizeInput                    10i 0                                                          
     D  offsetHeader                 10i 0                                                          
     D  sizeHeader                   10i 0                                                          
     D  offsetList                   10i 0                                                          
     D  sizeList                     10i 0                                                          
     D  numberList                   10i 0                                                          
     D  sizeEntry                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D* cntryID                       2                                                             
     D* langID                        3                                                             
     D* subsetInd                     1                                                             
     D* rsvd                         42                                                             
     D  rsvd                       2048                                                             
      *                                                                                             
     D ipPtr           S               *                                                            
     D Input           DS                  Qualified Based(ipPtr)                                   
     D  UsrSpc                       10a                                                            
     D  UsrSpcLib                    10a                                                            
     D  Fmt                           8a                                                            
     D  FmtMSGSLT                     8a                                                            
     D  SizeMSGSLT                   10i 0                                                          
     D  MaxMsgReq                    10i 0                                                          
     D  LstDir                       10a                                                            
     D  SltCriteria                  10a                                                            
     D  SevCriteria                  10i 0                                                          
     D  MaxMsgLen                    10i 0                                                          
     D  MaxMsgHlpLen                 10i 0                                                          
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKeyStr                 10i 0                                                          
     D  NumMsgQ                      10i 0                                                          
     D  OfsFldRtn                    10i 0                                                          
     D  NumFldRtn                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  DTCriteria                   13a                                                            
      *                                                                                             
     D hdPtr           S               *                                                            
     D Header          DS                  Qualified Based(hdPtr)                                   
     D  UsrSpc                       10a                                                            
     D  UsrSpcLib                    10a                                                            
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKeyStr                 10i 0                                                          
     D  OfsMsgKeyEnd                 10i 0                                                          
     D  NumMsgQ                      10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  DatTim1st                    13a                                                            
     D  DatTimEnd                    13a                                                            
      *                                                                                             
     D jlPtr           S               *                                                            
     D LSTM0100        DS                  Qualified Based(jlPtr)                                   
     D  OfsNext                      10i 0                                                          
     D  OfsFldRtn                    10i 0                                                          
     D  NbrFldRtn                    10i 0                                                          
     D  MsgSev                       10i 0                                                          
     D  MsgID                         7a                                                            
     D  MsgType                       2a                                                            
     D  MsgKey                        4a                                                            
     D  MsgFilNam                    10a                                                            
     D  MsgFilLib                    10a                                                            
     D  MsgQ                         10a                                                            
     D  MsgQLib                      10a                                                            
     D  DateSent                      7a                                                            
     D  TimeSent                      6a                                                            
     D  MicroSec                      6a                                                            
      *                                                                                             
     D rfPtr           S               *                                                            
     D FieldInfo       DS                  Qualified Based(rfPtr)                                   
     D  FstLvlTxtLen          29     32i 0                                                          
     D  FstLvlTxt             33    144                                                             
      *                                                                                             
     D MSLT0100        DS                                                                           
     D  MaxMsgReq                    10i 0 inz(-1)                                                  
     D  LstDirection                 10a   inz('*NEXT')                                             
     D  SltCriteria                  10a   inz('*MNR')                                              
     D* SltCriteria                  10a   inz('*ALL')                                              
     D  SevCriteria                  10i 0 inz(0)                                                   
     D  MaxMsgLen                    10i 0 inz(112)                                                 
     D  MaxMsgHlpLen                 10i 0 inz(4)                                                   
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKey                    10i 0                                                          
     D  NbrOfMSGQ                    10i 0 inz(1)                                                   
     D  OfsFldRtn                    10i 0                                                          
     D  NbrFldRtn                    10i 0 inz(1)                                                   
     D  MsgQname                     20a                                                            
     D  MsgKey                        4a   inz(x'00000000')                                         
     D* RtnFldId                     10i 0 inz(302)                                                 
     D  RtnFldId                     10i 0 inz(201)                                                 
      *                                                                                             
     D pName           S             20a                                                            
     D usPtr           S               *                                                            
      *                                                                                             
     D APIErr          DS                  Qualified                                                
     D  ErrSize                      10i 0 inz(%size(APIErr))                                       
     D  ErrLen                       10i 0 inz(0)                                                   
     D  ErrID                         7a                                                            
     D  rsvd                          1a                                                            
     D  ErrData                   32767a                                                            
      *                                                                                             
     D i               S              5  0                                                          
     D Text            S             52a                                                            
      *                                                                                             
     D HandleErr       PR                                                                           
      *                                                                                             
      /Free            
                                                                             
              MsgQname = 'QSYSOPR   QSYS      ' ;                                                   
              OfsMsgQ    = %addr(MsgQname) - %addr(MSLT0100) ;                                      
              OfsMsgKey  = %addr(MsgKey  ) - %addr(MSLT0100) ;                                      
              OfsFldRtn  = %addr(RtnFldId) - %addr(MSLT0100) ;                                      
                                                                                                    
              pName =    'LSTMSG    QTEMP     ' ;                                                   
              usPtr = CrtUsrspcP  (pName ) ;                                                        
                                                                                                    
              LstMsg    ( pName                                                                     
                         :'LSTM0100'                                                                
                         :MSLT0100                                                                  
                         :%size(MSLT0100)                                                           
                         :'MSLT0100'                                                                
                         :APIErr ) ;                                                                
                                                                                                    
              If APIErr.ErrLEN <> 0 ;                                                               
                HandleErr() ;                                                                       
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              If GenericHeader.numberList = 0 ;                                                     
                Text =                                                                              
                  '未応答のメッセージはありません。' ;                                                              
                dsply Text ;                                                                        
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              ipPtr = usPtr + GenericHeader.offsetInput ;                                           
              hdPtr = usPtr + GenericHeader.offsetHeader ;                                          
              jlPtr = usPtr + GenericHeader.offsetList ;                                            
                                                                                                    
              Text =                                                                                
                '未応答のメッセージが' +                                                                      
                %char(GenericHeader.numberList) +                                                   
                '個あります。' ;                                                                          
              dsply Text ;                                                                          
              Text =                                                                                
                '最初のものは' +                                                                          
                '20' + %subst(Header.DatTim1st:2:6) +                                               
                ' ' +                                                                               
                %subst(Header.DatTim1st:8:6) +                                                      
                'に送られています。' ;                                                                       
              dsply Text ;                                                                          
              Text =                                                                                
                '最後のものは' +                                                                          
                '20' + %subst(Header.DatTimEnd:2:6) +                                               
                ' ' +                                                                               
                %subst(Header.DatTimEnd:8:6) +                                                      
                'に送られています。' ;                                                                       
              dsply Text ;                                                                          
              Text = 'DSPLOG PERIOD((' +                                                            
                %subst(Header.DatTim1st:8:6) +                                                      
                ' ' +                                                                               
                '20' + %subst(Header.DatTim1st:2:6) +                                               
                ') (' +                                                                             
                %subst(Header.DatTimEnd:8:6) +                                                      
                ' ' +                                                                               
                '20' + %subst(Header.DatTimEnd:2:6) +                                               
                '))' ;                                                                              
              dsply Text ;                                                                          
              QCMDEXC (Text : %len(Text)) ;                                                         
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
      *                                                                                             
     P HandleErr       B                                                                            
     D HandleErr       PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P HandleErr       E                                                                            

未応答のメッセージをチェックし、存在した場合は DSPMSG QSYSOPR コマンドを発行して応答できるようにする

こちらは未応答のメッセージの存在をチェックした後、存在する場合は DSPMSG QSYSOPR で要応答メッセージを表示するようにしたものです。

      *                                                                                             
      *  CRTRPGMOD MODULE(CHKNRPMSG) SRCFILE(QRPGLESRC)                                             
      *            DBGVIEW(*SOURCE)                                                                 
      *                                                                                             
     D CrtUsrspcP      PR              *                                                            
     D  Name                         20a                                                            
      *                                                                                             
     D QCMDEXC         Pr                  ExtPgm( 'QCMDEXC' )                                      
     D  pCmd                      32702a   options(*varsize)                                        
     D                                     const                                                    
     D  pCmdLen                      15p 5 const                                                    
      *                                                                                             
     D LstMsg          Pr                  ExtPgm( 'QMHLSTM' )                                      
     D  pUsrspcName                  20a   Const                                                    
     D  pFormatName                   8a   Const                                                    
     D  pMsgSltInfo                        Const                                                    
     D                                     like(MSLT0100)                                           
     D  pSizeOfMSI                   10i 0 Const                                                    
     D  pFmtOfMSI                     8a   Const                                                    
     D  ErrorCode                          like(APIErr)                                             
      *                                                                                             
     D GenericHeader   DS                  Qualified Based(usPtr)                                   
     D  userarea                     64a                                                            
     D  size                         10i 0                                                          
     D  releaselevel                  4                                                             
     D  formatname                    8                                                             
     D  APIused                      10                                                             
     D  DateCreated                  13                                                             
     D  InforSts                      1                                                             
     D  sizeUsed                     10i 0                                                          
     D  offsetInput                  10i 0                                                          
     D  sizeInput                    10i 0                                                          
     D  offsetHeader                 10i 0                                                          
     D  sizeHeader                   10i 0                                                          
     D  offsetList                   10i 0                                                          
     D  sizeList                     10i 0                                                          
     D  numberList                   10i 0                                                          
     D  sizeEntry                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D* cntryID                       2                                                             
     D* langID                        3                                                             
     D* subsetInd                     1                                                             
     D* rsvd                         42                                                             
     D  rsvd                       2048                                                             
      *                                                                                             
     D ipPtr           S               *                                                            
     D Input           DS                  Qualified Based(ipPtr)                                   
     D  UsrSpc                       10a                                                            
     D  UsrSpcLib                    10a                                                            
     D  Fmt                           8a                                                            
     D  FmtMSGSLT                     8a                                                            
     D  SizeMSGSLT                   10i 0                                                          
     D  MaxMsgReq                    10i 0                                                          
     D  LstDir                       10a                                                            
     D  SltCriteria                  10a                                                            
     D  SevCriteria                  10i 0                                                          
     D  MaxMsgLen                    10i 0                                                          
     D  MaxMsgHlpLen                 10i 0                                                          
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKeyStr                 10i 0                                                          
     D  NumMsgQ                      10i 0                                                          
     D  OfsFldRtn                    10i 0                                                          
     D  NumFldRtn                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  DTCriteria                   13a                                                            
      *                                                                                             
     D hdPtr           S               *                                                            
     D Header          DS                  Qualified Based(hdPtr)                                   
     D  UsrSpc                       10a                                                            
     D  UsrSpcLib                    10a                                                            
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKeyStr                 10i 0                                                          
     D  OfsMsgKeyEnd                 10i 0                                                          
     D  NumMsgQ                      10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  DatTim1st                    13a                                                            
     D  DatTimEnd                    13a                                                            
      *                                                                                             
     D jlPtr           S               *                                                            
     D LSTM0100        DS                  Qualified Based(jlPtr)                                   
     D  OfsNext                      10i 0                                                          
     D  OfsFldRtn                    10i 0                                                          
     D  NbrFldRtn                    10i 0                                                          
     D  MsgSev                       10i 0                                                          
     D  MsgID                         7a                                                            
     D  MsgType                       2a                                                            
     D  MsgKey                        4a                                                            
     D  MsgFilNam                    10a                                                            
     D  MsgFilLib                    10a                                                            
     D  MsgQ                         10a                                                            
     D  MsgQLib                      10a                                                            
     D  DateSent                      7a                                                            
     D  TimeSent                      6a                                                            
     D  MicroSec                      6a                                                            
      *                                                                                             
     D rfPtr           S               *                                                            
     D FieldInfo       DS                  Qualified Based(rfPtr)                                   
     D  FstLvlTxtLen          29     32i 0                                                          
     D  FstLvlTxt             33    144                                                             
      *                                                                                             
     D MSLT0100        DS                                                                           
     D  MaxMsgReq                    10i 0 inz(-1)                                                  
     D  LstDirection                 10a   inz('*NEXT')                                             
     D  SltCriteria                  10a   inz('*MNR')                                              
     D* SltCriteria                  10a   inz('*ALL')                                              
     D  SevCriteria                  10i 0 inz(0)                                                   
     D  MaxMsgLen                    10i 0 inz(112)                                                 
     D  MaxMsgHlpLen                 10i 0 inz(4)                                                   
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKey                    10i 0                                                          
     D  NbrOfMSGQ                    10i 0 inz(1)                                                   
     D  OfsFldRtn                    10i 0                                                          
     D  NbrFldRtn                    10i 0 inz(1)                                                   
     D  MsgQname                     20a                                                            
     D  MsgKey                        4a   inz(x'00000000')                                         
     D* RtnFldId                     10i 0 inz(302)                                                 
     D  RtnFldId                     10i 0 inz(201)                                                 
      *                                                                                             
     D pName           S             20a                                                            
     D usPtr           S               *                                                            
      *                                                                                             
     D APIErr          DS                  Qualified                                                
     D  ErrSize                      10i 0 inz(%size(APIErr))                                       
     D  ErrLen                       10i 0 inz(0)                                                   
     D  ErrID                         7a                                                            
     D  rsvd                          1a                                                            
     D  ErrData                   32767a                                                            
      *                                                                                             
     D i               S              5  0                                                          
     D Text            S             52a                                                            
      *                                                                                             
     D HandleErr       PR                                                                           
      *                                                                                             
      /Free                                                                                         
              MsgQname = 'QSYSOPR   QSYS      ' ;                                                   
              OfsMsgQ    = %addr(MsgQname) - %addr(MSLT0100) ;                                      
              OfsMsgKey  = %addr(MsgKey  ) - %addr(MSLT0100) ;                                      
              OfsFldRtn  = %addr(RtnFldId) - %addr(MSLT0100) ;                                      
                                                                                                    
              pName =    'LSTMSG    QTEMP     ' ;                                                   
              usPtr = CrtUsrspcP  (pName ) ;                                                        
                                                                                                    
              LstMsg    ( pName                                                                     
                         :'LSTM0100'                                                                
                         :MSLT0100                                                                  
                         :%size(MSLT0100)                                                           
                         :'MSLT0100'                                                                
                         :APIErr ) ;                                                                
                                                                                                    
              If APIErr.ErrLEN <> 0 ;                                                               
                HandleErr() ;                                                                       
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              If GenericHeader.numberList = 0 ;                                                     
                Text =                                                                              
                  '未応答のメッセージはありません。' ;                                                              
                dsply Text ;                                                                        
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              ipPtr = usPtr + GenericHeader.offsetInput ;                                           
              hdPtr = usPtr + GenericHeader.offsetHeader ;                                          
              jlPtr = usPtr + GenericHeader.offsetList ;                                            
                                                                                                    
              Text =                                                                                
                '未応答のメッセージが' +                                                                      
                %char(GenericHeader.numberList) +                                                   
                '個あります。' ;                                                                          
              dsply Text ;                                                                          
              Text =                                                                                
                '最初のものは' +                                                                          
                '20' + %subst(Header.DatTim1st:2:6) +                                               
                ' ' +                                                                               
                %subst(Header.DatTim1st:8:6) +                                                      
                'に送られています。' ;                                                                       
              dsply Text ;                                                                          
              Text =                                                                                
                '最後のものは' +                                                                          
                '20' + %subst(Header.DatTimEnd:2:6) +                                               
                ' ' +                                                                               
                %subst(Header.DatTimEnd:8:6) +                                                      
                'に送られています。' ;                                                                       
              dsply Text ;                                                                          
              Text = 'DSPMSG MSGQ(*SYSOPR) ' +                                                      
                     'MSGTYPE(*INQ) ' +                                                             
                     'ASTLVL(*BASIC)' ;                                                             
              QCMDEXC (Text : %len(Text)) ;                                                         
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
      *                                                                                             
     P HandleErr       B                                                                            
     D HandleErr       PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P HandleErr       E                         

これ、「どうせ応答するんだったらチェックなんかしないで全部 DSPMSG QSYSOPR すればいいんじゃないの」なんていう人は運用というものを知らない人ですね。
それなりの台数(区画数)あったら、プログラムにチェックしてもらった方が速いし確実です。

もちろん、実際にはこんなふうに連続して実行する必要はありません。
たとえば、チェックのプログラムを定期的に動かしておき、人がチェックしなければいけないときに DSPMSG すればいいでしょう。
これはあくまでコーディング例であることをお忘れなく。

未応答のメッセージの情報を取得し、データベースに格納する

こちらは、それぞれのメッセージのテキストと情報を取得し、データベースに格納するようにしたものです。

メッセージを扱うには CL の方が得てして適しています。このように格納したデータをもとに RCV するなり SND するなりする、というやり方もありますね。

      ********************************************************                                      
      *                                                                                             
      *   CREATE TABLE LSTMSG                                                                
      *   (MSGSEV INT NOT NULL WITH DEFAULT,                                                        
      *    MSGID CHAR ( 7) NOT NULL WITH DEFAULT,                                                   
      *    MSGTYPE CHAR ( 5) NOT NULL WITH DEFAULT,                                                 
      *    MSGKEY CHAR ( 4) NOT NULL WITH DEFAULT,                                                  
      *    MSGFILE CHAR ( 10) NOT NULL WITH DEFAULT,                                                
      *    MSGFILELIB CHAR ( 10) NOT NULL WITH DEFAULT,                                             
      *    MSGQ CHAR ( 10) NOT NULL WITH DEFAULT,                                                   
      *    MSGQLIB CHAR ( 10) NOT NULL WITH DEFAULT,                                                
      *    MSGDATE CHAR ( 8) NOT NULL WITH DEFAULT,                                                 
      *    MSGTIME CHAR ( 6) NOT NULL WITH DEFAULT,                                                 
      *    MSGMICROSEC CHAR ( 6) NOT NULL WITH DEFAULT,                                             
      *    MSGTEXT VARCHAR (128 ) NOT NULL WITH DEFAULT,                                            
      *    ROW_TIMESTAMP TIMESTAMP NOT NULL WITH DEFAULT)                                           
      *                                                                                             
      *   CRTSQLRPGI OBJ(LSTNRPMSG) SRCFILE(QRPGLESRC) COMMIT(*CS)                                  
      *              OBJTYPE(*MODULE) DBGVIEW(*SOURCE)                                              
      *                                                                                             
      ********************************************************                                      
      *                                                                                             
     D CrtUsrspcP      PR              *                                                            
     D  Name                         20a                                                            
      *                                                                                             
     D LstMsg          Pr                  ExtPgm( 'QMHLSTM' )                                      
     D  pUsrspcName                  20a   Const                                                    
     D  pFormatName                   8a   Const                                                    
     D  pMsgSltInfo                        Const                                                    
     D                                     like(MSLT0100)                                           
     D  pSizeOfMSI                   10i 0 Const                                                    
     D  pFmtOfMSI                     8a   Const                                                    
     D  ErrorCode                          like(APIErr)                                             
      *                                                                                             
     D GenericHeader   DS                  Qualified Based(usPtr)                                   
     D  userarea                     64a                                                            
     D  size                         10i 0                                                          
     D  releaselevel                  4                                                             
     D  formatname                    8                                                             
     D  APIused                      10                                                             
     D  DateCreated                  13                                                             
     D  InforSts                      1                                                             
     D  sizeUsed                     10i 0                                                          
     D  offsetInput                  10i 0                                                          
     D  sizeInput                    10i 0                                                          
     D  offsetHeader                 10i 0                                                          
     D  sizeHeader                   10i 0                                                          
     D  offsetList                   10i 0                                                          
     D  sizeList                     10i 0                                                          
     D  numberList                   10i 0                                                          
     D  sizeEntry                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D* cntryID                       2                                                             
     D* langID                        3                                                             
     D* subsetInd                     1                                                             
     D  rsvd                         42                                                             
      *                                                                                             
     D ipPtr           S               *                                                            
     D Input           DS                  Qualified Based(ipPtr)                                   
     D  UsrSpc                       10a                                                            
     D  UsrSpcLib                    10a                                                            
     D  Fmt                           8a                                                            
     D  FmtMSGSLT                     8a                                                            
     D  SizeMSGSLT                   10i 0                                                          
     D  MaxMsgReq                    10i 0                                                          
     D  LstDir                       10a                                                            
     D  SltCriteria                  10a                                                            
     D  SevCriteria                  10i 0                                                          
     D  MaxMsgLen                    10i 0                                                          
     D  MaxMsgHlpLen                 10i 0                                                          
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKeyStr                 10i 0                                                          
     D  NumMsgQ                      10i 0                                                          
     D  OfsFldRtn                    10i 0                                                          
     D  NumFldRtn                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  DTCriteria                   13a                                                            
      *                                                                                             
     D hdPtr           S               *                                                            
     D Header          DS                  Qualified Based(hdPtr)                                   
     D  UsrSpc                       10a                                                            
     D  UsrSpcLib                    10a                                                            
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKeyStr                 10i 0                                                          
     D  OfsMsgKeyEnd                 10i 0                                                          
     D  NumMsgQ                      10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  DatTim1st                    13a                                                            
     D  DatTimEnd                    13a                                                            
      *                                                                                             
     D jlPtr           S               *                                                            
     D LSTM0100        DS                  Qualified Based(jlPtr)                                   
     D  OfsNext                      10i 0                                                          
     D  OfsFldRtn                    10i 0                                                          
     D  NbrFldRtn                    10i 0                                                          
     D  MsgSev                       10i 0                                                          
     D  MsgID                         7a                                                            
     D  MsgType                       2a                                                            
     D  MsgKey                        4a                                                            
     D  MsgFilNam                    10a                                                            
     D  MsgFilLib                    10a                                                            
     D  MsgQ                         10a                                                            
     D  MsgQLib                      10a                                                            
     D  DateSent                      7a                                                            
     D  TimeSent                      6a                                                            
     D  MicroSec                      6a                                                            
      *                                                                                             
     D rfPtr           S               *                                                            
     D FieldInfo       DS                  Qualified Based(rfPtr)                                   
     D  FstLvlTxtLen          29     32i 0                                                          
     D  FstLvlTxt             33    144                                                             
      *                                                                                             
     D MSLT0100        DS                                                                           
     D  MaxMsgReq                    10i 0 inz(-1)                                                  
     D  LstDirection                 10a   inz('*NEXT')                                             
     D  SltCriteria                  10a   inz('*MNR')                                              
     D* SltCriteria                  10a   inz('*ALL')                                              
     D  SevCriteria                  10i 0 inz(0)                                                   
     D  MaxMsgLen                    10i 0 inz(112)                                                 
     D  MaxMsgHlpLen                 10i 0 inz(4)                                                   
     D  OfsMsgQ                      10i 0                                                          
     D  OfsMsgKey                    10i 0                                                          
     D  NbrOfMSGQ                    10i 0 inz(1)                                                   
     D  OfsFldRtn                    10i 0                                                          
     D  NbrFldRtn                    10i 0 inz(1)                                                   
     D  MsgQname                     20a                                                            
     D  MsgKey                        4a   inz(x'00000000')                                         
     D* RtnFldId                     10i 0 inz(302)                                                 
     D  RtnFldId                     10i 0 inz(201)                                                 
      *                                                                                             
     D pName           S             20a                                                            
     D usPtr           S               *                                                            
      *                                                                                             
     D APIErr          DS                  Qualified                                                
     D  ErrSize                      10i 0 inz(%size(APIErr))                                       
     D  ErrLen                       10i 0 inz(0)                                                   
     D  ErrID                         7a                                                            
     D  rsvd                          1a                                                            
     D  ErrData                   32767a                                                            
      *                                                                                             
     D i               S              5  0                                                          
     D MsgDate         S              8a                                                            
     D MsgText         S            128a                                                            
      *                                                                                             
     D HandleErr       PR                                                                           
      *                                                                                             
      /Free                                                                                         

              MsgQname = 'QSYSOPR   QSYS      ' ;                                                   
              OfsMsgQ    = %addr(MsgQname) - %addr(MSLT0100) ;                                      
              OfsMsgKey  = %addr(MsgKey  ) - %addr(MSLT0100) ;                                      
              OfsFldRtn  = %addr(RtnFldId) - %addr(MSLT0100) ;                                      
                                                                                                    
              pName =    'LSTMSG    QTEMP     ' ;                                                   
              usPtr = CrtUsrspcP  (pName ) ;                                                        
                                                                                                    
              LstMsg    ( pName                                                                     
                         :'LSTM0100'                                                                
                         :MSLT0100                                                                  
                         :%size(MSLT0100)                                                           
                         :'MSLT0100'                                                                
                         :APIErr ) ;                                                                
                                                                                                    
              If APIErr.ErrLEN <> 0 ;                                                               
                HandleErr() ;                                                                       
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              If GenericHeader.numberList = 0 ;                                                     
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              ipPtr = usPtr + GenericHeader.offsetInput ;                                           
              hdPtr = usPtr + GenericHeader.offsetHeader ;                                          
                                                                                                    
              jlPtr = usPtr + GenericHeader.offsetList ;                                            
                                                                                                    
              exec SQL                                                                              
                 DELETE LSTMSG ;                                                             
                                                                                                    
              for i = 1 to GenericHeader.numberList ;                                               
                                                                                                    
                // MSG Text (Field Data)                                                            
                rfPtr =  usPtr + LSTM0100.OfsFldRtn ;                                               
                MsgText =                                                                           
                  %subst(FieldInfo.FstLvlTxt:1:FieldInfo.FstLvlTxtLen) ;                            
                                                                                                    
                MsgDate = '20' + %subst(LSTM0100.DateSent:2:6) ;                                    
                                                                                                    
                exec SQL                                                                            
                   INSERT INTO LSTMSG                                                        
                     VALUES(                                                                        
                           :LSTM0100.MsgSev,                                                        
                           :LSTM0100.MsgId,                                                         
                           '*INQ',                                                                  
                           :LSTM0100.MsgKey,                                                        
                           :LSTM0100.MsgFilNam,                                                     
                           :LSTM0100.MsgFilLib,                                                     
                           :LSTM0100.MsgQ,                                                          
                           :LSTM0100.MsgQLib,                                                       
                           :MsgDate,                                                                
                           :LSTM0100.TimeSent,                                                      
                           :LSTM0100.MicroSec,                                                      
                           :MsgText,                                                                
                           CURRENT_TIMESTAMP                                                        
                          ) ;                                                                       
                                                                                                    
                jlPtr =  usPtr + LSTM0100.OfsNext ;                                                 
                                                                                                    
              endfor ;                                                                              
                                                                                                    
                exec SQL                                                                            
                   COMMIT ;                                                                         
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
      *                                                                                             
     P HandleErr       B                                                                            
     D HandleErr       PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P HandleErr       E                            

データを格納するテーブルは ↓ で作成したものです。

CREATE TABLE LSTMSG 
(MSGSEV INT NOT NULL WITH DEFAULT, 
 MSGID CHAR ( 7) NOT NULL WITH DEFAULT,
 MSGTYPE CHAR ( 5) NOT NULL WITH DEFAULT,
 MSGKEY CHAR ( 4) NOT NULL WITH DEFAULT,
 MSGFILE CHAR ( 10) NOT NULL WITH DEFAULT,
 MSGFILELIB CHAR ( 10) NOT NULL WITH DEFAULT,
 MSGQ CHAR ( 10) NOT NULL WITH DEFAULT,
 MSGQLIB CHAR ( 10) NOT NULL WITH DEFAULT,
 MSGDATE CHAR ( 8) NOT NULL WITH DEFAULT,
 MSGTIME CHAR ( 6) NOT NULL WITH DEFAULT,
 MSGMICROSEC CHAR ( 6) NOT NULL WITH DEFAULT,
 MSGTEXT VARCHAR (128 ) NOT NULL WITH DEFAULT, 
 ROW_TIMESTAMP TIMESTAMP NOT NULL WITH DEFAULT)

[Top Pageに戻る]

Ads by TOK2