Re: GO to a menu within CL program -- MIDRANGE-L

Jeff Crosby <jlcrosby@fwi.com> wrote (in part):

>We use Inventory Management of DMAS.  The latest requires 4 libraries to be
>in the library list.  The only users that need these libraries are the buyers,
>and then only while in DMAS.


Here's a moodified version of a program our menu system uses to add and
remove libraries as they are needed.  In our situation, this program is
called, and is passed a parameter to indicate 'wakeup' or 'shutdown.'

This version should be fine as an in-line program.

The code to 'retrieve the real name of this program' was sponged from an
IBM menu generator way back in the dim ages of the S/38.  The idea is that
you can have a whole bunch of programs that save their LIBLs, each tracking
just the changes it made.

This program retrieves the LIBL as it exists right now, and saves it to a
data area it creates in QTEMP.  You then mutilate the LIBL, adding and
removing libraries as needed.  Now call your application's first menu.
When you're done with your application, RETURN to this program, which will
retrieve the LIBL from the data area, change your job's LIBL back to what
it was to start with, and exit.

One note about the 'mutilate your LIBL here' section.  I recommend just
adding and removing libraries.  Do not replace the LIBL in its entirety.
If your shop has any libraries that -you- require, replacing the entire
LIBL would remove those, too!

--Paul E Musselman
PaulMmn@ix.netcom.com



  SOURCE FILE . . . . . . .  EZMSRC/QCLSRC
  MEMBER  . . . . . . . . .  EZ99400

  SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6
...+... 7 ...+... 8

   3100              PGM
   3300              DCL        VAR(&CMD       ) TYPE(*CHAR) LEN( 300)
   3400              DCL        VAR(&PGMNAM    ) TYPE(*CHAR) LEN(  10)
   3600              DCL        VAR(&SENDER    ) TYPE(*CHAR) LEN(  80)
   3700              DCL        VAR(&SYS       ) TYPE(*CHAR) LEN(   2)
   3800              DCL        VAR(&SYSLIB    ) TYPE(*CHAR) LEN(  10)
   4000              DCL        VAR(&USERLIBL  ) TYPE(*CHAR) LEN( 275)
   4100
   4200  GET_PGMNAM: /*  Retrieve the real name of this program  */
   4300              CRTMSGQ    MSGQ(QTEMP/MENUMSGQ)
   4400              SNDMSG     MSG('Retrieve program name in sender field') +
   4500                         TOMSGQ(QTEMP/MENUMSGQ)
   4600              RCVMSG     MSGQ(QTEMP/MENUMSGQ) RMV(*NO) SENDER(&SENDER)
   4700              CHGVAR     VAR(&PGMNAM) VALUE(%SUBSTRING(&SENDER 27 10))
   4800              DLTMSGQ    MSGQ(QTEMP/MENUMSGQ)
   4900
   5500  CRT_DTAARA: CHKOBJ     OBJ(QTEMP/&PGMNAM) OBJTYPE(*DTAARA)
   5600                MONMSG     MSGID(CPF9801) EXEC(DO) /* NOT FOUND */

   5700                  CRTDTAARA  DTAARA(QTEMP/&PGMNAM) TYPE(*CHAR)
LEN(275) +
   5800                               TEXT('Contains library list before
driver +
   5900                               got hold of it')

   6000                    MONMSG     MSGID(CPF1023)  /* already there...
*/
   6100                ENDDO

   6200

   5100  RTVJOBA:    RTVJOBA    USRLIBL(&USERLIBL)
   5400
   6300  WAKEUP:     DO
   6400
   6500                CHGDTAARA  DTAARA(QTEMP/&PGMNAM) VALUE(&USERLIBL)
   6600

   6700                ADDLIBLE   LIB(XYZFILT1)      /* Mutilate your */
   6800                  MONMSG     MSGID(CPF0000)   /* LIBL here     */
   9000

   9100    ADDED:    ENDDO  /* Wakeup */
   9200

           /* call your application program here */

   9300

   9400  SHUTDOWN:   DO     /* put your LIBL back the way it was before you
started */
   9500

   9600                RTVDTAARA  DTAARA(QTEMP/&PGMNAM) RTNVAR(&USERLIBL)

   9700                CHGVAR     VAR(&CMD) VALUE('CHGLIBL    LIBL(' *CAT +

   9800                             &USERLIBL *CAT ')')

   9900                CALL       QCAEXEC (&CMD 300)

  10000

  10100              ENDDO  /* Shutdown */
  10200

  10300              ENDPGM
                                  * * * *  E N D  O F  S O U R C E  * * * *





+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---