|
midrange.com
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
+---
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.
