AA1_SAMPLE のCPF9999対応版を紹介したのでプログラムを呼び出すCLPの
テンプレートCLP: AA2_SAMPLE を紹介する。
AA2_SAMPLE は AA1_SAMPLE とほとんど同じであるが
プログラムからのエラー・メッセージも表示できるようにしている点が
AA1_SAMPLE とは異なる。
AA1_SAMPLE は基本的に APIを実行するサンプメ・ソースであるのに
対してこの AA2_SAMPLE はプログラムを呼出して実行することを
目的としている。
[サンプルCLP: AA2_SAMPLE ]
ソースはこちらから
0001.00 PGM
0002.00 /*----------------------------------------------------------------------*/
0003.00 /* AA2_SAMPLE : テンプレート・サンプル CLP (PGM CALL) CPF9999 改訂版 */
0004.00 /* */
0005.00 /* 2019/03/18 作成 */
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(&MSGDTA) TYPE(*CHAR) LEN(132)
0013.00 DCL VAR(&ERRDTA) TYPE(*CHAR) LEN(132)
0014.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0015.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0016.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0017.00 VALUE('*ESCAPE ')
0018.00 DCL VAR(&ERR) TYPE(*CHAR) LEN(1)
0019.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0020.00 VALUE(X'00000000')
0021.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0022.00 VALUE(X'000074') /* 2 進数 */
0023.00 MONMSG MSGID(CPF9999) EXEC(GOTO CMDLBL(ERROR))
0024.00
0025.00 /*( 環境の取得 )*/
0026.00 RTVJOBA TYPE(&TYPE)
0027.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0028.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0029.00 ENDDO /* バッチ */
0030.00 ELSE CMD(DO) /* 対話式 */
0031.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0032.00 ENDDO /* 対話式 */
0033.00
0034.00 /*( 入力パラメータの検査 )*/
0035.00
0036.00 /*( プログラムの実行 )*/
0037.00 CALL PGM(MYPGM) PARM(&ERR &MSG)
0038.00 IF COND(&ERR *EQ ' ') THEN(DO)
0039.00 CHGVAR VAR(&MSGTYPE) VALUE('*DIAG ')
0040.00 ENDDO
0041.00 IF COND(&MSG *NE ' ') THEN(DO)
0042.00 GOTO SNDMSG
0043.00 ENDDO
0044.00 RETURN
0045.00
0046.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) KEYVAR(&MSGKEY) +
0047.00 MSGDTA(&MSGDTA) MSGID(&MSGID)
0048.00 IF COND(&MSGID *EQ 'CPF9999') THEN(DO)
0049.00 CHGVAR VAR(&ERRDTA) VALUE(&MSGDTA)
0050.00 RCVMSG MSGTYPE(*PRV) MSGKEY(&MSGKEY) RMV(*NO) +
0051.00 MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
0052.00 MSGF(&MSGF) MSGFLIB(&MSGFLIB)
0053.00 ENDDO
0054.00 CHGVAR VAR(&STMMSG) VALUE(' プログラム ' *CAT +
0055.00 %SST(&ERRDTA 8 10) *TCAT +
0056.00 ' のステートメント ' *CAT %SST(&ERRDTA +
0057.00 24 4) *CAT ' で次のエラーが発生しました。 ')
0058.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&STMMSG) +
0059.00 TOMSGQ(&TOPGMQ) MSGTYPE(*DIAG)
0060.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0061.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0062.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0063.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0064.00 ENDDO
0065.00 ELSE CMD(DO)
0066.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0067.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0068.00 MSGTYPE(&MSGTYPE)
0069.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0070.00 ENDDO
0071.00 ENDPGM
[解説]
先のAA1_SAMPLE と最も異なるのは
0036.00 /*( プログラムの実行 )*/
0037.00 CALL PGM(MYPGM) PARM(&ERR &MSG)
0038.00 IF COND(&ERR *EQ ' ') THEN(DO)
0039.00 CHGVAR VAR(&MSGTYPE) VALUE('*DIAG ')
0040.00 ENDDO
0041.00 IF COND(&MSG *NE ' ') THEN(DO)
0042.00 GOTO SNDMSG
0043.00 ENDDO
0044.00 RETURN
の部分である。
プログラム MYPGM にはパラメータとして &ERR と &MSG を渡していて
プログラムないの処理で何かエラーが起これば MYPGM は
&ERR に ‘E’ という文字と &MSG にはエラー・メッセージを戻す。
これによって AA2_SAMPLE は MYPGM 内でエラーが発生したと検知して
エラー・メッセージ &MSG をメッセージ・タイプ *ESCAPE のままで
メッセージを出力するようにできている。
MYPGM が成功裡に終えてメッセージを表示したい場合は
&ERR はブランクで &MSG にだけメッセージが戻される。
このときはメッセージ・タイプは *DIAG として結果のメッセージとして
報告される。
&ERR も &MSG もブランクで戻った場合は AA2_SAMPE も直ちに終了する。
このように単にプログラムを呼び出して実行するだけというのではなく
その結果を報告できるように仕組まれている。
今回のCPF9999への改訂によってエラー場所も特定できるようになっている。