パネル・グループ出口プログラムとはパネル・グループのイベント駆動によって
呼び出されるプログラムのことである。
例えばパネル・グループで
・オプションとして選択された
・機能キーを押して呼び出された
などである。
パネル・グループは最初にパネル・グループを表示するプログラムは
最初に表示だけさせておいてそれだけである。
後は機能キーを押したり何かエンド・ユーザーの操作によって
別のプログラムを呼び出して実行させる。
この方法は VisualC++, VisualBASIC、などのイベント駆動プログラムと
全く同じ処理構造である。
このようにパネル・グループによって呼び出されるプログラムは
すべて同じパラメータ構造で呼び出されるようになっている。
ここで紹介するのがその構造を持つ処理プログラムである。
[パネル・グループ出口プログラム AA6_SAMPLE]
ソースはこちらから
0001.00 PGM PARM(&RCVPRM)
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* AA6_SAMPLE: パネル・グループ出口プログラム */
0004.00 /* */
0005.00 /* 2020/01/11 作成 */
0006.00 /*-------------------------------------------------------------------*/
0007.00 DCL VAR(&RCVPRM) TYPE(*CHAR) LEN(70)
0008.00 DCL VAR(&HANDLE) TYPE(*CHAR) LEN(8) /* +
0009.00 摘要業務ハンドル */
0010.00 DCL VAR(&LSTHND) TYPE(*CHAR) LEN(4) /* +
0011.00 摘要業務ハンドル */
0012.00 DCL VAR(&DTALEN) TYPE(*CHAR) LEN(4) /* 2 進数 */
0013.00 DCL VAR(&VARRCD) TYPE(*CHAR) LEN(10)
0014.00 DCL VAR(&VARDTA) TYPE(*CHAR) LEN(1024)
0015.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0016.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0017.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0018.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0019.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0020.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0021.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0022.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0023.00 VALUE('*ESCAPE ')
0024.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0025.00 VALUE(X'000074') /* 2 進数 */
0026.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0027.00 VALUE(X'00000000')
0028.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0029.00
0030.00 /*( 環境の取得 )*/
0031.00 RTVJOBA TYPE(&TYPE)
0032.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0033.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0034.00 ENDDO /* バッチ */
0035.00 ELSE CMD(DO) /* 対話式 */
0036.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0037.00 ENDDO /* 対話式 */
0038.00
0039.00 /*( パラメータの取得 )*/
0040.00 CHGVAR VAR(&HANDLE) VALUE(%SST(&RCVPRM 17 8))
0041.00 CHGVAR VAR(&LSTHND) VALUE(%SST(&RCVPRM 45 4))
0042.00
0043.00 /*( 選択レコードを検索 )*/
0044.00 CHGVAR VAR(%BIN(&DTALEN)) VALUE(1024)
0045.00 CALL PGM(QUIGETLE) PARM(&HANDLE &VARDTA &DTALEN +
0046.00 'SFLRCD ' 'SFL ' 'HNDL' 'Y' +
0047.00 ' ' &LSTHND 'N' +
0048.00 &LSTHND &APIERR)
0049.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0050.00 SNDPGMMSG MSG('CRTWTRCL(1)API: +
0051.00 QUIGETLE の実行で次のエラーが発生しました +
0052.00 。 ') MSGTYPE(*DIAG)
0053.00 GOTO APIERR
0054.00 ENDDO
0055.00
0056.00 /*( SFLRCD の内容を取得 )*/
0057.00 /*( 処理の開始 -- ここから )*/
0058.00 /*( 処理の終了 -- ここまで )*/
0059.00 RETURN
0060.00
0061.00 APIERR:
0062.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0063.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0064.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0065.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0066.00 GOTO SNDMSG
0067.00
0068.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0069.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0070.00 MSGFLIB(&MSGFLIB)
0071.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0072.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0073.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0074.00 ENDDO
0075.00 ELSE CMD(DO)
0076.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0077.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0078.00 MSGTYPE(&MSGTYPE)
0079.00 ENDDO
0080.00 DSPJOBLOG JOB(*) OUTPUT(*PRINT)
0081.00 ENDPGM
