先に「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であればエラーが起これば
エラー・メッセージだけでなくエラー・ステートメント行も併せて
報告されるので直ちに原因を解析することができる。
このようにエラーが起きても解析ができるようにしておくことこそが
品質の高い適用業務を作成することができるようになる。
これこそプロフェッショナルのテクニックである。
