Using external message files is a great way to keep your error messages external to your program visible and easy to maintain. When you create a new program and need to use an error message, the question becomes, "Do I already have an error message defined that I can use?"
When you start getting hundreds of error messages this can take awhile, and the average programmer's response is to just create a new error message and not bother looking for an existing error message. That creates duplicate or similar error messages. And if you are trying to maintain any consistency with your error messages, you'll have a problem.
To solve that problem, I created the FNDMSG command. (For those of you who aren't RPG shops, you'll be glad to know that this program is written entirely in CL.) This program allows you to specify any part of the first level message text and scan your message file for any error message that matches the string you put in. It will also list the last error message in the range you selected, so if you don't find an error message you were looking for and you need to add a new error message, you'll know what error message number to use next.
In this example, I have the default message file as QCPFMSG. If you want to specify a default message file, you'll probably want to replace that with your own message file name. If you don't want a default message file, then be sure to change the MSGF keyword to be MIN(1). So that you don't have to search the entire message file for a message, this command looks for messages with a prefix that you specify, such as CPF, CPI, etc.
Example: FNDMSG MSGID(CAE) SCANTXT(DA) MSGF(QCPFMSG)
This will find any error message that begins with CAE and has the letters da together in the first level message text.
This command uses a generic temporary file, so you will have to make sure it exists before compiling this command.
You can create this by using the following sequence of commands:
CRTPF FILE(MYLIB/FILE133) RCDLEN(133)
CRTCMD CMD(MYLIB/FNDMSG) PGM(MYLIB/FNDMSG) SRCFILE(MYLIB/QCMDSRC)
CRTCLPGM PGM(MYLIB/FNDMSG) SRCFILE(MYLIB/QCLSRC)
FNDMSG Command Source
/* ****************************************************** */
/* ** FIND MESSAGE COMMAND */
/* ****************************************************** */
CMD PROMPT('Find Message')
PARM KWD(MSGID) TYPE(*CHAR) LEN(3) MIN(1) +
PROMPT('Message Prefix')
PARM KWD(SCANTXT) TYPE(*CHAR) LEN(10) MIN(1) +
PROMPT('String to Find')
/* ** IF YOU DON'T WANT TO DEFAULT YOUR MESSAGE FILE */
/* ** NAME, THEN CHANGE THE MSGF KEYWORD TO BE MIN(1) */
PARM KWD(MSGF) TYPE(QUAL1) MIN(0) PROMPT('Message +
File')
/* CHANGE THE DEFAULT MESSAGE FILE OR LIBRARY HERE */
QUAL1: QUAL TYPE(*NAME) LEN(10) DFT(QCPFMSG )
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL ) +
SPCVAL((*LIBL)) EXPR(*YES) PROMPT('Library +
Name')
FNDMSG CL Command Processing Program Source
/********************************************************************/
/* Function...... - DISPLAY MESSAGES THAT MEET USER SELECTION */
/* CRITERIA VIA PARMS PASSED TO THIS PROGRAM */
/********************************************************************/
PGM PARM(&CHAR3 &PATTERN &FILELIB)
DCLF FILE(FILE133)
/* QCLSCAN VARIABLES */
DCL VAR(&RESULT) TYPE(*DEC) LEN(3 0)
DCL VAR(&STRING) TYPE(*CHAR) LEN(133)
DCL VAR(&BLNK) TYPE(*CHAR) LEN(133)
DCL VAR(&STRINGLEN) TYPE(*DEC) LEN(3 0) VALUE(133)
DCL VAR(&STRPOS) TYPE(*DEC) LEN(3 0) VALUE(1)
DCL VAR(&PATTERN) TYPE(*CHAR) LEN(10)
DCL VAR(&PATTERNLEN) TYPE(*DEC) LEN(3 0)
DCL VAR(&WILD) TYPE(*CHAR) LEN(1) /* blank means +
there are no wild cards to search for */
DCL VAR(&TRANS1) TYPE(*CHAR) LEN(1) VALUE('1') +
/* 1 means translate lower to upper case */
DCL VAR(&TRIM1) TYPE(*CHAR) LEN(1) VALUE('1') /* +
1 means trim blanks off of pattern end */
/* PROGRAM VARIABLES */
DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&LEN1) TYPE(*DEC) LEN(2)
DCL VAR(&CHAR3) TYPE(*CHAR) LEN(3)
DCL VAR(&FROMMSG) TYPE(*CHAR) LEN(7)
DCL VAR(&TOMSG) TYPE(*CHAR) LEN(7)
DCL VAR(&LSTTXT) TYPE(*CHAR) LEN(125) VALUE(' *** +
This is the last message in the range you +
selected. ***')
CHGVAR VAR(&FILE) VALUE(%SST(&FILELIB 1 10))
CHGVAR VAR(&LIB) VALUE(%SST(&FILELIB 11 10))
/* VALIDATE THAT MESSAGE FILE EXISTS */
CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*MSGF)
MONMSG MSGID(CPF0001 CPF9800) EXEC(DO)
CHGVAR VAR(&STRING) VALUE(&BLNK)
CHGVAR VAR(&STRING) VALUE('Message file' *BCAT +
&FILE *TCAT '/' *TCAT &LIB *BCAT 'not +
found')
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&STRING) +
MSGTYPE(*ESCAPE)
GOTO CMDLBL(ENDPGM)
ENDDO
LOOP:
/* GET STRING LENGTH */
CHGVAR VAR(&LEN1) VALUE(&LEN1 + 1)
IF COND(&LEN1 *GT 10) THEN(GOTO CMDLBL(DOIT))
IF COND(%SST(&PATTERN &LEN1 1) *GT ' ') THEN(CHGVAR +
VAR(&PATTERNLEN) VALUE(&LEN1))
GOTO CMDLBL(LOOP)
DOIT:
/* GET MESSAGE QUEUE */
CHKOBJ OBJ(QTEMP/FNDMSG) OBJTYPE(*MSGQ)
MONMSG MSGID(CPF9801) EXEC(DO)
CRTMSGQ MSGQ(QTEMP/FNDMSG)
ENDDO
CLRMSGQ MSGQ(QTEMP/FNDMSG)
/* GET WORK FILE */
CHKOBJ OBJ(QTEMP/FILE133) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(DO)
CRTPF FILE(QTEMP/FILE133) RCDLEN(133)
ENDDO
CLRPFM FILE(QTEMP/FILE133)
CHGVAR VAR(&FROMMSG) VALUE(&CHAR3 *CAT 'AAAA')
CHGVAR VAR(&TOMSG) VALUE(&CHAR3 *CAT '9999')
DSPMSGD RANGE(&FROMMSG &TOMSG) MSGF(&LIB/&FILE) +
DETAIL(*BASIC) OUTPUT(*PRINT)
OVRPRTF FILE(QPMSGD) HOLD(*YES)
CPYSPLF FILE(QPMSGD) TOFILE(QTEMP/FILE133) +
SPLNBR(*LAST)
DLTSPLF FILE(QPMSGD) SPLNBR(*LAST)
MONMSG MSGID(CPF0000)
DLTOVR FILE(QPMSGD)
OVRDBF FILE(FILE133) TOFILE(QTEMP/FILE133)
READ:
RCVF RCDFMT(FILE133)
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(DISPLAY))
IF COND(%SST(&FILE133 2 3) *NE &CHAR3) THEN(GOTO +
CMDLBL(READ))
CHGVAR VAR(&STRING) VALUE(&FILE133)
CHGVAR VAR(&RESULT) VALUE(0)
CALL PGM(QCLSCAN) PARM(&STRING &STRINGLEN &STRPOS +
&PATTERN &PATTERNLEN &TRANS1 &TRIM1 &WILD +
&RESULT)
IF COND(&RESULT *GT 1) THEN(DO)
CHGVAR VAR(%SST(&FILE133 12 1)) VALUE('-')
SNDUSRMSG MSG(&FILE133) MSGTYPE(*INFO) TOMSGQ(QTEMP/FNDMSG)
ENDDO
GOTO READ
DISPLAY:
/* DISPLAY LAST MESSAGE IN RANGE */
CHGVAR VAR(%SST(&STRING 9 125)) VALUE(&LSTTXT)
/* IF NO MESSAGES, THEN CHANGE THE MESSAGE */
IF COND(%SST(&STRING 1 8) *EQ ' ') THEN(DO)
CHGVAR VAR(&STRING) VALUE(&BLNK)
CHGVAR VAR(&STRING) VALUE('**** Message prefix' +
*BCAT &CHAR3 *BCAT 'does not exist in' +
*BCAT &FILE *TCAT '/' *TCAT &LIB)
ENDDO
SNDUSRMSG MSG(&STRING) MSGTYPE(*INFO) TOMSGQ(QTEMP/FNDMSG)
DSPMSG MSGQ(QTEMP/FNDMSG) START(*FIRST)
ENDPGM: ENDPGM
---------------------------
About the author: Tim is vice president of Technical Services at Interlink Technologies in Maumee, Ohio, where he serves as chief architect for their warehouse management system. He has worked in the banking, insurance, healthcare and distribution industries in various positions, including programmer/analyst, systems analyst and DP manager. Tim has worked on IBM midrange platforms since 1983.
