プロンプト選択プログラム(CHOICEPGM)とはコマンドで良く見かける、
名前、リストはF4キー
というようにリスト選択機能を提供するプログラムである。
自分でIBMユーティリティのようにリスト選択機能を作りたいと
思ったことはないだろうか?
あるいは次のようにパラメータの後ろに「から」「まで」の文字列を
表示することができる。
[仕入先マスター一覧表: PGM104 ]
仕入先マスター一覧表 (PGM104)
選択項目を入力して，実行キーを押してください。
仕入先コード . . . . . . . . . から
9999 まで
出力 . . . . . . . . . . . . . *PRINT *, *PRINT
終り
F3= 終了 F4=ﾌﾟﾛﾝﾌﾟﾄ F5= 最新表示 F12= 取り消し
F13= この画面の使用法 F24= キーの続き
[解説]
仕入先コード から
9999 まで と表示するだけでエンド・ユーザーにとって
操作がわかりやすいものとなる。
[コマンド: PGM104 ]
ソースはこちらから
0001.00 CMD PROMPT(' 仕入先マスター一覧表 ')
0002.00 PARM KWD(SRFROM) TYPE(*CHAR) LEN(4) CHOICE(*PGM) +
0003.00 CHOICEPGM(QTROBJ/PGM106P) +
0004.00 PROMPT(' 仕入先コード ')
0005.00 PARM KWD(SREND) TYPE(*CHAR) LEN(4) DFT(9999) +
0006.00 CHOICE(*PGM) CHOICEPGM(QTROBJ/PGM106P)
0007.00 PARM KWD(OUTPUT) TYPE(*CHAR) LEN(8) RSTD(*YES) +
0008.00 DFT(*PRINT) VALUES(* *PRINT) PROMPT(' 出力 ')
[プロンプト選択プログラム : PGM106P ]
ソースはこちらから
0001.00 PGM PARM(&CMDPRM1 &RTNVAR)
0002.00 DCL VAR(&CMDPRM1) TYPE(*CHAR) LEN(21)
0003.00 DCL VAR(&CMD) TYPE(*CHAR) LEN(10)
0004.00 DCL VAR(&KWD) TYPE(*CHAR) LEN(10)
0005.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0006.00 DCL VAR(&RTNVAR) TYPE(*CHAR) LEN(2000)
0007.00
0008.00 CHGVAR VAR(&CMD) VALUE(%SST(&CMDPRM1 1 10))
0009.00 CHGVAR VAR(&KWD) VALUE(%SST(&CMDPRM1 11 10))
0010.00 CHGVAR VAR(&TYPE) VALUE(%SST(&CMDPRM1 21 1))
0011.00 /*( テキスト )*/
0012.00 IF COND(&TYPE *EQ 'C') THEN(DO)
0013.00 IF COND((&KWD *EQ 'HNSFROM ') *OR (&KWD *EQ +
0014.00 'SHFROM ') *OR (&KWD *EQ 'TKFROM ') +
0015.00 *OR (&KWD *EQ 'SRFROM ')) THEN(DO)
0016.00 CHGVAR VAR(&RTNVAR) VALUE(' から ')
0017.00 ENDDO
0018.00 ELSE CMD(DO)
0019.00 CHGVAR VAR(&RTNVAR) VALUE(' まで ')
0020.00 ENDDO
0021.00 RETURN
0022.00 ENDDO
0023.00
0024.00 ENDPGM
[解説]
プロンプト選択プログラムのパラメータは
コマンド・パラメータ &CMDPRM と &RTNVAR の２つであり
&CMDPRM = コマンド名(10桁) + キー・ワード(10桁) + タイプ(1桁)
である。
タイプ が C とは後続する文字列が要求された場合であるので
このときに「から」「まで」をキー・ワードに応じて入れてやればよい。
このような プロンプト選択プログラムのテンプレートが次に示す AA6_SAMPELである。
[プロンプト選択プログラム : AA7_SAMPLE ]
ソースはこちらから
0001.00 PGM PARM(&RCVCMD &SNDPRM)
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* AA7_SAMPLE: プロンプト選択プログラム (CHOICEPGM) */
0004.00 /* */
0005.00 /* 2020/03/19 作成 */
0006.00 /*-------------------------------------------------------------------*/
0007.00 DCL VAR(&RCVCMD) TYPE(*CHAR) LEN(21)
0008.00 DCL VAR(&CMD) TYPE(*CHAR) LEN(10)
0009.00 DCL VAR(&KWD) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&ACT) TYPE(*CHAR) LEN(1)
0011.00 DCL VAR(&SNDPRM) TYPE(*CHAR) LEN(2000)
0012.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0013.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0014.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0015.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0016.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0017.00 DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0)
0018.00 DCL VAR(&DTALEN) TYPE(*CHAR) LEN(4) /* 2 進数 */
0019.00 DCL VAR(&BIN4) TYPE(*CHAR) LEN(4) /* 2 進数 */
0020.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(4)
0021.00 DCL VAR(&PRMHED) TYPE(*CHAR) LEN(30)
0022.00 DCL VAR(&TOTAL) TYPE(*CHAR) LEN(2)
0023.00 DCL VAR(&PRM1992) TYPE(*CHAR) LEN(1992)
0024.00 DCL VAR(&LEN) TYPE(*DEC) LEN(8 0)
0025.00 DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')
0026.00 DCL VAR(&COUNT) TYPE(*DEC) LEN(8 0)
0027.00 DCL VAR(&RECORD) TYPE(*CHAR) LEN(34)
0028.00 DCL VAR(&RECLEN) TYPE(*CHAR) LEN(2)
0029.00 DCL VAR(&KBN) TYPE(*CHAR) LEN(1)
0030.00 DCL VAR(&OBJOBJLIB) TYPE(*CHAR) LEN(20) +
0031.00 VALUE('ｵﾌﾞｼﾞｪｸﾄ/ﾗｲﾌﾞﾗﾘｰ')
0032.00 DCL VAR(&STRPOS) TYPE(*CHAR) LEN(4) +
0033.00 VALUE(X'0000007D') /* 2 進数開始位置 : +
0034.00 125 */
0035.00 DCL VAR(&LENDTA) TYPE(*CHAR) LEN(4) +
0036.00 VALUE(X'00000010') /* 2 進数受取長さ : 16 */
0037.00 DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(16) +
0038.00 VALUE(X'0000000000000000')
0039.00 DCL VAR(&OFFSET) TYPE(*CHAR) LEN(4) /* +
0040.00 2 進数 ｵﾌｾｯﾄ */
0041.00 DCL VAR(&NOENTR) TYPE(*CHAR) LEN(4) /* +
0042.00 2 進数項目数 */
0043.00 DCL VAR(&LSTSIZ) TYPE(*CHAR) LEN(4) /* +
0044.00 2 進数リストサイズ */
0045.00 DCL VAR(&ADDLEN) TYPE(*DEC) LEN(8 0) /* WORK */
0046.00 DCL VAR(&NOENT) TYPE(*DEC) LEN(8 0) /* WORK */
0047.00 DCL VAR(&N) TYPE(*DEC) LEN(8 0) VALUE(1) /* WORK */
0048.00 DCL VAR(&RCVDTA) TYPE(*CHAR) LEN(1024) /* +
0049.00 受取データ */
0050.00 DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0)
0051.00 DCL VAR(&FLD8) TYPE(*CHAR) LEN(8)
0052.00 DCL VAR(&DEV) TYPE(*CHAR) LEN(10)
0053.00 DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10)
0054.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0055.00
0056.00 CHGVAR VAR(&CMD) VALUE(%SST(&RCVCMD 01 10))
0057.00 CHGVAR VAR(&KWD) VALUE(%SST(&RCVCMD 11 10))
0058.00 CHGVAR VAR(&ACT) VALUE(%SST(&RCVCMD 21 1))
0059.00 IF COND(&ACT *EQ &NULL) THEN(DO)
0060.00 CHGVAR VAR(&SNDPRM) VALUE('F4=PROMOT')
0061.00 RETURN
0062.00 ENDDO
0063.00 IF COND(&ACT *EQ 'C') THEN(DO)
0064.00 CHGVAR VAR(&SNDPRM) VALUE(' 名前，リストは F4')
0065.00 RETURN
0066.00 ENDC: ENDDO
0067.00 /* ************************************************ */
0068.00 /* ライターの検索 */
0069.00 /* ************************************************ */
0070.00 CHGVAR VAR(&COUNT) VALUE(0)
0071.00 /*( ユーザー・スペースの作成 )*/
0072.00 CALL PGM(QUSCRTUS) PARM('QUSLOBJ QTEMP ' +
0073.00 'PF ' 1000 ' ' '*ALL ' +
0074.00 'QUSLOBJD 用ユーザー空間 ' '*YES ' +
0075.00 &APIERR)
0076.00 MONMSG CPF9870
0077.00 /*( QUSLOBJ : オブジェクト・リストＡＰＩ )*/
0078.00 CHGVAR VAR(&OBJOBJLIB) VALUE('*ALL QSYS ')
0079.00 CALL PGM(QUSLOBJ) PARM('QUSLOBJ QTEMP ' +
0080.00 'OBJL0200' &OBJOBJLIB '*DEVD ' &APIERR)
0081.00 /*( リストＡＰＩで作成されたユーザー空間の検索 )*/
0082.00 /*( リストデータセクションのオフセットを検索 )*/
0083.00 CALL PGM(QUSRTVUS) PARM('QUSLOBJ QTEMP ' +
0084.00 &STRPOS &LENDTA &RCVVAR)
0085.00 CHGVAR VAR(&OFFSET) VALUE(%SST(&RCVVAR 1 4))
0086.00 CHGVAR VAR(&NOENTR) VALUE(%SST(&RCVVAR 9 4))
0087.00 CHGVAR VAR(&LSTSIZ) VALUE(%SST(&RCVVAR 13 4))
0088.00
0089.00 /*( RCVVAR によって OFFSET,LSTSIZ を受取った )*/
0090.00 CHGVAR VAR(&STRPOS) VALUE(&OFFSET)
0091.00 CHGVAR VAR(&DEC08) VALUE(%BIN(&STRPOS))
0092.00 CHGVAR VAR(&DEC08) VALUE(&DEC08 + 1)
0093.00 CHGVAR VAR(%BIN(&STRPOS)) VALUE(&DEC08)
0094.00 CHGVAR VAR(&LENDTA) VALUE(&LSTSIZ)
0095.00 CHGVAR VAR(&ADDLEN) VALUE(%BIN(&LENDTA))
0096.00 CHGVAR VAR(&NOENT) VALUE(%BIN(&NOENTR))
0097.00 CHGVAR VAR(&COUNT) VALUE(0)
0098.00 CHGVAR VAR(&LEN) VALUE(0)
0099.00 CHGVAR VAR(%BIN(&RECLEN)) VALUE(10)
0100.00 READ:
0101.00 CALL PGM(QUSRTVUS) PARM('QUSLOBJ QTEMP ' +
0102.00 &STRPOS &LENDTA &RCVDTA)
0103.00 /*( 処理の開始 )*/
0104.00 CHGVAR VAR(&DEV) VALUE(%SST(&RCVDTA 01 10))
0105.00 CHGVAR VAR(&OBJATR) VALUE(%SST(&RCVDTA 32 10))
0106.00 IF COND(%SST(&OBJATR 1 3) *EQ 'PRT') THEN(DO)
0107.00 CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
0108.00 CHGVAR VAR(&RECORD) VALUE(&RECLEN *CAT &DEV)
0109.00 IF COND(&COUNT *EQ 1) THEN(DO) /* 最初 */
0110.00 CHGVAR VAR(&PRM1992) VALUE(&RECORD)
0111.00 ENDDO /* 最初 */
0112.00 ELSE CMD(DO) /* 2 番目以降 */
0113.00 CHGVAR VAR(&PRM1992) VALUE(%SST(&PRM1992 1 &LEN) +
0114.00 *CAT &RECORD)
0115.00 ENDDO /* 2 番目以降 */
0116.00 CHGVAR VAR(&LEN) VALUE(&LEN + 12)
0117.00 ENDDO
0118.00 /*( 処理の終了 )*/
0119.00 IF COND(&N < &NOENT) THEN(DO)
0120.00 CHGVAR VAR(&N) VALUE(&N + 1)
0121.00 CHGVAR VAR(&DEC08) VALUE(%BIN(&STRPOS))
0122.00 CHGVAR VAR(&DEC08) VALUE(&DEC08 + &ADDLEN)
0123.00 CHGVAR VAR(%BIN(&STRPOS)) VALUE(&DEC08)
0124.00 GOTO READ
0125.00 ENDDO
0126.00 REDEND:
0127.00 /*( 合計を記述する )*/
0128.00 CHGVAR VAR(%BIN(&TOTAL)) VALUE(&COUNT)
0129.00 CHGVAR VAR(&SNDPRM) VALUE(&TOTAL *CAT &PRM1992)
0130.00 RETURN
0131.00
0132.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0133.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0134.00 MSGFLIB(&MSGFLIB)
0135.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0136.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0137.00 MSGTYPE(*ESCAPE)
0138.00 ENDDO
0139.00 ELSE CMD(DO)
0140.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0141.00 MSGDTA(&MSGDTA) TOMSGQ(*TOPGMQ) +
0142.00 MSGTYPE(*ESCAPE)
0143.00 ENDDO
0144.00 DSPJOBLOG JOB(*) OUTPUT(*PRINT)
0145.00 ENDPGM: ENDPGM