You are here:
DBG/400
>
DBG400 Web
>
SourceCodeList
>
RpgSource
>
RpgQRYXREF0
(01 Oct 2014,
UnknownUser
)
(raw view)
E
dit
A
ttach
<verbatim> ***************************************************************** H Y ***************************************************************** FQRYLIST IF E DISK FQQRYSRC IF F 92 DISK UC FQRYXREF0UF E K DISK A ***************************************************************** ** DATA STRUCTURES ** * ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ IQQRYSRC NS I 1 60SRCSEQ I 7 120SRCDAT I 13 92 SRCDTA I 15 18 FROM I 25 45 LIBFIL * I DS I 1 6 DATESP I 1 2 DATEMM I 3 4 DATEDD I 7 8 DATE78 * Remove member command I 'RMVM FILE(QTEMP/QQRY-C CMD1 I 'SRC) MBR(*ALL)' * Retrieve QM Query command I DS I I 'RTVQMQRY QMQRY(Query- 1 80 CMD2 I 'libry/Queryname ) SR- I 'CFILE(QTEMP/QQRYSRC)- I ' ALWQRYDFN(*YES) ' I 16 36 LIBQRY ***************************************************************** C QRYKEY KLIST C KFLD ODOBNM C KFLD ODLBNM * C QRYKY1 KLIST C KFLD QRQRNM C KFLD QRQRLB C KFLD QRFLNM C KFLD QRFLLB ***************************************************************** * C 1 SETLLQRYLIST C READ QRYLIST 80 B001 C *IN80 DOWEQ*OFF C MOVE *OFF BYPASS 1 C MOVE *OFF UPDATE 1 C QRYKEY CHAINQRYXREF0 81 B002 C *IN81 IFEQ *OFF * Query last used C MOVELODUDAT DATESP C MOVE DATEDD DATE78 C MOVE DATEMM DATEDD C MOVE DATE78 DATEMM C MOVE DATESP LSTUSE 60 C Z-ADDQRRNDT RUNDTE 60 * If query not used since the last run of this program (CL cmd RTVQMQRY * 'uses' the query & changes the date, unfortunately), don't bother with * updates B003 C LSTUSE IFEQ RUNDTE C MOVE *ON BYPASS E003 C ENDIF E002 C ENDIF * B002 C BYPASS IFEQ *OFF * Remove any members in QTEMP/QQRYSRC C CALL 'QCMDEXC' 90 C PARM CMD1 CMDSTR256 C PARM 34 CMDLEN 155 * Retrieve the QM query source C ODLBNM CAT '/':0 LIBQRY P C CAT ODOBNM:0 LIBQRY C CALL 'QCMDEXC' 90 C PARM CMD2 CMDSTR256 C PARM 80 CMDLEN 155 * Open the source file C OPEN QQRYSRC * If QM query source retrieved okay B003 C *IN90 IFEQ *OFF * Loop through the source records, looking for the file refs C 1 SETLLQQRYSRC C READ QQRYSRC 81 * C MOVE *OFF CHKNOW 1 B004 C *IN81 DOWEQ*OFF * Look for the 'FROM' statement indicating the file refs. The source * generated will be in the following format, but from the start of the * source line. E.g. * ...+... 1 ...+... 2 ...+... 3 ...+... 4 *SELECT * ALL T01.METREF, T01.MEFUSR, T01.METUSR, T01.MEACKF, T01.METITL, * T02.MTLINE, T02.MTTEXT * FROM MMS/EMSPFME0 T01, * MMS/EMSPFMT0 T02 * WHERE T01.METREF = T02.MTTREF * ORDER BY T01.METREF ASC, T02.MTLINE ASC, T02.MTTEXT ASC * B005 C FROM IFEQ 'FROM' C MOVE *ON CHKNOW E005 C ENDIF * If file defs line reached B005 C CHKNOW IFEQ *ON * If first or subsequent file def line B006 C FROM IFEQ 'FROM' C FROM OREQ ' ' * ...extract the library from the start of the definition C '/' SCAN LIBFIL #P 30 70 B007 C *IN70 IFEQ *ON C #P SUB 1 LEN 30 C LEN SUBSTLIBFIL:1 QRFLLB P * ...and the file from the end C ' ' SCAN LIBFIL #E 30 70 B008 C *IN70 IFEQ *ON C ADD 1 #P C #E SUB #P LEN C LEN SUBSTLIBFIL:#P QRFLNM P * Format the fields & write X-ref record for this file C MOVE ODOBNM QRQRNM P C MOVE ODLBNM QRQRLB P C Z-ADD*DATE QRRNDT * Query last used C MOVELODUDAT DATESP C MOVE DATEDD DATE78 C MOVE DATEMM DATEDD C MOVE DATE78 DATEMM C MOVE DATESP QRLUDT * Query changed C MOVELODLDAT DATESP C MOVE DATEDD DATE78 C MOVE DATEMM DATEDD C MOVE DATE78 DATEMM C MOVE DATESP QRCHDT * Query created C MOVELODCDAT DATESP C MOVE DATEDD DATE78 C MOVE DATEMM DATEDD C MOVE DATE78 DATEMM C MOVE DATESP QRCRDT C Z-ADDODUCNT QRDYUS C MOVE ODCRTU QRCRTU * Delete the current record if there is one C QRYKY1 DELETQRYXREF 82 C WRITEQRYXREF E008 C ENDIF E007 C ENDIF X006 C ELSE C LEAVE E006 C ENDIF E005 C ENDIF * C READ QQRYSRC 81 E004 C ENDDO E003 C ENDIF C CLOSEQQRYSRC E002 C ENDIF * C READ QRYLIST 80 E001 C ENDDO * C SETON LR C RETRN ***************************************************************** </verbatim> -- Main.MartinRowe - 07 Dec 2010
E
dit
|
A
ttach
|
P
rint version
|
H
istory
: r2
<
r1
|
B
acklinks
|
V
iew topic
|
Edit
w
iki text
|
M
ore topic actions
Topic revision: r2 - 01 Oct 2014 - 19:37:01 -
UnknownUser
DBG400
Log In
DBG400 Web
Index
Search
Changes
Notifications
Statistics
Site Map
Downloads
Webs
DBG400
Jamaro
Main
Sandbox
Sandtub
System
Send a link to this page
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400?
Send feedback