Validation trigger in RPG

When I wrote about creating a validation trigger in SQL several people asked me to give an example using RPG. Never being one to turn down a challenge this post is going to show how to do the same as my SQL example, but completely in RPG.

I am not going to go into the reasons why you might want to consider using validation triggers, as I gave my opinion in the previous post.

I started my previous example giving an example of a SQL DDL table, in this example I am going to use a DDS physical file. FILE1 has three fields:

1. CUSTOMER - customer number
2. TRANSID - unique transaction id
3. AMOUNT - transaction amount in dollars

The DDS code for the file is very straight forward:

A UNIQUE A R FILE1R A CUSTOMER 5A A TRANSID 10P 0 A AMOUNT 10P 2 A K CUSTOMER A K TRANSID

When a record is added or changed in the file I want to be sure that the total amount for the customer is not greater than the credit limit for the customer on the Customer Balance file, CUSTBAL.

I have based this program loosely on my example RPG "after" trigger program that writes the added, changed, and deleted records to a log file.

I am going to start describing the RPG program starting with the definitions.

01 ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no) ; 02 dcl-pr SendMessage ; 03 *n char(80) ; 04 end-pr ; 05 dcl-f CUSTBAL keyed prefix(a_) ; 06 dcl-f FILE1 keyed prefix(b_) ; 07 /copy mylib/devsrc,trigger_ds 08 dcl-s AfterRecordPointer pointer ; 09 dcl-ds AfterSpace extname('FILE1') qualified based(AfterRecordPointer) ; 10 end-ds ; 11 dcl-ds Data extname('FILE1') ; 12 end-ds ; 13 dcl-s Message char(80) ; 14 dcl-s TotalAmount like(AMOUNT) ; 15 C *entry plist 16 C parm Parm1 17 C parm Parm2

Line 1: These are my standard control options I use in all my programs. I need to specify DFTACTGRP(*NO) as I will be calling a subprocedure.

Lines 2 – 4: This the subprocedure I will be calling. Recently I have been giving examples of what I call "open" subprocedures, this is what I call a "closed" subprocedure. This subprocedure is passed just one parameter, which is a character variable that is 80 long.

Lines 5 and 6: These are the two files I will be using in this program. As the files have some fields with the same names I use the prefix to help me differentiate which field I am using.

Line 7: TRIGGER_DS is just a copybook member that contains the standard code for the two input parameters all RPG trigger programs receive:

1. Parm1 – The data structure that contains all the trigger data.
2. Parm2 - The length of the Parm1 data structure.

I am not going to give those here, but refer you to my previous RPG trigger program example. By having this in a copybook I can insert it into every RPG trigger program I write.

Lines 8 - 10: I am using a pointer so I can retrieve the data from the trigger data structure, and have a data structure, based upon that pointer, to receive the data into.

Lines 11 and 12: This is the data structure I will be moving the data into before I can use it.

Line 13: Message is the variable I will be using to pass any message back to the calling program.

Line 14: TotalAmount is the variable I will using to calculate the customer's balance.

Lines 15 – 17: As I used a C-spec Parameter list in my previous example RPG trigger I am doing the same here.

And now onto the validation of the received data:

18 AfterRecordPointer = %addr(Parm1) + AfterOffset ; 19 Data = AfterSpace ; 20 if (Customer = ' ') ; 21 Message = 'U0000 Key field is blank' ; 22 SendMessage(Message) ; 23 endif ; 24 if (TransId = 0) ; 25 Message = 'U0001 Transaction id cannot be 0' ; 26 SendMessage(Message) ; 27 endif ; 28 if (Amount <= 0) ; 29 Message = 'U0002 Amount cannot be less or equal to 0' ; 30 SendMessage(Message) ; 31 endif ; 32 chain (CUSTOMER) CUSTBALR ; 33 if not(%found) ; 34 Message = 'U0004 Customer not in Customer Balance file' ; 35 SendMessage(Message) ; 36 endif ; 37 TotalAmount = AMOUNT ; 38 setll (CUSTOMER) FILE1R ; 39 dow (1 = 1) ; 40 reade (CUSTOMER) FILE1R ; 41 if (%eof) ; 42 leave ; 43 endif ; 44 TotalAmount += b_AMOUNT ; 45 enddo ; 46 if (TotalAmount > a_TOTAL) ; 47 Message = 'U0003 Customer maximum balance exceeded' ; 48 SendMessage(Message) ; 49 endif ; 50 return ;

Line 18: I retrieve the after record data from memory using the a pointer to the Parm1 data structure and the offset value from the data structure, and moving it into the AfterRecordPointer data structure.. I am only interested in the after image of the data as I want to work with what is going to be used to be added or changed in the file.

Line 19: I have found that I cannot use the data from AfterRecordPointer, therefore, I move it to another data structure, Data, that I can use the data within. As I did not use the QUALIFIED keyword in the definition of Data is means I can just use the subfields' names.

Lines 20 – 21: I start by checking if the Customer is not blank. If it is I move what I want my message to be to the variable Message, and then call the subprocedure SendMessage. As there is no SQL state code and SQL message text in a RPG trigger program I have combined the two into the Message variable.

Lines 24 – 27: Check if the Transaction id, TRANSID, is not zero.

Lines 28 – 31: The Amount, AMOUNT, has to be greater than zero.

Lines 32 – 36: I get the customer's maximum balance from the Customer Balance file, CUSTBAL. If a record is not found for this customer a message is sent to the SendMessage subprocedure.

Lines 37 – 45: Here I read the transaction file, FILE1, to calculate the total amount. I also include the amount from the trigger data structure. I would have preferred to do this using the SQL statement I did in the SQL validation trigger, but this is a totally RPG trigger.

Lines 46 – 49: If the total of transactions is greater than the customer balance maximum amount a message is sent, using the SendMessage subprocedure.

Line 50: Rather than closing the program by setting on *INLR I am just using a RETURN.

All of that code is simple. What about the subprocedure to send the message?

01 dcl-proc SendMessage ; 02 dcl-pi *n ; 03 Message char(80) ; 04 end-pi ; 05 dcl-pr SndMsgPgm extpgm('QMHSNDPM') ; 06 *n char(7) const ; //Message id 07 *n char(20) const ; //Message file 08 *n char(80) const ; //Message text 09 *n int(10) const ; //Length of message text 10 *n char(10) const ; //Message type 11 *n char(10) const ; //Call stack entry 12 *n int(10) const ; //Call stack counter 13 *n char(4) ; //Message key 14 *n char(16) ; //Error data structure 15 end-pr ; 16 dcl-s ErrorDs char(16) ; 17 dcl-s MessageKey char(4) ; 18 SndMsgPgm('CPF9898': 19 'QCPFMSG QSYS': 20 Message: 21 %len(%trimr(Message)): 22 '*ESCAPE': 23 '*': 24 2: 25 MessageKey: 26 ErrorDs) ; 27 end-proc ;

All the SendMessage subprocedure does is call the Send Program Message API, QMHSNDPM.

Line 1: All subprocedures start with a DCL-PROC.

Lines 2 – 4: The procedure interface states that we will receive one parameter that is a 80 long character variable that I am choosing to call Message.

Lines 5 – 15: This is the procedure definition for calling the QMHSNDPM API program. As it is a program I need the EXTPGM keyword on line 5, and as I am not using the API's name for this procedure I need to define it within the EXTPGM keyword.

Lines 16 and 17: I need these two variables as they are used by the API to return values to this, the calling subprocedure.

Lines 18 – 26: This is the call to the API with all its parameters. I have put only one per line to make it easier for you to see what each one is.

Line 18: The first parameter is the message number I am sending. IBM provides us with some generic messages that I can provide any text to I want. CPF9898 is one of those.

Line 19: This is the message file that CFP9898 is found in.

Line 20: This is the message I will be sending, which happens to be in the variable Message, that was passed to this subprocedure.

Line 21: I need to give the length of the message within Message. %TRIMR "removes" the training blanks, and %LEN determines the length of that.

Line 22: To be considered an error I need to give the message type of *ESCAPE.

Line 23: This is call stack entry. By passing "*" I am saying that the message is sent to the current call stack.

Line 24: This is the call stack counter. This number denotes which call stack I want to send the message to. As I want to return the message to the call stack of the calling program I have found that the value of '2' works best.

Lines 25 and 26: I don't care for the values returned from the API, but I do need to place the returned values into variables, that I defined on lines 16 and 17.

Line 27: Every subprocedure ends with END-PROC.

After I have compiled the program, as the program BEFTRG, then I need to add this trigger to the file. I do using the Add Physical file trigger command, ADDPFTRG:

ADDPFTRG FILE(FILE1) TRGTIME(*BEFORE) + TRGEVENT(*INSERT) PGM(BEFTRG) ADDPFTRG FILE(FILE1) TRGTIME(*BEFORE) + TRGEVENT(*UPDATE) PGM(BEFTRG)

OK, so what about a program to try and add invalid data to FILE1. I am going to use the same "template " of a program and change a small part to illustrate my examples.

01 ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no) ; 02 dcl-pr RetrieveMessage char(80) ; 03 end-pr ; 04 dcl-f FILE1 usage(*output) ; 05 dcl-s MessageCode char(5) ; 06 dcl-s MessageText char(80) ; //Something happens 20 *inlr = *on ;

Line 1: My standard control options for programs.

Lines 2 and 3: I am defining an external subprocedure. I do not want to say much about until I use it later.

Line 4: I am defining FILE1 as an output file.

Lines 5 and 6: More on these later.

The //Something happens is where I am going to insert the various snippets of code for my examples will be placed.

Line 20: And the programs ends with…

This example does not end well.

07 CUSTOMER = ' ' ; 08 TRANSID = 0 ; 09 AMOUNT = -1 ; 10 write FILE1R ;

As the when the write happens I receive the following error message:

Message ID . . . . . . : RNQ1023 Severity . . . . . . . : 99 Message type . . . . . : Inquiry Message . . . . : An error in the trigger program was detected before WRITE on file FILE1 (C G D F). Cause . . . . . : RPG procedure TESTPGM in program MTLIB/TESTPGM detected an error in the trigger program before WRITE operation was done on file FILE1. The actual file is MYLIB/FILE1(FILE1). The WRITE operation was not performed.

I need to add some error handling to my RPG code. Let me start with a Monitor group:

07 CUSTOMER = ' ' ; 08 TRANSID = 0 ; 09 AMOUNT = -1 ; 10 monitor ; 11 write FILE1R ; 12 on-error ; 13 endmon ;

The program does not error, and I see the error on the job log.

U0000 Key field is blank Application error. CPF9898 unmonitored by BEFTRG1 at statement *N, instruction X'0000'. Error occurred in trigger program. C Error occurred in trigger program. C An error in the trigger program was detected before WRITE on file FILE1.

I can also use the error operation extender to the WRITE operation code.

07 CUSTOMER = ' ' ; 08 TRANSID = 0 ; 09 AMOUNT = -1 ; 10 write(e) FILE1R ; 11 if (%error) ; 12 endif ;

Preventing the error from stopping the program is good, but what about retrieving it so that the program can make use of it. This is the part of the program I spent the longest thinking about. I could use the Receive Message command, RCVMSG, in CL, or one of the APIs I can call from the RPG program. But I wanted something really simple, and fortunately there is the Joblog information SQL table function, JOBLOG_INFO. I also decided to make this an external subprocedure, in its own module, which can be bound into programs. By doing I only have to code it once and use in many programs.

01 ctl-opt option(*nodebugio:*srcstmt) nomain ; 02 dcl-pr RetrieveMessage char(80) ; 03 end-pr ; 04 dcl-proc RetrieveMessage export ; 05 dcl-pi *n char(80) ; 06 end-pi ; 07 dcl-s MessageText char(80) ; 08 exec sql SELECT CAST(MESSAGE_TEXT AS CHAR(80) CCSID 37) 09 INTO :MessageText 10 FROM TABLE(QSYS2.JOBLOG_INFO('*')) A 11 WHERE MESSAGE_ID = 'CPF9898' 12 ORDER BY ORDINAL_POSITION DESC 13 FETCH FIRST ROW ONLY ; 14 return MessageText ; 15 end-proc ;

Line 1: Pretty standard control options. As this is a subprocedure member I have the NOMAIN to indicate to the compiler there is no main procedure.

Lines 2 and 3: The procedure interface definition. No parameters passed into the subprocedure, and one returned.

Line 4: Start of the subprocedure RetrieveMessage. The EXPORT keyword is needed as I want this subprocedure to return a value.

Line 5 and 6: The procedure interface.

Line 7: This variable is the will be used to hold the retrieved message text.

Lines 8 - 13: The SQL Select statement to retrieve the message text from the job log.

Line 8: On the IBM i I wrote this on I had to use the CAST function to convert the original value in the table column MESSAGE_TEXT to be something that is human readable. You might not have to do this.

Line 9: This the variable I am returning the message's text into.

Line 10: The asterisk ( * ) denotes that I only want to retrieve rows from this job.

Line 11: I need find the row with the message of CPF9898 as that is the message id the trigger program used.

Line 12: ORDINAL_POSITION is a unique number given to each job log entry. By sorting in descending order I will get the most recent log entry with the message id of CPF9898.

Line 13: I only need to retrieve the first, most recent, row that matches my criteria.

Line 14: I return the message text to the calling program.

Line 15: All procedures end with END-PROC.

Let me modify my test program to include the code to call this subprocedure:

07 CUSTOMER = ' ' ; 08 TRANSID = 0 ; 09 AMOUNT = -1 ; 10 monitor ; 11 write FILE1R ; 12 on-error ; 13 Message = RetrieveMessage() ; 14 MessageCode = %subst(Message:1:5) ; 15 Message = %triml(%subst(Message:6)) ; 16 dsply (MessageCode + ' : ' + %subst(Message:1:40)) ; 17 endmon ;

Line 13: When the subprocedure is called the returned value is placed in the program's variable Message.

Line 14: I want to put the first part of the message in its own field. This can be used to check which message this is, rather than have to compare the whole string.

Line 15: The rest of the string is left justified in Message.

Line 16: And now I can display the message from my job log.

DSPLY U0000 : Key field is blank.

I think you will agree that is easier than using an API or the RCVMSG command.

Let me do the next one a bit different using the error operation extender:

07 CUSTOMER = '1' ; 08 TRANSID = 0 ; 09 AMOUNT = -1 ; 10 write(e) FILE1R ; 11 if (%error) ; 12 Message = RetrieveMessage() ; 13 MessageCode = %subst(Message:1:5) ; 14 Message = %triml(%subst(Message:6)) ; 15 dsply (MessageCode + ' - ' + %subst(Message:1:40)) ; 16 endif ;

This gives me:

DSPLY U0001 : Transaction id cannot be 0.

I can keep going to the most complex part of the trigger program:

07 CUSTOMER = '1' ; 08 TRANSID = 1 ; 09 AMOUNT = 1.00 ; 10 write(e) FILE1R ; 11 if (%error) ; 12 Message = RetrieveMessage() ; 13 MessageCode = %subst(Message:1:5) ; 14 Message = %triml(%subst(Message:6)) ; 15 dsply (MessageCode + ' - ' + %subst(Message:1:40)) ; 16 endif ;

As this exceeds the maximum customer balance I see:

DSPLY U0003 : Customer maximum balance exceeded.

 

Which is better RPG or SQL validation trigger? I would say it depends on what you are doing and how you want to do it, you have a go and decided which you prefer. I must admit even in RPG validation triggers I do use SQL statements.

 

You can learn more about the QMHSNDPM API from the IBM website here.

 

This article was written for IBM i 7.3, and should work for earlier releases too.