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