Example: MSGEXIT user exit
The following example shows a MSGEXIT user-exit
module that changes message severities and suppresses messages. 
This example is included with Enterprise COBOL V6 in the SIGYSAMP dataset,
in member IGYMSGXT.
For helpful tips about using a message-exit module, see the comments within the code.
******************************************************************
* IGYMSGXT - Sample COBOL program for MSGEXIT *
******************************************************************
* *
* IBM Enterprise COBOL for z/OS *
* Version 6 Release 2 Modification 0 *
* *
* LICENSED MATERIALS - PROPERTY OF IBM. *
* *
* 5655-EC6 COPYRIGHT IBM CORP. 2017 *
* ALL RIGHTS RESERVED *
* *
* US GOVERNMENT USERS RESTRICTED RIGHTS - USE, *
* DUPLICATION OR DISCLOSURE RESTRICTED BY GSA *
* ADP SCHEDULE CONTRACT WITH IBM CORP. *
* *
******************************************************************
*****************************************************************
* Function: This is a SAMPLE user exit for the MSGEXIT *
* suboption of the EXIT compiler option. This exit *
* can be used to customize the severity of or *
* suppress compiler diagnostic messages and FIPS *
* messages. This example program includes several *
* sample customizations to show how customizations *
* are done. If you do not want the sample *
* customizations then either delete the unwanted *
* lines of code or comment them out with a comment *
* indicator in column 7 (*). *
* *
*---------------------------------------------------------------*
* *
* USAGE NOTE: To use this user exit program, make the *
* link-edited load module available to your *
* compiles that will use the MSGEXIT suboption of *
* the EXIT compiler option. Also, the name should *
* be changed, since IBM recommends that you avoid *
* having programs with names that start with IGY. *
* Sample steps to take: *
* 1) Make your customizations *
* 2) Change program name (E.G. MYEXIT) *
* 3) Compile and link into a dataset *
* 4) Include that dataset in your compile *
* JCL concatenation for the compile step. *
* If you link into USER.COBOLLIB: *
* *
* //COBOL.STEPLIB DD DSNAME=SYS1.SIGYCOMP,DISP=SHR *
* // DD DSNAME=USER.COBOLLIB,DISP=SHR *
* *
* 5) Finally, compile your programs with the *
* EXIT compiler option, EG: *
* EXIT(MSGEXIT(MYEXIT)) *
* *
* COMPILE NOTE: Compile this program with NOEXIT. *
* *
* *
*****************************************************************
Id Division.
Program-Id. IGYMSGXT.
Data Division.
Working-Storage Section.
*****************************************************************
* *
* Local variables. *
* *
*****************************************************************
77 EXIT-TYPEN PIC 9(4).
77 EXIT-DEFAULT-SEV-FIPS PIC X.
*****************************************************************
* *
* Definition of the User-Exit Parameter List, which is *
* passed from the COBOL compiler to the user-exit module. *
* *
*****************************************************************
Linkage Section.
01 EXIT-TYPE PIC 9(4) COMP.
01 EXIT-OPERATION PIC 9(4) COMP.
01 EXIT-RETURNCODE PIC 9(9) COMP.
01 EXIT-WORK-AREA.
02 EXIT-WORK-AREA-PTR OCCURS 6 POINTER.
01 EXIT-DUMMY POINTER.
01 EXIT-MESSAGE-PARMS.
02 EXIT-MESSAGE-NUM PIC 9(4) COMP.
02 EXIT-DEFAULT-SEV PIC 9(4) COMP.
02 EXIT-USER-SEV PIC S9(4) COMP.
01 EXIT-STRING.
02 EXIT-STR-LEN PIC 9(4) COMP.
02 EXIT-STR-TXT PIC X(64).
*****************************************************************
*****************************************************************
* *
* Begin PROCEDURE DIVISION *
* *
* Check parameters and perform the operation requested. *
* *
*****************************************************************
*****************************************************************
Procedure Division Using EXIT-TYPE EXIT-OPERATION
EXIT-RETURNCODE EXIT-WORK-AREA
EXIT-DUMMY EXIT-MESSAGE-PARMS
EXIT-STRING EXIT-DUMMY
EXIT-DUMMY EXIT-DUMMY.
Compute EXIT-RETURNCODE = 0
Evaluate TRUE
*****************************************************************
* Handle a bad invocation of this exit by the compiler. *
* This could happen if this routine was used for one of the *
* other EXITs, such as INEXIT, PRTEXIT or LIBEXIT. *
*****************************************************************
When EXIT-TYPE Not = 6
Move EXIT-TYPE to EXIT-TYPEN
Display '**** Invalid exit routine identifier'
Display '**** EXIT TYPE = ' EXIT-TYPE
Compute EXIT-RETURNCODE = 16
*****************************************************************
* Handle the OPEN call to this exit by the compiler *
* Display the exit string (str5 in syntax diagram) from *
* the EXIT(MSGEXIT('str5',mod5)) option specification. *
*****************************************************************
When EXIT-OPERATION = 0
* Display 'Opening MSGEXIT'
* If EXIT-STR-LEN Not Zero Then
* Display ' str5 len = ' EXIT-STR-LEN
* Display ' str5 = ' EXIT-STR-TXT(1:EXIT-STR-LEN)
* End-If
Continue
*****************************************************************
* Handle the CLOSE call to this exit by the compiler *
*****************************************************************
When EXIT-OPERATION = 1
* Display 'Closing MSGEXIT'
Goback
*****************************************************************
* Handle the customize message severity call to this exit *
* Display information about every customized severity. *
*****************************************************************
When EXIT-OPERATION = 5
* Display 'MSGEXIT called with MSGSEV'
If EXIT-MESSAGE-NUM < 8000 Then
Perform Error-Messages-Severity
Else
Perform FIPS-Messages-Severity
End-If
* If EXIT-RETURNCODE = 4 Then
* Display '>>>> Customizing message ' EXIT=MESSAGE-NUM
* ' with new severity ' EXIT-USER-SEV ' <<<<'
* If EXIT-MESSAGE-NUM > 8000 Then
* Display 'FIPS sev =' EXIT-DEFAULT-SEV-FIPS '<<<<'
* End-If
* End-If
*****************************************************************
* Handle a bad invocation of this exit by the compiler. *
* The compiler should not invoke this exit with EXIT-TYPE = 6 *
* and an opcode other than 0, 1, or 5. This should not happen *
* and IBM service should be contacted if it does. *
*****************************************************************
When Other
Display '**** Invalid MSGEXIT routine operation '
Display '**** EXIT OPCODE = ' EXIT-OPERATION
Compute EXIT-RETURNCODE = 16
End-Evaluate
Goback.
*****************************************************************
* ERROR MESSAGE PROCESSOR *
*****************************************************************
Error-Messages-Severity.
* Assume message severity will be customized...
Compute EXIT-RETURNCODE = 4
Evaluate EXIT-MESSAGE-NUM
*****************************************************************
* Change severity of message 1154(W) to 12 ('S') *
* This is the case of redefining a large item *
* with a smaller item, IBM Req # MR0904063236 *
*****************************************************************
When(1154)
Compute EXIT-USER-SEV = 12
*****************************************************************
* Modify the severity of RULES messages to enforce coding *
* standards or highlight coding that you want to avoid. *
* Here are the message numbers and what they flag: *
* 1158 RULES(NOOMITODOMIN) Missing min idx in ODO table def*
* 1348 RULES(NOEVENPACK) Even digit packed-decimal items *
* 1353 RULES(NOSLACKBYTES) Slack bytes within records *
* 1379 RULES(NOSLACKBYTES) Slack bytes between records *
* 2159 RULES(NOENDPERIOD) Cond stmt terminated by period *
* 2262 RULES(NOUNREFALL) Unref'd items (source/copybook) *
* 2262 RULES(NOUNREFSOURCE) Unref'd items (source only) *
* 2224 RULES(NOLAXPERF) Ineff. type for PERFORM VARYING *
* 2246 RULES(NOLAXPERF) Ineff. type for subscript *
* 2247 RULES(NOLAXPERF) Compiler option NOAWO in effect *
* 2248 RULES(NOLAXPERF) Option ARITH(EXTEND) in effect *
* 2249 RULES(NOLAXPERF) Option NOBLOCK0 in effect *
* 2250 RULES(NOLAXPERF) Option NOFASTSRT in effect *
* 2251 RULES(NOLAXPERF) Option NUMPROC(NOPFD) in effect*
* 2252 RULES(NOLAXPERF) Option OPTIMIZE(0) in effect *
* 2253 RULES(NOLAXPERF) Option SSRANGE in effect *
* 2254 RULES(NOLAXPERF) Option THREAD in effect *
* 2255 RULES(NOLAXPERF) Option TRUNC(STD) in effect *
* 2256 RULES(NOLAXPERF) Option TRUNC(BIN) in effect *
* 3084 RULES(NOLAXPERF) Ineff. type for arith sender *
* 3123 RULES(NOLAXPERF) Lots of padding in alph MOVE *
* *
*****************************************************************
When(1158) *> Disallow omitting ODO table min
Compute EXIT-USER-SEV = 12
When(1348) *> Disallow even-digit Comp-3
Compute EXIT-USER-SEV = 12
When(1353) When(1379) *> Disallow slack bytes
Compute EXIT-USER-SEV = 12
When(2159) *> Disallow period-termination
Compute EXIT-USER-SEV = 12 *> of conditional stmts
When(2262) *> Disallow unref'd data items
Compute EXIT-USER-SEV = 12
* Highlight poorly performing COBOL features
When(2224) *> Ineff. type for PERFORM VARYING
When(2246) *> Ineff. type for subscript
When(2247) *> Compiler option NOAWO in effect
When(2248) *> Option ARITH(EXTEND) in effect
When(2249) *> Option NOBLOCK0 in effect
When(2250) *> Option NOFASTSRT in effect
When(2251) *> Option NUMPROC(NOPFD) in effect
When(2252) *> Option OPTIMIZE(0) in effect
When(2253) *> Option SSRANGE in effect
When(2254) *> Option THREAD in effect
When(2255) *> Option TRUNC(STD) in effect
When(2256) *> Option TRUNC(BIN) in effect
When(3084) *> Ineff. type for arith sender
When(3123) *> Lots of padding in alph MOVE
Compute EXIT-USER-SEV = 8
*****************************************************************
* Change severity of messages 3178(I) to highlight File *
* Definitions that could lead to wrong-length read conditions. *
* Message 3178 is issued when the length of the shortest *
* record description is less than the FROM integer in the *
* RECORD IS VARYING clause, and when the length of the *
* longest record description is greater than the TO integer *
* in the RECORD IS VARYING clause. *
*****************************************************************
When(3178)
Compute EXIT-USER-SEV = 8
*****************************************************************
* Change severity of messages 3188(W) and 3189(W)
* to 12 ('S'). This is to force a fix for all
* SEARCH ALL cases that might behave differently
* between COBOL compilers previous to Enterprise
* COBOL release V3R4 and later compilers suchas
* Enterprise COBOL Version 4 Release 2.
* Another way to handle this migration is to analyze all of
* the warnings you get and then change them to I-level when
* the analysis is complete.
*****************************************************************
When(3188) When(3189)
Compute EXIT-USER-SEV = 12
*****************************************************************
* Change severity of message 4019 to suppress this message.
* Message 4019 says 'Compiler option "OPTFILE" was specified, "
* but file SYSOPTF could not be opened. No options from a
* "SYSOPTF" file were used.
* This customization would allow users to specify OPTFILE
* as a default option and it would only have an affect
* if there is a SYSOPTF file present
*****************************************************************
When(4019)
Compute EXIT-USER-SEV = -1
*****************************************************************
* Change severity of 'optimization' messages to suppress them
* so that compilation Return Code can be zero (RC=0)
* 7300: The code from lines &2 in program '&1' can never
* be executed and was therefore discarded.
* 7301: A zero base was raised to a zero power in a numeric
* literal exponentiation. The result was set to 1.
* 7302: A zero base was raised to a negative power in a numeric
* literal exponentiation. The result was set to 0.
* 7304: An exception "&1" occured while processing numeric
* literals. The result of the operation was set to zero.
* 7307: This statement may cause a program exception at execution
* time.
* 7309: There may be a loop from the "PERFORM" statement at "
* "PERFORM (line &1)" to itself.
* 7312: Procedure starting at 'proc-name' (line 'num') was
* copied one or more times to be inlined for PERFORM
* statements. xxx total bytes were generated from
* copying that procedure.
*****************************************************************
When(7300) When(7301) When(7302) When(7304)
When(7307) When(7309) When(7312)
Compute EXIT-USER-SEV = -1 *> Suppress the messages
*****************************************************************
* Change severity of message 7311(W) to 12 ('S'). This is the *
* case of INITCHECK messages about uninitialized data items. *
*****************************************************************
When(7311)
Compute EXIT-USER-SEV = 12
*****************************************************************
* Message severity Not customized
*****************************************************************
When Other
Compute EXIT-RETURNCODE = 0
End-Evaluate
.
*****************************************************************
* FIPS MESSAGE PROCESSOR *
*****************************************************************
Fips-Messages-Severity.
* Assume message severity will be customized...
Compute EXIT-RETURNCODE = 4
* Convert numeric FIPS(FLAGSTD) 'category' to character
* See the Programming Guide for description of FIPS category
EVALUATE EXIT-DEFAULT-SEV
When 81
MOVE 'D' To EXIT-DEFAULT-SEV-FIPS
When 82
MOVE 'E' To EXIT-DEFAULT-SEV-FIPS
When 83
MOVE 'H' To EXIT-DEFAULT-SEV-FIPS
When 84
MOVE 'I' To EXIT-DEFAULT-SEV-FIPS
When 85
MOVE 'N' To EXIT-DEFAULT-SEV-FIPS
When 86
MOVE 'O' To EXIT-DEFAULT-SEV-FIPS
When 87
MOVE 'Q' To EXIT-DEFAULT-SEV-FIPS
When 88
MOVE 'S' To EXIT-DEFAULT-SEV-FIPS
When Other
Continue
End-Evaluate
*****************************************************************
* Example of using FIPS category to force coding
* restrictions. This is not a recommendation!
* Change severity of all OBSOLETE item FIPS
* messages to 'S'
*****************************************************************
* If EXIT-DEFAULT-SEV-FIPS = 'O' Then
* Display '>>>> Default customizing FIPS category '
* EXIT-DEFAULT-SEV-FIPS ' msg ' EXIT-MESSAGE-NUM '<<<<'
* Compute EXIT-USER-SEV = 12
* End-If
Evaluate EXIT-MESSAGE-NUM
*****************************************************************
* Change severity of message 8062(O) to 8 ('E')
* 8062 = GO TO without proc name
*****************************************************************
When(8062)
Compute EXIT-USER-SEV = 8
*****************************************************************
* Change severity of message 8193(E) to 0('I')
* 8193 = GOBACK
*****************************************************************
When(8193)
Compute EXIT-USER-SEV = 0
*****************************************************************
* Change severity of message 8235(E) to 8 (Error)
* to disallow Complex Occurs Depending On
* 8235 = Complex Occurs Depending On
*****************************************************************
When(8235)
Compute EXIT-USER-SEV = 08
*****************************************************************
* Change severity of message 8270(O) to -1 (Suppress)
* 8270 = SERVICE LABEL
*****************************************************************
When(8270)
Compute EXIT-USER-SEV = -1
*****************************************************************
* Message severity Not customized
*****************************************************************
When Other
* For the default set 'O' to 'S' case...
* If EXIT-USER-SEV = 12 Then
* Compute EXIT-RETURNCODE = 4
* Else
Compute EXIT-RETURNCODE = 0
* End-If
End-Evaluate
.
END PROGRAM IGYMSGXT.