I have a program that we use to create export files that are ftp*d to our
data warehouse application. The program works great functionally but we
would like to improve the performance on files that have a lot of fields
and a lot of records (500,000+).
The program specs were:
1) Must be *generic* enough to process, without modification, any file on
our iSeries.
2) First row of file must contain:
a) File Name
b) Number of fields in file
c) Number of Records in the file
d) Last G/L posting date
3) Second row of the file must contain the field names
4) Subsequent rows will be the data
A sample of the first three rows would look like:
"XAT90090",5,1297,05/22/2005
"EFFDATE","APPLCD","ACCTNO","ACCTTYP","TRANAMT"
05/19/2005,20,1234567890,1,-190.78
4) All dates must be in MM/DD/CCYY format. For this I created a file
(XAP10005L1) that contains the fields that contain dates and the format
that they are in: a) File Name b) Date Field Name c)Stored Date
Format (*LongJul, *MDY, *JUL, *YMD, etc..) When processing a field I
check this file to see if it is a date field and reformat it if it is.
5) Only the fields that the user selects should appear in the export
file. The way I solved this issue is if the user does not want all the
fields in the data file, I created another PF DDS containing only the
desired fields. I pull the data from one file based on the fields this
*template* file.
I*ve borrowed a lot of code from this mail list and other web sites and
pieced together the following program.
Any suggestions on how it may be changed to improve the performance would
be greatly appreciated.
Thanks, Rich*
H DftActGrp(*NO) BndDir('QC2LE':'OSBBNDDIR')
H OPTION(*NODEBUGIO: *NOSHOWCPY: *SRCSTMT)
*
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
^1* Generic File to process desired data
FInFile IF F32766 Disk ExtFile(InputFile) UsrOpn
F InFDS(FileInFDS)
^1* Field Date Format File
FXAP10005L1IF E K Disk
^1* FTP Output File
FFTPOutput O A F32766 Disk ExtFile(OutputFile) UsrOpn
e* Prototype
D Entry PR ExtProc('XA90060')
D FileName 10A
D LibName 10A
D DDSName 10A
D DDSLib 10A
D Colum_Sep 1A
D Alpha_Sep 1A
D CBSName 10A
e* Prototype
D Entry PI
D FileName 10A
D LibName 10A
D DDSName 10A
D DDSLib 10A
D Colum_Sep 1A
D Alpha_Sep 1A
D CBSName 10A
^1* Define the INTERNAL prototypes (Subroutines) used in this program
D CloseSQLCursor PR
D DeclareCursor PR
D GetData PR
D GetFieldCount PR
D GetFieldDef PR
D IncludeInFile PR N
D inFieldName Like(FldName) CONST
D SetSQLOptions PR
D ValidSQLRecord PR N
D WriteHeaderRec PR
D WrtFieldNames PR
^1* Define the EXTERNAL prototypes used in this program
/COPY *LIBL/QOSBCPYSRC,SC9000PR
/COPY *LIBL/QOSBCPYSRC,TA9000PR
/COPY *LIBL/QOSBCPYSRC,XA1001PR
/COPY *LIBL/QOSBCPYSRC,XA10006PR
e* Procedure to get extract a NUMBER from a STRING
D FmtNumber PR 50A Varying
D NbrValue 50A Varying CONST
D DecPos 3 0 CONST
e* Procedure to change the file date to 'MM/DD/CCYY' format
D FormatDate PR 10A Varying
D inFormat Like(XAPDateF) CONST
^1* Input File Data Structure
DFileInFDS DS
D RecordCount 156 159B 0
^1* Data Structure to hold Date Fields
^1* Work Fields
D CurrentUserId S 10A Inz(*User)
D DataPtr S *
D FieldCount S 9 0
D FieldDSLen S 9 0 Inz(%Len(FieldDS))
D FieldDSPtr S * Inz(*Null)
D FldIdxPtr S *
D FTPField S 32766A Inz Varying
D i S 9 0 Inz(0)
D InputFile S 21A Inz
D LastPostDate S 7P 0 Inz
D Offset S 9 0 Inz(0)
D OutputFile S 21A Inz('QTEMP/DB2EXPORT')
D SQLCommand S 256A Varying Inz
D AlphaFld S 256A Varying Inz
D NumberFld S 31 15 Inz
D File S Like(FileName) Inz
D Lib S Like(LibName) Inz
^1* This DS will contain the data being read into the program
D DataRecord DS 32766
^1* This DS is used to contain the Field Information for the record
D FieldDS DS Based(FldIdxPtr)
D FldNumber 10 0
D FldName 10
D TblName 10
D Schema 10
D FldType 10
D FldLen 10I 0
D FldDecPos 3
D FldBytes 10I 0
D FldOffset 10I 0
D FldDateFmt Like(XAPDateF)
D FldExportFlg 1A
C
/Free
//^1*-----------------------------------------------------------------
//^1*aM A I N L I N E R O U T I N
E
//^1*-----------------------------------------------------------------
//^1Get the Last Posting Date
LastPostDate = GetLastPostDte( RtvBankDefault(CurrentUserId) );
//^1Combine the Library and file to look like 'LIBNAME/FILENAME'
LibName = toUpper(LibName);
FileName = toUpper(FileName);
InputFile = %Trim(LibName) + '/' + %Trim(FileName);
//^1Make sure the file names are in UPPER case
DDSName = toUpper(DDSName);
CBSName = toUpper(CBSName);
//^1Open the files to process
Open InFile;
Open FTPOutput;
//^1Count the # of fields in the file containing the fields to
export
File = DDSName;
Lib = DDSLib;
GetFieldCount();
//^1Write File Header Record
WriteHeaderRec();
//^1Count the # of fields in the file containing the data to
process
File = FileName;
Lib = LibName;
GetFieldCount();
//^1Retrieve Field Definitions
GetFieldDef();
//^1Write a record containing the Field Names
WrtFieldNames();
//^1Read the input file into the DS for processing
DoU %EOF(InFile);
Read InFile DataRecord;
If %EOF(InFile);
Leave;
EndIf;
//^1Strip out each field from the Data Structure
GetData();
EndDo;
//^1Close the files
Close InFile;
Close FTPOutput;
*InLR = *On;
/End-Free
^1*-----------------------------------------------------------------
^1*a O U T P U T S P E C S
^1*-----------------------------------------------------------------
OFTPOutput EADD WriteRec
O FTPField
*=====================================================================
*aGetFieldDef: Get the definitions of the fields in this file
*=====================================================================
P GetFieldDef B
/Free
//^1Alloc Storage to hold FieldDS for Each Column in the Table
FieldDSPtr = %Alloc(FieldDSLen * FieldCount);
//^1Set the pointer to the first "Occurance" of FieldDS in
//^1 the allocated Storage
FldIdxPtr = FieldDSPtr;
//^1Clearing the Data structure will init the fields in the
FieldDS
//^1data structure and avoid data decimal errors
Clear FieldDS;
//^1Build a cursor containing the list of columns (fields) in the
//^1file that is being exported.
DeclareCursor();
//^1Read all the records from the SQL Cursor
//^1and place the data into FieldDS
DoW ValidSQLRecord();
//^1Determine if this field is a date field
Chain (FileName : FldName) XAP10005L1;
If %Found( XAP10005L1 );
FldDateFmt = XAPDateF;
EndIf;
//^1Determine the offset to the beginning of the field
FldOffset = Offset;
//^1Determine the field should be included in the export file
//^1(All fields may not be exported to the Data Warehouse)
FldExportFlg = 'Y';
If Not IncludeInFile(FldName);
FldExportFlg = 'N';
EndIf;
//^1If this is not the last column in the table, calculate
//^1 the next offset and advance the pointer to the next
//^1 "occurrence" of FieldDs in the allocated storage.
If FldNumber <> FieldCount;
Offset = Offset + FldBytes;
FldIdxPtr = FieldDSPtr + (FieldDSLen * FldNumber);
Clear FieldDS;
EndIf;
EndDo;
CloseSQLCursor();
/End-Free
P GetFieldDef E
*=====================================================================
*aGetData: Get the data from the input record
*=====================================================================
P GetData B
D AlphaFld S 256A Varying Inz
D DataType S 1A Inz
/Free
//^1Set the pointer to the Field Description Data Structure
FldIdxPtr = FieldDSPtr;
//^1Set the Data Pointer to the beginning of the data record
DataPtr = %Addr(DataRecord);
//^1Clear the FTP Output field
Clear FTPField;
//^1Read each field and move it from the input record to output
For i = 1 to FieldCount;
Select;
//^1Skip this field because it is not in the export file
When FldExportFlg = 'N';
//^1This is a DATE field so reformat it to MM/DD/CCYY
When Not (FldDateFmt = *Blanks);
FTPField += FormatDate(FldDateFmt);
//^1This is a CHARACTER field move it to the FTP output field
When FldType = 'CHAR';
AlphaFld = %Trim(%SubSt(DataRecord : FldOffset+1 :
FldBytes));
//^1If there is something in the alpha field
If %Len(%Trim(AlphaFld)) > 0;
//^1Remove any quotes (") or commas (,) from the field
AlphaFld = %Trim(%XLate('"' : '''' : AlphaFld));
FTPField += Alpha_Sep + AlphaFld + Alpha_Sep;
EndIf;
//^1Extract the ZONED or PACKED data from the input buffer
When FldType = 'NUMERIC' or FldType = 'DECIMAL';
If FldType = 'NUMERIC';
DataType = 'S';
Else;
DataType = 'P';
EndIf;
AlphaFld = CvtNumFmt(%SubSt(DataRecord :
FldOffset+1 :
FldBytes) :
DataType :
%Uns(FldLen) :
%Uns(FldDecPos) :
'S' );
FTPField += FmtNumber(%SubSt(AlphaFld :
1 :
FldLen) :
%Int(FldDecPos) );
//^1Define other field types here
Other;
EndSL;
//^1If this is not the last field and the prior field was
//^1exported to the FTP file, add the Column Separator
If i < FieldCount and FldExportFlg = 'Y';
FTPField += Colum_Sep;
EndIf;
//^1Position to the next Field Definition in the DS
FldIdxPtr += FieldDSLen;
EndFor;
//^1Write the FTP Record to the output file
Except WriteRec;
/End-Free
P GetData E
*================================================================
*aSetSQLOptions: Insure the SQL options are set correctly
*================================================================
P SetSQLOptions B
C/EXEC SQL
+ Set Option
+ Commit = *NONE,
+ CloSqlCsr = *ENDMOD
C/END-EXEC
P SetSQLOptions E
*=====================================================================
*aDeclareCursor: Declare the SQL cursor used to retrieve field defs
*=====================================================================
P DeclareCursor B
^1* Build the list of columns in the Table
C/Exec SQL
+ Declare FileLayout Cursor for
+ SELECT ORDINAL_POSITION,
+ Char(COLUMN_NAME,10),
+ Char(TABLE_NAME,10),
+ Char(TABLE_SCHEMA,10),
+ Char(DATA_TYPE,10),
+ LENGTH,
+ Char(IfNull(Char(NUMERIC_SCALE),' '),3),
+ STORAGE,0,' ',' '
+ FROM SYSCOLUMNS
+ WHERE Table_Schema = :LibName
+ AND Table_Name = :FileName
+ ORDER BY ORDINAL_POSITION
C/End-Exec
^1* Open the Cursor
C/Exec SQL
+ Open FileLayout
C/End-Exec
P DeclareCursor E
*================================================================
*aValidSQLRecord: Fetch the next record from the SQL cursor
*================================================================
P ValidSQLRecord B Export
^1* Procedure Interface
D ValidSQLRecord PI 1N
C/EXEC SQL
+ Fetch from FileLayout into :FieldDS
C/END-Exec
C Return (%SubSt(SQLStt:1:2)='00' or
C %SubSt(SQLStt:1:2)='01')
P ValidSQLRecord E
*================================================================
*aCloseSQLCursor: Close the SQL Cursor
*================================================================
P CloseSQLCursor B
C/Exec SQL
+ Close FileLayout
C/End-Exec
P CloseSQLCursor E
*======================================================================
*aIncludeInFile: Check to see if the field should be included in
export
*======================================================================
P IncludeInFile B Export
^1* Procedure Interface
D IncludeInFile PI 1N
D inFieldName Like(FldName) CONST
D f S 3P 0 Inz
C Clear f
C/EXEC SQL
+ SELECT Count(*) INTO :f
+ FROM SYSCOLUMNS
+ WHERE Table_Schema = :DDSLib
+ AND Table_Name = :DDSName
+ AND COLUMN_NAME = :inFieldName
C/END-Exec
C Return (f > 0)
P IncludeInFile E
*================================================================
*aGetFieldCount: Get the # of fields in the file being processed
*================================================================
P GetFieldCount B
C/Exec SQL
+ SELECT Count(*) INTO :FieldCount
+ FROM SYSCOLUMNS
+ WHERE Table_Schema = :Lib
+ and Table_Name = :File
C/End-Exec
P GetFieldCount E
*=====================================================================
*aWriteHeaderRec: Write the FTP File Header Record
*=====================================================================
P WriteHeaderRec B
/Free
FTPField = Alpha_Sep + %Trim(CBSName) + Alpha_Sep + Colum_Sep +
%Trim(%EditC(FieldCount : '3')) + Colum_Sep +
%Trim(%EditC(RecordCount : '3')) + Colum_Sep +
%Char(%Date() - %Days(1) : *USA);
Except WriteRec;
/End-Free
P WriteHeaderRec E
*=====================================================================
*aWrtFieldNames: Write the field names to the output record
*=====================================================================
P WrtFieldNames B
/Free
//^1Set the first Field Description Data Structure
FldIdxPtr = FieldDSPtr;
//^1Clear the output field
Clear FTPField;
//^1Add each field name to the end of the output field
For i = 1 to FieldCount;
If FldExportFlg = 'Y';
FTPField += Alpha_Sep + %Trim(FldName) + Alpha_Sep +
Colum_Sep;
EndIf;
//^1Position to the next Field Definition in the DS
FldIdxPtr += FieldDSLen;
EndFor;
//^1Remove the Column Separator from the end of the record
FTPField = %SubSt(FTPField : 1 : %Len(FTPField) - 1);
Except WriteRec;
/End-Free
P WrtFieldNames E
*=====================================================================
*aFmtNumber: Format a Number that is in a string
*=====================================================================
P FmtNumber B
e* Prototype
D FmtNumber PI 50A Varying
D inNbrValue 50A Varying CONST
D inDecPos 3 0 CONST
*^1Define Local Work Fields
D DecPos S Like(inDecPos)
D IntIsNegative S N Inz(*Off)
D NbrValue S Like(inNbrValue) Inz
D Number S 50A Varying Inz
D ValidChars C '1234567890- '
D n S 31 15 Inz
D x S 5P 0 Inz
/FREE
NbrValue = inNbrValue;
DecPos = inDecPos;
//^1The negative sign is stored as an alpha character
IntIsNegative = %Check('0123456789':%TrimR(NbrValue)) > 0;
//^1Convert the negative character to its corresponding numeric
value
NbrValue = %XLate('}JKLMNOPQR' : '0123456789' : NbrValue);
//^1The number has decimal positions
If DecPos > 0;
n = %Int(NbrValue);
For x = 1 to DecPos;
n /= 10;
EndFor;
Number = %SubSt(%Trim(%EditC(n : 'L')) : 1 :
(%CheckR(ValidChars : %Trim(%EditC(n :
'L')))+DecPos));
Else;
//^1The number does not have any decimal positions
Number = %Trim(%EditC(%Dec(NbrValue:31:0):'L'));
EndIf;
If IntIsNegative;
Number = '-' + %Trim(Number);
EndIf;
If %Len(Number) < 1;
Number += '0';
EndIf;
Return Number;
/END-FREE
P FmtNumber E
*=====================================================================
*aFormatDate: Format the date field into MM/DD/CCYY format
*=====================================================================
P FormatDate B
e* Prototype
D FormatDate PI 10A Varying
D FromFormat Like(XAPDateF) CONST
*^1Define Local Work Fields
D NumericDate S 8S 0 Inz
/FREE
//^1Extract the Date from the input buffer
If FldType = 'NUMERIC';
NumericDate = ZonedToInt(DataPtr+FldOffset:FldLen:0);
ElseIf FldType = 'DECIMAL';
NumericDate = PackedToInt(DataPtr+FldOffset:FldLen:0);
EndIf;
//^1Convert the NumericDate to an alpha MM/DD/CCYY field
Monitor;
Select;
When NumericDate = *Zeros;
RETURN '';
When FromFormat = '*MDY';
RETURN %Char(%Date(NumericDate : *MDY):*USA);
When FromFormat = '*DMY';
RETURN %Char(%Date(NumericDate : *DMY):*USA);
When FromFormat = '*YMD';
RETURN %Char(%Date(NumericDate : *YMD):*USA);
When FromFormat = '*JUL';
RETURN %Char(%Date(NumericDate : *JUL):*USA);
When FromFormat = '*LONGJUL';
RETURN %Char(%Date(NumericDate : *LONGJUL):*USA);
When FromFormat = '*USA';
RETURN %Char(%Date(NumericDate : *USA):*USA);
Other;
RETURN '';
EndSL;
On-Error;
RETURN '';
EndMon;
/END-FREE
P FormatDate E
----------------------------------------------------------------------
Find just what you're after with the new, more precise MSN Search - try it
now!
midrange.com
