|
James, that is a good example what I am looking for. I like the idea to code the sending of messages into another program so that you can really reuse the code. Two questions remain: 1. Is the command SNDSTSMSG really an OS/400 command? 2. If you CALL program FWDPGMMSG are there no parameter passed to the programm? or is this because both programs run in the same stack that you can read the messages of the calling program? "James W. Kilgore" schrieb: > Detlef, > > We have several depending on the program function. > With/without display file and self submitting > With/without printer determination > > Where we really cut down on repetative code was to take the error > message processing and placing that into a separate program and that > eliminated the DCL and logic lines and made it a single CALL. > > The code follows: > > > /* ------------------------------------------------------------------*/ > > /* FWDPGMMSG Forward a program message to the caller */ > > /* ------------------------------------------------------------------*/ > > FWDPGMMSG: PGM > > /* ------------------------------------------------------------------*/ > > /* Message variables */ > > DCL &MSG *CHAR 512 /* Message text */ > > DCL &MSGDTA *CHAR 132 /* Message data */ > > DCL &MSGF *CHAR 10 /* Message file name */ > > DCL &MSGFLIB *CHAR 10 /* Message file library name */ > > DCL &MSGID *CHAR 7 /* Message reference ID number */ > > DCL &MSGKEY *CHAR 4 /* Message reference key received */ > > DCL &MSGTYPE *CHAR 8 /* Message type */ > > DCL &RTNTYPE *CHAR 2 /* Message return type code */ > > DCL &SENDER *CHAR 80 /* Message sender data */ > > DCL &TOPGMQ *CHAR 10 /* Program message queue name */ > > DCL &MSGCNT *DEC LEN(3 0) /* Message counter */ > > DCL &MSGMAX *DEC LEN(3 0) VALUE(25) /* Maximum messages*/ > > > > MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ENDPGM)) > > /* ------------------------------------------------------------------*/ > > /* Determine the calling programs name */ > > /* ------------------------------------------------------------------*/ > > SNDPGMMSG MSG('Send dummy message') + > > MSGTYPE(*RQS) KEYVAR(&MSGKEY) > > > > RCVMSG PGMQ(*PRV) MSGKEY(&MSGKEY) SENDER(&SENDER) > > > > CHGVAR VAR(&TOPGMQ) VALUE(%SST(&SENDER 56 10)) > > /* ------------------------------------------------------------------*/ > > /* Forward errors messages up the stack */ > > /* ------------------------------------------------------------------*/ > > NEXTMSG: CHGVAR VAR(&MSGCNT) VALUE(&MSGCNT + 1) + > > /* Increment message counter */ > > > > IF COND(&MSGCNT *GT &MSGMAX) + > > THEN(GOTO CMDLBL(ENDPGM)) + > > /* Test if counter exceeded maximum */ > > > > RCVMSG PGMQ(*PRV) MSGTYPE(*NEXT) MSGKEY(*TOP) + > > MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) + > > RTNTYPE(&RTNTYPE) MSGF(&MSGF) + > > MSGFLIB(&MSGFLIB) + > > /* Receive the next available message */ > > > > IF COND((&MSGID *EQ ' ') *AND (&MSG *EQ ' ')) + > > THEN(GOTO CMDLBL(ENDPGM)) + > > /* No more messages */ > > > > IF COND(&MSGID *EQ 'CPF9999 ') + > > THEN(GOTO CMDLBL(NEXTMSG)) + > > /* Filter out function checks */ > > /* ------------------------------------------------------------------*/ > > /* Determine typoe of message being processed */ > > /* ------------------------------------------------------------------*/ > > IF COND(&RTNTYPE *EQ '01') + > > THEN(CHGVAR VAR(&MSGTYPE) VALUE('*COMP')) + > > /* Completion message */ > > > > IF COND(&RTNTYPE *EQ '02') + > > THEN(CHGVAR VAR(&MSGTYPE) VALUE('*DIAG')) + > > /* Diagnostic messages */ > > > > IF COND(&RTNTYPE *EQ '04') + > > THEN(CHGVAR VAR(&MSGTYPE) VALUE('*INFO')) + > > /* Informational messages */ > > > > IF COND(&RTNTYPE *EQ '14') + > > THEN(CHGVAR VAR(&MSGTYPE) VALUE('*NOTIFY')) + > > /* Status messages */ > > > > IF COND(&RTNTYPE *EQ '15') + > > THEN(CHGVAR VAR(&MSGTYPE) VALUE('*DIAG')) + > > /* Convert *ESCAPE to diagnostic */ > > /* ------------------------------------------------------------------*/ > > /* Forward the message and loop back */ > > /* ------------------------------------------------------------------*/ > > SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + > > MSGDTA(&MSGDTA) TOPGMQ(*PRV &TOPGMQ) + > > MSGTYPE(&MSGTYPE) > > > > GOTO NEXTMSG > > /* ------------------------------------------------------------------*/ > > ENDPGM: ENDPGM /* End of program specifications */ > > /* ------------------------------------------------------------------*/ > > A sample program that uses this: > > /* ------------------------------------------------------------------*/ > /* $$$$RGZ Reorganize file by primary index */ > /* ------------------------------------------------------------------*/ > /* NOTICE: THIS PROGRAM IS LICENSED MATERIAL AND THE PROPERTY OF: */ > /* PROGRAMMER. . . . . .:James W. Kilgore */ > /* DATE WRITTEN. . . . .:11/02/93 */ > /* ------------------------------------------------------------------*/ > $$$$RGZ: PGM > /* ------------------------------------------------------------------*/ > /* Declare the program variables and copyright notice */ > /* ------------------------------------------------------------------*/ > DCL ©RIGHT *CHAR 128 + > VALUE('$$$$RGZ (c) Copyright 1993, + > Licensed materials and the property of: + > James W. Kilgore; All rights reserved.') > /* ------------------------------------------------------------------*/ > /* Job attributes */ > DCL &JOB *CHAR 10 /* Job name */ > DCL &JOBUSER *CHAR 10 /* Job user */ > DCL &JOBNBR *CHAR 6 /* Job number */ > DCL &JOBENDSTS *CHAR 1 /* End job request */ > /* ------------------------------------------------------------------*/ > /* Global message monitor */ > > MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(SNDERR)) > MONMSG MSGID(MCH0000) EXEC(GOTO CMDLBL(SNDERR)) > /* ------------------------------------------------------------------*/ > /* Test for system shutdown */ > /* ------------------------------------------------------------------*/ > RTVJOBA JOB(&JOB) USER(&JOBUSER) NBR(&JOBNBR) ENDSTS(&JOBENDSTS) > > IF COND(&JOBENDSTS *EQ '1') THEN(GOTO CMDLBL(ENDPGM)) > /* ------------------------------------------------------------------*/ > /* Perform the reorganization process */ > /* ------------------------------------------------------------------*/ > SNDSTSMSG MSGTEXT('$$$$RGZ command is executing') > > RGZPFM FILE(*LIBL/$$$$) KEYFILE(*LIBL/$$$$KEY $$$$KEY) > MONMSG MSGID(CPF2995 CPF2981) /* No data in member */ > GOTO ENDPGM > /* ------------------------------------------------------------------*/ > /* Display error messages */ > /* ------------------------------------------------------------------*/ > NEVERDO: CHGVAR ©RIGHT ©RIGHT /* use or lose */ > SNDERR: CALL FWDPGMMSG > SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGTYPE(*ESCAPE) + > MSGDTA('$$$$RGZ ended in error. See previous messages') > /* ------------------------------------------------------------------*/ > ENDPGM: ENDPGM /* End of program specifications */ > /* ------------------------------------------------------------------*/ > > Detlef Fallisch wrote: > > I am looking for a good common CL program skeleton or frame that I can > > use for my most CLPs. For example you need an error message handling in > > nearly each CL program, this error message handling statements > > (DCL/CHGVAR/GOTO etc.) I would expect in a "skeleton or frame" CLP. > > _______________________________________________ > This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list > To post a message email: MIDRANGE-L@xxxxxxxxxxxx > To subscribe, unsubscribe, or change list options, > visit: http://lists.midrange.com/mailman/listinfo/midrange-l > or email: MIDRANGE-L-request@xxxxxxxxxxxx > Before posting, please take a moment to review the archives > at http://archive.midrange.com/midrange-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.