Ibm midrange 必须从生产主表中删除记录

此代码是一个清除程序。我们希望清除从未订购过任何东西的客户（在公司中，如果有人是“潜在”客户，他们会保留记录。）

这将首先在测试环境中运行，但最终将针对生产环境运行。我们将保留创建的临时文件作为备份。我不知道如何删除。我认为此时需要这样做：如果找不到订单实体，请将记录写入

TRCMASAC

文件

C                   IF        NOT %FOUND(OEORH4)
C                   WRITE     TRCMASRR
 * Delete? file name or format name

代码如下：

FXRCMASAC  IF   E             DISK                            
  * Order Header file - Keyed by Company and entity number     
FOEORH4    IF   E           K DISK                            
FTRCMA1    UF A E           K DISK                                 
 * Customer Keycode BI file                                        
FZRCST1    IF   E           K DISK                                 
 * Output file - Customers who have no Keycode  - VRCSTKBI PF      
FVRCST1    UF A E           K DISK                                 
 * Address  Master file - xDRESSAD PF                              
FXDRES1    IF   E           K DISK                                 
 * Output file - Address  - ZDRESSAD PF                            
FZDRES1    UF A E           K DISK                                 

 *-----------------------------------------------------------------
 * Calculation Specification                                       
 *-----------------------------------------------------------------
 * Step 1                                                          
C                   READ      xRCMASAC                             
C                   DOW       NOT %EOF                             
 *                                                                 
 * Check the record does not exist in order header file            
C                   EXSR      CHKORH_SR                            
C                   READ      xRCMASAC                           
C                   ENDDO                                        

 * Step 2 and 3                                                  
C     *LOVAL        SETLL     TRCMA1                             
C                   READ(N)   TRCMA1                             
C                   DOW       NOT %EOF                           
 * limit number of records for test                              
c     counta        ifge      9000                               
C                   EVAL      *INLR = *ON                        
c                   leave                                        
c                   endif                                        
c     countz        ifge      9000                               
C                   EVAL      *INLR = *ON                        
c                   leave                                        
c                   endif                                        
 * Check the record does not exist in stock header file          
C                   EXSR      CHKCUS_SR                          
 *                                                               
C                   EXSR      CHKADR_SR                               
 *                                                                    
 * Read the next record                                               
C                   READ(N)   TRCMA1                                  
C                   ENDDO                                             

 *-----------------------------------------------------------------   
 * End of the Program                                                 
 *-----------------------------------------------------------------   
C                   EVAL      *INLR = *ON                             

 *-----------------------------------------------------------------   
 * Check the order header entity                                      
 *-----------------------------------------------------------------   
C     CHKORH_SR     BEGSR                                             
 *                                                                    
C     ORHKEY        CHAIN     OEORH4                                  
 * If the order entity is notfound, write the rec into TRCMASAC file  
C                   IF        NOT %FOUND(OEORH4)                      
C                   WRITE     TRCMASRR                           
C                   ENDIF                                           
 *                                                                  
C                   ENDSR                                           
 *----------------------------------------------------------------- 
 * Check the customer keycode entity                                
 *----------------------------------------------------------------- 
C     CHKCUS_SR     BEGSR                                           
 *                                                                  
C     ORHKEY        CHAIN     ZRCST1                                
 * If the order entity is found, write the rec into VRCSTKBI file   
C                   IF        %FOUND(ZRCST1)                        
C                   WRITE     VRCSTKRR                              
c                   add       1             countz            500   
C                   ENDIF                                           
 *                                                                  
C                   ENDSR                                           

 *----------------------------------------------------------------- 
 * Check the address entity for records of never ordered            
C     CHKADR_SR     BEGSR                                         
 *                                                                
C     ACENT#        CHAIN     ADRES1                              
 * If the order entity is found, write the rec into ZDRESSRR file 
C                   IF        %FOUND(ADRES1)                      
C                   WRITE     ZDRESSRR                            
c                   add       1             counta            500 
C                   ENDIF                                         
 *                                                                
C                   ENDSR                                         

 *----------------------------------------------------------------
 * Program Initialization Subroutine                              
 *----------------------------------------------------------------
C     *INZSR        BEGSR                                         
 *                                                                
 * ORDER HEADER KEYLIST                                           
C     ORHKEY        KLIST                                         
C                   KFLD                    ACCOM#                
C                   KFLD                    ACENT#                

c                   z-add     0             counta               
c                   z-add     0             countz               
 *                                                               
 * Clear TRCMASAC file data                                      
C     *LOVAL        SETLL     TRCMA1                             
C                   READ      TRCMA1                             
C                   DOW       NOT %EOF                           
C                   DELETE    TRCMASRR                           
 * Read the next record                                          
C                   READ      TRCMA1                             
C                   ENDDO                                        
 *                                                               
 * Clear VRCSTKBI file data                                      
C     *LOVAL        SETLL     VRCST1                             
C                   READ      VRCST1                             
C                   DOW       NOT %EOF                           
C                   DELETE    VRCSTKRR                           
 * Read the next record                                          
C                   READ      VRCST1                             

C                   ENDDO                      
 *                                             
 * Clear ZDRESSAD file data                    
C     *LOVAL        SETLL     ZDRES1           
C                   READ      ZDRES1           
C                   DOW       NOT %EOF         
C                   DELETE    ZDRESSRR         
 * Read the next record                        
C                   READ      ZDRES1           
C                   ENDDO
 *
C                   ENDSR

---

是的，您将在向

TRCMASRR

写入副本后删除记录：

C                   DELETE    OEORH4R

您将要删除记录格式名称，而不是文件名。在上面的代码中，我假设

OEORH4

中的记录格式名称为

OEORH4R

我猜您还需要删除与正在删除的客户记录相关的所有地址等。否则你会有“孤儿”

另外，在您的

*INZSR

中，我建议您以更高效的方式清除文件。制作

TRCMA1

、

VRCST1

和

ZDRES1

USROPN

文件如下：

FTRCMA1    UF A E           K DISK  USROPN
FVRCST1    UF A E           K DISK  USROPN
FZDRES1    UF A E           K DISK  USROPN

然后使用

QCMDEXC

执行

CLRPFM*LIBL/TRCMA1

，

CLRPFM*LIBL/VRCST1

和

CLRPFM*LIBL/ZDRES1

。当然，之后您必须

打开所有这三个文件

这将比单独删除每条记录更快，并且还可能有一些其他好处，具体取决于文件的设置方式。
为完整起见，以下是RPG手册参考，以供参考