RPG

336. RPG でマウスを操作するには?

Windows がこれほど普及している現在で RPG プログラムでも
マウスで操作させたいと思うのは当然である。
かのスティーブ・ジョブズは XEROX 社のマウスを初めて見たときに
「なぜマウスを商品化しないのか?!」と驚いたそうである。
Windows ではマウスを操作しない日はないが私達の 5250 エミュレータの
世界ではエンド・ユーザーにマウス操作を提供している機会は
少ないのではないだろうか?

例えば、項目を選択するのに 「1=選択」 のように入力させたり
機能キーを押させる操作よりはマウスでクリックするほうが
はるかにやさしく洗練されている操作であると言える。

5250 エミュレータで GUI コントロールを表現するには
仮想端末 API に 5250 表示装置が GUI コントロールをサポートしている端末であると
宣言しなければならない。
PCOMM や CA400 (=iAccess,= Client Access) では GUI コントロール・サポートの
フラグはオンではないので GUI コントロールを表現することができない。
AutoWeb ではGUI コントロール・サポートのフラグがオンであるので
様々な GUI コントロールを表現することができるのである。

ところがマウスに関しては DSPF の DDS キー・ワードだけで
マウスが使えるようになるのでここで紹介する。
IBM はマウス操作でロール・アップ / ダウンの操作を紹介しているが
マウスのクリックによるスクロール操作は Windows やブラウザでも例がないので
マウスを使うサンプルとしては説得力に欠けるのである。
ここではマウス・クリックによる POPUP 表示の例を紹介する。
あなたの適用業務をよりスタイリッシュなものにすることは間違いない。

【 PGM201:受注の入力 】

マウスでクリックすると POPUP 表示される。

【 POPUP表示 】

【 マウス操作の定義 】

..マウスの左ボタンを押すと CF04 キーを押したのと同じにする。

:
A                                      MOUBTN(*ULP CF04)
:

これはレコード・レベルでマウスをクリックすると CF04 キーを押したことになり
なおかつマウス・カーソル (=正しくは) の位置もプログラムに伝える。

【 DSPF: PGM201FM :受注の入力画面 】

0001.00      A*%%TS  SD  20070731  210529  QTR         REL-V5R4M0  5722-WDS          
0002.00      A*-----------------------------------------------*                      
0003.00      A*  SFLENT :  サブ・ファイル入力                                        
0004.00      A*                                                                      
0005.00      A*        受注の入力                                                    
0006.00      A*                                                                      
0007.00      A*  CRTEXDSPF QTROBJ/PGM201FM  +                                        
0008.00      A*  SRCFILE(QTRSRC/QDSPSRC) LVLCHK(*NO) AUT(*ALL)                       
0009.00      A*-----------------------------------------------*                      
0010.00      A                                      DSPSIZ(27 132 *DS4 24 80 *DS3)   
0011.00      A  *DS4                                MSGLOC(27)                       
0012.00      A  *DS3                                MSGLOC(24)                       
0013.00      A                                      PRINT                            
0014.00      A                                      HELP                             
0015.00      A                                      ALTHELP(CA01)                    
0016.00      A                                      HLPPNLGRP(PGM201H QTROBJ/PGM201H)
0017.00      A                                      HLPTITLE(' 受注の入力 ')         
0018.00      A          R DSPHEAD                                                    
0019.00      A                                      TEXT(' 初期画面 ')               
0020.00      A                                      CF03(03 ' 終了 ')                
0021.00      A                                      SETOF(99)                        
0022.00      A                                      BLINK                            
0023.00      A          H                           HLPARA(2 12 2 17)                
0024.00      A                                      HLPPNLGRP('PGM201/JUCNO' -            
0025.00      A                                      QTROBJ/PGM201H)                       
0026.00      A                                  1 27' 受注の入力 '                        
0027.00      A                                      DSPATR(HI)                            
0028.00      A*                                     COLOR(PNK)                            
0029.00      A                                  2  2' 受注№ '                            
0030.00      A            JUCNO          5Y 0B  2 12TEXT(' 受注№ ')                      
0031.00      A                                      CHECK(RZ)                             
0032.00      A                                      CHECK(ER)                             
0033.00      A                                 11 15' 必要な項目を打鍵して実行キーを押 +  
0034.00      A                                       して下さい。 '                       
0035.00      A*                                     DSPATR(HI)                            
0036.00      A                                 11 63HTML('<IMG SRC="/AS400-NET.USR/IMAG+  
0037.00      A                                      E/AUTOWEB.GIF">')                     
0038.00      A                                 23  2'F3= 終了 '                           
0039.00      A                                      COLOR(BLU)                            
0040.00      A                                 24  2' これはメッセージ・テストです '      
0041.00      A          R SFREC01                   SFL                                   
0042.00      A                                      TEXT(' SFLレコード ')              
0043.00      A  20                                                                        
0044.00      AO 99                                  SFLNXTCHG                             
0045.00      A            GYO            4A  B  9  2TEXT(' № ')                          
0046.00      A  03                                  DSPATR(UL)                            
0047.00      A            JHCODE    R        B  9  7REFFLD(SHOHINR/SHCODE QTRFIL/SHOHIN)  
0048.00      A                                      TEXT('*POPUP SHCODE,SHNAME,SHTANK')  
0049.00      A  66                                  DSPATR(PC)                           
0050.00      A  66                                  DSPATR(RI)                           
0051.00      A            SHNAME    R        O  9 18REFFLD(SHOHINR/SHNAME QTRFIL/SHOHIN) 
0052.00      A                                      TEXT(' 商品名 ')                     
0053.00      A            JUSUR          3Y 0B  9 48TEXT(' 受注数 ')                     
0054.00      A                                      EDTCDE(Z)                            
0055.00      A                                      CHECK(RB)                            
0056.00      A                                      DSPATR(CS)                           
0057.00      A  71                                  DSPATR(PC)                           
0058.00      A            JUTANK    R    7Y 0B  9 55REFFLD(SHOHINR/SHTANK QTRFIL/SHOHIN) 
0059.00      A                                      TEXT(' 単価 ')                       
0060.00      A                                      EDTCDE(K)                            
0061.00      A                                      CHECK(RB)                            
0062.00      A                                      DSPATR(CS)                           
0063.00      A            JUKING         7Y 0B  9 67TEXT(' 受注金額 ')                   
0064.00      A                                      EDTCDE(K)                            
0065.00      A                                      CHECK(RB)                            
0066.00      A                                      DSPATR(CS)                           
0067.00      A            ZKSU           5Y 0O  9 82TEXT(' 在庫数 ')                     
0068.00      A                                      EDTCDE(K)                            
0069.00      A            THSU           5Y 0O  9 92TEXT(' 手配数 ')                     
0070.00      A                                      EDTCDE(K)                            
0071.00      A*                                                                          
0072.00      A          R SFCTL01                   SFLCTL(SFREC01)              
0073.00      A*%%TS  SD  20070731  174853  QTR         REL-V5R4M0  5722-WDS      
0074.00      A                                      SFLSIZ(0013)                 
0075.00      A  *DS3                                SFLSIZ(0011)                 
0076.00      A                                      SFLPAG(0012)                 
0077.00      A  *DS3                                SFLPAG(0010)                 
0078.00      A                                      TEXT(' SFLコントロール ') 
0079.00      A                                      ROLLUP(14 ' 次頁 ')          
0080.00      A                                      ROLLDOWN(15 ' 前頁 ')        
0081.00      A                                      CF03(03 ' 終了 ')            
0082.00      A                                      CF04(04 'プロンプト')           
0083.00      A                                      CF05(05 ' 照会 ')            
0084.00      A                                      CF10(10 ' 更新 ')            
0085.00      A                                      CF23(23 ' 削除 ')            
0086.00      A                                      CF12(12 ' 前画面 ')          
0087.00      A                                      SETOF(99)                    
0088.00      A                                      BLINK                        
0089.00      A                                      OVERLAY                      
0090.00      A  42                                  SFLDSP                       
0091.00      A  41                                  SFLDSPCTL                    
0092.00      A  43                                  SFLINZ                       
0093.00      A  46                                  SFLDLT                       
0094.00      A  44                                  SFLCLR                       
0095.00      A  45                                  SFLEND(*MORE)                
0096.00      A* 45                                  SFLEND(*SCRBAR)                   
0097.00      A*                                     SFLDROP(CF11)                     
0098.00      A                                      MOUBTN(*ULP CF04)                 
0099.00      A  61                                  SFLMSGID(EDT0411 QPDA/QEDTMSG 61) 
0100.00      A  62                                  SFLMSGID(EDT0410 QPDA/QEDTMSG 62) 
0101.00      A  66                                  SFLMSGID(CPF9897 QSYS/QCPFMSG +   
0102.00      A                                      66 &MSGDTA)                       
0103.00      A  67                                  SFLMSGID(CPD6A6D QSYS/QCPFMSG 67) 
0104.00      A                                      RTNCSRLOC(&RCD &FLD &CSRP)        
0105.00      A          H                           HLPARA(2 12 2 17)                 
0106.00      A                                      HLPPNLGRP('PGM201/JUCNO' -        
0107.00      A                                      QTROBJ/PGM201H)                   
0108.00      A          H                           HLPARA(4 17 4 20)                 
0109.00      A                                      HLPPNLGRP('PGM201/JUTKCD' -       
0110.00      A                                      QTROBJ/PGM201H)                   
0111.00      A          H                           HLPARA(3 71 3 78)                 
0112.00      A                                      HLPPNLGRP('PGM201/JUDATE' -       
0113.00      A                                      QTROBJ/PGM201H)                   
0114.00      A          H                           HLPARA(4 71 4 78)                 
0115.00      A                                      HLPPNLGRP('PGM201/JUNOKI' -       
0116.00      A                                      QTROBJ/PGM201H)                   
0117.00      A          H                           HLPARA(6 13 6 14)                 
0118.00      A                                      HLPPNLGRP('PGM201/JUKBN' -        
0119.00      A                                      QTROBJ/PGM201H)                   
0120.00      A          H                           HLPARA(6 45 6 46)               
0121.00      A                                      HLPPNLGRP('PGM201/JUSHOR' -     
0122.00      A                                      QTROBJ/PGM201H)                 
0123.00      A          H                           HLPARA(6 68 6 71)               
0124.00      A                                      HLPPNLGRP('PGM201/JUTANT' -     
0125.00      A                                      QTROBJ/PGM201H)                 
0126.00      A          H                           HLPARA(9 7 18 16)               
0127.00      A                                      HLPPNLGRP('PGM201/JHCODE' -     
0128.00      A                                      QTROBJ/PGM201H)                 
0129.00      A          H                           HLPARA(9 48 18 50)              
0130.00      A                                      HLPPNLGRP('PGM201/JUSUR' -      
0131.00      A                                      QTROBJ/PGM201H)                 
0132.00      A          H                           HLPARA(9 55 18 61)              
0133.00      A                                      HLPPNLGRP('PGM201/JUTANK' -     
0134.00      A                                      QTROBJ/PGM201H)                 
0135.00      A          H                           HLPARA(9 67 18 73)              
0136.00      A                                      HLPPNLGRP('PGM201/JUKING' -     
0137.00      A                                      QTROBJ/PGM201H)                 
0138.00      A            DSPREC         4S 0H      SFLRCDNBR(CURSOR)               
0139.00      A            RCD           10A  H                                      
0140.00      A            FLD           10A  H                                      
0141.00      A            CSRP           4S 0H      TEXT('SFL 表示 レコード № ')      
0142.00      A            MSGDTA        60A  P                                      
0143.00      A                                  1 27' 受注の入力 '                  
0144.00      A                                      DSPATR(HI)                              
0145.00      A*                                     COLOR(PNK)                              
0146.00      A            DSPMOD         6A  O  1 72DSPATR(HI)                              
0147.00      A                                  2  2' 受注№ '                              
0148.00      A            JUCNO          5Y 0O  2 12TEXT(' 受注№ ')                        
0149.00      A                                  3 80' 受注日 '                              
0150.00      A  *DS3                            3 62                                        
0151.00      A            JUDATE         8Y 0B  3 89TEXT(' 受注日 ')                        
0152.00      A  *DS3                            3 71                                        
0153.00      A  64                                  ERRMSG(' 受注日の誤りです。        -    
0154.00      A                                                                ' 64)         
0155.00      A*    編集コード :W  を日付のフィールドとみなしてカレンダーを追加します。      
0156.00      A                                      EDTCDE(W)                               
0157.00      A                                  4  2' 得意先コード '                        
0158.00      A            JUTKCD    R    4A  B  4 17TEXT('*POPUP TKCODE, TKNMJ, TKNM, -     
0159.00                                             TKKBN')                                 
0160.00      A                                      REFFLD(TOKMASR/TKCODE QTRFIL/TOKMAS)    
0161.00      A  63                                  ERRMSG(' 得意先コードの誤りです。  -    
0162.00      A                                                                ' 63)         
0163.00      A            TKNAME    R        O  4 22REFFLD(TOKMASR/TKNMJ QTRFIL/TOKMAS)     
0164.00      A                                  4 80' 納期 '                                
0165.00      A  *DS3                            4 62                                        
0166.00      A            JUNOKI         8Y 0B  4 89TEXT(' 納期 ')                          
0167.00      A  *DS3                            4 71                                        
0168.00      A  65                                  ERRMSG(' 納期の誤りです。          - 
0169.00      A                                                                ' 65)      
0170.00      A*    編集コード :W  を日付のフィールドとみなしてカレンダーを追加します。   
0171.00      A                                      EDTCDE(W)                            
0172.00      A                                  6  2' 受注区分 '                         
0173.00      A            JUKBN          2   B  6 13                                     
0174.00      A                                      VALUES('01' '02')                    
0175.00      A                                      TEXT('" 売上 " " 返品 "')            
0176.00      A            JUNAME         6A  O  6 16                                     
0177.00      A  08                                  DSPATR(ND)                           
0178.00      A                                  6 34' 処理区分 '                         
0179.00      A            JUSHOR         2   B  6 45                                     
0180.00      A                                      VALUES('01' '02')                    
0181.00      A                                      TEXT('" 今月 " " 来勘 "')            
0182.00      A            JSNAME         6A  O  6 48                                     
0183.00      A  08                                  DSPATR(ND)                           
0184.00      A                                  6 57' 担当者 '                           
0185.00      A            JUTANT    R    4A  B  6 66REFFLD(TANTOMR/TACODE QTRFIL/TANTO)  
0186.00      A                                      TEXT('*COMBO *KEY')                  
0187.00      A            TTNAM     R    8A  O  6 71REFFLD(TANTOMR/TTNAM QTRFIL/TANTO)   
0188.00      A                                      TEXT('*COMBO *DATA')                 
0189.00      A                                  8  2' № '                               
0190.00      A                                      DSPATR(HI)                           
0191.00      A                                  8  7' 商品コード '                       
0192.00      A                                      DSPATR(HI)                  
0193.00      A                                  8 21' 商品名 '                  
0194.00      A                                      DSPATR(HI)                  
0195.00      A                                  8 45' 受注数 '                  
0196.00      A                                      DSPATR(HI)                  
0197.00      A                                  8 57' 単価 '                    
0198.00      A                                      DSPATR(HI)                  
0199.00      A                                  8 67' 受注金額 '                
0200.00      A                                      DSPATR(HI)                  
0201.00      A                                  8 81' 現在庫数 '                
0202.00      A                                      DSPATR(HI)                  
0203.00      A                                  8 92' 手配数 '                  
0204.00      A                                      DSPATR(HI)                  
0205.00      A*                                                                 
0206.00      A          R DSPEND01                                              
0207.00      A*%%TS  SD  20070731  210529  QTR         REL-V5R4M0  5722-WDS     
0208.00      A                                      TEXT(' 機能キーの表示 ')    
0209.00      A                                      OVERLAY                     
0210.00      A*                                     PUTRETAIN                   
0211.00      A                                 23  2'F3= 終了 '                 
0212.00      A                                      COLOR(BLU)                  
0213.00      A                                 23 17'F4= プロンプト '           
0214.00      A                                      COLOR(BLU)                  
0215.00      A                                 23 34'F10= 更新 '                
0216.00      A                                      COLOR(BLU)                          
0217.00      A                                 23 51'F23= 削除 '                        
0218.00      A                                      COLOR(BLU)                          
0219.00      A                                 23 68'F12= 前画面 '                      
0220.00      A                                      COLOR(BLU)                          
0221.00      A          R ENDOPT                                                        
0222.00      A*%%TS  SD  19930612  150356  NIK         REL-V2R1M0  5738-PW1             
0223.00      A                                      TEXT(' 終了画面 ')                  
0224.00      A*                                     CF03(03 ' 終了 ')                   
0225.00      A                                      CSRLOC(LIN        POS)              
0226.00      A                                  1 34' 終了 '                            
0227.00      A                                      COLOR(PNK)                          
0228.00      A                                      DSPATR(HI)                          
0229.00      A                                  3  2' 処理されたレコード数 '            
0230.00      A                                  5 10' 追加  . . . . . :'                
0231.00      A            ADDREC         5Y 0O  5 35EDTCDE(4)                           
0232.00      A                                  6 10' 変更  . . . . . :'                
0233.00      A            CHGREC         5Y 0O  6 35EDTCDE(4)                           
0234.00      A                                  7 10' 削除  . . . . . :'                
0235.00      A            DLTREC         5Y 0O  7 35EDTCDE(4)                           
0236.00      A                                 11  2' 選択項目を打鍵して,実行キーを押 +
0237.00      A                                       してください。 '                   
0238.00      A                                      COLOR(BLU)                          
0239.00      A                                 13  5' データ入力の終了  . . . . . .'    
0240.00      A            ANS            1A  B 13 39VALUES('Y' 'N')  
0241.00      A                                 13 53'Y=YES, N=NO'    
0242.00      A                                 23  2'F3= 終了 '      
0243.00      A                                      COLOR(BLU)       
0244.00      A                                 23 15'F12= 前画面 '   
0245.00      A                                      COLOR(BLU)       
0246.00      A            LIN            3S 0H                       
0247.00      A            POS            3S 0H                                  

【 解説 】

注目はレコード : SFCTL01 に記述されている、

0098.00      A                                      MOUBTN(*ULP CF04)

だけである。

【 RPG: PGM201:受注の入力 】

0001.00 H DFTNAME(PGM201) DATEDIT(*YMD/)                                                      
0002.00 F**********  受注の入力 ******************************************                    
0003.00 FPGM201FM  CF   E             WORKSTN                                                 
0004.00 F                                     SFILE(SFREC01:RRN1)                             
0005.00 F                                     INFDS(INFDS)                                    
0006.00 FJUCHU     UF A E           K DISK                                                    
0007.00 FTOKMAS    IF   E           K DISK                                                    
0008.00 FSHOHIN    IF   E           K DISK                                                    
0009.00 FSHZAIKO   IF   E           K DISK                                                    
0010.00 FTANTO     IF   E           K DISK                                                    
0011.00 F*****************************************************************                    
0012.00                                                                                       
0013.00  * CRTBNDRPG QTROBJ/PGM201 SRCFILE(QTRSRC/QRPGLESRC)                                  
0014.00  *   DFTACTGRP(*NO) ACTGRP(*NEW) AUT(*ALL)                                            
0015.00                                                                                       
0016.00 D AR              S              1    DIM(80)                                         
0017.00 D SAVDTA          S              1    DIM(1024)                             SAVE-データ 
0018.00 D*                                                                                    
0019.00 D*         -( サブ・ファイル の ファイル 情報 )-                                                
0020.00 D*                                                                                    
0021.00 D* SAVE-RESTORE のための ファイル の DATA-STRUCTURE                                       
0022.00 D*       読み取り ファイル の FORMAT を外部 DS として READ                                
0023.00 D SAVEDS        E DS                  EXTNAME(JUCHU)                                  
0024.00 D  DSPDTA                 1   1024                                                     
0025.00 D                                     DIM(1024)                             入力 データ  
0026.00 D INFDS           DS                                                                   
0027.00 D  NUM_ROWS             152    153B 0                                                  
0028.00 D  NUM_COLS             154    155B 0                                                  
0029.00 D  NUM_RCDS             156    159I 0                                                  
0030.00 D*( カーソル の行と桁の取り込み )                                                          
0031.00 D  LINE                 370    371B 0                                                  
0032.00 D*  TOPRRN: 今表示している サブ・ファイル の先頭の RRN                                       
0033.00 D  TOPRRN               378    379B 0                                                  
0034.00 D* BRRN : サブファイル の レコードNO ( 2 進数 )                                                
0035.00 D  BRRN                 376    377B 0                                                  
0036.00 D*( WORK 日付 YYMMDD データ 構造  )                                                      
0037.00 D DATEDS          DS                                                                   
0038.00 D  SRY                    1      2  0                                                  
0039.00 D  SRYMD                  1      8  0                                                  
0040.00 D  YYMMDD                 3      8  0                                                  
0041.00 D  YYMM                   3      6  0                                                  
0042.00 D  MMDD                   5      8  0                                                  
0043.00 D  YY                     3      4  0                                                  
0044.00 D  MM                     5      6  0                                                  
0045.00 D  DD                     7      8  0                                                  
0046.00 D*( 在庫数の配列 )                                                                     
0047.00 D                 DS                                                                   
0048.00 D DDS001        E DS                  EXTNAME(TOKMAS)                           
0049.00 D DDS002        E DS                  EXTNAME(SHOHIN)                           
0050.00 D PNLOBJ          DS                                                            
0051.00 D  GRP                    1     10                                              
0052.00 D  GRPLIB                11     20                                              
0053.00 D* LIB名付きPGM名                                              *          
0054.00 D JHCOD           C                   CONST('JHCODE    ')                       
0055.00 D ANS005          C                   CONST('QTROBJ/POP005')                    
0056.00 D WEBFAC          C                   CONST('ASNET.COM/WEBFACE')                
0057.00 D PGM101          C                   CONST('QTROBJ/PGM101')                    
0058.00 D MSG01           C                   CONST(' 商品コード ')                     
0059.00 D MSG02           C                   CONST(' の誤りです。 ')                   
0060.00                                                                                 
0061.00 C*                                                                              
0062.00 C*( 初期画面 )                                                                  
0063.00 C*----------------------------------------------------+                         
0064.00 C     START         TAG                                                    |    
0065.00 C                   EXFMT     DSPHEAD                                      |    
0066.00 C*----------------------------------------------------+                         
0067.00 C                   SETOFF                                       99             
0068.00 C*( CF03 )- 終了                                                                
0069.00 C     *IN03         IFEQ      *ON                                          CF03 
0070.00 C                   SETON                                        LR             
0071.00 C   LR              EXSR      LRRTN                                             
0072.00 C   LR              RETURN                                                         
0073.00 C                   GOTO      START                                                
0074.00 C                   END                                                    CF03    
0075.00 C*( CF05 )- 得意先マスターの登録                                                   
0076.00 C     *IN05         IFEQ      *ON                                          CF05    
0077.00 C                   CALL      PGM101                                               
0078.00 C                   GOTO      START                                                
0079.00 C                   END                                                    CF03    
0080.00 C*( 実行キー )                                                                     
0081.00 C*   : KEYをファイルにセット                                                    
0082.00 C*----------------------------------------------------+                            
0083.00 C     SETKEY        KLIST                                                  |       
0084.00 C                   KFLD                    JUCNO                          |       
0085.00 C                   KFLD                    JUGYO                          |       
0086.00 C*----------------------------------------------------+                            
0087.00 C                   MOVE      *ZEROS        JUGYO                                  
0088.00 C                   EXSR      SFLCLR                                               
0089.00 C     SETKEY        SETLL     JUCHU                                                
0090.00 C*   : ファイルの読み取り                                                          
0091.00 C                   MOVE      ' 入力 '      DSPMOD            6                    
0092.00 C                   Z-ADD     1             TOPRRN                                 
0093.00 C                   EXSR      READ                                                 
0094.00 C                   Z-ADD     1             DSPREC                                 
0095.00 C*( サブ・ファイルの表示 )                                                         
0096.00 C*----------------------------------------------------+                                 
0097.00 C     DSPLY         TAG                                                    |            
0098.00 C                   WRITE     DSPEND01                                     |            
0099.00 C                   SETON                                        4142      |SFL-DSPLY   
0100.00 C                   EXFMT     SFCTL01                                      |            
0101.00 C                   SETOFF                                       4142      |            
0102.00 C*----------------------------------------------------+                                 
0103.00 C                   SETOFF                                       99                     
0104.00 C*( CF03 )- 終了                                                                        
0105.00 C     *IN03         IFEQ      *ON                                          CF03         
0106.00 C                   SETON                                        LR                     
0107.00 C   LR              EXSR      LRRTN                                                     
0108.00 C   LR              RETURN                                                              
0109.00 C                   GOTO      DSPLY                                                     
0110.00 C                   END                                                    CF03         
0111.00 C*( CF04 )- プロンプト                                                                  
0112.00 C     *IN04         IFEQ      *ON                                          CF04         
0113.00 C     FLD           IFEQ      JHCOD                                                     
0114.00 C     CSRP          ANDGT     *ZEROS                                                    
0115.00 C                   EXSR      PROMPT                                                    
0116.00 C   99              GOTO      DSPLY                                                     
0117.00 C                   ELSE                                                                
0118.00 C                   SETON                                        6799      ERR          
0119.00 C                   GOTO      DSPLY                                                     
0120.00 C                   END                                                               
0121.00 C                   END                                                    CF04       
0122.00 C*                                                                                    
0123.00 C*( CF12 )- 前画面                                                                    
0124.00 C     *IN12         IFEQ      *ON                                          CF12       
0125.00 C                   SETOFF                                       12                   
0126.00 C                   EXSR      SFLDLT                                                  
0127.00 C                   EXSR      CLEAR                                                   
0128.00 C                   GOTO      START                                                   
0129.00 C                   END                                                    CF12       
0130.00 C*                     |                                                              
0131.00 C*( ROLL UP )- 次ページ                                                               
0132.00 C     *IN14         IFEQ      *ON                                          ROLLUP     
0133.00 C                   EXSR      ROLLUP                                                  
0134.00 C                   GOTO      DSPLY                                                   
0135.00 C                   END                                                    ROLLUP     
0136.00 C*-( ROLL DOWN )- 前ページ                                                            
0137.00 C     *IN15         IFEQ      *ON                                          ROLLDOWN   
0138.00 C                   Z-ADD     1             DSPREC                                    
0139.00 C                   SETON                                        6299      ERRMSG     
0140.00 C                   GOTO      DSPLY                                                   
0141.00 C                   END                                                    ROLLDOWN   
0142.00 C*                     |                                                              
0143.00 C     TOPRRN        IFNE      *ZEROS                                                  
0144.00 C                   Z-ADD     TOPRRN        DSPREC                                       
0145.00 C                   END                                                                  
0146.00 C*   : 見出し画面のチェック                                                              
0147.00 C  N23              EXSR      MIDCHK                                                     
0148.00 C   99              GOTO      DSPLY                                                      
0149.00 C*   : 見出し項目のSAVE                                                              
0150.00 C                   MOVE      JUCNO         MIB001                                       
0151.00 C     *LIKE         DEFINE    JUCNO         MIB001                                       
0152.00 C                   MOVE      JUTKCD        MIB002                                       
0153.00 C     *LIKE         DEFINE    JUTKCD        MIB002                                       
0154.00 C                   MOVE      JUDATE        MIB003                                       
0155.00 C     *LIKE         DEFINE    JUDATE        MIB003                                       
0156.00 C                   MOVE      JUNOKI        MIB004                                       
0157.00 C     *LIKE         DEFINE    JUNOKI        MIB004                                       
0158.00 C                   MOVE      TKNAME        MIB005                                       
0159.00 C     *LIKE         DEFINE    TKNAME        MIB005                                       
0160.00 C                   MOVE      JUSHOR        MIB006                                       
0161.00 C     *LIKE         DEFINE    JUSHOR        MIB006                                       
0162.00 C                   MOVE      JSNAME        MIB007                                       
0163.00 C     *LIKE         DEFINE    JSNAME        MIB007                                       
0164.00 C*   : 明細画面のチェック                                                                
0165.00 C     1             DO        *HIVAL        RRN1                           RRN1=1-*HIVAL 
0166.00 C                   SETOFF                                       50                      
0167.00 C*( 実行キー )                                                                           
0168.00 C  N10                                                                     
0169.00 CANN23              READC     SFREC01                                50    
0170.00 C*                                                                         
0171.00 C*( CF10 )- 更新                                                           
0172.00 C*( CF23 )- 削除                                                           
0173.00 C   10                                                                     
0174.00 COR 23RRN1          CHAIN     SFREC01                            50        
0175.00 C*                                                                         
0176.00 C   50              GOTO      RECEND                                       
0177.00 C*   : ブランク キー 入力の オミット                                                
0178.00 C     JHCODE        IFEQ      *BLANKS                                      
0179.00 C     JUKING        ANDEQ     *ZEROS                                       
0180.00 C                   GOTO      UPDBPS                                       
0181.00 C                   END                                                    
0182.00 C                   Z-ADD     BRRN          DSPREC                         
0183.00 C                   MOVE      MIB001        JUCNO                          
0184.00 C                   MOVE      MIB002        JUTKCD                         
0185.00 C                   MOVE      MIB003        JUDATE                         
0186.00 C                   MOVE      MIB004        JUNOKI                         
0187.00 C                   MOVE      MIB005        TKNAME                         
0188.00 C                   MOVE      MIB006        JUSHOR                         
0189.00 C                   MOVE      MIB006        JSNAME                         
0190.00 C  N23              EXSR      MIDCHK                                       
0191.00 C*                     |                                                   
0192.00 C*---------------------+                                                            
0193.00 C* 入力明細行のチェック                                                             
0194.00 C*---------------------+                                                            
0195.00 C                   MOVEL     GYO           FLD1              1                     
0196.00 C     FLD1          IFNE      'D'                                           削除 ?  
0197.00 C     *IN23         ANDNE     '1'                                                   
0198.00 C                   MOVE      RRN1          DSPREC            4 0           表示 RRN
0199.00 C                   EXSR      CHECK                                                 
0200.00 C   99              GOTO      SFLWRT                                                
0201.00 C                   END                                                             
0202.00 C*                     |                                                            
0203.00 C*---------------------+                                                            
0204.00 C* データ・ベース更新                                                               
0205.00 C*---------------------+                                                            
0206.00 C*                     |                                                            
0207.00 C     *IN10         IFEQ      *ON                                          F10,F23  
0208.00 C     *IN23         OREQ      *ON                                                   
0209.00 C*----------------------------------------------------+                             
0210.00 C     TRNKEY        KLIST                                                  |        
0211.00 C                   KFLD                    JUCNO                          |        
0212.00 C                   KFLD                    JUGYO                          |        
0213.00 C*----------------------------------------------------+                             
0214.00 C*   : 更新キーを生成                                                               
0215.00 C*                                                                                  
0216.00 C                   MOVE      DSPDTA        SAVDTA                                 
0217.00 C*   : データ・ベース検索                                                          
0218.00 C                   EXSR      CLEAR                                                
0219.00 C                   SETOFF                                       90                
0220.00 C     TRNKEY        CHAIN     JUCHU                              90                
0221.00 C   90              GOTO      ADDCHG                                               
0222.00 C*                     |                                                           
0223.00 C*   :  変更 / 削除                                                                
0224.00 C                   MOVEL     GYO           FLD1              1                    
0225.00 C     FLD1          CABEQ     'D'           TRNUPD                          削除 ? 
0226.00 C   23              GOTO      TRNUPD                                               
0227.00 C*                     |                                                           
0228.00 C*   : 追加 / 変更                                                                 
0229.00 C     ADDCHG        TAG                                                            
0230.00 C                   MOVE      SAVDTA        DSPDTA                                 
0231.00 C                   MOVE      MIB001        JUCNO                                  
0232.00 C                   MOVE      MIB002        JUTKCD                                 
0233.00 C                   MOVE      MIB003        JUDATE                                 
0234.00 C                   MOVE      MIB004        JUNOKI                                 
0235.00 C                   MOVE      MIB005        TKNAME                                 
0236.00 C                   MOVE      MIB006        JUSHOR                                 
0237.00 C                   MOVE      MIB006        JSNAME                                 
0238.00 C*                     |                                                           
0239.00 C     TRNUPD        TAG                                                            
0240.00 C                   MOVEL     GYO           FLD1              1                       
0241.00 C     FLD1          COMP      'D'                                    50               
0242.00 C   23              SETON                                        50                   
0243.00 C*   : データ・ベースへ追加・更新                                                     
0244.00 C*----------------------------------------------------+                               
0245.00 C   90                                                                                
0246.00 CANN50              WRITE     JUCHUR                                       | ADD      
0247.00 C  N90                                                                                
0248.00 CANN50              UPDATE    JUCHUR                                       | CHG      
0249.00 C  N90                                                                                
0250.00 CAN 50              DELETE    JUCHUR                                       | DLT      
0251.00 C*----------------------------------------------------+                               
0252.00 C  N50              MOVE      BRRN          GYO                                       
0253.00 C   90              ADD       1             ADDREC            5 0                     
0254.00 C  N90                                                                                
0255.00 CANN50              ADD       1             CHGREC            5 0                     
0256.00 C  N90                                                                                
0257.00 CAN 50              ADD       1             DLTREC            5 0                     
0258.00 C                   END                                                    F10,F23    
0259.00 C*                     |                                                              
0260.00 C*---------------------+                                                              
0261.00 C* サブ・ファイル更新                                                                 
0262.00 C*---------------------+                                                              
0263.00 C     SFLWRT        TAG                                                               
0264.00 C                   MOVE      TOPRRN        TOPSAV                                       
0265.00 C*----------------------------------------------------+                                  
0266.00 C                   UPDATE    SFREC01                                      |             
0267.00 C*----------------------------------------------------+                                  
0268.00 C                   Z-ADD     BRRN          DSPREC                                       
0269.00 C                   MOVE      TOPSAV        TOPRRN                                       
0270.00 C     UPDBPS        TAG                                                                  
0271.00 C   99              GOTO      DSPLY                                         エラー       
0272.00 C                   END                                                    RRN1=1-*HIVAL 
0273.00 C*   : 実行キーの終了                                                                    
0274.00 C     RECEND        TAG                                                                  
0275.00 C*   : コマンド部のチェック ( DSPEND01                                                   
0276.00 C  N23              EXSR      CMDCHK                                                     
0277.00 C   99              GOTO      DSPLY                                                      
0278.00 C*                                                                                       
0279.00 C     *IN10         IFEQ      *ON                                                        
0280.00 C     *IN23         OREQ      *ON                                                        
0281.00 C                   GOTO      START                                                      
0282.00 C                   END                                                                  
0283.00 C                   GOTO      DSPLY                                                      
0284.00 C*                                                                                       
0285.00 C     END           TAG                                                                  
0286.00 C******************************************************                                  
0287.00 C     *INZSR        BEGSR                                                                
0288.00 C******************************************************                               
0289.00 C*  初期 サイクル のみの実行                                                              
0290.00 C     *LIKE         DEFINE    TOPRRN        TOPSAV                                    
0291.00 C                   CLEAR                   SAVEDS                                    
0292.00 C                   MOVE      *ZEROS        JUDATE                                    
0293.00 C                   MOVE      *ZEROS        JUNOKI                                    
0294.00 C                   CLEAR                   DATEDS                                    
0295.00 C                   MOVE      910101        DATE              6 0                     
0296.00 C*( U8 = HTML インターフェースで実行中 )                                              
0297.00 C   U8              SETON                                            08               
0298.00 C  N08NUM_COLS      COMP      132                                    08               
0299.00 C*( サブファイル END-FLAG を ON にする )                                                   
0300.00 C                   SETON                                        45                   
0301.00 C                   SETON                                        2310                 
0302.00 C                   SETOFF                                       2310                 
0303.00 C  N08              MOVE      10            GYOSU             2 0           行数      
0304.00 C   08              MOVE      12            GYOSU                           行数      
0305.00 C*( DS の数字 フィールド の クリヤー )                                                        
0306.00 C                   CLEAR                   SFREC01                                   
0307.00 C                   MOVE      09            STRGYO            2 0           開始行№  
0308.00 C                   Z-ADD     UDATE         JUDATE                          初期値    
0309.00 C                   Z-ADD     1             JUCNO                                     
0310.00 C                   Z-ADD     0             CSRP                                      
0311.00 C     INZEND        ENDSR                                                             
0312.00 C******************************************************                               
0313.00 C     MIDCHK        BEGSR                                                             
0314.00 C******************************************************                               
0315.00 C*( 見出しチェック )                                                                  
0316.00 C*----------------------------------------------------*                               
0317.00 C*( JUTKCD    :  得意先コード       :( CHAIN ファイル )                               
0318.00 C*----------------------------------------------------*                               
0319.00 C                   MOVE      *BLANKS       TKNMJ                                     
0320.00 C                   SETOFF                                       99                   
0321.00 C     JUTKCD        CHAIN     TOKMAS                             99                   
0322.00 C   99              SETON                                        63  99    ERRMSG     
0323.00 C   99              GOTO      MIDEND                                                  
0324.00 C                   MOVEL     TKNMJ         TKNAME                                    
0325.00 C*                                                                                    
0326.00 C*----------------------------------------------------*                               
0327.00 C*( JUDATE    :  受注日             :( DATCHK 日付 )                                  
0328.00 C*----------------------------------------------------*                               
0329.00 C     JUDATE        IFEQ      *ZEROS                                         省略値   
0330.00 C                   MOVEL     UDATE         JUDATE                                    
0331.00 C                   END                                                      省略値   
0332.00 C*                                                                                    
0333.00 C     JUDATE        IFNE      *ZEROS                                        IF-       
0334.00 C                   MOVE      JUDATE        DATE              6 0                     
0335.00 C                   EXSR      DATCHK                                                  
0336.00 C                   END                                                     ENDRTN   
0337.00 C   99              SETON                                        64         ERRMSG   
0338.00 C   99              GOTO      MIDEND                                        GOTO XXX 
0339.00 C     JUNOKI        IFNE      *ZEROS                                       JUNOKI=   
0340.00 C*----------------------------------------------------*                              
0341.00 C*( JUNOKI    :  納期               :( DATCHK 日付 )                                 
0342.00 C*----------------------------------------------------*                              
0343.00 C     JUNOKI        IFNE      *ZEROS                                        IF-      
0344.00 C                   MOVE      JUNOKI        DATE              6 0                    
0345.00 C                   EXSR      DATCHK                                                 
0346.00 C                   END                                                     ENDRTN   
0347.00 C   99              SETON                                        65         ERRMSG   
0348.00 C   99              GOTO      MIDEND                                        GOTO XXX 
0349.00 C                   END                                                              
0350.00 C*----------------------------------------------------*                              
0351.00 C*( JUKBN     :  受注区分                                                            
0352.00 C*----------------------------------------------------*                              
0353.00 C                   MOVE      *BLANKS       JUNAME                                   
0354.00 C     JUKBN         IFNE      *BLANKS                                                
0355.00 C     JUKBN         IFEQ      '01'                                                   
0356.00 C                   MOVE      ' 売上 '      JUNAME                                   
0357.00 C                   END                                                              
0358.00 C     JUKBN         IFEQ      '02'                                                   
0359.00 C                   MOVE      ' 返品 '      JUNAME                                   
0360.00 C                   END                                                            
0361.00 C                   END                                                            
0362.00 C*----------------------------------------------------*                            
0363.00 C*( JUSHOR    :  処理区分                                                          
0364.00 C*----------------------------------------------------*                            
0365.00 C                   MOVE      *BLANKS       JSNAME                                 
0366.00 C     JUSHOR        IFNE      *BLANKS                                              
0367.00 C     JUSHOR        IFEQ      '01'                                                 
0368.00 C                   MOVE      ' 通常 '      JSNAME                                 
0369.00 C                   END                                                            
0370.00 C     JUSHOR        IFEQ      '02'                                                 
0371.00 C                   MOVE      ' 来勘 '      JSNAME                                 
0372.00 C                   END                                                            
0373.00 C                   END                                                            
0374.00 C*----------------------------------------------------*                            
0375.00 C*( JUTANT    :  担当者コード       :( CHAIN ファイル )                            
0376.00 C*----------------------------------------------------*                            
0377.00 C                   MOVE      *BLANKS       TTNAM                                  
0378.00 C                   SETOFF                                       99                
0379.00 C     JUTANT        CHAIN     TANTO                              99                
0380.00 C   99              SETON                                        63  99    ERRMSG  
0381.00 C   99              GOTO      MIDEND                                               
0382.00 C     MIDEND        ENDSR                                                          
0383.00 C******************************************************                            
0384.00 C     READ          BEGSR                                                       
0385.00 C******************************************************                         
0386.00 C*( データ・ベースの検索 )                                                      
0387.00 C*----------------------------------------------------+                         
0388.00 C     EQLKEY        KLIST                                                  |    
0389.00 C                   KFLD                    JUCNO                          |    
0390.00 C*----------------------------------------------------+                         
0391.00 C                   SETON                                        51             
0392.00 C                   SETOFF                                       71             
0393.00 C     RTNRED        TAG                                                         
0394.00 C*                                                                              
0395.00 C     TOPRRN        ADD       GYOSU         ENDRRN            4 0               
0396.00 C                   SUB       1             ENDRRN                              
0397.00 C*                                                                              
0398.00 C                   Z-ADD     TOPRRN        DSPREC                              
0399.00 C     TOPRRN        DO        ENDRRN        RRN1              4 0          READ 
0400.00 C                   SETOFF                                       50             
0401.00 C     EQLKEY        READE     JUCHU                                  50         
0402.00 C     *IN50         IFEQ      *ON                                          EOF  
0403.00 C                   SETOFF                                       1129           
0404.00 C                   CLEAR                   SFREC01                             
0405.00 C   U8              SETON                                            08         
0406.00 C  N08NUM_COLS      COMP      132                                    08         
0407.00 C                   Z-ADD     0             SZZSU                               
0408.00 C                   ELSE                                                   EOF  
0409.00 C                   MOVE      ' 変更 '      DSPMOD                              
0410.00 C   U8              SETON                                            08         
0411.00 C  N08NUM_COLS      COMP      132                                    08         
0412.00 C*( CHECK  : READ した レコード の チェック )                                          
0413.00 C   51              EXSR      MIDCHK                                            
0414.00 C                   EXSR      CHECK                                             
0415.00 C                   END                                                    EOF  
0416.00 C*( 行 NO に入れる )                                                            
0417.00 C                   MOVE      RRN1          GYO                                 
0418.00 C                   MOVE      TOPRRN        TOPSAV                              
0419.00 C*( サブファイル へ更新 )                                                            
0420.00 C*----------------------------------------------------+                         
0421.00 C                   WRITE     SFREC01                                      |    
0422.00 C*----------------------------------------------------+                         
0423.00 C   51              MOVE      RRN1          DSPREC                              
0424.00 C   51              SETOFF                                       51             
0425.00 C                   Z-ADD     RRN1          LSTRRN            4 0               
0426.00 C                   MOVE      TOPSAV        TOPRRN                              
0427.00 C                   END                                                    READ 
0428.00 C     REDEND        TAG                                                         
0429.00 C     *IN11         IFEQ      *ON                                               
0430.00 C     ENDRRN        ADD       1             TOPRRN                              
0431.00 C                   GOTO      RTNRED                                            
0432.00 C                   END                                                             
0433.00 C                   ENDSR                                                           
0434.00 C******************************************************                             
0435.00 C     CHECK         BEGSR                                                           
0436.00 C******************************************************                             
0437.00 C*( 明細チェック )                                                                  
0438.00 C                   MOVE      GYO           JUGYO                                   
0439.00 C*----------------------------------------------------*                             
0440.00 C*( JHCODE    :  商品 コード          :( CHAIN ファイル )                             
0441.00 C*----------------------------------------------------*                             
0442.00 C                   CLEAR                   DDS002                          外部 DS 
0443.00 C                   SETOFF                                       99                 
0444.00 C     JHCODE        CHAIN     SHOHIN                             99                 
0445.00 C     *IN99         IFEQ      *ON                                                   
0446.00 C                   SETON                                        66  99    ERRMSG   
0447.00 C     MSG01         CAT(P)    JHCODE:0      MSGDTA                                  
0448.00 C                   CAT       MSG02:0       MSGDTA                                  
0449.00 C                   GOTO      CHKEND                                                
0450.00 C                   ENDIF                                                           
0451.00 C*                                                                                  
0452.00 C     JUTANK        IFEQ      *ZEROS                                       JUTANK=  
0453.00 C                   Z-ADD     SHTANK        JUTANK                                  
0454.00 C                   END                                                             
0455.00 C     JUSUR         MULT      JUTANK        JUKING                                  
0456.00 C*----------------------------------------------------*                      
0457.00 C*  SHZAIKO :  在庫マスターより在庫数を取得                                  
0458.00 C*             在庫数は HTML にのみ表示されます                              
0459.00 C*----------------------------------------------------*                      
0460.00 C                   Z-ADD     0             SZZSU                            
0461.00 C                   SETOFF                                       99          
0462.00 C     JHCODE        CHAIN     SHZAIKO                            99          
0463.00 C                   SETOFF                                       99          
0464.00 C                   Z-ADD     SZZSU         ZKSU                             
0465.00 C     CHKEND        ENDSR                                                    
0466.00 C******************************************************                      
0467.00 C     CMDCHK        BEGSR                                                    
0468.00 C******************************************************                      
0469.00 C*   : コマンド部のチェック ( DSPEND01                                       
0470.00 C                   READ      DSPEND01                               50      
0471.00 C   50              GOTO      CMDEND                                         
0472.00 C     CMDEND        ENDSR                                                    
0473.00 C******************************************************                      
0474.00 C     SFLCLR        BEGSR                                                    
0475.00 C******************************************************                      
0476.00 C*( サブファイル の クリヤー )                                                        
0477.00 C*----------------------------------------------------+                      
0478.00 C                   SETON                                        44        | 
0479.00 C                   WRITE     SFCTL01                                      | 
0480.00 C                   SETOFF                                       44        |       
0481.00 C*----------------------------------------------------+                            
0482.00 C                   ENDSR                                                          
0483.00 C******************************************************                            
0484.00 C     SFLDLT        BEGSR                                                          
0485.00 C******************************************************                            
0486.00 C*( サブファイル の削除 )                                                               
0487.00 C*----------------------------------------------------+                            
0488.00 C                   SETON                                        46        |       
0489.00 C                   WRITE     SFCTL01                                      |       
0490.00 C                   SETOFF                                       46        |       
0491.00 C*----------------------------------------------------+                            
0492.00 C                   ENDSR                                                          
0493.00 C******************************************************                            
0494.00 C     INZVAR        BEGSR                                                          
0495.00 C******************************************************                            
0496.00 C*( 初期値 )                                                                       
0497.00 C                   Z-ADD     UDATE         JUDATE                          初期値 
0498.00 C                   ENDSR                                                          
0499.00 C******************************************************                            
0500.00 C     ROLLUP        BEGSR                                                          
0501.00 C******************************************************                            
0502.00 C                   SETOFF                                       45                
0503.00 C     ENDRRN        ADD       1             TOPRRN                                 
0504.00 C                   EXSR      READ                                                
0505.00 C                   SETON                                        45               
0506.00 C     UPEND         ENDSR                                                         
0507.00 C******************************************************                           
0508.00 C     CLEAR         BEGSR                                                         
0509.00 C******************************************************                           
0510.00 C     *NOKEY        CLEAR                   JUCHUR                                
0511.00 C                   EXSR      INZVAR                                        初期値
0512.00 C                   ENDSR                                                         
0513.00 C*****************************************************                            
0514.00 C     LRRTN         BEGSR                                                         
0515.00 C*****************************************************                            
0516.00 C*( 終了画面 )                                                                    
0517.00 C     ADDREC        IFGT      *ZEROS                                              
0518.00 C     CHGREC        ORGT      *ZEROS                                              
0519.00 C     DLTREC        ORGT      *ZEROS                                              
0520.00 C                   MOVE      'Y'           ANS               1                   
0521.00 C*----------------------------------------------------+                           
0522.00 C                   EXFMT     ENDOPT                                       |      
0523.00 C*----------------------------------------------------+                           
0524.00 C                   SETOFF                                       99               
0525.00 C*( CF12 )- 前画面                                                                
0526.00 C     *IN12         IFEQ      *ON                                          CF12   
0527.00 C                   SETOFF                                       12LR             
0528.00 C                   GOTO      LREND                                             
0529.00 C                   END                                                    CF12 
0530.00 C*( 実行キー )                                                                  
0531.00 C     ANS           IFEQ      'N'                                               
0532.00 C                   SETOFF                                       LR             
0533.00 C                   GOTO      LREND                                             
0534.00 C                   END                                                         
0535.00 C                   END                                                         
0536.00 C*                                                                              
0537.00 C     LREND         ENDSR                                                       
0538.00 C******************************************************                         
0539.00 C     DATCHK        BEGSR                                                       
0540.00 C******************************************************                         
0541.00 C*( 日付 チェック サブ・ルーチン )       FOR YY/MM/DD                                     
0542.00 C                   MOVE      *IN51         IN51              1                 
0543.00 C                   MOVE      *IN52         IN52              1                 
0544.00 C     DATE          MULT      .0001         #YEAR             2 0    99         
0545.00 C**                   SUB  88        #YEAR              平成                    
0546.00 C  N99DATE          MULT      .01           #MONTH            2 0    99         
0547.00 C  N99              Z-ADD     DATE          #DAY              2 0    99         
0548.00 C  N99#MONTH        COMP      12                                 99             
0549.00 C  N99#YEAR         MULT      .25           #CHKLY            1 1    50         
0550.00 C  N99#MONTH        COMP      2                                      51         
0551.00 C  N99#MONTH        MULT(H)   1.07          #MONTH                              
0552.00 C  N99#MONTH        DIV       2             #CHKLY                   52
0553.00 C  N99                                                                 
0554.00 CANN51                                                                 
0555.00 CAN 52#DAY          COMP      30                                 99    
0556.00 C  N99                                                                 
0557.00 CANN51                                                                 
0558.00 CANN52#DAY          COMP      31                                 99    
0559.00 C  N99                                                                 
0560.00 CAN 51                                                                 
0561.00 CANN50#DAY          COMP      28                                 99    
0562.00 C  N99                                                                 
0563.00 CAN 51                                                                 
0564.00 CAN 50#DAY          COMP      29                                 99    
0565.00 C                   MOVE      IN51          *IN51                      
0566.00 C                   MOVE      IN52          *IN52                      
0567.00 C     DATEND        ENDSR                                              
0568.00 C******************************************************                
0569.00 C     PROMPT        BEGSR                                              
0570.00 C******************************************************                
0571.00 C                   EXSR      CURSOR                                   
0572.00 C                   EXSR      LINCHK                                   
0573.00 C   99              GOTO      DSPLY                                    
0574.00 C*( ポップ・アップ・ウインドウ・パネルの呼出し )                       
0575.00 C*----------------------------------------------------+                
0576.00 C                   CALL      ANS005                                       |ウィンドウ 表示   
0577.00 C                   PARM                    SEL001           10            |              
0578.00 C*----------------------------------------------------+                                   
0579.00 C*( 選択結果を更新 )                                                                      
0580.00 C                   MOVEL     SEL001        JHCODE                                        
0581.00 C     SEL001        IFNE      *BLANKS                                                     
0582.00 C                   MOVE      *ZEROS        JUTANK                                        
0583.00 C                   MOVE      *ZEROS        JUSUR                                         
0584.00 C                   MOVE      *ZEROS        JUKING                                        
0585.00 C                   EXSR      CHECK                                                       
0586.00 C                   SETON                                        71                       
0587.00 C*----------------------------------------------------+                                   
0588.00 C                   UPDATE    SFREC01                                      |              
0589.00 C*----------------------------------------------------+                                   
0590.00 C                   SETOFF                                       71                       
0591.00 C                   END                                                                   
0592.00 C                   ENDSR                                                                 
0593.00 C*****************************************************                                    
0594.00 C     CURSOR        BEGSR                                                                 
0595.00 C*****************************************************                                    
0596.00 C     LINE          DIV       256           LIN               3 0          ガメン の行数    
0597.00 C                   MVR                     POS               3 0          ガメン の桁数    
0598.00 C                   ENDSR                                                                 
0599.00 C******************************************************                                   
0600.00 C     LINCHK        BEGSR                                                  
0601.00 C******************************************************                    
0602.00 C     STRGYO        ADD       GYOSU         ENDGYO            2 0          
0603.00 C                   SUB       1             ENDGYO                         
0604.00 C* カーソル は開始行と終了行とのあいだにあるか                                 
0605.00 C     LIN           COMP      STRGYO                             50  50    
0606.00 C   50LIN           COMP      ENDGYO                               5050    
0607.00 C* 94: カーソル が適切な位置になかった                                         
0608.00 C  N50              SETON                                        9967      
0609.00 C   99              GOTO      LINEND                                       
0610.00 C     LIN           SUB       STRGYO        RRN1                           
0611.00 C                   ADD       TOPRRN        RRN1                           
0612.00 C                   SETOFF                                       90        
0613.00 C     RRN1          CHAIN     SFREC01                            90        
0614.00 C   90              GOTO      LINEND                                       
0615.00 C                   Z-ADD     RRN1          DSPREC                         
0616.00 C*( 更新する ファイル に  CHAIN )                                              
0617.00 C                   SETOFF                                       90        
0618.00 C     TRNKEY        CHAIN(N)  JUCHU                              90        
0619.00 C*( DUMMY EXCPT )                                                          
0620.00 C*----------------------------------------------------+                    
0621.00 C* N90                UPDATJUCHUR                     | CHG                
0622.00 C*----------------------------------------------------+                    
0623.00 C     LINEND        ENDSR                                                  

【 解説 】

CF04 キーを押したときには

0111.00 C*( CF04 )- プロンプト                                                                  
0112.00 C     *IN04         IFEQ      *ON                                          CF04         
0113.00 C     FLD           IFEQ      JHCOD                                                     
0114.00 C     CSRP          ANDGT     *ZEROS                                                    
0115.00 C                   EXSR      PROMPT                                                    
0116.00 C   99              GOTO      DSPLY                                                     
0117.00 C                   ELSE                                                                
0118.00 C                   SETON                                        6799      ERR          
0119.00 C                   GOTO      DSPLY                                                     
0120.00 C                   END                                                               
0121.00 C                   END                                                    CF04 

のようにして POPUP を表示しているがマウス操作を追加したからといっても
RPG は何ら変更を加えてはいない。