Exception handling in RPG

If you have ever worked on AS400 you would have come across error messages like CPFxxxx while running you pmg/application. I know and you know how frustrating it is. Well let see what we can do mange then so that the program performs a meaning full function rather than then showing the stupid error.


When we execute our program. The program makes request to the Operating system. If the request fails the operating system responds by sending as escape message to the program message queue. When the escape message arrives it is checked whether the program is going to hand the error, if not the system error handling kicks in.

As we all know the most common way for exception handling in RPG is using *PSSR subroutine. I will show you by an example how it works

D PSSROnce S N
D BombProgram PR ExtPgm('BOMBPGM')
BegSR *PSSR;
Dump(A);
If PSSROnce;
*INH1 = *On;
Return;
Else;
PSSROnce = *On;
BombProgram();
EndIf;
EndSR '*CANCL';


The (A) extender means that a DEBUG keyword is not required on the H Spec.

The above code is an example of how *PSSR subroutine will contain. In case the program is not having *PSSR subroutine the program fails with an error message.

The program shown above will perform a DUMP and call program BombProgram. The indicator PSSROnce in the program is added to avoid infinite loop. In case some thing bombs in *PSSR it will again call *PSSR which will fail again and result in infinite calls to *PSSR routine.

*CANCL is to stop the execution of the program when error is occured the other valid values are

*DETL. Continue at the beginning of detail output lines
*GETIN. Input Record Routine
*TOTC. Total Time Calculations
*TOTL. Continue at the beginning of total output lines
*OFL. Continue at the beginning of overflow lines
*DETC. Continue at the beginning of detail calculations.
*CANCL. Cancel the Execution of the program

Now the logic for BombProgram().

DclF FrndlyDsp
Dcl &Counter *Dec (5 0)
Dcl &Type *Char (1)

DspJobLog *Print
SndMsg ('Please help Me') ToMsgQ(QSysOpr)
RtvJobA Type (&Type)
If (&Type = '0') Goto End
Loop: SndRcvF RcdFmt(FRNDLERROR)
ChgVar &Counter (&Counter + 1)
If (&Count < 100) Goto Loop
End: EndJob *Immed

When this program is invocked it will print Job Log, Send msg to the QsysOpr for Help and display a user-friendly screen to the user. It is up to you to decided what needs to be displayed in the screen. The user has to press Enter 100 times to get out of the screen.

In the next post will try to cover more details about exception handeling in respect to Files