SFL(サブ・ファイル)を表示する混合リスト・パネルの作成を前回に紹介した。
それを処理する適用業務をここで紹介する。
DFUのような単票型式の紹介プログラムでは
DSPPNL ————————–> DSPHEAD————————> DSPDTA01
パネル・グループを *PNLGRP [実行キー] パネル: DSPDTA01を
表示するだけ パネル:DSPHEADを表示 表示
のようにして最初はパネル・グループを表示するだけで
実行キーを押したときに処理するプログラムを別に作成した。
つまり実行キーというイベントが発生したときに初めて呼び出されるプログラムを
定義したのである。
今回も
・パネル・グループの表示
・SFL明細行の追加
は別々のプログラムである。
DSPPNL ————————–> SFLCTL————————> PNL003CL
パネル・グループを *PNLGRP [実行キー] SFLレコードを追加
表示するだけ パネル:SFLCTLを表示
最初に「パネル・グループの表示」を実行するために野江に紹介したCLP: DSPPNLCLを
少し修正してみた。
[コマンドを処理するCLP:DSPPNLCL:ソース]
ソースはこちらから
0001.00 PGM PARM(&PNLGRPLIB &PANEL &PGMOBJLIB)
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* DSPPNLCL : パネル・グループ表示 */
0004.00 /* */
0005.00 /* 2020/01/02 作成 */
0006.00 /*-------------------------------------------------------------------*/
0007.00 DCL VAR(&PNLGRLIB) TYPE(*CHAR) LEN(20)
0008.00 DCL VAR(&PNLGRP) TYPE(*CHAR) LEN(10)
0009.00 DCL VAR(&PNLLIB) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&PANEL) TYPE(*CHAR) LEN(10)
0011.00 DCL VAR(&PGMOBJLIB) TYPE(*CHAR) LEN(20)
0012.00 DCL VAR(&PGM) TYPE(*CHAR) LEN(10)
0013.00 DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
0014.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0015.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0016.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0017.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0018.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0019.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0020.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0021.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0022.00 VALUE('*ESCAPE ')
0023.00 DCL VAR(&ERR) TYPE(*CHAR) LEN(1)
0024.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0025.00 VALUE(X'00000000')
0026.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0027.00 VALUE(X'000074') /* 2 進数 */
0028.00 /*( パネル・グループの変数 )*/
0029.00 DCL VAR(&HANDLE) TYPE(*CHAR) LEN(8) /* +
0030.00 摘要業務ハンドル */
0031.00 DCL VAR(&FNCTON) TYPE(*CHAR) LEN(4) +
0032.00 VALUE(X'00000000') /* 2 進数 */
0033.00 DCL VAR(&PANEL) TYPE(*CHAR) LEN(10)
0034.00 DCL VAR(&AGAIN) TYPE(*CHAR) LEN(1) VALUE(Y)
0035.00 DCL VAR(&USRTSK) TYPE(*CHAR) LEN(1) VALUE(N)
0036.00 DCL VAR(&STACK) TYPE(*CHAR) LEN(4) +
0037.00 VALUE(X'00000001') /* 2 進数 */
0038.00 DCL VAR(&UIMMSG) TYPE(*CHAR) LEN(10) VALUE(*CALLER)
0039.00 DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
0040.00 DCL VAR(&CSROPT) TYPE(*CHAR) LEN(1) VALUE(D)
0041.00 DCL VAR(&LASLST) TYPE(*CHAR) LEN(4) VALUE(NONE)
0042.00 DCL VAR(&ERRLST) TYPE(*CHAR) LEN(4)
0043.00 DCL VAR(&WAITTIME) TYPE(*CHAR) LEN(4) +
0044.00 VALUE(X'FFFFFFFF') /* 2 進数 */
0045.00 DCL VAR(&CF03) TYPE(*CHAR) LEN(4) +
0046.00 VALUE(X'FFFFFFFC') /* 2 進数 */
0047.00 DCL VAR(&CF05) TYPE(*CHAR) LEN(4) +
0048.00 VALUE(X'00000005') /* 2 進数 */
0049.00 DCL VAR(&CF06) TYPE(*CHAR) LEN(4) +
0050.00 VALUE(X'00000006') /* 2 進数 */
0051.00 DCL VAR(&CF12) TYPE(*CHAR) LEN(4) +
0052.00 VALUE(X'FFFFFFF8') /* 2 進数 */
0053.00 DCL VAR(&CF13) TYPE(*CHAR) LEN(4) +
0054.00 VALUE(X'0000000D') /* 2 進数 */
0055.00 DCL VAR(&CF14) TYPE(*CHAR) LEN(4) +
0056.00 VALUE(X'0000000E') /* 2 進数 */
0057.00 DCL VAR(&CF15) TYPE(*CHAR) LEN(4) +
0058.00 VALUE(X'0000000F') /* 2 進数 */
0059.00 DCL VAR(&CF17) TYPE(*CHAR) LEN(4) +
0060.00 VALUE(X'00000011') /* 2 進数 */
0061.00 DCL VAR(&CF18) TYPE(*CHAR) LEN(4) +
0062.00 VALUE(X'00000012') /* 2 進数 */
0063.00 DCL VAR(&VARDTA) TYPE(*CHAR) LEN(1024)
0064.00 DCL VAR(&VARRCD) TYPE(*CHAR) LEN(10)
0065.00 DCL VAR(&DTALEN) TYPE(*CHAR) LEN(4) +
0066.00 VALUE(X'0000003C') /* 2 進数 =60 */
0067.00 DCL VAR(&CSRVAR) TYPE(*CHAR) LEN(10) +
0068.00 VALUE('OPT ')
0069.00 DCL VAR(&CSRPOS) TYPE(*CHAR) LEN(2) VALUE(X'0001')
0070.00 DCL VAR(&CSRLST) TYPE(*CHAR) LEN(10) +
0071.00 VALUE('SFL ')
0072.00 DCL VAR(&CSRNAME) TYPE(*CHAR) LEN(10) +
0073.00 VALUE(' ')
0074.00 DCL VAR(&PNLGRPLIB) TYPE(*CHAR) LEN(20) +
0075.00 VALUE('WRKWINWTR WINDOWS ')
0076.00 DCL VAR(&AREA) TYPE(*CHAR) LEN(4) /* 2 進数 */
0077.00 DCL VAR(&EXITPG) TYPE(*CHAR) LEN(4) +
0078.00 VALUE(X'00000000') /* 2 進数 */
0079.00 DCL VAR(&OPT) TYPE(*CHAR) LEN(2) VALUE(X'0000')
0080.00 DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0)
0081.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0082.00
0083.00 /*( 環境の取得 )*/
0084.00 RTVJOBA TYPE(&TYPE)
0085.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0086.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0087.00 ENDDO /* バッチ */
0088.00 ELSE CMD(DO) /* 対話式 */
0089.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0090.00 ENDDO /* 対話式 */
0091.00
0092.00 /*( パラメータの取得 )*/
0093.00 CHGVAR VAR(&PNLGRP) VALUE(%SST(&PNLGRPLIB 01 10))
0094.00 CHGVAR VAR(&PNLLIB) VALUE(%SST(&PNLGRPLIB 11 10))
0095.00 CHGVAR VAR(&PGM) VALUE(%SST(&PGMOBJLIB 01 10))
0096.00 CHGVAR VAR(&OBJLIB) VALUE(%SST(&PGMOBJLIB 11 10))
0097.00
0098.00 /*( QUIOPNDA : パネル・グループのオープン )*/
0099.00 START: CHGVAR VAR(&DEC08) VALUE(-1)
0100.00 CHGVAR VAR(%BIN(&AREA)) VALUE(&DEC08)
0101.00 CALL PGM(QUIOPNDA) PARM(&HANDLE &PNLGRPLIB &AREA +
0102.00 &EXITPG 'N' &APIERR)
0103.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0104.00 SNDPGMMSG +
0105.00 MSG('API: QUHDSPH の実行で次のエラーが発生 +
0106.00 しました。 ') MSGTYPE(*DIAG)
0107.00 GOTO APIERR
0108.00 ENDDO
0109.00 /*( 実行キープログラムを指定 )*/
0110.00 CALL PGM(QUIPUTV) PARM(&HANDLE &PGMOBJLIB &DTALEN +
0111.00 'PGMRCD ' &APIERR)
0112.00 /*( リスト不完全出口プログラムを指定 )*/
0113.00 CALL PGM(QUISETLA) PARM(&HANDLE 'SFL ' 'TOP +
0114.00 ' 'EXITPGM ' 'SAME' 'N' &APIERR)
0115.00 CALL PGM(QUIPUTV) PARM(&HANDLE &PGMOBJLIB &DTALEN +
0116.00 'EXITRCD ' &APIERR)
0117.00 DSPLY:
0118.00 CALL PGM(QUIDSPP) PARM(&HANDLE &FNCTON &PANEL +
0119.00 &AGAIN &APIERR &USRTSK &STACK &UIMMSG +
0120.00 &MSGKEY &CSROPT &LASLST &ERRLST &WAITTIME)
0121.00 CHGVAR VAR(&MSGKEY) VALUE(' ')
0122.00 CHGVAR VAR(&CSROPT) VALUE('D')
0123.00 /*( CF03 )= 終了 */
0124.00 IF COND(&FNCTON *EQ &CF03) THEN(DO)
0125.00 GOTO CLOSE
0126.00 ENDDO
0127.00 /*( CF12 )= 取消し */
0128.00 IF COND(&FNCTON *EQ &CF12) THEN(DO)
0129.00 GOTO CLOSE
0130.00 ENDDO
0131.00 /*( 実行キー )*/
0132.00 GOTO DSPLY
0133.00
0134.00 /*( 適用業務のクローズ )*/
0135.00 CLOSE:
0136.00 CALL PGM(QUICLOA) PARM(&HANDLE 'M' &APIERR)
0137.00 RETURN
0138.00
0139.00
0140.00 APIERR:
0141.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0142.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0143.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0144.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0145.00 GOTO SNDMSG
0146.00
0147.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0148.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF)
0149.00 MSGFLIB(&MSGFLIB)
0150.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0151.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0152.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0153.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0154.00 ENDDO
0155.00 ELSE CMD(DO)
0156.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0157.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0158.00 MSGTYPE(&MSGTYPE)
0159.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0160.00 ENDDO
0161.00 ENDPGM
[解説]
追加したのは
0112.00 /*( リスト不完全出口プログラムを指定 )*/ 0113.00 CALL PGM(QUISETLA) PARM(&HANDLE 'SFL ' 'TOP + 0114.00 ' 'EXITPGM ' 'SAME' 'N' &APIERR) 0115.00 CALL PGM(QUIPUTV) PARM(&HANDLE &PGMOBJLIB &DTALEN + 0116.00 'EXITRCD ' &APIERR)
の部分である。
リスト(SFL)が不完全なときに呼び出される出口プログラムを定義している。
つまりこのパネル・グループが表示されるだけで定義済みの不完全出口プログラムが
自動的に呼び出されて実行されるのである。
EXITPGM とは
0107.00 :VARRCD NAME=EXITRCD VARS='EXITPGM WNDPMT TFRPNL'.
として定義している。
IBM は「不完全リスト」としか表現していないので理解に苦しむ人も多いのではないかと
思う。
「不完全リスト」とはリストしてまだ完成していない、つまりまだ表示しなければ
ならないデータが残っているという意味である。
それではどのようにして完全か不完全かを見分けるのかというと
リストの設定は QUISETLA でリストが不完全のときに呼び出す出口プログラムを
定義しておく。
そしてリストは最初に開いたときはすべて不完全な状態であるので
QUISETLA で定義した出口プログラムを呼び出してリストのレコードを
次々と追加してこれですべて揃ったのであれば、やはり QUISETLA で
このリストは完全であるとして ALL としてセットする。
つまり完全をセットしたことによりそのリストは完全なものとなり
これ以上不完全で口プログラムが呼び出されることはなくなる。
これが「不完全リスト」という意味なのであるが IBMマニュアルでは
そのような説明まではしていない。
それではその不完全出口プログラムを紹介しよう。
[ PNL003CL : 不完全出口プログラム ]
ソースはこちらから
001.00 PGM PARM(&RCVPRM)
002.00 /*-------------------------------------------------------------------*/
003.00 /* PNL003CL : 商品マスター照会 */
004.00 /* */
005.00 /* 2020/01/04 作成 */
006.00 /*-------------------------------------------------------------------*/
007.00 DCL VAR(&RCVPRM) TYPE(*CHAR) LEN(70)
008.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
009.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
010.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
011.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
012.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
013.00 DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
014.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
015.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
016.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
017.00 VALUE('*ESCAPE ')
018.00 DCL VAR(&ERR) TYPE(*CHAR) LEN(1)
019.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
020.00 VALUE(X'000074') /* 2 進数 */
021.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
022.00 VALUE(X'00000000')
023.00 /*( PNLGRP 変数 )*/
0024.00 DCL VAR(&HANDLE) TYPE(*CHAR) LEN(8) /* +
0025.00 摘要業務ハンドル */
0026.00 DCL VAR(&LHANDL) TYPE(*CHAR) LEN(4) /* +
0027.00 リストハンドル */
0028.00 DCL VAR(&LSTHND) TYPE(*CHAR) LEN(4) /* +
0029.00 リストハンドル */
0030.00 DCL VAR(&LSTNAM) TYPE(*CHAR) LEN(10)
0031.00 DCL VAR(&DSPDTA) TYPE(*CHAR) LEN(1024)
0032.00 DCL VAR(&DTALEN) TYPE(*CHAR) LEN(4) +
0033.00 VALUE(X'00000400') /* 2 進数 */
0034.00 DCLF FILE(QTRFIL/SHOHIN)
0035.00 DCL VAR(&SHTANK_C) TYPE(*CHAR) LEN(7)
0036.00 DCL VAR(&NO) TYPE(*DEC) LEN(4 0) VALUE(0)
0037.00 DCL VAR(&NORCD) TYPE(*CHAR) LEN(4)
0038.00 DCL VAR(&NOLEN) TYPE(*CHAR) LEN(4) +
0039.00 VALUE(X'00000004') /* 2 進数 */
0040.00 DCL VAR(&OPTION) TYPE(*CHAR) LEN(4) VALUE('FRST')
0041.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0042.00
0043.00 /*( 環境の取得 )*/
0044.00 RTVJOBA TYPE(&TYPE)
0045.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0046.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0047.00 ENDDO /* バッチ */
0048.00 ELSE CMD(DO) /* 対話式 */
0049.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0050.00 ENDDO /* 対話式 */
0051.00
0052.00 /*( 入力パラメータの取得 )*/
0053.00 CHGVAR VAR(&HANDLE) VALUE(%SST(&RCVPRM 17 8))
0054.00 CHGVAR VAR(&LSTNAM) VALUE(%SST(&RCVPRM 35 10))
0055.00 CHGVAR VAR(&LHANDL) VALUE(%SST(&RCVPRM 45 4))
0056.00
0057.00 READ: RCVF RCDFMT(SHOHINR)
0058.00 MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(REDEND))
0059.00 CHGVAR VAR(&SHTANK_C) VALUE(&SHTANK)
0060.00 CHGVAR VAR(&DSPDTA) VALUE(&SHCODE *CAT &SHNAME +
0061.00 *CAT &SHTANK_C *CAT &SHSCOD)
0062.00 CALL PGM(QTROBJ/PNL002) PARM(&DSPDTA &ERR &MSG)
0063.00 /*( リスト追加 )*/
0064.00 CHGVAR VAR(&NO) VALUE(&NO + 1)
0065.00 CHGVAR VAR(&NORCD) VALUE(&NO)
0066.00 CALL PGM(QUIPUTV) PARM(&HANDLE &NORCD &NOLEN +
0067.00 'NORCD ' &APIERR)
0068.00 CALL PGM(QUIADDLE) PARM(&HANDLE &DSPDTA &DTALEN +
0069.00 'SFLRCD' 'SFL' &OPTION &LSTHND &APIERR)
0070.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0071.00 SNDPGMMSG +
0072.00 MSG('API: QUIADDLE の実行で次のエラーが発生 +
0073.00 しました。 ') MSGTYPE(*DIAG)
0074.00 GOTO APIERR
0075.00 ENDDO
0076.00 CHGVAR VAR(&OPTION) VALUE('NEXT')
0077.00 GOTO READ
0078.00 REDEND:
0079.00 /*( すべてのセットを宣言 )*/
0080.00 CALL PGM(QUISETLA) PARM(&HANDLE 'SFL ' 'ALL +
0081.00 ' 'EXITPGM ' 'SAME' 'N' &APIERR)
0082.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0083.00 SNDPGMMSG +
0084.00 MSG('API: QUSETLA の実行で次のエラーが発生 +
0085.00 しました。 ') MSGTYPE(*DIAG)
0086.00 GOTO APIERR
0087.00 ENDDO
0088.00 RETURN
0089.00
0090.00
0091.00 APIERR:
0092.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0093.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0094.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0095.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0096.00 GOTO SNDMSG
0097.00
0098.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0099.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0100.00 MSGFLIB(&MSGFLIB)
0101.00 SNDMSG:
0102.00 IF COND(&MSGID *EQ ' ') THEN(DO)
0103.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0104.00 TOMSGQ(*TOPGMQ) MSGTYPE(*ESCAPE)
0105.00 ENDDO
0106.00 ELSE CMD(DO)
0107.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0108.00 MSGDTA(&MSGDTA) TOMSGQ(*TOPGMQ) +
0109.00 MSGTYPE(*ESCAPE)
0110.00 ENDDO
0111.00 ENDPGM
[解説]
0034.00 DCLF FILE(QTRFIL/SHOHIN)
で商品マスター(QTRFIL/SHOHIN)を定義しておいて
0057.00 READ: RCVF RCDFMT(SHOHINR) 0058.00 MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(REDEND)) : 0077.00 GOTO READ 0078.00 REDEND:
で商品レコード: SHOHINR を読み取って
0062.00 CALL PGM(QTROBJ/PNL002) PARM(&DSPDTA &ERR &MSG)
で入出力バッファーをセットして….この PNL002 は単票照会のときに使った
同じプログラムである。
0068.00 CALL PGM(QUIADDLE) PARM(&HANDLE &DSPDTA &DTALEN + 0069.00 'SFLRCD' 'SFL' &OPTION &LSTHND &APIERR)
でリストにSFLレコードを追加している。
この
0062.00 CALL PGM(QTROBJ/PNL002) PARM(&DSPDTA &ERR &MSG)
だけがこのプログムの「個性」であり極めて汎用的な仕上がりになっていることに
注意して欲しい。
このように社内である程度共通のルール化をしてしまえば
ほとんどパネル・グループを作るだけの労力だけでほとんどのオブジェクトは
再利用することによって適用業務を構築することができる。
このようにパネル・グループを使ってオブジェクト指向の開発を行うと
・多くのオブジェクトの再利用が可能になる。
・テスト済みの品質保証されたオブジェクトを利用するので
短期間で高品質の適用業務の開発が可能である。
少し前にオブジェクトの再利用のためにSOA(=Service Oriented Archtechture )
と呼ばれるXMLで機能を公開するための構成が注目されたのだが
SOA化する労力と費用があまりにも莫大なため
普及することはなかった。しかし、
パネル・グループのよるオブジェクト指向型の適用業務であれば
既存のシステムを再構築することなく再利用可能で高品質な
適用業務を短期間のうちに構築することができる。
このようなオブジェクト指向が何と30年以上も前にIBMによって開発されており
そしてこの考えは今なお新しい。