H DFTNAME(CAMERAD) DATEDIT(*YMD/)BNDDIR('QC2LE')                                               
     F********  部品検収の入力 ****************************************                             
     FCAMERADFM CF   E             WORKSTN                                                          
     FBUHINM    IF   E           K DISK                                                             
     FBKENSHU   UF A E           K DISK                                                             
     F                                     INFDS(INFDSF)                                            
     F*****************************************************************                             
      *    QTRSRC/QRPGLESRC(CAMERAD)                                                                
      *     使用目的    :   更新 (*UPDATE)                                                          
      *     作成日      :  2021/07/21         13:33:02                                              
      *     作成者      :  QTR                                                                      
                                                                                                    
     D IFR             S             32    DIM(1) CTDATA PERRCD(1)               見出し             
     D INFDSF          DS                  QUALIFIED                                                
      * オープン・フィードバック域   160 BYTES 81-240                                               
     D  OPNFBK                81    240                                          ファイル名         
     D   ODP_TYPE             81     82                                         ODP タイプ          
     D   FILE_NAME            83     92                                         ODP タイプ          
     D   LIBRARY              93    102                                         ODP タイプ          
     D   MEMBER              129    138                                          メンバー名         
                                                                                                    
     D*( WORK 日付 YYMMDD ﾃﾞｰﾀ 構造  )                                                              
     D DATEDS          DS                                                                           
     D  SRY                    1      2  0                                                          
     D  SRYMD                  1      8  0                                                          
     D  YYMMDD                 3      8  0                                                          
     D  YYMM                   3      6  0                                                          
     D  MMDD                   5      8  0                                                          
     D  YY                     3      4  0                                                          
     D  MM                     5      6  0                                                          
     D  DD                     7      8  0                                                          
                                                                                                    
     D SAVEDS        E DS                  EXTNAME(BKENSHU)                                         
     D  DSPDTA                 1   1024                                                             
     D                                     DIM(1024)                             入力 ﾃﾞｰﾀ          
                                                                                                    
      *[ 注意 ]                                                                                     
      * このプログラムはパラメータつきで呼び出すことができます。                                    
      * パラメータなしで呼び出された場合は単独で動作します。                                        
     C*----------------------------------------------------+                                        
     C     *ENTRY        PLIST                                                  |                   
     C                   PARM                    SEL001                                             
     C                   PARM                    SEL002                                             
     C*----------------------------------------------------+                                        
     C     *LIKE         DEFINE    BKNCOD        SEL001                                             
     C     *LIKE         DEFINE    BKDATE        SEL002                                             
     C                   IF        %PARMS > 0                                                       
     C                   MOVE      SEL001        BKNCOD                                             
     C                   MOVE      SEL002        BKDATE                                             
     C                   GOTO      GET_RECORD                                                       
     C                   ELSE                                                                       
     C                   MOVEL     'WUK-0001'    BKNCOD                                             
     C                   MOVE      SRYMD         BKDATE                                             
     C                   Z-ADD     1             BKNUKO                                             
     C                   GOTO      GET_RECORD                                                       
     C                   ENDIF                                                                      
     C*----------------------------------------------------+                                        
     C     RECKEY        KLIST                                                                      
     C                   KFLD                    BKNCOD                                             
     C                   KFLD                    BKDATE                                             
     C*----------------------------------------------------+                                        
     C*( 初期画面 )                                                                                 
     C*----------------------------------------------------+                                        
     C     START         TAG                                                    |                   
     C                   EXFMT     DSPHEAD                                      |                   
     C*----------------------------------------------------+                                        
     C                   SETOFF                                       99                            
     C*( CF03 )- 終了                                                                               
     C     *IN03         IFEQ      *ON                                          CF03                
     C                   SETON                                        LR                            
     C   LR              EXSR      LRRTN                                                            
     C   LR              RETURN                                                                     
     C                   GOTO      START                                                            
     C                   ENDIF                                                                      
     C*( ROLLUP )                                                                                   
     C     *IN07         IFEQ      *ON                                          CF03                
     C                   EXSR      ROLLUP                                                           
     C   99              GOTO      START                                                            
     C                   ENDIF                                                                      
     C*( ROLLDWN )                                                                                  
     C     *IN08         IFEQ      *ON                                          CF03                
     C                   EXSR      ROLLDWN                                                          
     C   99              GOTO      START                                                            
     C                   ENDIF                                                                      
     C*( 実行キー )                                                                                 
     C     GET_RECORD    TAG                                                                        
     C     *NOKEY        CLEAR                   BKENSHUR                                           
     C                   MOVEL     IFR(1)        BPHOTO                                             
     C                   SETOFF                                       90                            
     C     RECKEY        CHAIN     BKENSHU                            90                            
     C  N90              MOVEL     ' 変更 '      DSPMSG                                             
     C   90              MOVEL     ' 入力 '      DSPMSG                                             
     C                   EXSR      CHECK                                                            
     C   99              GOTO      START                                                            
     C*( 明細画面 )                                                                                 
     C*----------------------------------------------------+                                        
     C     DSPLY         TAG                                                    |                   
     C                   EXFMT     DSPDTA01                                     |                   
     C*----------------------------------------------------+                                        
     C                   SETOFF                                       99                            
     C*( CF03 )- 終了                                                                               
     C     *IN03         IFEQ      *ON                                          CF03                
     C                   SETON                                        LR                            
     C   LR              EXSR      LRRTN                                                            
     C   LR              RETURN                                                                     
     C                   GOTO      DSPLY                                                            
     C                   END                                                    CF03                
     C*( CF12 )- 前画面                                                                             
     C     *IN12         IFEQ      *ON                                          CF12                
     C                   SETOFF                                       12                            
     C                   GOTO      START                                                            
     C                   END                                                    CF12                
     C*( CF10 )- 更新                                                                               
     C     *IN10         IFEQ      *ON                                          CF10                
     C                   SETOFF                                       10                            
     C                   EXSR      CHECK                                                            
     C   99              GOTO      DSPLY                                                            
     C*----------------------------------------------------+                                        
     C   90              WRITE     BKENSHUR                                     |                   
     C  N90              UPDATE    BKENSHUR                                     |                   
     C*----------------------------------------------------+                                        
     C   90              ADD       1             ADDREC                                             
     C  N90              ADD       1             CHGREC                                             
     C                   GOTO      START                                                            
     C                   END                                                    CF10                
     C*( CF23 )- 削除                                                                               
     C     *IN23         IFEQ      *ON                                          CF23                
     C                   SETOFF                                       23                            
     C*----------------------------------------------------+                                        
     C  N90              DELETE    BKENSHUR                                     |                   
     C*----------------------------------------------------+                                        
     C  N90              ADD       1             DLTREC                                             
     C                   GOTO      START                                                            
     C                   END                                                    CF23                
     C*( ROLLUP )                                                                                   
     C     *IN07         IFEQ      *ON                                          CF03                
     C                   EXSR      ROLLUP                                                           
     C   99              GOTO      DSPLY                                                            
     C                   ENDIF                                                  CF12                
     C*( ROLLDWN )                                                                                  
     C     *IN08         IFEQ      *ON                                          CF03                
     C                   EXSR      ROLLDWN                                                          
     C   99              GOTO      DSPLY                                                            
     C                   ENDIF                                                                      
     C*( 実行キー )                                                                                 
     C                   GOTO      DSPLY                                                            
     C*                                                                                             
     C     END           TAG                                                                        
     C******************************************************                                        
     C     *INZSR        BEGSR                                                                      
     C******************************************************                                        
     C*  初期サイクルのみの実行                                                                     
     C                   Z-ADD     21            SRY                                                
     C                   MOVE      UDATE         YYMMDD                                             
     C     INZEND        ENDSR                                                                      
     C******************************************************                                        
     C     CHECK         BEGSR                                                                      
     C******************************************************                                        
     C*( 明細チエック )                                                                             
     C                   SETOFF                                       99                            
     C     BKNCOD        CHAIN     BUHINM                             99                            
     C     CHKEND        ENDSR                                                                      
     C******************************************************                                        
     C     LRRTN         BEGSR                                                                      
     C******************************************************                                        
     C                   MOVE      'Y'           ANS                                                
     C*----------------------------------------------------+                                        
     C     ENDDSP        TAG                                                    |                   
     C                   EXFMT     ENDOPT                                       |                   
     C*----------------------------------------------------+                                        
     C*( CF03 )- 終了                                                                               
     C     *IN03         IFEQ      *ON                                          CF03                
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
     C                   END                                                    CF03                
     C*( CF12 )- 前画面                                                                             
     C     *IN12         IFEQ      *ON                                          CF03                
     C                   SETOFF                                       LR                            
     C                   LEAVESR                                                                    
     C                   END                                                    CF03                
     C*( 実行キー )                                                                                 
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     ROLLUP        BEGSR                                                                      
     C******************************************************                                        
     C                   SETOFF                                       07                            
     C     RECKEY        SETGT     BKENSHU                                                          
     C                   READ      BKENSHU                                61                        
     C   61              SETON                                        99                            
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     ROLLDWN       BEGSR                                                                      
     C******************************************************                                        
     C                   SETOFF                                       07                            
     C     RECKEY        SETLL     BKENSHU                                                          
     C                   READP     BKENSHU                                61                        
     C   61              SETON                                        99                            
     C                   ENDSR                                                                      
**  IFR                                                                                             
/AS400-NET.USR/TEMP/ENGINE.PNG