Tools

46. 実行ジョブの画面サイズを調べる RTVDSPSIZ

ある適用業務は *DS4 27*132 の環境下で動作するように設計されているとする。
うかつに *DS3 24*80 の環境でこのプログラムをエンド・ユーザーが起動すると
たちまちエラーCPF4169によってアベンドしてしまう。

エンド・ユーザーに不審な思いをさせたくないようにするにはどのようにすればよいだろうか ?
RPG の中で *INZSR サブルーチンの中でプログラムが起動される前にチェックしたいのだが
*INZSR の中では DSPFは既にオープンされているので、
今回の問題は *INZSR が実行される前にエラーとなってしまう。

それならば *PSSR サブルーチンでモニターしようとしても、やはり *PSSR に行く前にエラーとなってしまう。
であればRPGが起動される前に検査する必要がある。
ところが RTVJOBA や DSPJOB を実行してみても現在、起動している5250エミュレータが
どの画面サイズで実行されているかの情報は見つからない。
確かに RPG の INFDS の内部では

  D INFDS           DS                 
  D  NUM_ROWS             282    283B 0
  D  NUM_COLS             284    285B 0	

のようにして現在、実行中のDSPFの画面サイズを取得できるはずであるので
どこかで取得できる方法はあるはずである。
RPG では取得しようにも132桁で定義されているDSPFを暗黙的にオープンする前に
エラーとなってしまうのでこの方法は採用できない。

現在、実行中の画面サイズを取得するコマンドは用意されていない。
実はこの機能を提供するAPI は動的画面管理API の中の

QsnRtvScrDim

という名前の関数のみであるが、これはプログラム名ではなくサービス・プログラム
QSNAPI から公開されている関数(プロシージャー)である。
従って CALL 命令では呼び出すことはできない。
そこで C言語でこの関数を呼び出すプログラムを開発することになるのだが
IBM i の開発者では C言語はわからないという人が多いので
今回は CLP (CLLE) によってこの関数を呼びだすようにした。

【コマンド: RTVDSPSIZ】
CMD        PROMPT(' 画面寸法の検索 ')                  
PARM       KWD(LINS) TYPE(*DEC) LEN(2 0) RTNVAL(*YES) +
             PROMPT(' 行数 ')                          
PARM       KWD(COLS) TYPE(*DEC) LEN(3 0) RTNVAL(*YES) +
             PROMPT(' 桁数 ')                          
【コンパイル】
CRTCMD CMD(MYLIB/RTVDSPSIZ) PGM(MYLIB/RTVDSPSIZ) SRCFILE(MYSRCLIB/QCMDSRC) ALLOW(*BPGM *IPGM) AUT(*ALL)
【解説】

コマンド : RTVDSPSIZ は RTNVAL(*YES)で示されているように
画面サイズの行(LINS)と桁(COLS)の値を返すので
実行時の環境はバッチのみであるとして

ALLOW(*BPGM *IPGM)

の指定が必要である。

【CLP: RTVDSPSIZ】
             PGM        PARM(&LIND &COLD)                               
/*-------------------------------------------------------------------*/ 
/*   RTVDSPSIZ :  DSPF サイズの検索                                  */ 
/*                                                                   */ 
/*   2016/03/12  作成                                                */ 
/*   COMPILE:    CRTBNDCL OBJLIB/RTVDSPSIZ                           */ 
/*               SRCFILE(MYSRCLIB/QCLLESRC)                          */ 
/*               DFTACTGRP(*NO) ACTGRP(*NEW) AUT(*ALL)               */ 
/*                                                                   */ 
/*-------------------------------------------------------------------*/ 
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                  
             DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                  
             DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                  
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)               
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)               
             DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                   
             DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)                
             DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +             
                          VALUE(X'000074') /* 2 進数  */                
             DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                
                          VALUE(X'00000000')                         
             DCL        VAR(&LIN) TYPE(*CHAR) LEN(4)                 
             DCL        VAR(&COL) TYPE(*CHAR) LEN(4)                 
             DCL        VAR(&DEC08) TYPE(*DEC) LEN(8 0)              
             DCL        VAR(&LIND) TYPE(*DEC) LEN(2 0)               
             DCL        VAR(&COLD) TYPE(*DEC) LEN(3 0)               
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))      
                                                                     
             RTVJOBA    TYPE(&TYPE)                                  
             IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */  
             CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')             
             ENDDO      /*  バッチ  */                               
             ELSE       CMD(DO) /*  対話式  */                       
             CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')             
             ENDDO      /*  対話式  */                               
             CALLPRC    PRC('QsnRtvScrDim') PARM((&LIN) (&COL) (0) + 
                          (&APIERR))                                 
             IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)  
             SNDPGMMSG  +                                            
             MSG('API: QsnRtvScrDim の実行で次のエラーが発生 +       
                           しました。 ') MSGTYPE(*DIAG)              
             GOTO       APIERR                                         
             ENDDO                                                     
             CHGVAR     VAR(&DEC08) VALUE(%BIN(&LIN))                  
             CHGVAR     VAR(&LIND) VALUE(&DEC08)                       
             CHGVAR     VAR(&DEC08) VALUE(%BIN(&COL))                  
             CHGVAR     VAR(&COLD) VALUE(&DEC08)                       
             RETURN                                                    
                                                                       
 APIERR:                                                               
             CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))           
             CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))       
             CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')                 
             CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')              
             GOTO       SNDMSG                                         
 ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +            
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +  
                          MSGFLIB(&MSGFLIB)                            
 SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                  
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +    
                          TOMSGQ(&TOPGMQ) MSGTYPE(*ESCAPE)             
             ENDDO                                                     
             ELSE       CMD(DO)                              
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + 
                          MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +  
                          MSGTYPE(*ESCAPE)                   
             ENDDO                                           
             ENDPGM                                          
【コンパイル】
CRTBNDCL PGM(MYLIB/RTVDSPSIZ) SRCFILE(MYSRCFILE/QCLLESRC) DFTACTGRP(*NO)  ACTGRP(*NEW) AUT(*ALL)

参考までに

CRTCLMOD QTEMP/RTVDSPSIZ SRCFILE(MYSRCFILE/QCLLESRC) AUT(*ALL)
さらに

CRTPGM MYLIB/RTVDSPSIZ MODULE(QTEMP/RTVDSPSIZ) BNDSRVPGM(QSYS/QSNAPI) AUT(*ALL)
でもよい。CRTBNDCL なら一回のコンパイルだけで済む。

【解説】

実行しているのは

		
 CALLPRC    PRC('QsnRtvScrDim') PARM((&LIN) (&COL) (0) + 
                          (&APIERR))

の部分だけであって他は大部分がこのプログラムにエラーが発生したときのモニターである。
この CLP は、対話式、バッチ・ジョブや例外的な多くのエラーをモニターできるように
設計されているので社内で CLP を開発するときの参考にしてほしい。

【使用例】
             PGM                                                       
/*-------------------------------------------------------------------*/
/*   PHOTOCL   : SFL 写真画像                                        */
/*                                                                   */
/*   2016/03/12  作成                                                */
/*-------------------------------------------------------------------*/
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                 
             DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                 
             DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                 
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)              
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)              
             DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                  
             DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)               
             DCL        VAR(&LIN) TYPE(*DEC) LEN(2 0)                  
             DCL        VAR(&COL) TYPE(*DEC) LEN(3 0)                  
             MONMSG     MSGID(CPF0000 RNX0000) EXEC(GOTO CMDLBL(ERROR))
                                                                       
             RTVJOBA    TYPE(&TYPE)                                    
             IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */    
             CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')               
             ENDDO      /*  バッチ  */                                 
             ELSE       CMD(DO) /*  対話式  */                         
             CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')               
             ENDDO      /*  対話式  */                                 
             RTVDSPSIZ  LINS(&LIN) COLS(&COL)                
             IF         COND(&COL *NE 132) THEN(DO)                    
             CHGVAR     VAR(&MSG) +                                    
                          VALUE(' 実行するには 132 桁の環境が必要で +  
                           す。 ')                                     
             GOTO       SNDMSG                                         
             ENDDO                                                     
             CALL       PGM(QTROBJ/PHOTO)                              
             RETURN                                                    
                                                                       
 ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +            
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +  
                          MSGFLIB(&MSGFLIB)                            
 SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                  
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +    
                          TOMSGQ(&TOPGMQ) MSGTYPE(*ESCAPE)             
             ENDDO                                                     
             ELSE       CMD(DO)                               
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +  
                          MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +   
                          MSGTYPE(*ESCAPE)                    
             ENDDO                                            
             ENDPGM                                           
【解説】

このCLPは *DS4 27*132 の環境下での実行を必要としているので
プログラムを呼び出す前に今の環境が *DS4 27*132 であるかどうかを
RTVDSPSIZ を使って調べている。

RTVDSPSIZ を使っているのは

             RTVDSPSIZ  LINS(&LIN) COLS(&COL)                
             IF         COND(&COL *NE 132) THEN(DO)                    
             CHGVAR     VAR(&MSG) +                                    
                          VALUE(' 実行するには 132 桁の環境が必要で +  
                           す。 ')                                     
             GOTO       SNDMSG                                         
             ENDDO

の部分である。
RTVDSPSIZを使って取得した桁数が 132 でない場合は
エラー・メッセージを出力して終了するようにしている。

※動的画面管理APIについて

API の中で「動的画面管理API」というジャンルがあって
多くの読者はこれが何であるか不明であろうと推測されるので簡単な説明をしておく。

「動的画面管理API」とは5250画面の上に動的にフィールドを配置したり出力する、という意味ではない。
これは 5250ストリームに対する入出力命令を集めたもので
5250ストリームを独自に構成することができる機能である。
仮想端末APIを扱う場合には仮想端末に対して入出力するだけで済むので、
特にこのAPI は必要としない。
それではなぜこのAPI が用意されているのかというと、
恐らくは DDS の USRDFN キーワードをサポートするためのものであろう。

DDS の USRDFN キーワードとは
ユーザーが独自にその表示レコードの5250ストリームを作成するというものである。
つまり USRDFN で示された表示レコードのフィールドはいわゆるフィールドの値ではなく
5250ストリームを記述することになる。
USRDFN を使っている人は少ないだろうと予想したが、
米国サイトでは 2つの記事を見つけることができた。
興味深い利用方法が紹介されていたので、いずれこのサイトでも紹介したい。