AA4_SAMPLE はプロンプト一時変更プログラム ( 初期設定 )であり
コマンドの初期値をセットするプログラムである。
コマンドを作成するときにプロンプト一時変更プログラム(PMTOVRPGM)として
指定されるプログラムである。
条件によってコマンド・パラメータの初期値を変更したい場合がある。
そのようなときにパラメータの初期値をこのプログラムで
作ってしまうことができる。
コマンド・パラメータを変更する原理は簡単で
返信パラメータで FILE(xxxx のようにパラメータ文字列を作って
コマンドに戻してやればよいだけである。
[プロンプト一時変更プログラム ( 初期設定 ) AA4_SAMPLE ]
ソースはこちらから
0001.00 PGM PARM(&CMDNAME &STRING)
0002.00 /*------------------------------------------------------------------------*/
0003.00 /* AA4_SAMPLE : プロンプト一時変更プログラム */
0004.00 /* -- このプログラムはコマンドの初期値を設定します。 */
0005.00 /* &STRING に長さとパラメータの初期値を戻します。 */
0006.00 /* */
0007.00 /* 2019/12/01 作成 */
0008.00 /*------------------------------------------------------------------------*/
0009.00 DCL VAR(&CMDNAME) TYPE(*CHAR) LEN(20)
0010.00 DCL VAR(&STRING) TYPE(*CHAR) LEN(5700)
0011.00 DCL VAR(&STRINGLEN) TYPE(*DEC) LEN(8 0) VALUE(1024)
0012.00 DCL VAR(&BIN2) TYPE(*CHAR) LEN(2) VALUE(X'0400') +
0013.00 /* 長さ 1024 バイト */
0014.00 DCL VAR(&BIN4) TYPE(*CHAR) LEN(4)
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 /*--------------------------------------------------*/
0029.00 /* 以下は装置の初期値パラメータ */
0030.00 /*--------------------------------------------------*/
0031.00 DCL VAR(&DEV_) TYPE(*CHAR) LEN(10)
0032.00 /*--------------------------------------------------*/
0033.00 /* 以下は返信パラメータ */
0034.00 /*--------------------------------------------------*/
0035.00 DCL VAR(&DEV) TYPE(*CHAR) LEN(40) +
0036.00 VALUE(' ??DEV(')
0037.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0038.00
0039.00 /*( 環境の取得 )*/
0040.00 RTVJOBA TYPE(&TYPE)
0041.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0042.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0043.00 ENDDO /* バッチ */
0044.00 ELSE CMD(DO) /* 対話式 */
0045.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0046.00 ENDDO /* 対話式 */
0047.00
0048.00 /* ************************************************ */
0049.00 /* 返信パラメータの作成 */
0050.00 /* ************************************************ */
0051.00 CHGVAR VAR(&DEV) VALUE(&DEV *TCAT &WTR *TCAT ')')
0052.00 /* ************************************************ */
0053.00 /* 返信ストリングの作成 */
0054.00 /* ************************************************ */
0055.00 CHGVAR VAR(&STRING) VALUE(&BIN2) /* 長さ */
0056.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &DEV)
0057.00 RETURN
0058.00
0059.00 ERROR: /*( エラーがあったときは CPF0011 を *ESCAPE で戻す )*/
0060.00 RCVMSG RMV(*NO) MSG(&MSG)
0061.00 SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0062.00 SNDPGMMSG MSGID(CPF0011) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
0063.00 ENDPGM
[解説]
パラメータ &CMDNAME はこのコマンドの名前が収められているだけのもの。
返信ストリング &STRING に変更したいパラメータの文字列を戻してやればよい。
ただし &STRING の先頭 2バイトはバイナリで後ろに続く文字列の長さを
入れる必要がある。
ここでは固定で 1024ばいととして後続に1024バイトの文字列が続くようにしている。
わかりやすくするために例を示す。
[売上明細表: URIAGE]
売上明細表 (URIAGE)
選択項目を入力して，実行キーを押してください。
売上年月日から . . . . . . . . 20200701 数値
まで . . . . . . . . 20200731 数値
終り
F3= 終了 F4=ﾌﾟﾛﾝﾌﾟﾄ F5= 最新表示 F12= 取り消し
F13= この画面の使用法 F24= キーの続き
[解説]
これは売上明細表を出力するためのコマンド・プロンプト画面である。
このコマンドを起動した日が 2020年7月27日(=小職の誕生日)であるので
7月1日～7月31日の期間が初期値としてセットされている。
8月に起動すればもちろん8月の日付として表示されるはずである。
このコマンドの初期値をセットしているのが URIINZ という名前のCLプログラムである。
最初にこのコマンド: URIAGE のソースを紹介すると
[コマンド: 売上明細表: URIAGE]
ソースはこちらから
0001.00 CMD PROMPT(' 売上明細表 ') +
0002.00 PMTOVRPGM(QUATTRO/URIINZ)
0003.00 PARM KWD(URFROM) TYPE(*DEC) LEN(8 0) +
0004.00 PROMPT(' 売上年月日から ')
0005.00 PARM KWD(URTO) TYPE(*DEC) LEN(8 0) +
0006.00 PROMPT(' まで ')
[コンパイル]
CRTCMD CMD(OBJLIB/URIAGE) PGM(OBJLIB/URIAGECL) SRCFILE(SRCLIB/QCMDSRC)
PMTOVRPGM(OBJLIB/URIINZ) AUT(*ALL)
として PMTOBRPGM に URIINZ を指定している。
[CLP : URIINZ プロンプト一時変更プログラム ]
ソースはこちらから
0001.00 PGM PARM(&CMDNAME &STRING)
0002.00 /*------------------------------------------------------------------------*/
0003.00 /* URIINZ : コマンド一時変更プログラム */
0004.00 /* -- このプログラムはコマンドの初期値を設定します。 */
0005.00 /* &STRING に長さとパラメータの初期値を戻します。 */
0006.00 /* */
0007.00 /* 2020/04/12 作成 */
0008.00 /*------------------------------------------------------------------------*/
0009.00 DCL VAR(&CMDNAME) TYPE(*CHAR) LEN(20)
0010.00 DCL VAR(&STRING) TYPE(*CHAR) LEN(5700)
0011.00 DCL VAR(&STRINGLEN) TYPE(*DEC) LEN(8 0) VALUE(1024)
0012.00 DCL VAR(&BIN2) TYPE(*CHAR) LEN(2) VALUE(X'0400') +
0013.00 /* 長さ 1024 バイト */
0014.00 DCL VAR(&BIN4) TYPE(*CHAR) LEN(4)
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 /*--------------------------------------------------*/
0029.00 /* 以下は装置の初期値パラメータ */
0030.00 /*--------------------------------------------------*/
0031.00 DCL VAR(&DEV_) TYPE(*CHAR) LEN(10)
0032.00 /*--------------------------------------------------*/
0033.00 /* 以下は返信パラメータ */
0034.00 /*--------------------------------------------------*/
0035.00 DCL VAR(&URFROM) TYPE(*CHAR) LEN(40) +
0036.00 VALUE(' ??URFROM(')
0037.00 DCL VAR(&URTO) TYPE(*CHAR) LEN(40) +
0038.00 VALUE(' ??URTO(')
0039.00 /*--------------------------------------------------*/
0040.00 /* 以下は作業用の変数 */
0041.00 /*--------------------------------------------------*/
0042.00 DCL VAR(&DATE) TYPE(*CHAR) LEN(6)
0043.00 DCL VAR(&YY) TYPE(*CHAR) LEN(2)
0044.00 DCL VAR(&MM) TYPE(*CHAR) LEN(2)
0045.00 DCL VAR(&DD) TYPE(*CHAR) LEN(2)
0046.00 DCL VAR(&CYY) TYPE(*CHAR) LEN(4)
0047.00 DCL VAR(&FROMYMD) TYPE(*CHAR) LEN(8)
0048.00 DCL VAR(&TOYMD) TYPE(*CHAR) LEN(8)
0049.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0050.00
0051.00 /*( 環境の取得 )*/
0052.00 RTVJOBA TYPE(&TYPE) DATE(&DATE)
0053.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0054.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0055.00 ENDDO /* バッチ */
0056.00 ELSE CMD(DO) /* 対話式 */
0057.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0058.00 ENDDO /* 対話式 */
0059.00
0060.00 /* ************************************************ */
0061.00 /* 返信パラメータの作成 */
0062.00 /* ************************************************ */
0063.00 CHGVAR VAR(&YY) VALUE(%SST(&DATE 01 02))
0064.00 CHGVAR VAR(&MM) VALUE(%SST(&DATE 03 02))
0065.00 CHGVAR VAR(&DD) VALUE(%SST(&DATE 05 02))
0066.00 CHGVAR VAR(&CYY) VALUE('20' *CAT &YY)
0067.00 /*( 開始日 )*/
0068.00 CHGVAR VAR(&FROMYMD) VALUE(&CYY *CAT &MM *CAT +
0069.00 '01')
0070.00 CHGVAR VAR(&URFROM) VALUE(&URFROM *TCAT &FROMYMD +
0071.00 *TCAT ') ')
0072.00 /*( 終了日 )*/
0073.00 SELECT
0074.00 WHEN COND(&MM = '01') THEN(DO)
0075.00 CHGVAR VAR(&DD) VALUE('31')
0076.00 ENDDO
0077.00 WHEN COND(&MM = '02') THEN(DO)
0078.00 CHGVAR VAR(&DD) VALUE('28')
0079.00 ENDDO
0080.00 WHEN COND(&MM = '03') THEN(DO)
0081.00 CHGVAR VAR(&DD) VALUE('31')
0082.00 ENDDO
0083.00 WHEN COND(&MM = '04') THEN(DO)
0084.00 CHGVAR VAR(&DD) VALUE('30')
0085.00 ENDDO
0086.00 WHEN COND(&MM = '05') THEN(DO)
0087.00 CHGVAR VAR(&DD) VALUE('31')
0088.00 ENDDO
0089.00 WHEN COND(&MM = '06') THEN(DO)
0090.00 CHGVAR VAR(&DD) VALUE('30')
0091.00 ENDDO
0092.00 WHEN COND(&MM = '07') THEN(DO)
0093.00 CHGVAR VAR(&DD) VALUE('31')
0094.00 ENDDO
0095.00 WHEN COND(&MM = '08') THEN(DO)
0096.00 CHGVAR VAR(&DD) VALUE('31')
0097.00 ENDDO
0098.00 WHEN COND(&MM = '09') THEN(DO)
0099.00 CHGVAR VAR(&DD) VALUE('30')
0100.00 ENDDO
0101.00 WHEN COND(&MM = '10') THEN(DO)
0102.00 CHGVAR VAR(&DD) VALUE('31')
0103.00 ENDDO
0104.00 WHEN COND(&MM = '11') THEN(DO)
0105.00 CHGVAR VAR(&DD) VALUE('30')
0106.00 ENDDO
0107.00 WHEN COND(&MM = '12') THEN(DO)
0108.00 CHGVAR VAR(&DD) VALUE('31')
0109.00 ENDDO
0110.00 ENDSELECT
0111.00 CHGVAR VAR(&TOYMD) VALUE(&CYY *CAT &MM *CAT &DD)
0112.00 CHGVAR VAR(&URTO) VALUE(&URTO *TCAT &TOYMD *TCAT ')')
0113.00 /* ************************************************ */
0114.00 /* 返信ストリングの作成 */
0115.00 /* ************************************************ */
0116.00 CHGVAR VAR(&STRING) VALUE(&BIN2) /* 長さ */
0117.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &URFROM)
0118.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &URTO)
0119.00 RETURN
0120.00
0121.00 ERROR: /*( エラーがあったときは CPF0011 を *ESCAPE で戻す )*/
0122.00 RCVMSG RMV(*NO) MSG(&MSG)
0123.00 SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0124.00 SNDPGMMSG MSGID(CPF0011) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
0125.00 ENDPGM
[解説]
今日の日付を
0052.00 RTVJOBA TYPE(&TYPE) DATE(&DATE)
で取得しておいて
0063.00 CHGVAR VAR(&YY) VALUE(%SST(&DATE 01 02)) 0064.00 CHGVAR VAR(&MM) VALUE(%SST(&DATE 03 02)) 0065.00 CHGVAR VAR(&DD) VALUE(%SST(&DATE 05 02))
で年月日に分割して
0111.00 CHGVAR VAR(&TOYMD) VALUE(&CYY *CAT &MM *CAT &DD) 0112.00 CHGVAR VAR(&URTO) VALUE(&URTO *TCAT &TOYMD *TCAT ')')
で組み立てなおして
0113.00 /* ************************************************ */ 0114.00 /* 返信ストリングの作成 */ 0115.00 /* ************************************************ */ 0116.00 CHGVAR VAR(&STRING) VALUE(&BIN2) /* 長さ */ 0117.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &URFROM) 0118.00 CHGVAR VAR(&STRING) VALUE(&STRING *TCAT &URTO) 0119.00 RETURN
によって返信ストリング &STRING に埋め込んで戻しているだけの簡単なものである。
エラーがあったときは IBM の取り決めによって
0121.00 ERROR: /*( エラーがあったときは CPF0011 を *ESCAPE で戻す )*/ 0122.00 RCVMSG RMV(*NO) MSG(&MSG) 0123.00 SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG) 0124.00 SNDPGMMSG MSGID(CPF0011) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
のようにして CPF0011を戻すことになっている。