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