|
midrange.com
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
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
