RpgQRYXREF0 < DBG400

<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
This topic: DBG400 > SourceCodeList > RpgSource > RpgQRYXREF0
Topic revision: r2 - 01 Oct 2014 - 19:37:01 - UnknownUser
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