55. 入出力レコードを表示する DSPPGMSTK
WRKACTJOB でプログラム実行スタックを見たことは何度もあるはずだ。
しかし肝心のスタックの部分が QWSGET とか「.DRV..」とかでは
何やら意味不明である。
IBM も表示するなら意味のある情報を表示して欲しい。
開発者が知りたいのは、
- プログラムのどのステップで停止しているのか?
- 現在、入出力中の表示レコードは何か?
という２点に尽きるだろう。
そこで DSPPGMSTK というプログラムのスタックを表示するコマンドを
自作してみた。
コマンド: DSPPGMSTK の実行
プログラム・スタックの表示 (DSPPGMSTK)
選択項目を入力して，実行キーを押してください。
ジョブ名 . . . . . . . . . . . QPADEV0003 名前 , *
ユーザー . . . . . . . . . . QTR 名前
番号 . . . . . . . . . . . . 695047 000000-999999
【 説明 】
ジョブ名, ユーザー, 番号は手入力するのは面倒なので
WRKACTJOB で対象ジョブを見つけて「2= 変更」で表示されるプロンプト画面の一部を
コピーしてから DSPPGMSTK を起動して張り付けるとよい。
実行結果
DSPPGMSTK プログラム・スタックの表示
システム : XXXXXXXX
ジョブ : QPADEV0003 ユーザー : QTR 番号 : 695047
選択項目を入力して実行キーを押してください。
5= 表示
OPT № プログラム STMT 命令 レコード
1 QCMD QSYS
2 QUICMENU QSYS
3 QUIMNDRV QSYS
4 QUIMGFLW QSYS
5 QUICMD QSYS
6 QCMD QSYS
7 PGM201 QTROBJ 9900 EXFMT SFCTL01
【 説明 】
この表示であればプログラム PGM201 のステートメント 99.00 の EXFMT 命令で
停止していることが非常によく理解できる。
さらに「5=表示」を選択すると
プログラム・スタックの表示
システム : XXXXXXXX
ジョブ : QPADEV0003 ユーザー : QTR 番号 : 695047
確認して，実行キーを押してください。
プログラム . . . . : PGM201 QTROBJ
ソース・ファイル . : QRPGLESRC QTRSRC
ソース・メンバー . : PGM201
STMT . . . . . . . : 9900
命令 . . . . . . . : EXFMT
レコード . . . . . : SFCTL01
表示ファイル . . . : PGM201FM QTROBJ
F3= 終了 F5= プログラム・ソースの編集 F12= 取消し
【 説明 】
「5=表示」によってさらに詳細な情報が表示されて
DSPF の名前も知ることができる。
今までのスタック情報とはかなり進化している。
「F5= プログラム・ソースの編集」キーを押すと SEU が開始されて
RPG ソースが表示されるので直ちに解析を開始することができる、という
スグレものである。
これはもちろん製品: AutoWeb の一部の機能であり、ユーザーであれば
GO SERVERメニューの
「9. プログラム・スタックの表示 DSPPGMSTK」
によって このプログラムを利用することができる。
【 コマンド: DSPPGMSTK 】
0001.00 CMD PROMPT(' プログラム・スタックの表示 ')
0002.00 PARM KWD(JOB) TYPE(JOB) DFT(*) SNGVAL((*)) +
0003.00 PROMPT(' ジョブ名 ')
0004.00 JOB: QUAL TYPE(*NAME) LEN(10) MIN(1)
0005.00 QUAL TYPE(*NAME) LEN(10) MIN(1) PROMPT(' ユーザー ')
0006.00 QUAL TYPE(*CHAR) LEN(6) RANGE(000000 999999) +
0007.00 PROMPT(' 番号 ')
【 PNLGRP: DSPPGMSTK 】
0001.00 .*******************************************************************
0002.00 .*
0003.00 .* PANEL GRP NAME: DSPPGMSTK
0004.00 .*
0005.00 .* TEXT : プログラム・スタックの表示
0006.00 .*
0007.00 .* TYPE : 処置リスト・パネル
0008.00 .*
0009.00 .* PRIMARY FILE : #FILE
0010.00 .* LIBRARY : #FILLIB
0011.00 .* MEMBER : #FILMBR
0012.00 .*
0013.00 .* 作成日 : 2017/06/03 10:23:00
0014.00 .*
0015.00 .* 作成ユーザー : QTR DSP01
0016.00 .*
0017.00 .* 変更日 : 2017/06/03 10:23:00
0018.00 .*
0019.00 .* 変更ユーザー : QTR DSP01
0020.00 .*
:
0462.00 :EDATA.
0463.00 :EPANEL.
0464.00 :EPNLGRP.
【 解説 】
パネル・グループ (*PNLGRP) とは DSPF の代わりとなるインターフェースである。
IBM のユーティリティーの 90% 以上はパネル・グループ (*PNLGRP) でできている。
パネル・グループ (*PNLGRP) のコンパイルは
CRTPNLGRP PNLGRP(MYLIB/DSPPGMSTK)
SRCFILE(MYSRCLIB/QPNLSRC) AUT(*ALL)
SRCFILE(MYSRCLIB/QPNLSRC) AUT(*ALL)
【 CLP: DSPPGMSTKC 】
0001.00 PGM PARM(&JOBINFO)
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* DSPPGMSTK : プログラム・スタックの表示 */
0004.00 /* */
0005.00 /* 2017/06/02 作成 */
0006.00 /*-------------------------------------------------------------------*/
0007.00 DCL VAR(&JOBINFO) TYPE(*CHAR) LEN(26)
0008.00 DCL VAR(&JOB) TYPE(*CHAR) LEN(10)
0009.00 DCL VAR(&USER) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&NBR) TYPE(*CHAR) LEN(6)
0011.00 DCL VAR(&JOBID) TYPE(*CHAR) LEN(16)
0012.00 DCL VAR(&INF0100) TYPE(*CHAR) LEN(512)
0013.00 DCL VAR(&INFSIZ) TYPE(*CHAR) LEN(4)
0014.00 DCL VAR(&DSPF) TYPE(*CHAR) LEN(10)
0015.00 DCL VAR(&DSPFLIB) TYPE(*CHAR) LEN(10)
0016.00 DCL VAR(&DSPRCD) TYPE(*CHAR) LEN(10)
0017.00 DCL VAR(&ACTRCD) TYPE(*CHAR) LEN(10)
0018.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0019.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0020.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0021.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0022.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0023.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0024.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0025.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0026.00 VALUE('*ESCAPE ')
0027.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0028.00 VALUE(X'000074') /* 2 進数 */
0029.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0030.00 VALUE(X'00000000')
0031.00 DCL VAR(&SYSTEM) TYPE(*CHAR) LEN(8)
0032.00 /*( PNLGRP 変数 )*/
0033.00 DCL VAR(&HANDLE) TYPE(*CHAR) LEN(8) /* +
0034.00 摘要業務ハンドル */
0035.00 DCL VAR(&LSTHND) TYPE(*CHAR) LEN(4) /* +
0036.00 リスト・ハンドル */
0037.00 DCL VAR(&CSROPT) TYPE(*CHAR) LEN(1) VALUE(D)
0038.00 DCL VAR(&PANEL) TYPE(*CHAR) LEN(10)
0039.00 DCL VAR(&FNCTON) TYPE(*CHAR) LEN(4) +
0040.00 VALUE(X'00000000') /* 2 進数 */
0041.00 DCL VAR(&AGAIN) TYPE(*CHAR) LEN(1) VALUE(Y)
0042.00 DCL VAR(&USRTSK) TYPE(*CHAR) LEN(1) VALUE(N)
0043.00 DCL VAR(&STACK) TYPE(*CHAR) LEN(4) +
0044.00 VALUE(X'00000001') /* 2 進数 */
0045.00 DCL VAR(&UIMMSG) TYPE(*CHAR) LEN(10) VALUE(*CALLER)
0046.00 DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
0047.00 DCL VAR(&LASLST) TYPE(*CHAR) LEN(4) VALUE(NONE)
0048.00 DCL VAR(&ERRLST) TYPE(*CHAR) LEN(4)
0049.00 DCL VAR(&WAITTIME) TYPE(*CHAR) LEN(4) +
0050.00 VALUE(X'FFFFFFFF') /* 2 進数 */
0051.00 DCL VAR(&CF03) TYPE(*CHAR) LEN(4) +
0052.00 VALUE(X'FFFFFFFC') /* 2 進数 */
0053.00 DCL VAR(&CF05) TYPE(*CHAR) LEN(4) +
0054.00 VALUE(X'00000005') /* 2 進数 */
0055.00 DCL VAR(&CF12) TYPE(*CHAR) LEN(4) +
0056.00 VALUE(X'FFFFFFF8') /* 2 進数 */
0057.00 DCL VAR(&DTALEN) TYPE(*CHAR) LEN(4) /* 2 進数 */
0058.00 DCL VAR(&VARRCD) TYPE(*CHAR) LEN(10)
0059.00 DCL VAR(&AREA) TYPE(*CHAR) LEN(4) /* 2 進数 */
0060.00 DCL VAR(&EXITPG) TYPE(*CHAR) LEN(4) +
0061.00 VALUE(X'00000000') /* 2 進数 */
0062.00 DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0)
0063.00 DCLF FILE(QTEMP/QPDSPJOB) RCDFMT(*ALL)
0064.00 DCL VAR(&NO) TYPE(*DEC) LEN(6 0) VALUE(1)
0065.00 DCL VAR(&NOC) TYPE(*CHAR) LEN(6)
0066.00 DCL VAR(&PGM) TYPE(*CHAR) LEN(21)
0067.00 DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
0068.00 DCL VAR(&STMT) TYPE(*CHAR) LEN(8)
0069.00 DCL VAR(&RPG) TYPE(*CHAR) LEN(10)
0070.00 DCL VAR(&CHGVAR) TYPE(*CHAR) LEN(1) VALUE('0')
0071.00 DCL VAR(&OPT) TYPE(*CHAR) LEN(2)
0072.00 DCL VAR(&SFLDTA) TYPE(*CHAR) LEN(1024)
0073.00 DCL VAR(&USRAPP) TYPE(*CHAR) LEN(1) VALUE(' ')
0074.00 /*( QCLSCAN 変数 )*/
0075.00 DCL VAR(&STRLEN) TYPE(*DEC) LEN(3 0) VALUE(132)
0076.00 DCL VAR(&STRPOS) TYPE(*DEC) LEN(3 0) VALUE(1)
0077.00 DCL VAR(&PATLEN) TYPE(*DEC) LEN(3 0) VALUE(14)
0078.00 DCL VAR(&RESULT) TYPE(*DEC) LEN(3 0)
0079.00 DCL VAR(&DSPFFLIB) TYPE(*CHAR) LEN(21)
0080.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0081.00
0082.00 /*( 環境の取得 )*/
0083.00 RTVJOBA TYPE(&TYPE)
0084.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0085.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0086.00 ENDDO /* バッチ */
0087.00 ELSE CMD(DO) /* 対話式 */
0088.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0089.00 ENDDO /* 対話式 */
0090.00 RTVNETA SYSNAME(&SYSTEM)
0091.00
0092.00 AGAIN:
0093.00 /*( パラメータの取得 )*/
0094.00 CHGVAR VAR(&JOB) VALUE(%SST(&JOBINFO 01 10))
0095.00 CHGVAR VAR(&USER) VALUE(%SST(&JOBINFO 11 10))
0096.00 CHGVAR VAR(&NBR) VALUE(%SST(&JOBINFO 21 6))
0097.00
0098.00 /*( QWSRTVOI : 最後に出力された活動レコードを取得する )*/
0099.00 CHGVAR VAR(%BIN(&INFSIZ)) VALUE(512)
0100.00 CALL PGM(QWSRTVOI) PARM(&INF0100 &INFSIZ +
0101.00 'OINF0100' &JOBINFO &JOBID &APIERR)
0102.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0103.00 SNDPGMMSG +
0104.00 MSG('API: QWSRTVOI の実行で次のエラーが発生 +
0105.00 しました。 ') MSGTYPE(*DIAG)
0106.00 GOTO APIERR
0107.00 ENDDO
0108.00 CHGVAR VAR(&DSPF) VALUE(%SST(&INF0100 09 10))
0109.00 CHGVAR VAR(&DSPFLIB) VALUE(%SST(&INF0100 19 10))
0110.00 CHGVAR VAR(&DSPFFLIB) VALUE(&DSPF *CAT ' ' *CAT +
0111.00 &DSPFLIB)
0112.00 CHGVAR VAR(&ACTRCD) VALUE(%SST(&INF0100 29 10))
0113.00
0114.00 /*( QTEMP/QPDSPJOB ファイルの作成 )*/
0115.00 CHKOBJ OBJ(QTEMP/QPDSPJOB) OBJTYPE(*FILE)
0116.00 MONMSG MSGID(CPF9800) EXEC(DO)
0117.00 CRTPF FILE(QTEMP/QPDSPJOB) RCDLEN(132) +
0118.00 IGCDTA(*YES) LVLCHK(*NO) AUT(*ALL)
0119.00 ENDDO
0120.00
0121.00 /*( DSPJOB : 呼出しスタックの表示 )*/
0122.00 OVRPRTF FILE(QPDSPJOB) HOLD(*YES) SECURE(*YES) +
0123.00 OVRSCOPE(*JOB)
0124.00 DSPJOB JOB(&NBR/&USER/&JOB) OUTPUT(*PRINT) +
0125.00 OPTION(*PGMSTK)
0126.00 DLTOVR FILE(QPDSPJOB) LVL(*JOB)
0127.00 CPYSPLF FILE(QPDSPJOB) TOFILE(QTEMP/QPDSPJOB) +
0128.00 SPLNBR(*LAST) MBROPT(*REPLACE)
0129.00 DLTSPLF FILE(QPDSPJOB) JOB(*) SPLNBR(*LAST)
0130.00 RCVMSG PGMQ(*SAME) MSGTYPE(*LAST) RMV(*YES)
0131.00
0132.00 /*( QUIOPNDA : パネル・グループのオープン )*/
0133.00 CHGVAR VAR(&DEC08) VALUE(-1)
0134.00 CHGVAR VAR(%BIN(&AREA)) VALUE(&DEC08)
0135.00 CALL PGM(QUIOPNDA) PARM(&HANDLE 'DSPPGMSTK +
0136.00 ASNET.COM ' &AREA &EXITPG 'N' &APIERR)
0137.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0138.00 SNDPGMMSG +
0139.00 MSG('API: QUIOPNDA の実行で次のエラーが発生 +
0140.00 しました。 ') MSGTYPE(*DIAG)
0141.00 GOTO APIERR
0142.00 ENDDO
0143.00 /*( 変数のセット )*/
0144.00 CHGVAR VAR(&SFLDTA) VALUE(&SYSTEM)
0145.00 CHGVAR VAR(%BIN(&DTALEN)) VALUE(10)
0146.00 CALL PGM(QUIPUTV) PARM(&HANDLE &SFLDTA &DTALEN +
0147.00 'SYSRCD ' &APIERR)
0148.00 CHGVAR VAR(&SFLDTA) VALUE(&JOB)
0149.00 CALL PGM(QUIPUTV) PARM(&HANDLE &SFLDTA &DTALEN +
0150.00 'JOBRCD ' &APIERR)
0151.00 CHGVAR VAR(&SFLDTA) VALUE(&USER)
0152.00 CALL PGM(QUIPUTV) PARM(&HANDLE &SFLDTA &DTALEN +
0153.00 'USRRCD ' &APIERR)
0154.00 CHGVAR VAR(&SFLDTA) VALUE(&NBR)
0155.00 CHGVAR VAR(%BIN(&DTALEN)) VALUE(6)
0156.00 CALL PGM(QUIPUTV) PARM(&HANDLE &SFLDTA &DTALEN +
0157.00 'NBRRCD ' &APIERR)
0158.00 CHGVAR VAR(%BIN(&DTALEN)) VALUE(20)
0159.00 CALL PGM(QUIPUTV) PARM(&HANDLE 'PGMSTKCL +
0160.00 ASNET.COM ' &DTALEN 'PGMRCD ' &APIERR)
0161.00
0162.00 /*( プログラム・スタックの読取り )*/
0163.00 READ: RCVF RCDFMT(QPDSPJOB)
0164.00 MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(REDEND))
0165.00 IF COND((%SST(&QPDSPJOB 74 10) = '*DFTACTGRP') +
0166.00 *OR (%SST(&QPDSPJOB 74 10) = '*NEW') *OR +
0167.00 (%SST(&QPDSPJOB 74 10) = 'QILE')) THEN(DO)
0168.00 CHGVAR VAR(&PGM) VALUE(%SST(&QPDSPJOB 8 21))
0169.00 CHGVAR VAR(&OBJLIB) VALUE(%SST(&QPDSPJOB 19 10))
0170.00 CHGVAR VAR(&STMT) VALUE(%SST(&QPDSPJOB 32 8))
0171.00 IF COND((&OBJLIB *NE 'QSYS ') *AND (&STMT +
0172.00 *EQ ' ')) THEN(DO)
0173.00 GOTO READ
0174.00 ENDDO
0175.00 CHGVAR VAR(&NOC) VALUE(&NO)
0176.00 ZERO: IF COND(%SST(&NOC 1 1) *EQ '0') THEN(DO)
0177.00 CHGVAR VAR(&NOC) VALUE(%SST(&NOC 2 5))
0178.00 GOTO ZERO
0179.00 ENDDO
0180.00 /*( SFLRCD に明細行を追加 )*/
0181.00 CHGVAR VAR(%BIN(&DTALEN)) VALUE(1024)
0182.00 CHGVAR VAR(%BIN(&OPT)) VALUE(0)
0183.00 /*( 最後の活動ユーザーにレコード名を更新する )*/
0184.00 IF COND((&OBJLIB *EQ 'QSYS ') *AND (&USRAPP +
0185.00 *EQ '1')) THEN(DO)
0186.00 CHGVAR VAR(%SST(&SFLDTA 48 10)) VALUE(&ACTRCD)
0187.00 CHGVAR VAR(%SST(&SFLDTA 58 21)) VALUE(&DSPFFLIB)
0188.00 CALL PGM(QUIUPDLE) PARM(&HANDLE &SFLDTA &DTALEN +
0189.00 'SFLRCD ' 'SFL ' 'SAME' &LSTHND +
0190.00 &APIERR)
0191.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0192.00 SNDPGMMSG +
0193.00 MSG('API: QUIUPDLE の実行で次のエラーが発生 +
0194.00 しました。 ') MSGTYPE(*DIAG)
0195.00 GOTO APIERR
0196.00 ENDDO
0197.00 ENDDO
0198.00
0199.00 /*( レコードの追加 )*/
0200.00 IF COND((&OBJLIB *EQ 'QSYS ') *AND +
0201.00 (&USRAPP *EQ '1')) THEN(DO)
0202.00 GOTO READ
0203.00 ENDDO
0204.00
0205.00 IF COND(&OBJLIB *NE 'QSYS ') THEN(DO)
0206.00 CHGVAR VAR(&USRAPP) VALUE('1')
0207.00 ENDDO
0208.00 IF COND(%SST(&STMT 1 8) *EQ '.DRVRX01') THEN(DO)
0209.00 CHGVAR VAR(&RPG) VALUE('EXFMT ')
0210.00 ENDDO
0211.00 CHGVAR VAR(&SFLDTA) VALUE(&OPT *CAT &NOC *CAT &PGM +
0212.00 *CAT &STMT *CAT &RPG *CAT &DSPRCD *CAT +
0213.00 &CHGVAR *CAT &OPT)
0214.00 CALL PGM(QUIADDLE) PARM(&HANDLE &SFLDTA &DTALEN +
0215.00 'SFLRCD ' 'SFL ' 'LAST' &LSTHND +
0216.00 &APIERR)
0217.00 CHGVAR VAR(&NO) VALUE(&NO + 1)
0218.00 ENDDO
0219.00 /*( EXFMT 検査 )*/
0220.00 IF COND(&USRAPP *EQ '1') THEN(DO)
0221.00 CHGVAR VAR(&PATLEN) VALUE(14)
0222.00 CALL PGM(QCLSCAN) PARM(&QPDSPJOB &STRLEN &STRPOS +
0223.00 '_QRNX_WS_EXFMT' &PATLEN ' ' ' ' ' ' &RESULT)
0224.00 IF COND(&RESULT *GT 0) THEN(DO)
0225.00 CHGVAR VAR(&RPG) VALUE('EXFMT ')
0226.00 CHGVAR VAR(%SST(&SFLDTA 38 10)) VALUE(&RPG)
0227.00 CALL PGM(QUIUPDLE) PARM(&HANDLE &SFLDTA &DTALEN +
0228.00 'SFLRCD ' 'SFL ' 'SAME' &LSTHND +
0229.00 &APIERR)
0230.00 GOTO READ
0231.00 ENDDO
0232.00 ENDDO
0233.00
0234.00 GOTO READ
0235.00 REDEND:
0236.00
0237.00 /*( QUIDSPP : パネル表示 )*/
0238.00 START:
0239.00 CHGVAR VAR(&CSROPT) VALUE('D')
0240.00 CHGVAR VAR(&PANEL) VALUE('DSPTOP ')
0241.00 CALL PGM(QUIDSPP) PARM(&HANDLE &FNCTON &PANEL +
0242.00 &AGAIN &APIERR &USRTSK &STACK &UIMMSG +
0243.00 &MSGKEY &CSROPT &LASLST &ERRLST &WAITTIME)
0244.00 CHGVAR VAR(&MSGKEY) VALUE(' ')
0245.00 /*( CF03 )= 終了 */
0246.00 IF COND(&FNCTON *EQ &CF03) THEN(DO)
0247.00 GOTO CLOSE
0248.00 ENDDO
0249.00 /*( CF05 )= 再表示 */
0250.00 IF COND(&FNCTON *EQ &CF05) THEN(DO)
0251.00 CALL PGM(QUICLOA) PARM(&HANDLE 'M' &APIERR)
0252.00 GOTO AGAIN
0253.00 ENDDO
0254.00 /*( CF12 )= 取消し */
0255.00 IF COND(&FNCTON *EQ &CF12) THEN(DO)
0256.00 GOTO CLOSE
0257.00 ENDDO
0258.00 /*( 実行キー )*/
0259.00 GOTO START
0260.00
0261.00 /*( 適用業務のクローズ )*/
0262.00 CLOSE:
0263.00 CALL PGM(QUICLOA) PARM(&HANDLE 'M' &APIERR)
0264.00 RETURN
0265.00 RETURN
0266.00
0267.00 APIERR:
0268.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0269.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0270.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0271.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0272.00 GOTO SNDMSG
0273.00
0274.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0275.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0276.00 MSGFLIB(&MSGFLIB)
0277.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0278.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0279.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0280.00 ENDDO
0281.00 ELSE CMD(DO)
0282.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0283.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0284.00 MSGTYPE(&MSGTYPE)
0285.00 ENDDO
0286.00 ENDPGM
【 解説 】
動作原理としては
0124.00 DSPJOB JOB(&NBR/&USER/&JOB) OUTPUT(*PRINT) + 0125.00 OPTION(*PGMSTK)
で、プログラム・スタックを出力して
0162.00 /*( プログラム・スタックの読取り )*/ 0163.00 READ: RCVF RCDFMT(QPDSPJOB)
で、そのファイルを読み取って
0214.00 CALL PGM(QUIADDLE) PARM(&HANDLE &SFLDTA &DTALEN + 0215.00 'SFLRCD ' 'SFL ' 'LAST' &LSTHND + 0216.00 &APIERR)
によってパネル・グループ (*PNLGRP) の明細行にレコードを追加するのであるが
あらかじめ
0098.00 /*( QWSRTVOI : 最後に出力された活動レコードを取得する )*/ 0099.00 CHGVAR VAR(%BIN(&INFSIZ)) VALUE(512) 0100.00 CALL PGM(QWSRTVOI) PARM(&INF0100 &INFSIZ + 0101.00 'OINF0100' &JOBINFO &JOBID &APIERR)
によって最後に出力された表示レコード名を調べておいて、これを
0227.00 CALL PGM(QUIUPDLE) PARM(&HANDLE &SFLDTA &DTALEN + 0228.00 'SFLRCD ' 'SFL ' 'SAME' &LSTHND + 0229.00 &APIERR)
で更新することによって表示レコードがプログラム・スタック表示として
表示される、というストーリーである。
