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
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.