H DFTNAME(AA_SFL) DATEDIT(*YMD/) BNDDIR('QC2LE')                                               
     F********** AA_SFL *************************************************                           
     FANS004FM  CF   E             WORKSTN                                                          
     F                                     SFILE(SFREC01:RRN1)                                      
     F                                     INFDS(INFDS)                                             
     FSQLFUNCOL IF A E           K DISK                                                             
     F                                     EXTFILE(SQLFUN_LIB)                                      
     F**********************************************************************                        
                                                                                                    
      * CRTRPGMOD  OBJ(QTEMP/AA_SFL)   SRCFILE(R610SRC/QRPGLESRC)                                   
      * DBGVIEW(*SOURCE) AUT(*ALL)                                                                  
      * CRTPGM PGM(ASNET.COM/AA_SFL) MODULE(QTEMP/AA_SFL ACTGRP(*NEW)                               
      *        AUT(*ALL)                                                                            
                                                                                                    
      *-------------------------------------------------------------------*                         
      *  2017/05/01 : 作成                                                                          
      *-------------------------------------------------------------------*                         
     D INFDS           DS                                                                           
     D*( eｰmy の行と桁の取り込み )                                                                  
     D  LINE                 370    371B 0                                                          
     D*  TOPRRN: 今表示している iﾊﾞｦﾊｨay の先頭の RRN                                               
     D  TOPRRN               378    379B 0                                                          
     D* BRRN : iﾊﾞﾊｨay の z[ｰqﾞNO ( 2 進数 )                                                        
     D  BRRN                 376    377B 0                                                          
                                                                                                    
      *( 作業変数 )                                                                                 
     D SQLFUN_LIB      S             21    INZ('QUSRTEMP/SQLFUNCOL')                                
     D AR              S              1A   DIM(256)                                                 
     D N               S              4S 0                                                          
     D TRUE            S              1A   DIM(256)                                                 
     D TRUE#           S              4B 0 INZ(0)                                                   
     D FALSE#          S              4B 0 INZ(-1)                                                  
     D QUOT            C                   CONST(X'7D')                                             
     D OE              C                   CONST(X'0E')                                             
     D OF              C                   CONST(X'0F')                                             
     D NULL            C                   CONST(X'00')                                             
                                                                                                    
     D*( プログラム状況データ構造 )                                                                 
     D INFDS_THIS     SDS                                                                           
     D  PROC_NAM         *PROC                                                                      
     D  ROUTINE          *ROUTINE                                                                   
     D                              512A                                                            
     D  PGMINFO                1    512                                                             
     D  LINE_NUM              21     28                                                             
     D  CPFID                 40     46                                                             
     D  CPFDTA                91    170                                                             
     D  ERRMSGID              46     51                                                             
     D  CURUSR               358    367                                                             
                                                                                                    
     D*( WORK 日付 YYMMDD ｺﾞｰn 構造  )                                                              
     D DATEDS          DS                                                                           
     D  CENTURY                1      2  0 INZ(20)                                                  
     D  YYMMDD                 3      8  0                                                          
     D  YY                     3      4                                                             
     D  MM                     5      6                                                             
     D  DD                     7      8                                                             
     D  CYY                    1      4                                                             
                                                                                                    
     D* ＬＩＢ名付きＰＧＭ名                                              *                         
     D ANS005          C                   CONST('QTROBJ/ANS005')                                   
                                                                                                    
     C*   : ＫＥＹをファイルにセット                                                                
     C*--------------------------------------------------------------------------                   
     C     USRKEY        KLIST                                                  |                   
     C                   KFLD                    USER                           |                   
     C*--------------------------------------------------------------------------                   
     C                   EXSR      SFLCLR                                                           
     C     SETKEY        SETLL     JUCHU                                                            
     C*   : ファイルの読み取り                                                                      
     C                   Z-ADD     1             TOPRRN                                             
     C                   EXSR      READ                                                             
     C                   Z-ADD     1             DSPREC                                             
     C*( サブ・ファイルの表示 )                                                                     
     C*----------------------------------------------------+                                        
     C     DSPLY         TAG                                                    |                   
     C                   WRITE     DSPEND01                                     |                   
     C                   SETON                                        4142      |SFL-DSPLY          
     C                   EXFMT     SFCTL01                                      |                   
     C                   SETOFF                                       4142      |                   
     C*----------------------------------------------------+                                        
     C                   SETOFF                                       99                            
     C*( CF03 )- 終了                                                                               
     C     *IN03         IFEQ      *ON                                          CF03                
     C                   SETON                                        LR                            
     C   LR              RETURN                                                                     
     C                   ENDIF                                                  CF03                
     C*( 実行キー )                                                                                 
     C                   GOTO      DSPLY                                                            
     C                   RETURN                                                                     
     C******************************************************                                        
     C     *INZSR        BEGSR                                                                      
     C******************************************************                                        
     C*  初期 CYCLE のみの実行                                                                      
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     READ          BEGSR                                                                      
     C******************************************************                                        
     C*( データ・ベースの検索 )                                                                     
     C*----------------------------------------------------+                                        
     C     EQLKEY        KLIST                                                  |                   
     C                   KFLD                    JUCNO                          |                   
     C*----------------------------------------------------+                                        
     C     RTNRED        TAG                                                                        
     C*                                                                                             
     C     TOPRRN        ADD       GYOSU         ENDRRN            4 0                              
     C                   SUB       1             ENDRRN                                             
     C*                                                                                             
     C                   Z-ADD     TOPRRN        DSPREC                                             
     C     TOPRRN        DO        ENDRRN        RRN1              4 0          READ                
     C                   SETOFF                                       50                            
     C     EQLKEY        READE     JUCHU                                  50                        
     C   50              LEAVE                                                                      
     C*( 行 NO に入れる )                                                                           
     C                   MOVE      RRN1          GYO                                                
     C*( iﾊﾞﾊｨay へ更新 )                                                                           
     C*----------------------------------------------------+                                        
     C                   WRITE     SFREC01                                      |                   
     C*----------------------------------------------------+                                        
     C     RRN1          IFEQ      TOPRRN                                                           
     C                   MOVE      RRN1          DSPREC                                             
     C                   ENDIF                                                                      
     C                   END                                                    READ                
     C     REDEND        ENDSR                                                                      
     C******************************************************                                        
     C     SFLCLR        BEGSR                                                                      
     C******************************************************                                        
     C*( iﾊﾞﾊｨay の gxtｰ )                                                                          
     C*----------------------------------------------------+                                        
     C                   SETON                                        44                            
     C                   WRITE     SFCTL01                                                          
     C                   SETOFF                                       44                            
     C*----------------------------------------------------+                                        
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     SFLBLK        BEGSR                                                                      
     C******************************************************                                        
     C*( iﾊﾞﾊｨay の初期化 )                                                                         
     C                   CLEAR                   SFREC01                                            
     C                   EXSR      INZVAR                                        初期値             
     C                   MOVE      HED001        JUCNO                                              
     C                   ENDSR