H DFTNAME(FAXSPL) DATEDIT(*YMD/) BNDDIR('QC2LE')                                               
     F********** スプールの FAX 番号で送信 *********************************                        
     FHATTUL1   IF   E           K DISK                                                             
     FSIREMT    IF   E           K DISK                                                             
     FBUHINM    IF   E           K DISK                                                             
     FQPRINT    O    F  132        PRINTER OFLIND(*INOF)                                            
     F                                     FORMLEN(66)                                              
     F                                     FORMOFL(62)                                              
     F**********************************************************************                        
                                                                                                    
      * CRTBNDRPG  PGM(QTROBJ/FAXSPL)  SRCFILE(QTRSRC/QRPGLESRC)                                    
      * DFTACTGRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)                                      
                                                                                                    
      *-------------------------------------------------------------------*                         
      *  2020/12/23 : 作成                                                                          
      *-------------------------------------------------------------------*                         
      *( 作業変数 )                                                                                 
     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 HDR             S             32    DIM(1) CTDATA PERRCD(1)               見出し             
     D LIN             S              1    DIM(132)                                                 
                                                                                                    
                                                                                                    
     C*-------------------------------------------------------------------------+                   
     C     *ENTRY        PLIST                                                  |                   
     C                   PARM                    FROMSIR           4            |                   
     C                   PARM                    TOSIR             4            |                   
     C                   PARM                    DATEFROM          8 0          |                   
     C                   PARM                    DATEEND           8 0          |                   
     C                   PARM                    SRNMJ_           32            |                   
     C                   PARM                    LR                1            |                   
     C*-------------------------------------------------------------------------+                   
     C*----------------------------------------------------+                                        
     C     SETKEY        KLIST                                                                      
     C                   KFLD                    HTSRCD                                             
     C                   KFLD                    HTDATE                                             
     C                   KFLD                    HTHTNO                                             
     C                   KFLD                    HTGYO                                              
     C*----------------------------------------------------+                                        
     C                   MOVEA     *ALL'-'       LIN                                                
     C                   MOVEL     FROMSIR       HTSRCD                                             
     C                   MOVEL     DATEFROM      HTDATE                                             
     C                   MOVE      *LOVAL        HTHTNO                                             
     C                   MOVE      *LOVAL        HTGYO                                              
     C     SETKEY        SETGT     HATTUL1                                                          
     C                   DO        *HIVAL                                       DO-*HIVAL           
     C                   SETOFF                                       50                            
     C                   READ      HATTUL1                                50                        
     C   50              MOVE      '*'           LR                                                 
     C   50              LEAVE                                                                      
     C     SETKEY        SETLL     HATTUL1                                                          
     C*----------------------------------------------------+                                        
     C     EQLKEY        KLIST                                                                      
     C                   KFLD                    HTSRCD                                             
     C                   KFLD                    HTDATE                                             
     C*----------------------------------------------------+                                        
      *( 次の仕入先を READ )                                                                        
     C                   DO        *HIVAL                                         DO-*HIVAL-EQL     
     C                   SETOFF                                       50                            
     C     EQLKEY        READE     HATTUL1                                50                        
     C   50              MOVE      '*'           LR                                                 
     C   50              LEAVE                                                                      
     C     HTSRCD        IFGT      TOSIR                                                            
     C                   MOVE      '*'           LR                                                 
     C                   LEAVE                                                                      
     C                   ENDIF                                                                      
     C                   SETOFF                                       99                            
     C     HTSRCD        CHAIN     SIREMT                             99                            
     C                   MOVEL(P)  SRNMJ         SRNMJ_                                             
     C                   SETOFF                                       99                            
     C     HTBHCD        CHAIN     BUHINM                             99                            
     C*( 明細印刷 )                                                                                 
     C*-------------------------------------------------------------------------+                   
     C                   SETON                                        42        |                   
     C                   EXSR      OUTPUT                                       |                   
     C*-------------------------------------------------------------------------+                   
     C                   ADD       1             KENSU             7 0           件数               
     C                   ENDDO                                                    DO-*HIVAL-EQL     
     C                   MOVEL     HTSRCD        FROMSIR                                            
      *( 連続 READ はしないで CLP に戻す )                                                          
     C                   LEAVE                                                                      
      *                                                                                             
     C                   ENDDO                                                  DO-*HIVAL           
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
     C******************************************************                                        
     C     OUTPUT        BEGSR                                                                      
     C******************************************************                                        
     C  N40              SETON                                        4041                          
     C                   EXCEPT                                                                     
     C   OF              SETOFF                                       40OF                          
     C                   SETOFF                                       414243                        
     C                   SETOFF                                       444546                        
     C                   SETOFF                                       474849                        
     C                   ENDSR                                                                      
     OQPRINT    E    41                     1 04                                                    
     O                       SRFAX               15                             FAX 番号埋め込み    
     O          E    41                     2                                                       
     O                       UDATE         Y      8                                                 
     O                                           14 ' 作成 '                                        
     O                       HDR(1)              82                                                 
     O                                          128 'PAGE.'                                         
     O                       PAGE          Z    131                                                 
     O          E    41                     1                                                       
     O                       HTSRCD               4                                                 
     O                       SRNMJ               38                                                 
     O                                           42 ' 様 '                                          
     O          E    41                     1                                                       
     O                       LIN                132                                                 
     O          E    41                     1                                                       
     O                                            8 ' コード '                                      
     O                                           20 ' 品　名 '                                      
     O                                           42 ' 単価 '                                        
     O                                           60 ' 発注数 '                                      
     O                                           80 ' 金額 '                                        
     O          E    41                     1                                                       
     O                       LIN                132                                                 
     O          E    42                     2                                                       
     O                       HTBHCD              12                                                 
     O                       BHNAME              33                                                 
     O                       HTTANK        J     44                                                 
     O                       HTSUR         J     60                                                 
     O                       HTKING        J     80                                                 
**  HDR                                                                                             
 注文書