This command provides the possibility to find a database field, searching in max 4 libraries, looking by field name or by field type (alphanumeric or numeric and if numeric, by integer digits and decimal digits).
The structure of this command is:
FNDFLD (CMD)
|FNDFLDC (CLP)
|FNDFLDR (RPG)
|FNDFLDC1 (CLP)
|FNDFLDC0 (CLP)
|FNDFLDC2 (CLP)
|FNDFLDC3 (CLP)
|FNDFLDC4 (CLP)
The command FNDFLD call FNDFLDC (CLP) and this is the source:
/* */
/* PGM RICHIAMAMTO DAL COMANDO FNDFLD. */
/* AVVIA L'ELABORAZIONE E EFFETTUA IL DSPSPLF PER VIS. IL RISULTATO. */
/* */
PGM PARM(&LIB1 &LIB2 &LIB3 &LIB4 &FLDNM &FLDTP +
&FLDLN &FLDDC)
/* */
DCL VAR(&LIB1) TYPE(*CHAR) LEN(10)
DCL VAR(&LIB2) TYPE(*CHAR) LEN(10)
DCL VAR(&LIB3) TYPE(*CHAR) LEN(10)
DCL VAR(&LIB4) TYPE(*CHAR) LEN(10)
DCL VAR(&FLDNM) TYPE(*CHAR) LEN(10)
DCL VAR(&FLDTP) TYPE(*CHAR) LEN(1)
DCL VAR(&FLDLN) TYPE(*DEC) LEN(3 0)
DCL VAR(&FLDDC) TYPE(*DEC) LEN(3 0)
/* */
CALL PGM(FNDFLDR) PARM(&LIB1 &LIB2 &LIB3 &LIB4 +
&FLDNM &FLDTP &FLDLN &FLDDC)
/* */
DSPSPLF FILE(QPQXPRTF) SPLNBR(*LAST)
MONMSG MSGID(CPF0000)
/* */
ENDPGM
This CLP invokes and RPG pgm (FNDFLDR) that provides to call the appropriate search according to the parameter set.
This is the FNDFLDR source:
FFNDFLD0VCF E WORKSTN * ISTRPAR DS I 1 1 APIC1 I 2 11 NMCMPV I 12 12 APIC2 * * Parametri di input - arrivano direttamente dal comando * C *ENTRY PLIST C PARM PLIB1 10 C PARM PLIB2 10 C PARM PLIB3 10 C PARM PLIB4 10 C PARM PFLDNA 10 C PARM PFLDTY 1 C PARM PFLDLN 30 C PARM PFLDEC 30 * * Sposto i parametri nei campi del DSPF * C MOVELPLIB1 LIB1V C MOVELPLIB2 LIB2V C MOVELPLIB3 LIB3V C MOVELPLIB4 LIB4V C MOVELPFLDNA NMCMPV C MOVELPFLDTY TPCMPV C PFLDTY IFEQ 'A' C Z-ADDPFLDLN LNFLDV C ELSE C Z-ADDPFLDLN NRINTV C Z-ADDPFLDEC NRDECV C ENDIF * *---------- Inizio flusso principale del programma -----------* * C MOVEL'''' APIC1 C MOVEL'''' APIC2 * C SETOF 50 * C LIB1V IFNE *BLANKS C LIB2V ORNE *BLANKS C LIB2V ORNE *BLANKS C LIB2V ORNE *BLANKS C SETON 50 C ENDIF * C 50 NMCMPV IFEQ *BLANKS C SETOF 50 C ENDIF * C N50 TPCMPV IFEQ *BLANKS C SETOF 50 C ELSE C LNFLDV IFEQ 0 C NRINTV ANDEQ0 C SETOF 50 C ELSE C SETON 50 C ENDIF C ENDIF * * Se i parametri impostati dal comando sono OK, procedo. * C *IN50 IFEQ *ON * C EXSR ESEGUI * C ELSE * C WRITETESTA C SETOF 0110 * C DO *HIVAL * C WRITECMD C EXFMTFNDFLD1D * C SETOF 900203 * C KC LEAVE * C EXSR CONTR C N90 EXSR SECFMT * C KC LEAVE * C ENDDO * C ENDIF * C SETON LR *--------------------------------------------------------------* * SUBROUTINE CHE EFFETUA I CONTROLLI SUL PRIMO FORMATO RECORD * * DI IMMISSIONE * * * * 90 - Errore generale * * 02 - Nessuna Libreria specificata * * 03 - Ne Nome Campo ne Tipo sono stati specificati * *--------------------------------------------------------------* C CONTR BEGSR * C SETOF 0203 * C LIB1V COMP *BLANKS 02 C 02 LIB2V COMP *BLANKS 02 C 02 LIB3V COMP *BLANKS 02 C 02 LIB4V COMP *BLANKS 02 * C N02 DO C NMCMPV IFEQ *BLANKS C TPCMPV ANDEQ*BLANKS C SETON 03 C ENDIF C ENDDO * C *IN02 IFEQ *ON C *IN03 OREQ *ON C SETON 90 C ENDIF * C ENDSR *--------------------------------------------------------------* * SUBROUTINE CHE EFFETUA L'EMISSIONE DEL SECONDO FORMATO RECOR.* * DI IMMISSIONE * * * * 90 - Errore generale * * 10 - Abilita F12 * * 01 - ON = Se Tipo Campo A * * OFF = Se Tipo Campo N * *--------------------------------------------------------------* C SECFMT BEGSR * C NMCMPV IFEQ *BLANKS * C SELEC C TPCMPV WHEQ 'A' C SETON 01 C TPCMPV WHEQ 'N' C SETOF 01 C ENDSL * C SETON 10 C SETOF 90 * C N01 Z-ADD0 NRDECV C N01 Z-ADD0 NRINTV C 01 Z-ADD0 LNFLDV * C DO *HIVAL * C WRITECMD * C EXFMTFNDFLD2D * C SETOF 9004 * C *INKC IFEQ *ON C *INKL OREQ *ON C SETOF 0110 C LEAVE C ENDIF * C EXSR CONTR1 * * Lancio del CLP che esegue la stampa. * C N90 EXSR ESEGUI * C KC LEAVE * C ENDDO * C ELSE * * Lancio del CLP che esegue la stampa. * C EXSR ESEGUI * C ENDIF * C ENDSR *--------------------------------------------------------------* * SUBROUTINE CHE EFFETUA I CONTROLLI SUL SECONDO FORMATO RECORD* * DI IMMISSIONE * * * * 90 - Errore generale * * 04 01- Lunghezza errate * * 04N01- Cifre Intere errate * *--------------------------------------------------------------* C CONTR1 BEGSR * C SETOF 04 * C 01 LNFLDV COMP 0 04 * C N01 NRINTV COMP 0 04 * C 04 SETON 90 * C ENDSR *--------------------------------------------------------------* * SUBROUTINE DI LANCIO DEL COMANDO DI RICERCA DEL CAMPO * *--------------------------------------------------------------* C ESEGUI BEGSR * C CALL 'FNDFLDC1' * C LIB1V IFNE *BLANKS C CALL 'FNDFLDC0' C PARM LIB1V C ENDIF * C LIB2V IFNE *BLANKS C CALL 'FNDFLDC0' C PARM LIB2V C ENDIF * C LIB3V IFNE *BLANKS C CALL 'FNDFLDC0' C PARM LIB3V C ENDIF * C LIB4V IFNE *BLANKS C CALL 'FNDFLDC0' C PARM LIB4V C ENDIF * * CLP di lancio del query per la selezione del nome o lun. campo * C NMCMPV IFEQ *BLANKS * C LNFLDV IFNE 0 C MOVELLNFLDV S$ 3 C CALL 'FNDFLDC2' C PARM S$ C ENDIF * C NRINTV IFNE 0 C MOVELNRINTV S$ 3 C MOVELNRDECV D$ 3 C CALL 'FNDFLDC3' C PARM S$ C PARM D$ C ENDIF * C ELSE * C CALL 'FNDFLDC4' C PARM STRPAR * C ENDIF * C MOVE *ON *INKC * C ENDSR
In this RPG is used a DSPF (FNDFLD0V) that provides the interface where the user set the libraries and the field information to be searched.
Although, the core of this command is the following CLPs and the correlated QMQUERIES and QMFORM used in.
This is the soruce of FNDFLDC1 (CLP):
/* */
CHKOBJ OBJ(QTEMP/FINDFIELD) OBJTYPE(*FILE)
MONMSG MSGID(CPF0000) EXEC(GOTO FINE)
CLRPFM FILE(QTEMP/FINDFIELD)
/* */
FINE: ENDPGM
The source code for FNDFLDC0:
PGM PARM(&LIBF)
/* */
DCL VAR(&LIBF) TYPE(*CHAR) LEN(10)
/* */
DSPFFD FILE(&LIBF/*ALL) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/FINDFIELD) OUTMBR(*FIRST *ADD)
/* */
ENDPGM
This CLP MUST BE INVOKED FOR EACH LIBRARY (the limit of 4 libraries is a right mix of capability and speed).
The source code for FNDFLDC2:
PGM PARM(&FLLN)
/* */
DCL VAR(&FLLN) TYPE(*CHAR) LEN(3)
/* */
STRQMQRY QMQRY(SQLWHRFLD) OUTPUT(*PRINT) +
QMFORM(*LIBL/WHRFLDFRM) SETVAR((FLDLN +
&FLLN))
ENDPGM
The source code for FNDFLD3C:
/* */
PGM PARM(&FLLN &FLDC)
/* */
DCL VAR(&FLLN) TYPE(*CHAR) LEN(3)
DCL VAR(&FLDC) TYPE(*CHAR) LEN(3)
/* */
STRQMQRY QMQRY(SQLWHRFLD3) OUTPUT(*PRINT) +
QMFORM(*LIBL/WHRFLDFRM) SETVAR((FLDLN +
&FLLN) (FLDDC &FLDC))
ENDPGM
The source code for FNDFLD4C:
PGM PARM(&FLNM)
/* */
DCL VAR(&FLNM) TYPE(*CHAR) LEN(12)
/* */
STRQMQRY QMQRY(SQLWHRFLD4) OUTPUT(*PRINT) +
QMFORM(*LIBL/WHRFLDFRM) SETVAR((FLDNM +
&FLNM))
ENDPGM
Than, these are the source of the QMQUERIES and QMFORM then do the dirty work.
Start then Query Manager and creates these queries:
SQL statement for SQLWHRFLD:
SELECT
-- Columns
A.WHFILE, A.WHLIB, A.WHTEXT, A.WHFLDI, A.WHFLDB, A.WHFTXT
-- Tables
FROM "QTEMP"/"FINDFIELD" A
-- Row Selection
WHERE ((WHFTYP = 'P')
AND (WHFLDB = &FLDLN) AND (WHFLDD=0))
-- Sort Columns
ORDER BY A.WHLIB, A.WHFILE
SQL Statement for SQLWHRFLD3:
SELECT
-- Columns
A.WHFILE, A.WHLIB, A.WHTEXT, A.WHFLDI, A.WHFLDB, A.WHFTXT
-- Tables
FROM "QTEMP"/"FINDFIELD" A
-- Row Selection
WHERE ((WHFTYP = 'P')
AND (WHFLDD = &FLDLN) AND (WHFLDP = &FLDDC))
-- Sort Columns
ORDER BY A.WHLIB, A.WHFILE
SQL statement for SQLWHRFLD4:
SELECT
-- Columns
A.WHFILE, A.WHLIB, A.WHTEXT, A.WHFLDI, A.WHFLDB, A.WHFTXT
-- Tables
FROM "QTEMP"/"FINDFIELD" A
-- Row Selection
WHERE ((WHFTYP = 'P')
AND (WHFLDI = &FLDNM))
-- Sort Columns
ORDER BY A.WHLIB, A.WHFILE
Than crates this QM Report Form:
Definition of WHRFLDFRM:
Column Heading Usage Edit Seq Indent Width
1 File 1 1
2 Libreria 2 1
3 Descrizione_formato testo 3 1 30
4 Campo 4 1 6
5 Lun. 5 1 3
6 Descr. campo 6 1 15
If you decide to use parameter for command, you don't need DSPF (FNDFLD0V), because you can pass parameter from CMD-CLP-RPG directly without use a DSPF for prompting user.
I hope you like this utility. For any question, please e-mail me at sandro@sicosbt.it
This was first published in May 2001