H DFTNAME(SMP106) DATEDIT(*YMD/)                                                               
     F**********  振替伝票の入力 **************************************                             
     FSMP106FM  CF   E             WORKSTN                                                          
     F                                     SFILE(SFREC01:RRN1)                                      
     F                                     INFDS(INFDS)                                             
     F                                     MAXDEV(*FILE)                                            
     FFRIKAE    UF A E           K DISK                                                             
     FBUKAM     IF   E           K DISK                                                             
     FTANTOM    IF   E           K DISK                                                             
     FKAMOKU    IF   E           K DISK                                                             
     F*****************************************************************                             
     D SAVDTA          S              1    DIM(1024)                             SAVE-ﾃﾞｰﾀ          
     D*       読み取り ﾌｧｲﾙ の FORMAT を外部 DS として READ                                         
     D DATADS        E DS                  EXTNAME(FRIKAE)                                          
     D  MIDDTA                 1     22                                                             
     D  DSPDTA                 1   1024                                                             
     D                                     DIM(1024)                             入力 ﾃﾞｰﾀ          
     D*                                                                                             
     D*         -( ｻﾌﾞ･ﾌｧｲﾙ の ﾌｧｲﾙ 情報 )-                                                         
     D*                                                                                             
     D INFDS           DS                                                                           
     D  NUMROW               152    153B 0                                                          
     D  NUMCOL               154    155B 0                                                          
     D*( ｶｰｿﾙ の行と桁の取り込み )                                                                  
     D  LINE                 370    371B 0                                                          
     D*  TOPRRN: 今表示している ｻﾌﾞ･ﾌｧｲﾙ の先頭の RRN                                               
     D  TOPRRN               378    379B 0                                                          
     D* BRRN : ｻﾌﾞﾌｧｲﾙ の ﾚｺｰﾄﾞNO ( 2 進数 )                                                        
     D  BRRN                 376    377B 0                                                          
     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                 DS                                                                           
     D  RRN1                   1      4  0                                                          
     D  EOF                    5      5                                                             
     D  FLD1                   6      6                                                             
     D  DATE                   7     12  0                                                          
     D  DENNO                 13     18  0                                                          
     C*( 初期画面 )                                                                                 
     C                   MOVE      '000001'      FRDENN                                             
     C                   GOTO      HEDSTR                                                           
     C*----------------------------------------------------+                                        
     C     START         TAG                                                    |                   
     C                   EXFMT     DSPHEAD                                      |                   
     C*----------------------------------------------------+                                        
     C                   SETOFF                                       99                            
     C*( CF03 )- 終了                                                                               
     C     *IN03         IFEQ      *ON                                          CF03                
     C                   EXSR      LRRTN                                                            
     C   LR              RETURN                                                                     
     C                   GOTO      START                                                            
     C                   END                                                    CF03                
     C*( 実行キー )                                                                                 
     C*                     |                                                                       
     C*                     |                                                                       
     C*   : 初期画面のチエック                                                                      
     C     HEDSTR        TAG                                                                        
     C                   EXSR      HEDCHK                                                           
     C   99              GOTO      START                                                            
     C*                     |                                                                       
     C*   : ＫＥＹをファイルにセット                                                                
     C*----------------------------------------------------+                                        
     C     SETKEY        KLIST                                                  |                   
     C                   KFLD                    FRDENN                         |                   
     C                   KFLD                    FRGYO                          |                   
     C*----------------------------------------------------+                                        
     C*( *LOVAL のセット )                                                                          
     C                   MOVE      *ZEROS        FRGYO                                              
     C                   EXSR      SFLCLR                                                           
     C     SETKEY        SETLL     FRIKAE                                                           
     C                   Z-ADD     0             GOKEI                                              
     C*   : ファイルの読み取り                                                                      
     C                   Z-ADD     1             TOPRRN                                             
     C                   EXSR      READ                                                             
     C                   Z-ADD     1             DSPREC                                             
     C*( サブ・ファイルの表示 )                                                                     
     C*----------------------------------------------------+                                        
     C     DSPLY         TAG                                                    |                   
     C                   SETON                                        41        |                   
     C     BRRN          IFGT      *ZEROS                                       |                   
     C                   SETON                                        42        |                   
     C                   WRITE     GRDREC                                       |                   
     C                   ELSE                                                   |                   
     C*   ( 検索した見つかったレコードがない )             |                                        
     C                   WRITE     NOREC                                        |                   
     C                   ENDIF                                                  |                   
     C                   WRITE     DSPEND01                                     |                   
     C                   EXFMT     SFCTL01                                      |                   
     C                   SETOFF                                       4142      |                   
     C*----------------------------------------------------+                                        
     C                   SETOFF                                       99                            
     C*( CF03 )- 終了                                                                               
     C     *IN03         IFEQ      *ON                                          CF03                
     C                   WRITE     GRDCLR                                                           
     C                   EXSR      LRRTN                                                            
     C   LR              RETURN                                                                     
     C                   GOTO      DSPLY                                                            
     C                   ENDIF                                                  CF03                
     C*                                                                                             
     C*( CF12 )- 前画面                                                                             
     C     *IN12         IFEQ      *ON                                          CF12                
     C                   SETOFF                                       12                            
     C                   EXSR      SFLDLT                                                           
     C                   WRITE     GRDCLR                                                           
     C                   GOTO      START                                                            
     C                   ENDIF                                                  CF12                
     C*                     |                                                                       
     C*( ROLL UP )- 次ページ                                                                        
     C     *IN14         IFEQ      *ON                                                              
     C                   EXSR      ROLLUP                                                           
     C                   GOTO      DSPLY                                                            
     C                   ENDIF                                                                      
     C*( ROLL DOWN )- 前ページ                                                                      
     C     *IN15         IFEQ      *ON                                                              
     C                   Z-ADD     1             DSPREC                                             
     C                   SETON                                        6299      ERRMSG              
     C                   GOTO      DSPLY                                                            
     C                   ENDIF                                                                      
     C*                                                                                             
     C     TOPRRN        IFNE      *ZEROS                                                           
     C                   Z-ADD     TOPRRN        DSPREC                                             
     C                   ENDIF                                                                      
     C*( 実行キー )                                                                                 
     C*   : 見出し画面のチエック                                                                    
     C  N23              EXSR      MIDCHK                                                           
     C   99              GOTO      DSPLY                                                            
     C*   : 見出し項目のＳＡＶＥ                                                                    
     C                   MOVE      MIDDTA        MIDSAV                                             
     C     *LIKE         DEFINE    MIDDTA        MIDSAV                                             
     C*   : 明細画面のチエック                                                                      
     C     1             DO        *HIVAL        RRN1                                               
     C*( 実行キー )                                                                                 
     C  N10                                                                                         
     CANN23              READC     SFREC01                                50                        
     C*( CF10 )- 更新                                                                               
     C*( CF23 )- 削除                                                                               
     C   10                                                                                         
     COR 23RRN1          CHAIN     SFREC01                            50                            
     C   50              LEAVE                                                                      
     C*   :  ブランク・キー入力のオミット                                                           
     C     FRKRCD        IFEQ      *BLANKS                                                          
     C     FRKSCD        ANDEQ     *BLANKS                                                          
     C                   ITER                                                                       
     C                   ENDIF                                                                      
     C*                                                                                             
     C                   Z-ADD     BRRN          DSPREC                                             
     C*---------------------+                                                                       
     C* 入力明細行のチエック                                                                        
     C*---------------------+                                                                       
     C                   MOVEL     GYO           FLD1                                               
     C     FLD1          IFNE      'D'                                           削除 ?             
     C     *IN23         ANDEQ     *OFF                                                             
     C                   EXSR      CHECK                                                            
     C   99              GOTO      SFLWRT                                                           
     C                   ENDIF                                                                      
     C*---------------------+                                                                       
     C* データ・ベース更新                                                                          
     C*---------------------+                                                                       
     C     *IN10         IFEQ      *ON                                          F10,F23             
     C     *IN23         OREQ      *ON                                                              
     C*----------------------------------------------------+                                        
     C     TRNKEY        KLIST                                                  |                   
     C                   KFLD                    FRDENN                         |                   
     C                   KFLD                    FRGYO                          |                   
     C*----------------------------------------------------+                                        
     C*   : 更新キーを生成                                                                          
     C                   MOVE      RRN1          FRGYO                                              
     C                   MOVE      DSPDTA        SAVDTA                                             
     C*   : データ・ベース検索                                                                      
     C     *NOKEY        CLEAR                   FRIKAER                                            
     C                   SETOFF                                       90                            
     C     TRNKEY        CHAIN     FRIKAE                             90                            
     C                   MOVE      SAVDTA        DSPDTA                                             
     C*   : データ・ベースへ追加・更新                                                              
     C                   MOVEL     GYO           FLD1              1                                
     C     FLD1          COMP      'D'                                    50                        
     C   23              SETON                                        50                            
     C*----------------------------------------------------+                                        
     C   90                                                                                         
     CANN50              WRITE     FRIKAER                                      | ADD               
     C  N90                                                                                         
     CANN50              UPDATE    FRIKAER                                      | CHG               
     C  N90                                                                                         
     CAN 50              DELETE    FRIKAER                                      | DLT               
     C*----------------------------------------------------+                                        
     C   90              ADD       1             ADDREC            5 0                              
     C  N90                                                                                         
     CANN50              ADD       1             CHGREC            5 0                              
     C  N90                                                                                         
     CAN 50              ADD       1             DLTREC            5 0                              
     C                   ENDIF                                                  F10,F23             
     C*---------------------+                                                                       
     C* サブ・ファイル更新                                                                          
     C*---------------------+                                                                       
     C     SFLWRT        TAG                                                                        
     C                   MOVE      TOPRRN        TOPSAV                                             
     C     *LIKE         DEFINE    TOPRRN        TOPSAV                                             
     C*  ( 合計の加減を計算 )                                                                       
     C                   SUB       FBKING        GOKEI                                              
     C                   ADD       FRKING        GOKEI                                              
     C                   Z-ADD     FRKING        FBKING                                             
     C*----------------------------------------------------+                                        
     C                   UPDATE    SFREC01                                      |                   
     C*----------------------------------------------------+                                        
     C                   Z-ADD     BRRN          DSPREC                                             
     C                   MOVE      TOPSAV        TOPRRN                                             
     C   99              GOTO      DSPLY                                         エラー             
     C*                                                                                             
     C                   ENDDO                                                                      
     C*( CF10 )- 更新                                                                               
     C*( CF23 )- 削除                                                                               
     C     *IN10         IFEQ      *ON                                                              
     C     *IN23         OREQ      *ON                                                              
     C                   GOTO      START                                                            
     C*( 実行キー )                                                                                 
     C                   ELSE                                                                       
     C                   GOTO      DSPLY                                                            
     C                   ENDIF                                                                      
     C*                                                                                             
     C     END           TAG                                                                        
     C******************************************************                                        
     C     *INZSR        BEGSR                                                                      
     C******************************************************                                        
     C*  初期サイクルのみの実行                                                                     
     C*(  サブ・ファイル END-FLAG を ON にする )                                                    
     C                   SETON                                        45                            
     C*( DS の数字 ﾌｨｰﾙﾄﾞ のクリヤー )                                                              
     C     *NOKEY        CLEAR                   FRIKAER                                            
     C                   Z-ADD     0             RRN1                                               
     C                   EXSR      SFLINZ                                                           
     C                   MOVE      05            GYOSU             2 0           行数               
     C                   MOVE      09            STRGYO            2 0           開始行�Y           
     C                   MOVE      20150101      SRYMD                                              
     C                   MOVE      150101        DATE                                               
     C                   SETON                                        11                            
     C                   SETOFF                                       11                            
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     HEDCHK        BEGSR                                                                      
     C******************************************************                                        
     C*( 初期画面チエック )                                                                         
     C*----------------------------------------------------*                                        
     C*( FRDENN    :  伝票�Y                ( 自動発生 )                                            
     C*----------------------------------------------------*                                        
     C     FRDENN        IFEQ      *BLANKS                                                          
     C     *HIVAL        SETGT     FRIKAE                                                           
     C                   READP     FRIKAE                                 50                        
     C     *IN50         IFEQ      *ON                                                              
     C                   MOVE      '000001'      FRDENN                                             
     C                   ELSE                                                                       
     C                   MOVE      FRDENN        DENNO                                              
     C                   ADD       1             DENNO                                              
     C                   MOVE      DENNO         FRDENN                                             
     C                   ENDIF                                                                      
     C*----------------------------------------------------*                                        
     C*( FRDATE    :  伝票日付             :( UDATE )                                               
     C*----------------------------------------------------*                                        
     C                   MOVE      UDATE         YYMMDD                                             
     C                   MOVE      SRYMD         FRDATE                                             
     C*----------------------------------------------------*                                        
     C*( FRBKCD    :  部課コード         :( CHAIN ファイル )                                        
     C*----------------------------------------------------*                                        
     C                   MOVE      '92'          FRBKCD                                             
     C*----------------------------------------------------*                                        
     C*( FRTANC    :  担当者コード       :( CHAIN ファイル )                                        
     C*----------------------------------------------------*                                        
     C                   MOVE      '1201'        FRTANC                                             
     C                   EXSR      MIDCHK                                                           
     C                   ENDIF                                                                      
     C     HEDEND        ENDSR                                                                      
     C******************************************************                                        
     C     MIDCHK        BEGSR                                                                      
     C******************************************************                                        
     C*( 見出しチエック )                                                                           
     C*----------------------------------------------------*                                        
     C*( FRDATE    :  伝票日付             :( DATCHK 日付 )                                         
     C*----------------------------------------------------*                                        
     C                   MOVE      FRDATE        DATE                                               
     C                   EXSR      DATCHK                                                           
     C   99              SETON                                        63                            
     C   99              GOTO      MIDEND                                                           
     C*----------------------------------------------------*                                        
     C*( FRBKCD    :  部課コード         :( CHAIN ファイル )                                        
     C*----------------------------------------------------*                                        
     C                   MOVE      *BLANKS       BKNAME                                             
     C                   SETOFF                                       99                            
     C     FRBKCD        CHAIN     BUKAM                              99                            
     C   99              SETON                                        64                            
     C   99              GOTO      MIDEND                                                           
     C*----------------------------------------------------*                                        
     C*( FRTANC    :  担当者コード       :( CHAIN ファイル )                                        
     C*----------------------------------------------------*                                        
     C                   MOVE      *BLANKS       TTNAMJ                                             
     C                   SETOFF                                       99                            
     C     FRTANC        CHAIN     TANTOM                             99                            
     C   99              SETON                                        65                            
     C   99              GOTO      MIDEND                                                           
     C     MIDEND        ENDSR                                                                      
     C******************************************************                                        
     C     READ          BEGSR                                                                      
     C******************************************************                                        
     C                   MOVE      *BLANKS       EOF                                                
     C                   SETOFF                                       45                            
     C                   MOVE      MIDDTA        MIDSAV                                             
     C*( データ・ベースの検索 )                                                                     
     C*----------------------------------------------------+                                        
     C     EQLKEY        KLIST                                                  |                   
     C                   KFLD                    FRDENN                         |                   
     C*----------------------------------------------------+                                        
     C     TOPRRN        ADD       GYOSU         ENDRRN            4 0                              
     C                   SUB       1             ENDRRN                                             
     C*                                                                                             
     C     TOPRRN        DO        ENDRRN        RRN1                           READ                
     C                   SETOFF                                       50                            
     C     EQLKEY        READE     FRIKAE                                 50                        
     C*( 終り )                                                                                     
     C     *IN50         IFEQ      *ON                                          EOF                 
     C                   MOVE      'E'           EOF                                                
     C                   SETOFF                                       1129                          
     C                   SETON                                        45                            
     C                   EXSR      SFLINZ                                                           
     C                   ELSE                                                   EOF                 
     C     RRN1          IFEQ      TOPRRN                                                           
     C                   MOVE      MIDDTA        MIDSAV                                             
     C                   Z-ADD     RRN1          DSPREC                                             
     C                   EXSR      MIDCHK                                                           
     C                   ENDIF                                                                      
     C                   Z-ADD     FRKING        FBKING                                             
     C                   ADD       FRKING        GOKEI                                              
     C*( CHECK  : READ したレコードの妥当性検査 )                                                   
     C                   EXSR      CHECK                                                            
     C                   ENDIF                                                  EOF                 
     C*( 行 NO に入れる )                                                                           
     C                   MOVE      RRN1          GYO                                                
     C*( サブ・ファイルへ更新 )                                                                     
     C*----------------------------------------------------+                                        
     C                   WRITE     SFREC01                                      |                   
     C*----------------------------------------------------+                                        
     C                   ENDDO                                                  READ                
     C                   MOVE      MIDSAV        MIDDTA                                             
     C     REDEND        ENDSR                                                                      
     C******************************************************                                        
     C     CHECK         BEGSR                                                                      
     C******************************************************                                        
     C*( 明細チエック )                                                                             
     C*----------------------------------------------------*                                        
     C*( FRKRCD    :  借方科目コード     :( CHAIN ファイル )                                        
     C*----------------------------------------------------*                                        
     C                   MOVE      *BLANKS       FRKRNM                                             
     C                   SETOFF                                       99                            
     C     FRKRCD        CHAIN     KAMOKU                             99                            
     C   99              SETON                                        66                            
     C   99              GOTO      CHKEND                                                           
     C                   MOVE      KMNAME        FRKRNM                                             
     C*----------------------------------------------------*                                        
     C*( FRKSCD    :  貸方科目コード     :( CHAIN ファイル )                                        
     C*----------------------------------------------------*                                        
     C                   MOVE      *BLANKS       FRKSNM                                             
     C                   SETOFF                                       99                            
     C     FRKSCD        CHAIN     KAMOKU                             99                            
     C   99              SETON                                        67                            
     C   99              GOTO      CHKEND                                                           
     C                   MOVE      KMNAME        FRKSNM                                             
     C     CHKEND        ENDSR                                                                      
     C******************************************************                                        
     C     DATCHK        BEGSR                                                                      
     C******************************************************                                        
     C*( 日付 ﾁｴｯｸ ｻﾌﾞ･ﾙｰﾁﾝ )       FOR YY/MM/DD                                                    
     C                   MOVE      *IN51         IN51              1                                
     C                   MOVE      *IN52         IN52              1                                
     C     DATE          MULT      .0001         #YEAR             2 0    99                        
     C**                   SUB  88        #YEAR              平成                                   
     C  N99DATE          MULT      .01           #MONTH            2 0    99                        
     C  N99              Z-ADD     DATE          #DAY              2 0    99                        
     C  N99#MONTH        COMP      12                                 99                            
     C  N99#YEAR         MULT      .25           #CHKLY            1 1    50                        
     C  N99#MONTH        COMP      2                                      51                        
     C  N99#MONTH        MULT(H)   1.07          #MONTH                                             
     C  N99#MONTH        DIV       2             #CHKLY                   52                        
     C  N99                                                                                         
     CANN51                                                                                         
     CAN 52#DAY          COMP      30                                 99                            
     C  N99                                                                                         
     CANN51                                                                                         
     CANN52#DAY          COMP      31                                 99                            
     C  N99                                                                                         
     CAN 51                                                                                         
     CANN50#DAY          COMP      28                                 99                            
     C  N99                                                                                         
     CAN 51                                                                                         
     CAN 50#DAY          COMP      29                                 99                            
     C                   MOVE      IN51          *IN51                                              
     C                   MOVE      IN52          *IN52                                              
     C     DATEND        ENDSR                                                                      
     C******************************************************                                        
     C     SFLCLR        BEGSR                                                                      
     C******************************************************                                        
     C*( サブ・ファイルのクリヤー )                                                                 
     C*----------------------------------------------------+                                        
     C                   SETON                                        44        |                   
     C                   WRITE     SFCTL01                                      |                   
     C                   SETOFF                                       44        |                   
     C*----------------------------------------------------+                                        
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     SFLDLT        BEGSR                                                                      
     C******************************************************                                        
     C*( サブ・ファイルの削除 )                                                                     
     C*----------------------------------------------------+                                        
     C                   SETON                                        46        |                   
     C                   WRITE     SFCTL01                                      |                   
     C                   SETOFF                                       46        |                   
     C*----------------------------------------------------+                                        
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     SFLINZ        BEGSR                                                                      
     C******************************************************                                        
     C*( サブ・ファイルの初期化 )                                                                   
     C                   CLEAR                   SFREC01                                            
     C                   EXSR      INZVAR                                        初期値             
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     INZVAR        BEGSR                                                                      
     C******************************************************                                        
     C*( 初期値 )                                                                                   
     C                   MOVE      RRN1          FRGYO                                              
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     ROLLUP        BEGSR                                                                      
     C******************************************************                                        
     C                   SETOFF                                       45                            
     C     ENDRRN        ADD       1             TOPRRN                                             
     C                   Z-ADD     TOPRRN        DSPREC                                             
     C                   EXSR      READ                                                             
     C                   SETON                                        45                            
     C     UPEND         ENDSR                                                                      
     C******************************************************                                        
     C     LRRTN         BEGSR                                                                      
     C******************************************************                                        
     C*( 終了画面 )                                                                                 
     C                   MOVE      'Y'           ANS                                                
     C*----------------------------------------------------+                                        
     C                   EXFMT     ENDOPT                                       |                   
     C*----------------------------------------------------+                                        
     C                   SETOFF                                       99                            
     C*( CF12 )- 前画面                                                                             
     C     *IN12         IFEQ      *ON                                                              
     C                   GOTO      LREND                                                            
     C                   ENDIF                                                                      
     C*( 実行キー )                                                                                 
     C     ANS           IFEQ      'N'                                                              
     C                   GOTO      LREND                                                            
     C                   ENDIF                                                                      
     C*( LR- 終了 )                                                                                 
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
     C     LREND         ENDSR