× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  • Subject: RE: Checking lots of Queries for a field
  • From: "Allen, Stuart" <sallen@xxxxxxxxxxxx>
  • Date: Thu, 28 Oct 1999 09:06:51 -0500

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


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

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.