|
Looks good Ron. One slight problem though; the LPRINT command dosen't seem to exist on my machine (V4R3)..... Or am i missing something? (Apologies, i'm not well versed in the art of programming) Regards, Stuart > -----Original Message----- > From: Ron Hudson [SMTP:roxrhud@colaik.com] > Sent: Wednesday, October 27, 1999 9:47 PM > To: MIDRANGE-L@midrange.com > Subject: Re: Checking lots of Queries for a field > > > > > I had the same need. With the DMPSYSOBJ hint, I threw this together. > So far, it seems to meet my needs. Hope it's helpful. > > > Ron Hudson > Ron.Hudson@colaik.com > Collins & Aikman > > > > /*********************************************************************/ > /* UTE015C */ > /* Call this pgm w/ a parm of lib and string. */ > /* A report will be printed showing all queries containing the */ > /* string. */ > /* Note: */ > /* The string cannot contain any blanks! */ > /*********************************************************************/ > PGM PARM(&LIB &STRNG) > DCLF *LIBL/QADSPOBJ > DCL &LIB *CHAR 10 > DCL &STRNG *CHAR 20 > > CHKOBJ QTEMP/OBJDMP *FILE > MONMSG MSGID(CPF9801) EXEC( + > CRTPF QTEMP/OBJDMP RCDLEN(132)) > CHGPF FILE(QTEMP/OBJDMP) SIZE(*NOMAX) > > CPYSPLF QPSRVDMP QTEMP/OBJDMP MBROPT(*ADD) > MONMSG MSGID(CPF3309) EXEC(DO) > GOTO ITSOK > ENDDO > > SNDMSG MSG('This utility cannot be used when + > QPSRVDMP spool files exists') + > TOUSR(*REQUESTER) > GOTO THATSALL > > ITSOK: DSPOBJD &LIB/*ALL *QRYDFN OUTPUT(*OUTFILE) + > OUTFILE(QTEMP/QRYS) > OVRDBF FILE(QADSPOBJ) TOFILE(QTEMP/QRYS) > > READIT: RCVF RCDFMT(QLIDOBJD) WAIT(*YES) > > MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(SCANIT)) > > DMPSYSOBJ OBJ(&ODOBNM) CONTEXT(&LIB) OBJTYPE(*QRYDFN) > > CPYSPLF QPSRVDMP TOFILE(QTEMP/OBJDMP) MBROPT(*ADD) > DLTSPLF QPSRVDMP > > GOTO READIT > > SCANIT: CALL UTE015C2 &STRNG > > THATSALL: RCLRSC > CLRPFM QTEMP/OBJDMP > ENDPGM > __________________________________________________________________________ > _ > ______ > > /*********************************************************************/ > /* UTE015C2 */ > /* Called from UTE015C */ > /* Before compiling this pgm, */ > /* CRTPF FILE(*libl/OBJDMP) RCDLEN(132) */ > /* After compiling, DLTF *libl/OBJDMP */ > /*********************************************************************/ > PGM &STRNG > DCLF OBJDMP > DCL &STRNG *CHAR 20 > DCL &QRY *CHAR 10 > DCL &OBJDMP *CHAR 132 > DCL &PRTD *CHAR 1 > DCL &CURDAT *CHAR 6 > /* QCLSCAN VARS */ > DCL &STRLEN *DEC LEN(3 0) VALUE(132) > DCL &STRPOS *DEC LEN(3 0) VALUE(1) > DCL &PATLEN *DEC LEN(3 0) > DCL &TRANS *CHAR LEN(1) > DCL &TRIM *CHAR LEN(1) > DCL &WILD *CHAR LEN(1) > DCL &RESULT *DEC LEN(3 0) VALUE(1) > > CHGVAR &PATLEN 1 > CALL QCLSCAN PARM(&STRNG &STRLEN &STRPOS + > ' ' &PATLEN &TRANS &TRIM &WILD &RESULT) > CHGVAR &PATLEN &RESULT > > RTVJOBA DATE(&CURDAT) > LPRINT DATA('UTE015C - Queries contaning string ' + > *cat &STRNG *CAT ' ' *CAT &CURDAT) > READIT: RCVF RCDFMT(OBJDMP) WAIT(*YES) > MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(THATSALL)) > > IF (%SST(&OBJDMP 1 4) = 'OBJ-') THEN(DO) > CHGVAR &QRY (%SST(&OBJDMP 6 10)) > CHGVAR &PRTD '0' > GOTO READIT > ENDDO > > IF (&PRTD = '1') THEN(GOTO READIT) > > CALL QCLSCAN PARM(&OBJDMP &STRLEN &STRPOS + > &STRNG &PATLEN &TRANS &TRIM &WILD &RESULT) > IF (&RESULT > 0) THEN(DO) > LPRINT &QRY > CHGVAR &PRTD '1' > ENDDO > > GOTO READIT > > THATSALL: RCLRSC > ENDPGM > __________________________________________________________________________ > _ > ______ > > From: Allen, Stuart > > > Does anyone have a routine that lets you scan a load of Query > definitions > > for a particular field, a la option 25 in PDM? > > > +--- > | 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 > +--- +--- | 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.