コマンド入力でオブジェクト名を
検索するためには
PARM KWD(GOOGLE) TYPE(*CHAR) LEN(40) CASE(*MIXED) +
CHOICE(*PGM) CHOICEPGM(CHAO.COM/GOOGLE) +
PMTCTL(GOOGLE) PROMPT('Google モデル ')
のようにして CHOICEPGM を指定すれば良い。
CHOICEPGM とは次のような例であり非常に便利になる機能である。
仮想印刷装置 . . . . . . . . リストは F4 または *ALL
CHOICEPGMでは通常表示の場合とF4=検索キーを押された場合を
受け取ったパラメータで識別できるので
F4キーを押されたときはデータを読んで戻せばよい。
戻す形式は
[2バイト戻り項目数] + [2バイト:レコードの長さ + レコード] +
[2バイト:レコードの長さ + レコード] +
:
[2バイト:レコードの長さ + レコード] +
の形式で戻せばよい。
IBMコマンドのようにF4キーで動的に検索できれば
わかりやすくてユーザーの操作性も良くなる。
[CHOICEPGMサンプル]
ソースはこちらから
0001.00 PGM PARM(&RCVCMD &SNDPRM)
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* GOOGLE : プロンプト選択プログラム (CHOICEPGM) */
0004.00 /* GOOGLE モデルの検索 */
0005.00 /* */
0006.00 /* 2020/04/01 作成 */
0007.00 /*-------------------------------------------------------------------*/
0008.00 DCL VAR(&RCVCMD) TYPE(*CHAR) LEN(21)
0009.00 DCL VAR(&CMD) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&KWD) TYPE(*CHAR) LEN(10)
0011.00 DCL VAR(&ACT) TYPE(*CHAR) LEN(1)
0012.00 DCL VAR(&SNDPRM) TYPE(*CHAR) LEN(2000)
0013.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0014.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0015.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0016.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0017.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0018.00 DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0)
0019.00 DCL VAR(&DTALEN) TYPE(*CHAR) LEN(4) /* 2 進数 */
0020.00 DCL VAR(&BIN4) TYPE(*CHAR) LEN(4) /* 2 進数 */
0021.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0022.00 VALUE(X'0000007400000000') /* 2 進数 */
0023.00 DCL VAR(&PRMHED) TYPE(*CHAR) LEN(30)
0024.00 DCL VAR(&TOTAL) TYPE(*CHAR) LEN(2)
0025.00 DCL VAR(&PRM1992) TYPE(*CHAR) LEN(1992)
0026.00 DCL VAR(&LEN) TYPE(*DEC) LEN(8 0)
0027.00 DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')
0028.00 DCL VAR(&COUNT) TYPE(*DEC) LEN(8 0)
0029.00 DCL VAR(&RECORD) TYPE(*CHAR) LEN(42)
0030.00 DCL VAR(&RECLEN) TYPE(*CHAR) LEN(2) VALUE(X'0022')
0031.00 DCL VAR(&KBN) TYPE(*CHAR) LEN(1)
0032.00 DCL VAR(&OBJOBJLIB) TYPE(*CHAR) LEN(20) +
0033.00 VALUE('ｵﾌﾞｼﾞｪｸﾄ/ﾗｲﾌﾞﾗﾘｰ')
0034.00 DCL VAR(&STRPOS) TYPE(*CHAR) LEN(4) +
0035.00 VALUE(X'0000007D') /* 2 進数開始位置 : +
0036.00 125 */
0037.00 DCL VAR(&LENDTA) TYPE(*CHAR) LEN(4) +
0038.00 VALUE(X'00000010') /* 2 進数受取長さ : 16 */
0039.00 DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(16) +
0040.00 VALUE(X'0000000000000000')
0041.00 DCL VAR(&OFFSET) TYPE(*CHAR) LEN(4) /* +
0042.00 2 進数 ｵﾌｾｯﾄ */
0043.00 DCL VAR(&NOENTR) TYPE(*CHAR) LEN(4) /* +
0044.00 2 進数項目数 */
0045.00 DCL VAR(&LSTSIZ) TYPE(*CHAR) LEN(4) /* +
0046.00 2 進数リストサイズ */
0047.00 DCL VAR(&ADDLEN) TYPE(*DEC) LEN(8 0) /* WORK */
0048.00 DCL VAR(&NOENT) TYPE(*DEC) LEN(8 0) /* WORK */
0049.00 DCL VAR(&N) TYPE(*DEC) LEN(8 0) VALUE(1) /* WORK */
0050.00 DCL VAR(&RCVDTA) TYPE(*CHAR) LEN(1024) /* +
0051.00 受取データ */
0052.00 DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0)
0053.00 DCL VAR(&FLD8) TYPE(*CHAR) LEN(8)
0054.00 DCL VAR(&DEV) TYPE(*CHAR) LEN(10)
0055.00 DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10)
0056.00 /*( MODEL の検索 )*/
0057.00 DCLF FILE(CHAO.USR/MODEL)
0058.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0059.00
0060.00 CHGVAR VAR(&CMD) VALUE(%SST(&RCVCMD 01 10))
0061.00 CHGVAR VAR(&KWD) VALUE(%SST(&RCVCMD 11 10))
0062.00 CHGVAR VAR(&ACT) VALUE(%SST(&RCVCMD 21 1))
0063.00 IF COND(&ACT *EQ &NULL) THEN(DO)
0064.00 CHGVAR VAR(&SNDPRM) VALUE('F4=PROMOT')
0065.00 RETURN
0066.00 ENDDO
0067.00 IF COND(&ACT *EQ 'C') THEN(DO)
0068.00 CHGVAR VAR(&SNDPRM) VALUE(' 名前，リストは F4')
0069.00 RETURN
0070.00 ENDC: ENDDO
0071.00 /* ************************************************ */
0072.00 /* モデルの検索 */
0073.00 /* ************************************************ */
0074.00 CHGVAR VAR(&LEN) VALUE(0)
0075.00 CHGVAR VAR(&COUNT) VALUE(0)
0076.00 READ: RCVF RCDFMT(MODELR)
0077.00 MONMSG MSGID(CPF0864) EXEC(DO)
0078.00 RCVMSG RMV(*YES)
0079.00 GOTO REDEND
0080.00 ENDDO
0081.00 /*( 処理の開始 )*/
0082.00 IF COND(%SCAN('Google' &AINAME) > 0) THEN(DO)
0083.00 CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
0084.00 CHGVAR VAR(&RECORD) VALUE(&RECLEN *CAT &MODEL)
0085.00 IF COND(&COUNT *EQ 1) THEN(DO) /* 最初 */
0086.00 CHGVAR VAR(&PRM1992) VALUE(&RECORD)
0087.00 ENDDO /* 最初 */
0088.00 ELSE CMD(DO) /* 2 番目以降 */
0089.00 CHGVAR VAR(&PRM1992) VALUE(%SST(&PRM1992 1 &LEN) +
0090.00 *CAT &RECORD)
0091.00 ENDDO /* 2 番目以降 */
0092.00 CHGVAR VAR(&LEN) VALUE(&LEN + 36)
0093.00 ENDDO
0094.00 /*( 処理の終了 )*/
0095.00 GOTO READ
0096.00 REDEND:
0097.00 /*( 合計を記述する )*/
0098.00 CHGVAR VAR(%BIN(&TOTAL)) VALUE(&COUNT)
0099.00 CHGVAR VAR(&SNDPRM) VALUE(&TOTAL *CAT &PRM1992)
0100.00 RETURN
0101.00
0102.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0103.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0104.00 SNDMSGFLIB(&MSGFLIB)
0105.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0106.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0107.00 MSGTYPE(*ESCAPE)
0108.00 ENDDO
0109.00 ELSE CMD(DO)
0110.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0111.00 MSGDTA(&MSGDTA) TOMSGQ(*TOPGMQ) +
0112.00 MSGTYPE(*ESCAPE)
0113.00 ENDDO
0114.00 DSPJOBLOG JOB(*) OUTPUT(*PRINT)
0115.00 ENDPGM: ENDPGM
[解説]
このCHOICEPGMは「Google」という文字列を含んでいるMODELというファイルの
レコードだけを抽出して選択の候補としてコマンドに戻している。
ところで戻すフィールド: AINAMEは実は40バイトであるが
この40バイトを戻そうとするとどうしても実行時には
許容値のリストに正しくない長さが定義された。
のエラーが発生してしまう。非常にわかりにくい日本語である。
この原因が不明で苦労して最寄りのAIに相談してみたが
いろいろとアドバイスはあったのだが2時間ほど試しても
解決できないので社員に頼むと10分ばかりで
原因は戻すフィールドの長さは34バイトという制限があることが
わかった。
AIもこれは見逃していたようでもう少ししっかりマニュアルを
調べて欲しいものである。
