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



Thanks Bob,

Here it is


Thanks,

Mark


Mark Walter
Sr. Programmer/Analyst
Hanover Wire Cloth a div of CCX, Inc.
mwalter@hanoverwire.com
http://www.hanoverwire.com
717.637.3795 Ext.3040



     DgetAuditFiles    PR              *
     D count                         10i 0

     DgetAuditFields   PR              *
     D tabName                       10    CONST
     D count                         10i 0

     DgetFieldDesc     PR           110
     D libName                       10    CONST
     D tabName                       10    CONST
     D fldName                       10    CONST


     DgetFileDesc      PR            50
     D                               10    CONST
     D                               10    CONST

     DgetFieldDesc     PR           110
     D libName                       10    CONST
     D tabName                       10    CONST
     D fldName                       10    CONST

*** Subprocedure 1 ***

     PgetAuditFiles    B                   Export
     DgetAuditFiles    PI              *
     D count                         10i 0

     Dds_File          DS            60    occurs(50)
     D c_file                        10    overlay(ds_file:*next)
     D fileDesc                      50    overlay(ds_File:*next)

     Dp_dsFile         S               *   INZ(%addr(ds_file))
     Dstatement        s            100
     Dx                s                   like(count)


     C                   CLEAR                   ds_File
     C                   CLEAR                   x

     C                   EVAL      statement =
     C                              'SELECT DISTINCT c_file FROM empbenaud'

     C/exec sql
     C+ PREPARE stmnt FROM :statement
     C/end-exec

     C                   EVAL      count = sqler3

?    C                   IF        count = 0
     C                   RETURN    *null
?    C                   ENDIF
?
?    C/exec sql
     C+ DECLARE cursr CURSOR FOR stmnt
     C/end-exec

     C/exec sql
     C+ OPEN cursr
     C/end-exec

?    C                   DOU       sqlstt = '02000' or sqlcod < 0
     C                   EVAL      x = x + 1
     C     x             OCCUR     ds_file

     C/exec sql
     C+ FETCH FROM cursr INTO :c_file
     C/end-exec

     C                   EVAL      fileDesc = getFileDesc('EBLIB':c_file)

?    C                   ENDDO

c    c                   eval      count = x -1
?
?    C/exec sql
?    C+ CLOSE cursr
?    C/end-exec
?
     C                   RETURN    p_dsFile
     P                 E


*** Subprocedure 2 ***
     PgetAuditFields   B                   Export
     DgetAuditFields   PI              *
     D tabname                       10    CONST
     D count                         10i 0

     Dds_Field         DS           120    occurs(500)
     D c_field                       10    overlay(ds_field:1)
     D fldDesc                      110    overlay(ds_field:11)
     D c_label                       60    overlay(ds_field:11)
     D c_labelText                   50    overlay(ds_Field:71)
     Dp_dsField        S               *   INZ(%addr(ds_field))

     Dstatement        s            300
     Dx                s                   like(count)
     DQT               C                   CONST('''')


     C                   CLEAR                   ds_Field
     C                   CLEAR                   x

     C                   EVAL      statement =
     C                              'SELECT DISTINCT c_field FROM empbenaud
+
     c                               WHERE c_file = ' + QT + %trim(tabname)
+
     c                              QT + ' AND c_action = ''C'''

     C/exec sql
     C+ PREPARE st FROM :statement
     C/end-exec

     C                   EVAL      count = sqler3

?    C                   IF        count = 0
     C                   RETURN    *null
?    C                   ENDIF
?
?    C/exec sql
     C+ DECLARE cur CURSOR FOR st
     C/end-exec

     C/exec sql
     C+ OPEN cur
     C/end-exec

?    C                   DOU       sqlstt = '02000' or sqlcod < 0
     C                   EVAL      x = x + 1
     C     x             OCCUR     ds_field

     C/exec sql
     C+ FETCH FROM cur INTO :c_field
     C/end-exec

     C                   EVAL      fldDesc =
     c                              getFieldDesc('EBLIB':tabName:c_field)

?    C                   ENDDO

c    c                   eval      count = x -1
?
?    C/exec sql
?    C+ CLOSE cur
?    C/end-exec
?
     C                   RETURN    p_dsField
     P                 E

*** Mainline Code ***

     DdsFile           DS            60    occurs(50) based(p_dsFile)
     D c_file                        10    overlay(dsFile:*next)
     D fileDesc                      50    overlay(dsFile:*next)
     Dp_dsFile         S               *   INZ

     DfileFields       DS           120    occurs(1000) based(p_fileFields)
     D c_field                       10    overlay(fileFields:*next)
     D c_fldLabel                    60    overlay(fileFields:*next)
     D c_fldText                     50    overlay(fileFields:*next)
     Dp_fileFields     S               *   INZ
     c                   eval      fileCnt = 0
     c                   eval      p_dsFile = getAuditFiles(fileCnt)
      * build the subfile
     C                   for       x = 1 to fileCnt
     c     x             occur     dsFile
.....


      * reset the pointer and counter variables
     c                   eval      fldCnt = 0
      * get the pointer to the data structure for the fields
     c                   eval      p_fileFields =
     c                              getAuditFields(h_file:fldCnt)
      * do not proceed if procedure returns null
     c                   if        p_fileFields <> *null
      * count through each element
     c                   for       y = 1 to fldCnt

     c     y             occur     fileFields




As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:

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.