CL

137. CPF9999 をモニターするテンプレート AA1_SAMPLE

先に「CLPでのエラー・モニター解決」で紹介したように
MONMSG CPF0000 ではなく MONMSG CPF9999 でモニターすれば
エラー・ステートメントを得られると紹介した。
そこで MONMSG CPF9999 に変更した新しいCLPテンプレート AA1_SAMPLE
公開する。
CLPのテンプレートを自分のソース・ライブラリーに登録して保管しておけば
毎回、修正したりする工数を大幅に削減することができ
品質に優れたCLPプログラムを開発することができる。

CLPテンプレートは既にいくつか紹介しているが
ここに紹介するのは最も基本型となる AA1_SAMPLE という名前のCLPである。

[サンプルCLP: AA1_SAMPLE ]

ソースはこちらから

0001.00              PGM                                                                 
0002.00 /*-------------------------------------------------------------------*/          
0003.00 /*   AA1_SAMPLE :  テンプレート・サンプル CLP  CPF9999 改訂版        */          
0004.00 /*                                                                   */          
0005.00 /*   2018/02/01  作成                                                */          
0006.00 /*-------------------------------------------------------------------*/          
0007.00              DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                           
0008.00              DCL        VAR(&STMMSG) TYPE(*CHAR) LEN(132)                        
0009.00              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                           
0010.00              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                           
0011.00              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                        
0012.00              DCL        VAR(&MSGKEY) TYPE(*CHAR) LEN(4)                          
0013.00              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                        
0014.00              DCL        VAR(&ERRDTA) TYPE(*CHAR) LEN(132)                        
0015.00              DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                            
0016.00              DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)                         
0017.00              DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +                      
0018.00                           VALUE('*ESCAPE   ')                                    
0019.00              DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +                      
0020.00                           VALUE(X'000074') /* 2 進数  */                         
0021.00              DCL        VAR(&ERR) TYPE(*CHAR) LEN(1)                             
0022.00              DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                         
0023.00                           VALUE(X'00000000')                                     
0024.00              MONMSG     MSGID(CPF9999) EXEC(GOTO CMDLBL(ERROR))       
0025.00                                                                       
0026.00 /*( 環境の取得 )*/                                                    
0027.00              RTVJOBA    TYPE(&TYPE)                                   
0028.00              IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */   
0029.00              CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')              
0030.00              ENDDO      /*  バッチ  */                                
0031.00              ELSE       CMD(DO) /*  対話式  */                        
0032.00              CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')              
0033.00              ENDDO      /*  対話式  */                                
0034.00                                                                       
0035.00              IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)   
0036.00              SNDPGMMSG  +                                             
0037.00                           MSG('API: QUIDSPH の実行で次のエラーが発生 +
0038.00                            しました。 ') MSGTYPE(*DIAG)               
0039.00              GOTO       APIERR                                        
0040.00              ENDDO                                                    
0041.00              RETURN                                                   
0042.00                                                                       
0043.00  APIERR:                                                              
0044.00              CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))          
0045.00              CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))      
0046.00              CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')                
0047.00              CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')             
0048.00              GOTO       SNDMSG                                             
0049.00                                                                            
0050.00  ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) KEYVAR(&MSGKEY) +          
0051.00                           MSGDTA(&MSGDTA) MSGID(&MSGID)                    
0052.00              IF         COND(&MSGID *EQ 'CPF9999') THEN(DO)                
0053.00              CHGVAR     VAR(&ERRDTA) VALUE(&MSGDTA)                        
0054.00              RCVMSG     MSGTYPE(*PRV) MSGKEY(&MSGKEY) RMV(*NO) +           
0055.00                           MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) +        
0056.00                           MSGF(&MSGF) MSGFLIB(&MSGFLIB)                    
0057.00              ENDDO                                                         
0058.00              CHGVAR     VAR(&STMMSG) VALUE(' プログラム ' *CAT +           
0059.00                           %SST(&ERRDTA 8 10) *TCAT +                       
0060.00                           ' のステートメント ' *CAT %SST(&ERRDTA +         
0061.00                           24 4) *CAT ' で次のエラーが発生しました。 ')     
0062.00              SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&STMMSG) +     
0063.00                           TOMSGQ(&TOPGMQ) MSGTYPE(*DIAG)                   
0064.00  SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                      
0065.00              SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +        
0066.00                           TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)                
0067.00              MONMSG     MSGID(CPF2400) EXEC(RETURN)                        
0068.00              ENDDO                                                         
0069.00              ELSE       CMD(DO)                                            
0070.00              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +               
0071.00                           MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +                
0072.00                           MSGTYPE(&MSGTYPE)        
0073.00              MONMSG     MSGID(CPF2400) EXEC(RETURN)
0074.00              ENDDO                                 
0075.00              ENDPGM 


                                 

[解説]

MONMSG は当然 CPF0000 から CPF9999 へ変更されている。

0024.00              MONMSG     MSGID(CPF9999) EXEC(GOTO CMDLBL(ERROR))

次に CPF9999 のエラーのメッセージ・キーを

0050.00  ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) KEYVAR(&MSGKEY) +          
0051.00                           MSGDTA(&MSGDTA) MSGID(&MSGID)

によって受け取るのであるが RMV(*NO) にしておかないとメッセージ・キーは
受け取れない。
最初に受け取るこのメッセージはCPF9999でエラー・ステートメントが入っているが
エラーの原因を示すメッセージではない。

RCVMSG でメッセージが消えてしまうのであればメッセージ・キーは意味のないものに
なってしまうのでOSは RMV(*NO)を必要としている。
MSGID や MSGDTA の受け取りは必要であるが MSGFやMSGFFLIBはここでは必要ないので
受け取りは指定していない。

次に

0053.00              CHGVAR     VAR(&ERRDTA) VALUE(&MSGDTA)

によってメッセージ・データを保管するのだがデバッグしてみればわかるように
このメッセージ・データにステートメント番号が収められているので
後でメッセージを作成するときに使用する。

続いて

0054.00              RCVMSG     MSGTYPE(*PRV) MSGKEY(&MSGKEY) RMV(*NO) +           
0055.00                           MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) +        
0056.00                           MSGF(&MSGF) MSGFLIB(&MSGFLIB)

によって真のエラー・メッセージを取得する。
ステートメント情報は

0058.00              CHGVAR     VAR(&STMMSG) VALUE(' プログラム ' *CAT +           
0059.00                           %SST(&ERRDTA 8 10) *TCAT +                       
0060.00                           ' のステートメント ' *CAT %SST(&ERRDTA +         
0061.00                           24 4) *CAT ' で次のエラーが発生しました。 ')     
0062.00              SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&STMMSG) +     
0063.00                           TOMSGQ(&TOPGMQ) MSGTYPE(*DIAG)

によって出力する。
そして実際のエラーを

0064.00  SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                      
0065.00              SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +        
0066.00                           TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)                
0067.00              MONMSG     MSGID(CPF2400) EXEC(RETURN)                        
0068.00              ENDDO                                                         
0069.00              ELSE       CMD(DO)                                            
0070.00              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +               
0071.00                           MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +                
0072.00                           MSGTYPE(&MSGTYPE)        
0073.00              MONMSG     MSGID(CPF2400) EXEC(RETURN)
0074.00              ENDDO    

によって出力する。
このCLPテンプレートを使って生成したCLPであればエラーが起これば
エラー・メッセージだけでなくエラー・ステートメント行も併せて
報告されるので直ちに原因を解析することができる。

このようにエラーが起きても解析ができるようにしておくことこそが
品質の高い適用業務を作成することができるようになる。
これこそプロフェッショナルのテクニックである。