RE: Checking lots of Queries for a field

["Ron Hudson" <roxrhud@xxxxxxxxxx>]

Stuart,

I believe the LPRINT is a TAATOOL.  It's a great utility to print from CL
pgms.  Below are the final
versions.

I have  cleaned up a few things, made it a little quicker, and also handled
 the situation of a string
spanning 2 lines in the dump.

I would like to give Thanks and Credit to Henrik Krebs for some offline
discussion and Great Ideas!

I have thoroughly tested the code.........but no guarantees are made.


Ron Hudson
Collins & Aikman
Ron.Hudson@colaik.com



/*********************************************************************/
/* 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
             DCL        &JOBTYPE *CHAR 1

             RTVJOBA    TYPE(&JOBTYPE)
             IF         (&JOBTYPE *EQ '1') THEN(DO)
             SBMJOB     CMD(CALL PGM(UTE015C) PARM(&LIB &STRNG)) +
                          JOB(QRYSCAN)
             RETURN
             ENDDO

             CHKOBJ     QTEMP/OBJDMP *FILE
             MONMSG     MSGID(CPF9801) EXEC( +
             CRTPF      QTEMP/OBJDMP RCDLEN(132))
             CHGPF      FILE(QTEMP/OBJDMP) SIZE(*NOMAX)

             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  &ODOBNM CONTEXT(&LIB) OBJTYPE(*QRYDFN)

             CPYSPLF    QPSRVDMP TOFILE(QTEMP/OBJDMP) +
                          SPLNBR(*LAST) MBROPT(*ADD)
             DLTSPLF    QPSRVDMP SPLNBR(*LAST)

             GOTO       READIT

 SCANIT:     CALL UTE015C2 &STRNG

 THATSALL:   RCLRSC
             CLRPFM QTEMP/OBJDMP
             ENDPGM
_________________________________________________________________________

/*********************************************************************/
/* UTE015C2                                                          */
/*  Called from UTE015C                                              */
/* Before compiling this pgm,                                        */
/*  CRTPF FILE(OBJDMP) RCDLEN(132)                                   */
/*  After compiling, DLTF 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
             DCL        &SPACE1  *CHAR 32
             DCL        &SPACE2  *CHAR 32
             DCL        &TSPACE  *CHAR 64
/* QCLSCAN VARS */
             DCL        &STRLEN  *DEC  LEN(3 0) VALUE(64)
             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)

/* Determine string length */
             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))

             CHGVAR     &SPACE1 %SST(&OBJDMP 88 32)

             IF         (%SST(&OBJDMP 1 4) = 'OBJ-') THEN(DO)
             CHGVAR     &QRY (%SST(&OBJDMP 6 10))
             CHGVAR     &PRTD '0'
             CHGVAR     &SPACE2 &SPACE1
             GOTO       READIT
             ENDDO

             IF         (&PRTD = '1') THEN(GOTO READIT)

/* Handle strings spanning 2 lines */
             CHGVAR     &TSPACE VALUE(&SPACE2 *CAT &SPACE1)

             IF         (&TSPACE *GT ' ') THEN(DO)
             CALL       QCLSCAN PARM(&TSPACE &STRLEN &STRPOS +
                          &STRNG &PATLEN &TRANS &TRIM &WILD &RESULT)
             IF         (&RESULT > 0) THEN(DO)
             LPRINT     &QRY
             CHGVAR     &PRTD '1'
             ENDDO
             ENDDO

             CHGVAR     &SPACE2 &SPACE1
             GOTO READIT

 THATSALL:   RCLRSC
             ENDPGM
_________________________________________________________________________






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


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