× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



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   &COPYRIGHT   *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     &COPYRIGHT  &COPYRIGHT   /* 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 thread ...

Follow-Ups:
Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

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.