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