H DFTNAME(FAXHAT) 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) USROPN                                     
     F                                     FORMLEN(66)                                              
     F                                     FORMOFL(62)                                              
     F**********************************************************************                        
                                                                                                    
      * CRTBNDRPG  PGM(QTROBJ/FAXHAT)  SRCFILE(QTRSRC/QRPGLESRC)                                    
      * DFTACTGRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)                                      
                                                                                                    
      *-------------------------------------------------------------------*                         
      *  2020/12/23 : 作成                                                                          
      *-------------------------------------------------------------------*                         
      *( 作業変数 )                                                                                 
     D AR              S              1A   DIM(256)                                                 
     D CMD             S           1024A                                                            
     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)                                                 
                                                                                                    
     D SYSTEM          PR            10I 0 EXTPROC('ﾍﾓﾍﾎｵﾃ')                                        
     D   CMD                           *   VALUE OPTIONS(*STRING)                                   
                                                                                                    
     C*-------------------------------------------------------------------------+                   
     C     *ENTRY        PLIST                                                  |                   
     C                   PARM                    FROMSIR           4            |                   
     C                   PARM                    TOSIR             4            |                   
     C                   PARM                    DATEFROM          8 0          |                   
     C                   PARM                    DATEEND           8 0          |                   
     C                   PARM                    OUTPUT_           6            |                   
     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        SETLL     HATTUL1                                                          
     C                   DO        *HIVAL                                       DO-*HIVAL           
     C                   SETOFF                                       50                            
     C                   READ      HATTUL1                                50                        
     C   50              LEAVE                                                                      
     C     SETKEY        SETLL     HATTUL1                                                          
     C*----------------------------------------------------+                                        
     C     EQLKEY        KLIST                                                                      
     C                   KFLD                    HTSRCD                                             
     C                   KFLD                    HTDATE                                             
     C*----------------------------------------------------+                                        
     C                   EXSR      OVRPRTF                                                          
     C                   OPEN      QPRINT                               90                          
     C     *IN90         IFEQ      *OFF                                         QPRINT              
     C                   DO        *HIVAL                                         DO-*HIVAL-EQL     
     C                   SETOFF                                       50                            
     C     EQLKEY        READE     HATTUL1                                50                        
     C   50              LEAVE                                                                      
     C                   SETOFF                                       99                            
     C     HTSRCD        CHAIN     SIREMT                             99                            
     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                   CLOSE     QPRINT                                                           
      *                                                                                             
     C                   SELECT                                                 SELECT              
     C                   WHEN      OUTPUT_ = '*     '                                               
     C                   EXSR      DSPLY                                                            
     C                   WHEN      OUTPUT_ = '*PRINT'                                               
     C                   EXSR      PRINT                                                            
     C                   WHEN      OUTPUT_ = '*FAX  '                                               
     C                   EXSR      SNDFAX                                                           
     C                   ENDSL                                                  SELECT              
     C                   EXSR      DLTOVR                                                           
      *                                                                                             
     C                   ENDIF                                                  QPRINT              
      *                                                                                             
     C                   ENDDO                                                  DO-*HIVAL           
     C                   SETON                                        LR                            
     C                   RETURN                                                                     
     C******************************************************                                        
     C     OVRPRTF       BEGSR                                                                      
     C******************************************************                                        
     C                   IF        OUTPUT_ = '*     ' OR                        OVRPRTF             
     C                             OUTPUT_ = '*MAIL '                                               
      /FREE                                                                                         
        SYSTEM('OVRPRTF FILE(QPRINT) HOLD(*YES) USRDTA('' 注文書 '') -                              
          SECURE(*YES) OVRSCOPE(*JOB)');                                                            
      /END-FREE                                                                                     
     C                   ELSE                                                   OVRPRTF             
      /FREE                                                                                         
        SYSTEM('OVRPRTF FILE(QPRINT) USRDTA('' 注文書 '') -                                         
          SECURE(*YES) OVRSCOPE(*JOB)');                                                            
      /END-FREE                                                                                     
     C                   ENDIF                                                  OVRPRTF             
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     DLTOVR        BEGSR                                                                      
     C******************************************************                                        
      /FREE                                                                                         
        SYSTEM('DLTOVR FILE(QPRINT) LVL(*JOB)');                                                    
        SYSTEM('DLTSPLF    FILE(QPRINT) SPLNBR(*LAST)');                                            
      /END-FREE                                                                                     
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     DSPLY         BEGSR                                                                      
     C******************************************************                                        
      /FREE                                                                                         
        SYSTEM('DSPSPLF    FILE(QPRINT) SPLNBR(*LAST)');                                            
      /END-FREE                                                                                     
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     PRINT         BEGSR                                                                      
     C******************************************************                                        
     C                   ENDSR                                                                      
     C******************************************************                                        
     C     SNDFAX        BEGSR                                                                      
     C******************************************************                                        
      /FREE                                                                                         
        CMD = 'SPOOLWTR/CVTSPLF SPLF(QPRINT) JOB(*) SPLNO(*LAST) ' +                                
              ' OUTPUT(*PDF) ' +                                                                    
              'OPTION(*FAX) RECIPIENT((' + %TRIMR(SRFAX) + ' '' +                                   
              %TRIMR(SRNMJ) + '')) ' +                                                              
              ' FROM(0669938746) FAX_SUBJ('' 注文書 '')' +                                          
              ' FAXFROM('' 株式会社オフィスクアトロ '')' +                                          
              ' COVERPAGE(*NO)';                                                                    
        SYSTEM(CMD);                                                                                
      /END-FREE                                                                                     
     C                   ENDSR                                                                      
     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                     2 06                                                    
     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                                                                                             
 注文書