Re: CL frame/skeleton program

["James W. Kilgore" <email@xxxxxxxxxxxxxxxxxxx>]

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.