× 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.



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.


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.