Question

This code is a purge program. We want to purge customers who never ordered anything (in the company they keep record if someone is a 'potential' customer.)

This will run first in a test environment but eventually against production. We will keep the temp files created as backup. I am not sure how to do the delete. I think it is needed at the point: If the order entity is not found, write the record into TRCMASAC file

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

Here's the code:

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
Was it helpful?

Solution

Yes, you will delete the record after you write a copy out to TRCMASRR:

C                   DELETE    OEORH4R

You will want to delete the record format name, not the file name. In my code above I've assumed the record format name in OEORH4 is OEORH4R.

My guess is you would also want to delete all addresses, etc. that are related to the customer record you're deleting. Otherwise you end up having "orphans"...

Also, in your *INZSR I recommend you clear your files in a more efficient manner. Make TRCMA1, VRCST1 and ZDRES1 USROPN files like this:

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

and then use QCMDEXC to execute a CLRPFM *LIBL/TRCMA1, CLRPFM *LIBL/VRCST1 and CLRPFM *LIBL/ZDRES1. And of course you would have to OPEN all three files afterwards.

This will be faster than deleting each record individually and could have some other benefits as well depending on how the files are set up.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top