Avatar of Philky101
Philky101 asked on

RPG Subroutine - want to confirm it is fine.

In this subroutine, we want to see which Customer address records, are not in the Order history,
and if not in there, we want to see if not in the Invoice history. In which cases we want to purge this customer. We want to write each record prior to the delete. We do not want to check the same customer twice +. as there are duplicate Customer numbers (entity #). Is this Subroutine have any holes you might notice?



C     CHKORH_SR     BEGSR                                                    
 *                                                                            
C                   MOVE      'N'           PUGFIL            1              
C     ORHKEY        CHAIN     OEORH4                                          
 * If the order entity is notfound, write the rec into TRCMASAC file          
C                   IF        NOT %FOUND(OEORH4)                              
C                   MOVE      'Y'           PUGFIL                            
C                   endif                                                    
c     pugfil        ifne      'Y'                                            
C     ORHKEY        CHAIN     OEinh4                                          
C                   IF        NOT %FOUND(OEinh4)                              
C                   MOVE      'Y'           PUGFIL                            
C                   ENDIF                                                    
C                   ENDIF                                                    
 *                                                                            
C                   IF        PUGFIL = 'Y' AND        
C                             ACENT# <> ACENT#_OLD                      
c                   EXSR      CHKCUS_SR                                
c     ACFLAG        IFEQ      'N'                                      
C                   WRITE     TRCMASRR                                  
c                   delete    arcmasrr                                  
 * Check the record does not exist in stock header file                
 *                                                                      
c     acflag        ifeq      'N'                                      
C                   EXSR      CHKADR_SR                                
c*                                                                      
c                   ENDIF                                              
C                   ENDIF                                              
C                   ENDIF                                              
C                   MOVE      ACENT#        ACENT#_OLD                  
 *                                                                      
C                   ENDSR
DB2Programming

Avatar of undefined
Last Comment
Gary Patterson, CISSP

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Gary Patterson, CISSP

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Member_2_276102

As posted in the question, it looks incorrect to me. But it's not at all clear what "correct" code should look like.

If a matching record exists in OEORH4, then PUGFIL will keep the value 'N'. But then comes:
c     pugfil        ifne      'Y'

Open in new window

That is, the test for existence in OEinh4 only happens if a record does exist in OEORH4. If a record isn't then found in OEinh4, PUGFIL is finally set to 'Y'.

So the only way the DELETE can happen is if a matching record is found in OEORH4 and not found in OEinh4, plus the added tests for ACENT# <> ACENT#_OLD and ACFLAG = 'N'.

That doesn't seem to match the description of the problem where neither file should have a matching record.

In order to know what any correct coding should look like, the problem needs to be stated much more clearly.

Tom
Gary Patterson, CISSP

Tom, as usual , raises a good point - though the current code will delete in two cases:

1) Delete if not found in OEORH4 (OEINH4 won't be checked)
2) Delete if found in OEORH4, but not found in OEINH4

Or stated as a single rule: "Delete if missing in either file."  

If the rule is "Delete if missing in BOTH files" then you want to do something like this:

C     CHKORH_SR     BEGSR                                                    
 *                                                                            
C                   MOVE      'N'           PUGFIL            1              
C     ORHKEY        SETLL     OEORH4                                          
 * If the order entity is notfound, write the rec into TRCMASAC file          
C                   IF        NOT %EQUAL(OEORH4)                              
C     ORHKEY        SETLL     OEinh4                                          
C                   IF        NOT %EQUAL(OEinh4)                              
C                   MOVE      'Y'           PUGFIL                            
C                   ENDIF                                                    
C                   ENDIF                                                    
 *                                                                            
C                   IF        PUGFIL = 'Y' AND        
C                             ACENT# <> ACENT#_OLD                      
c                   EXSR      CHKCUS_SR                                
 ***CHKCUS_SR sets ACFLAG?
c     ACFLAG        IFEQ      'N'                                      
C                   WRITE     TRCMASRR                                  
c                   delete    arcmasrr                                  
 * Check the record does not exist in stock header file                
 *                                                                      
c     acflag        ifeq      'N'                                      
C                   EXSR      CHKADR_SR                                
c*                                                                      
c                   ENDIF                                              
C                   ENDIF                                              
C                   ENDIF                                              
C                   MOVE      ACENT#        ACENT#_OLD                  
 *                                                                      
C                   ENDSR 

Open in new window

Member_2_276102

Heh, yep, no check at all for OEinh4 when not found in OEORH4. I should've looked deeper, but the question was already closed and I only wanted to get attention back to it.

The SETLLs and NOT %EQUAL() tests are the way to go, though it's not clear where the ACENT# value comes from. We have to assume that its set before the subroutine is called. If none of the field values from OEORH4 and OEinh4 are used by the program, the files should not be CHAINed to. Just use SETLL to do an existence test.

Once SETLL runs, there's no need for setting PUGFIL. It can be replaced by [ NOT (%EQUAL(OEORH4) OR %EQUAL(OEinh4)) ]. Even that doesn't seem need as long as the WRITE and DELETE are inside the IF-tests anyway.

If I understand the actual requirement (which isn't certain), the logic would seem like this:
C     CHKORH_SR     BEGSR

C                   IF        ACENT# <> ACENT#_OLD

C     ORHKEY        SETLL     OEORH4
 * If the order entity is notfound, write the rec into TRCMASAC file
C                   IF        NOT %EQUAL(OEORH4)

C     ORHKEY        SETLL     OEinh4
C                   IF        NOT %EQUAL(OEinh4)
c                   EXSR      CHKCUS_SR

 ***CHKCUS_SR sets ACFLAG?
c                   IF        ACFLAG = 'N'

C                   WRITE     TRCMASRR
c                   delete    arcmasrr

 * Check the record does not exist in stock header file
C                   EXSR      CHKADR_SR

C                   ENDIF
C                   ENDIF
C                   ENDIF

C                   MOVE      ACENT#        ACENT#_OLD

C                   ENDIF

C                   ENDSR

Open in new window

That seems to have the same logical result as the original coding while meeting requirements. Since the original contains %FOUND(), etc., we can assume RPG IV. In that case, I'd probably do it a little differently. But that gets into coding styles rather than trying to determine what logic is correct.

Note that it's not clear why CHKADR_SR should be executed in this sequence. It doesn't seem to have a purpose inside this subroutine.

Tom
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
Gary Patterson, CISSP

Yeah - I just ignored the parts that weren't covered in the code shown - too much conjecture required to suit me, and focused on the parts mentioned in the question - just the "top part".  

I thought there was a chance, based on prefix and location in the code, that ACFLAG and ACENT# might be updated in CHKCUS_SR, so I didn't touch any of that.
Member_2_276102

The results shouldn't change for ACFLAG and ACENT# by the logic rearrangement.

There wasn't any point in having a test for [ACFLAG = 'N'] nested inside a test for [ACFLAG = 'N'] when there were no intervening statements that could modify the value.

The test for [ACENT# <> ACENT#_OLD] might as well be the outer test after the CHAINs become SETLLs; the CHAINs were the only possible modifiers. And the only reason to do the MOVE for ACENT# would be if [ACENT# <> ACENT#_OLD]. Might as well enclose it, too. And since it's enclosed along with the call to CHKCUS_SR, any change there would still be caught.

Now, if the CHAINs really are needed...?

Tom
Gary Patterson, CISSP

I see what you mean - second ACFLAG check is redundant.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.