 |
| PSDS with PSSR to catch program exceptions in RPG AS400 |
Program Status Data Structure (PSDS)
You can read more about PSDS by reading the following article.
Using Program Error Subroutine (*PSSR)
We can write *PSSR subroutine in our RPG program to handle the program errors/exception
When any error/exception occurs in the RPG program following things happen if we coded PSDS and *PSSR in our RPG program.
You can code a *PSSR subroutine for all the subprocedures in the module and each *PSSR is local to the subprocedure in which it is coded.
Example of PSDS with *PSSR to catch program exceptions in RPGLE
Here in this example, we will divide a number by zero in RPGLE. We will write the code in Fixed format, /Free and Fully Free RPG.
RPG Code in Fixed format for program status data structure in RPG AS400
* Program status data structure
* program exception available to rpg program (1 psds per module)
D psds1 SDS
D proc_name *proc * module/program
* 1 to 10 position, 10 chars
D pgm_status *status * status code
* 11 to 15 position, (5,0) zoned decimal
D pgm_prvstatus 16 20S 0 * Prev. status
D src_listing 21 28 * src. list line
D routine *routine * routine
* 29 to 36 position, 8 chars
* *INIT --> program initialization
* *DETL --> detail lines
* *GETIN --> get input record
* *TOTC --> Total calculations
* *TOTL --> Total lines
* *DETC --> Detail calculations
* *OFL --> Overflow lines
* *TERM --> Program ending
* *ROUTINE --> name of program or procedure called (first 8 chars)
D parms *parms * no. of parms pass
* 37 to 39 position, (3,0) zoned decimal
D excptype 40 42 * exception type
* CPF --> operating system exception
* MCH --> machine exception
D excpnum 43 46 * exception number
* CPF --> CPF message number
* MCH --> MCH message number
D reserved1 47 50 * reserved
D workarea 51 80 * internal use by
* ILE RPG compiler
D pgmlib 81 90 * prgram library
D excpdata 91 170 * exception data
D excpcause 171 174 * exception that
* cause RNX9001
D filename 175 184 * file name on whic
*h last file operati
*on occur updated on
*ly when error occur
D unused 185 190 * unused
D date 191 198 * date(*date format)
D yy 199 200S 0 * first two digits
* of 4 digit year
D filenametrn 201 208 * file name truncate
* (175-184 pos above
D statusinfo 209 243 * status info on las
*t file used
D jobname 244 253 * job name
D username 254 263 * user name
D jobnumber 264 269 * job number
D date2 270 275S 0 * date (udate format
* pgm running
* (191-198 pos above
D pgmrundate 276 281S 0 * date of pgm runnin
D time 282 287S 0 * time (hhmmss)
* pgm running
D date3 288 293 * date (udate format
* pgm compiled
D time2 294 299 * time (hhmmss)
* pgm compiled
D cmplevel 300 303 * compiler level
D srcfile 304 313 * src file name
D srclib 314 323 * src lib name
D srcmbr 324 333 * src file member
D pgmproc 334 343 * pgm containing
* procedure
D modproc 344 353 * module containing
* procedure
D srcid 354 355B 0 * src id match the
* binary 2 (5i,0)
* statement number
* from pos 21-28
D srcid2 356 357B 0 * src id match the
* binary 2 (5i,0)
* statement number
* from pos 228-235
D curuserprf 358 367 * current user profi
D exterrorcd 368 371I 0 * external error cod
* Integer (10,0)
D elements 372 379I 0 * elements set by XM
* Integer (20,0)
*L-INTO or DATA-INTO
D internaljobid 380 395 * internal job id
D systemname 396 403 * system name
D unused2 404 429 * unused
*variable
D num1 S 1P 0 INZ(3)
D num2 S 1P 0 INZ(0)
D result S 1P 0 INZ(0)
D returncode S 6A
D DIVIDEBYZERO S 20A INZ('DIVIDE BY ZERO')
D STATUSCD S 50A INZ('ERROR OCCUR WITH STATUS CODE')
C num1 DIV num2 result
C RESULT DSPLY
C EVAL *INLR = *ON
C *PSSR BEGSR
C IF PGM_STATUS = 00102
C DIVIDEBYZERO DSPLY
C* EVAL RETURNCODE = ' '
C EVAL RETURNCODE = '*CANCL'
C* EVAL RETURNCODE = '*GETIN'
C ELSE
C STATUSCD DSPLY
C PGM_STATUS DSPLY
C EVAL RETURNCODE = '*CANCL'
C ENDIF
C ENDSR returncode
RPG Code in /Free format for program status data structure in RPG AS400
* Program status data structure
* program exception available to rpg program (1 psds per module)
D psds1 SDS
D proc_name *proc * module/program
* 1 to 10 position, 10 chars
D pgm_status *status * status code
* 11 to 15 position, (5,0) zoned decimal
D pgm_prvstatus 16 20S 0 * Prev. status
D src_listing 21 28 * src. list line
D routine *routine * routine
* 29 to 36 position, 8 chars
* *INIT --> program initialization
* *DETL --> detail lines
* *GETIN --> get input record
* *TOTC --> Total calculations
* *TOTL --> Total lines
* *DETC --> Detail calculations
* *OFL --> Overflow lines
* *TERM --> Program ending
* *ROUTINE --> name of program or procedure called (first 8 chars)
D parms *parms * no. of parms pass
* 37 to 39 position, (3,0) zoned decimal
D excptype 40 42 * exception type
* CPF --> operating system exception
* MCH --> machine exception
D excpnum 43 46 * exception number
* CPF --> CPF message number
* MCH --> MCH message number
D reserved1 47 50 * reserved
D workarea 51 80 * internal use by
* ILE RPG compiler
D pgmlib 81 90 * prgram library
D excpdata 91 170 * exception data
D excpcause 171 174 * exception that
* cause RNX9001
D filename 175 184 * file name on whic
*h last file operati
*on occur updated on
*ly when error occur
D unused 185 190 * unused
D date 191 198 * date(*date format)
D yy 199 200S 0 * first two digits
* of 4 digit year
D filenametrn 201 208 * file name truncate
* (175-184 pos above
D statusinfo 209 243 * status info on las
*t file used
D jobname 244 253 * job name
D username 254 263 * user name
D jobnumber 264 269 * job number
D date2 270 275S 0 * date (udate format
* pgm running
* (191-198 pos above
D pgmrundate 276 281S 0 * date of pgm runnin
D time 282 287S 0 * time (hhmmss)
* pgm running
D date3 288 293 * date (udate format
* pgm compiled
D time2 294 299 * time (hhmmss)
* pgm compiled
D cmplevel 300 303 * compiler level
D srcfile 304 313 * src file name
D srclib 314 323 * src lib name
D srcmbr 324 333 * src file member
D pgmproc 334 343 * pgm containing
* procedure
D modproc 344 353 * module containing
* procedure
D srcid 354 355B 0 * src id match the
* binary 2 (5i,0)
* statement number
* from pos 21-28
D srcid2 356 357B 0 * src id match the
* binary 2 (5i,0)
* statement number
* from pos 228-235
D curuserprf 358 367 * current user profi
D exterrorcd 368 371I 0 * external error cod
* Integer (10,0)
D elements 372 379I 0 * elements set by XM
* Integer (20,0)
*L-INTO or DATA-INTO
D internaljobid 380 395 * internal job id
D systemname 396 403 * system name
D unused2 404 429 * unused
*variable
D num1 S 1P 0 INZ(3)
D num2 S 1P 0 INZ(0)
D result S 1P 0 INZ(0)
D returncode S 6A
/Free
// DSPMSGD RANGE(*FIRST *LAST) MSGF(QRNXMSG) DETAIL(*BASIC)
result = num1/num2;
DSPLY result;
*INLR = *ON;
// Normal Codes
// 00000 --> No Exception/Error
// 00001 --> Called program returned with the LR indicator on.
// 00050 --> Conversion resulted in substitution.
// Exception/Error codes
// 00100 --> Value out of range for string operation
// 00102 --> Divide by zero
// 00105 --> Invalid characters in character to numeric conversion functions.
// 00112 --> Invalid Date, Time or Timestamp value.
// 00113 --> Date overflow or underflow.
// 00114 --> Date mapping errors
// 00120 --> Table or array out of sequence.
// 00121 --> Array index not valid
// 00122 --> OCCUR outside of range
// 00211 --> Error calling program or procedure
// 00222 --> Pointer or parameter error
// 00333 --> Error on DSPLY operation
// 00351 --> Error parsing XML document
// 00352 --> Invalid option for %XML
// 00353 --> XML document does not match RPG variable
// 00354 --> Error preparing for XML parsing
// 00401 --> Data area specified on IN/OUT not found
// 00411 --> Data area type or length does not match
// 00412 --> Data area not locked for output
// 00413 --> Error on IN/OUT operation
// 00414 --> User not authorized to use data area
// 00415 --> User not authorized to change data area
// 00421 --> Error on UNLOCK operation
// 00425 --> Length requested for storage allocation is out of range
// 00431 --> Data area previously locked by another program
// 00432 --> Data area locked by program in the same process
// 00450 --> Character field not entirely enclosed by shift-out and shift-in characters
// 00451 --> Conversion between two CCSIDs is not supported
// 00452 --> Some characters could not be converted between two CCSIDs
// 00453 --> An error occurred during conversion between two CCSIDs
// 00803 --> Rollback operation failed.
// 00804 --> Error occurred on COMMIT operation
// 00805 --> Error occurred on ROLBK operation
// 00907 --> Decimal data error (digit or sign not valid)
// 09999 --> Program exception in system routine.
//________________________________________________________________
Begsr *pssr;
If PGM_STATUS = 00102;
DSPLY 'ERROR: DIVIDE BY ZERO';
returncode = ' ';
//returncode = '*CANCL';
//returncode = '*GETIN';
Else;
DSPLY 'ERROR OCCURRED WITH STATUS CODE';
DSPLY PGM_STATUS;
returncode = '*CANCL';
EndIf;
endsr returncode;
//________________________________________________________________
/End-Free
RPG Code in Fully Free format for program status data structure in RPG AS400
**FREE
//Program status data structure
//program exception available to rpg program (1 psds per module)
dcl-ds psds1 psds;
proc_name *proc; // module/program
// 1 to 10 position, 10 chars
pgm_status *status; // status code
// 11 to 15 position, (5,0) zoned decimal
pgm_prvstatus zoned(5);// Prev. status
src_listing char(8); // src. list line
routine *routine; // routine
// 29 to 36 position, 8 chars
// *INIT --> program initialization
// *DETL --> detail lines
// *GETIN --> get input record
// *TOTC --> Total calculations
// *TOTL --> Total lines
// *DETC --> Detail calculations
// *OFL --> Overflow lines
// *TERM --> Program ending
// *ROUTINE --> name of program or procedure called (first 8 chars)
parms *parms; // no. of parms pass
// 37 to 39 position, (3,0) zoned decimal
excptype char(3); // exception type
// CPF --> operating system exception
// MCH --> machine exception
excpnum char(4);//exception number
// CPF --> CPF message number
// MCH --> MCH message number
reserved1 char(4);// reserved
workarea char(30); // internal use by ILE RPG compiler
pgmlib char(10); // prgram library
excpdata char(80); // exception data
excpcause char(4); //exception that cause RNX9001
filcname char(10); // file name on whicc last file operation occur updated only when error occur
unused char(6); //unused
date char(8); //date(*date format)
yy zoned(2); //first two digits of 4 digit year
filenametrn char(8); // file name truncate 175-184 pos above
statusinfo char(35); // status info on last file used
jobname char(10); // job name
username char(10); // user name
jobnumber zoned(6); //job number
date2 zoned(6); // date (udate format pgm running (191-198 pos above
pgmrundate zoned(6); // date of pgm running
time zoned(6); // time (hhmmss) pgm running
date3 char(6); // date (udate format pgm compiled
time2 char(6); // time (hhmmss) pgm compiled
cmplevel char(4); // compiler level
srcfile char(10); // src file name
srclib char(10); // src lib name
srcmbr char(10); //src file member
pgmproc char(10); // pgm containing procedure
modproc char(10); // module containing procedure
srcid bindec(2); // src id match the statement number from pos 21-28
srcid2 bindec(2); // src id match the statement number from pos 228-235
// binary 2 (5i,0)
curuserprf char(10); // current user profi
exterrorcd int(10); // external error cod
// Integer (10,0)
elements int(20); //elements set by XML-INTO or DATA-INTO
// Integer (20,0)
internaljobid char(16); //internal job id
systemname char(8); // system name
unused2 char(6); //unused
end-ds;
dcl-s num1 packed(1:0) inz(3);
dcl-s num2 packed(1:0) inz(0);
dcl-s result packed(1:0) inz(0);
dcl-s returncode char(6);
result = num1/num2;
DSPLY result;
*INLR = *ON;
Begsr *pssr;
If PGM_STATUS = 00102;
DSPLY 'ERROR: DIVIDE BY ZERO';
returncode = ' ';
//returncode = '*CANCL';
//returncode = '*GETIN';
Else;
DSPLY 'ERROR OCCURRED WITH STATUS CODE';
DSPLY PGM_STATUS;
returncode = '*CANCL';
EndIf;
endsr returncode;
Related Post
Read also :
- Data Structure and Types of DS in RPG AS400
- Using a Data Structure to subdivide the field in RPG AS400
- Using a Data Structure to group fields in RPG AS400
- Externally Described Data Structure in RPG AS400
- Using EXTFLD to code Externally Described DS in RPG AS400
- Using PREFIX to rename all fields in an external data structure in RPG AS400
- Define an externally-described data structure using the LIKEREC keyword in RPG AS400
- Difference between LIKEREC and EXTNAME keyword in RPG AS400
- Multiple Occurrence Data Structure in RPG AS400
- Data Area Data Structure in RPG AS400
- *LDA Local data area data structure in RPG AS400
- File information data structures (INFDS) in RPG AS400
- Indicator data structure in RPG AS400
- Program Status Data Structure in RPG AS400
- Using keywords QUALIFIED, LIKEDS, and DIM with data structures
- Array Data Structures in RPG AS400
- Defining Data Structure Parameters in a Prototype or Procedure Interface
- Using INFDS with INFSR to catch file exception in RPG AS400