Let's return to the Retrieve Database File Description (QDBRTVFD) and Copy Numeric Value (CPYNV) APIs.
In developing a general-purpose utility to detect decimal data errors, we have made use of a few APIs. In the article "In Search of Decimal Data Errors," we saw how the List Fields (QUSLFLD) API can be used to find all numeric fields, within a user-specified file record format, that are defined as either zoned decimal or packed decimal. In addition to discovering the data type of each field, we were also able to determine the name of the field, the number of decimal positions, the number of digits to the right of the decimal point, the number of bytes used to store the field value, and the starting location of the field within the record format.
In the article "Detecting Decimal Data Errors," we saw how the Copy Numeric Value (CPYNV) API can be used, in conjunction with the information obtained with the QUSLFLD API, to determine which field(s) in a record would cause a MCH1202 decimal data error due to the encoding of the data found in a given zoned or packed numeric field.
In the article "Diagnosing Decimal Data Errors," we saw how the Convert Hex to Character (cvthc) API can be used to convert the hex value of a field to a character string suitable for printing or displaying.
This month, we will return to further look at how two of these APIs can be utilized. The Retrieve Database File Description (QDBRTVFD) API was previously used in the GetFDefn procedure to 1) verify that the file being checked for decimal data errors was a physical file, and 2) determine the record format name associated with the physical file. This month, we will also be using this API to determine those fields of a physical file that are defined as part of the record key. In the case of the Copy Numeric Value (CPYNV) API, this was previously used to detect decimal data errors. We'll also be using this API to format record key numeric data, which is stored in packed decimal or binary format, to the displayable format of zoned decimal. We'll then print this record key field information, along with our current printing of the relative record number of the record, when a decimal data error is detected. This additional information should aid a user when later accessing and correcting numeric field(s) in error.
Changes to the Find Decimal Data Errors Printer File
In order to print key field value information we'll be adding two record formats to the FNDDDEPRTF printer file we created last month. The two new formats, Key_Vals and MoreKeyVs, are shown below.
***************************************************************
A R KEY_VALS SPACEB(2)
A 1'***********************'
A 1'KEY FIELD(S):'
A SPACEB(1)
A KEY_NAME 11A 15
A KEY_DATA 100A 30
***************************************************************
A R MOREKEYVS SPACEB(1)
A KEY_NAME 11A 15
A KEY_DATA 100A 30
Record format Key_Vals is used to print the initial key field name and value for a record found to contain decimal data errors. If the file is defined with more than one key field, record format MoreKeyVs is used to print the additional key field names and values.
After adding these two record formats to the FNDDDEPRTF DDS source, and assuming that you stored the source in member FNDDDEPRTF of QDDSSRC, you can re-create the printer file using this command:
CRTPRTF FILE(FNDDDEPRTF) SRCFILE(QDDSSRC)
Changes to the Find Decimal Data Errors Program
Here is the latest version of the FNDDDE program with changes from last month shown in bold.
h DftActGrp(*No) BndDir('QC2LE')
fFileX if f32766 disk extfile(FileXVar) usropn
f infds(FileXDS)
fFndDDEPrtFo e printer infds(PrtFDS)
*********************************************************************
dFndDDE pr extpgm('FNDDDE')
d File_In 10a const
d Lib_In 10a const
dFndDDE pi
d File_In 10a const
d Lib_In 10a const
*********************************************************************
d CpyN pr extproc('_LBCPYNV')
d Rcv like(Target)
d RcvAttr 7a const
d Src const like(Source)
d SrcAttr 7a const
d CvtFrmNibbles pr extproc('cvthc')
d Rcv 100a
d Src 50a const
d Length 10i 0 value
d CrtUsrSpc pr extpgm('QUSCRTUS')
d QualName 20a const
d XtndSpcAttr 10a const
d IntSize 10i 0 const
d IntValue 1a const
d PubAut 10a const
d Text 50a const
d Replace 10a const options(*nopass)
d ErrCde likeds(QUSEC)
d options(*nopass)
d Domain 10a const options(*nopass)
d TfrSiz 10i 0 const options(*nopass)
d OptSpcAlgn 1a const options(*nopass)
d GetFDefn pr
d LogRecIDVals pr
d LogNbrError pr
d LstFld pr extpgm('QUSLFLD')
d QualUsrSpc 20a const
d Format 8a const
d QualFileName 20a const
d RcdFmt 10a const
d OvrPrc 1a const
d ErrCde likeds(QUSEC)
d options(*nopass)
d MapKeyVal pr
d KeyFld 10i 0 value
d RmvPM pr extpgm('QMHRMVPM')
d CSE 10a const
d CSECtr 10i 0 const
d MsgKey 4a const
d MsgToRmv 10a const
d ErrCde likeds(QUSEC)
d LenCSE 10i 0 const options(*nopass)
d CSEQual 20a const options(*nopass)
d RmvUnhExcp 10a const options(*nopass)
d CSEType 10a const options(*nopass)
d AlwDftRpyRej 10a const options(*nopass)
d RtvFD pr extpgm('QDBRTVFD')
d RcvVar 1a options(*varsize)
d LenRcvVar 10i 0 const
d QualNameRtn 20a
d Format 8a const
d QualFileName 20a const
d RcdFmt 10a const
d OvrPrc 1a const
d System 10a const
d FmtType 10a const
d ErrCde likeds(QUSEC)
d RtvUsrSpcPtr pr extpgm('QUSPTRUS')
d QualUsrSpc 20a const
d UsrSpcPtr *
d ErrCde likeds(QUSEC)
d SndEscMsg pr
d MsgID_In 7a const
d MsgDta_In 256a const
d SndPgmMsg pr extpgm('QMHSNDPM')
d MsgID 7a const
d MsgFile 20a const
d MsgDta 256a const options(*varsize)
d LenMsgDta 10i 0 const
d MsgType 10a const
d CSE 10a const options(*varsize )
d CSECtr 10i 0 const
d MsgKey 4a
d ErrCde likeds(QUSEC)
d options(*varsize)
d LenCSE 10i 0 const options(*nopass)
d QualCSE 20a const options(*nopass)
d WaitTime 10i 0 const options(*nopass)
d CSEDtaType 10a const options(*nopass)
d CCSID 10i 0 const options(*nopass)
d SndSysMsg pr
*********************************************************************
d CpyNFailure c const(00202)
d MaxNbrKeyFlds c const(100)
d MaxNbrNumFlds c const(1000)
d Integer c const(x'00')
d Packed c const(x'03')
d SpcSize c const(1048576)
d Zoned c const(x'02')
*********************************************************************
* Structures related to API QDBRTVFD
d myQDBQ25_Ptr s *
d myQDBQ25 ds likeds(QDBQ25)
d based(myQDBQ25_Ptr)
d myQDBQ36_Ptr s *
d myQDBQ36 ds likeds(QDBQ36)
d based(myQDBQ36_Ptr)
d myQDBQ39_Ptr s *
d myQDBQ39 ds likeds(QDBQ39)
d based(myQDBQ39_Ptr)
* Structures related to API QUSLFLD
d LstFldHdr_Ptr s *
d LstFldHdr ds likeds(QUSH0100)
d based(LstFldHdr_Ptr)
d LstFld100_Ptr s *
d LstFld100 ds likeds(QUSL0100)
d based(LstFld100_Ptr)
d CurNbrNumFlds s 5u 0
d NumFlds ds qualified
d NumFldsArray 21a dim(MaxNbrNumFlds)
d FldName 10a overlay(NumFldsArray :1)
d Bytes 5u 0 overlay(NumFldsArray :11)
d SrcAttr 7a overlay(NumFldsArray :13)
d Type 1a overlay(SrcAttr :1)
d Scale 3u 0 overlay(SrcAttr :2)
d Digits 3u 0 overlay(SrcAttr :3)
d 10i 0 overlay(SrcAttr :4)
d inz(0)
d BfrStrPos 5u 0 overlay(NumFldsArray :20)
d CurNbrKeyFlds s 5u 0
d KeyFlds ds qualified
d KeyFldsArray 22a dim(MaxNbrKeyFlds)
d FldName 10a overlay(KeyFldsArray :1)
d Bytes 5u 0 overlay(KeyFldsArray :11)
d VarLen 1a overlay(KeyFldsArray :13)
d SrcAttr 7a overlay(KeyFldsArray :14)
d Type 1a overlay(SrcAttr :1)
d Scale 3u 0 overlay(SrcAttr :2)
d Digits 3u 0 overlay(SrcAttr :3)
d 10i 0 overlay(SrcAttr :4)
d inz(0)
d BfrStrPos 5u 0 overlay(KeyFldsArray :21)
d Key_Ptr s *
d Key ds qualified
d based(Key_Ptr)
d KeyValue 100a
d KeyVarLen 5i 0 overlay(KeyValue :1)
d KeyDateVal d overlay(KeyValue :1)
d KeyTimeVal t overlay(KeyValue :1)
d KeyTimeStampVal...
d z overlay(KeyValue :1)
d IntSrcAttr ds qualified
d Type 1a inz(x'00')
d Scale 3u 0 inz(0)
d Length 3u 0
d 10i 0 inz(0)
d ZonedView ds
d ZonedType 1a inz(x'02')
d ZonedScale 3u 0
d ZonedDigits 3u 0
d 10i 0 inz(0)
d FileXDS ds
d RelNo 397 400i 0
d PrtFDS ds
d OFLine 188 189i 0
d CurLine 367 368i 0
d PSDS sds
d ExcpID 40 46a
d CurUsr 358 367a
d ErrCde ds qualified
d Hdr likeds(QUSEC)
d MsgDta 256a
*********************************************************************
d BlnkNbr s 20i 0
d FileXVar s 21a
d GoodNbr s 20i 0
d RecIDLogged s n
d MsgDta s 256a
d MsgKey s 4a
d NonBlnkNbr s 20i 0
d NotMCH1202 s n
d QualNameRtn s 20a
d RcdFmt s 10a
d Source s 100a based(Source_Ptr)
d Source_Ptr s *
d Target s 100a
d X s 10i 0
d Y s 10i 0
*********************************************************************
/copy qsysinc/qrpglesrc,qdbrtvfd
/copy qsysinc/qrpglesrc,qusec
/copy qsysinc/qrpglesrc,qusgen
/copy qsysinc/qrpglesrc,quslfld
*********************************************************************
iFileX ns
i 132766 InpBfr
*********************************************************************
/free
write Heading;
read FileX;
dow (not %eof(FileX));
for X = 1 to CurNbrNumFlds;
Source_Ptr = %addr(InpBfr) + NumFlds.BfrStrPos(X) - 1;
monitor;
CpyN(Target :NumFlds.SrcAttr(X)
:Source :NumFlds.SrcAttr(X));
GoodNbr += 1;
on-error CpyNFailure;
if ExcpID = 'MCH1202';
LogNbrError();
else;
NotMCH1202 = *on;
endif;
on-error *all;
NotMCH1202 = *on;
endmon;
endfor;
read FileX;
RecIDLogged = *off;
enddo;
close FileX;
if (CurLine + 5) >= OFLine;
write Heading;
endif;
write NbrSum;
if NotMCH1202;
Fld_Data = 'Other numeric errors also found';
else;
// Remove all messages UNLESS a non-MCH1202
// was received
RmvPM('*' :0 :' ' :'*ALL' :ErrCde);
Fld_Data = 'Data analysis was completed successfully.';
endif;
if (CurLine + 4) >= OFLine;
write Heading;
endif;
write TheEnd;
close FndDDEPrtF;
*inlr = *on;
return;
// *****************************************************************
begsr *inzsr;
// Set API QUSEC parameter to send exceptions
QUSBPrv = 0;
// Set API ErrCde parameter to not send exceptions
ErrCde.Hdr.QUSBPrv = %size(ErrCde);
GetFDefn();
// Get list of File_In fields and field attributes
RtvUsrSpcPtr('QUSLFLD QTEMP' :LstFldHdr_Ptr :ErrCde);
if ErrCde.Hdr.QUSBAvl > 0;
if ErrCde.Hdr.QUSEI = 'CPF9801';
// Create user space if not found
CrtUsrSpc('QUSLFLD QTEMP' :' ' :SpcSize :x'00'
:'*ALL' :'UsrSpc for QUSLFLD output'
:'*YES' :QUSEC :'*USER' :0 :'1');
RtvUsrSpcPtr('QUSLFLD QTEMP' :LstFldHdr_Ptr :QUSEC);
else;
// Any other error is a hard failure
SndSysMsg();
endif;
endif;
LstFld('QUSLFLD QTEMP' :'FLDL0100'
:(File_In + Lib_In) :RcdFmt :'0' :QUSEC);
for X = 1 to LstFldHdr.QUSNbrLE;
if X = 1;
LstFld100_Ptr = LstFldHdr_Ptr + LstFldHdr.QUSOLD;
else;
LstFld100_Ptr += LstFldHdr.QUSSEE;
endif;
// Load up numeric fields into NumFldsArray
select;
when LstFld100.QUSDT = 'S';
CurNbrNumFlds += 1;
NumFlds.FldName(CurNbrNumFlds) = LstFld100.QUSFN02;
NumFlds.Bytes(CurNbrNumFlds) = LstFld100.QUSFLB;
NumFlds.Type(CurNbrNumFlds) = Zoned;
NumFlds.Scale(CurNbrNumFlds) = LstFld100.QUSDP;
NumFlds.Digits(CurNbrNumFlds) = LstFld100.QUSigits;
NumFlds.BfrStrPos(CurNbrNumFlds) = LstFld100.QUSIBP;
when LstFld100.QUSDT = 'P';
CurNbrNumFlds += 1;
NumFlds.FldName(CurNbrNumFlds) = LstFld100.QUSFN02;
NumFlds.Bytes(CurNbrNumFlds) = LstFld100.QUSFLB;
NumFlds.Type(CurNbrNumFlds) = Packed;
NumFlds.Scale(CurNbrNumFlds) = LstFld100.QUSDP;
NumFlds.Digits(CurNbrNumFlds) = LstFld100.QUSigits;
NumFlds.BfrStrPos(CurNbrNumFlds) = LstFld100.QUSIBP;
other;
// Don't care about other types
endsl;
if CurNbrKeyFlds > 0;
// Load key location information if keys defined
Y = %lookup(LstFld100.QUSFN02 :KeyFlds.FldName
:1 :CurNbrKeyFlds);
if Y > 0;
select;
when LstFld100.QUSDT = 'B';
KeyFlds.Type(Y) = Integer;
when LstFld100.QUSDT = 'P';
KeyFlds.Type(Y) = Packed;
when LstFld100.QUSDT = 'S';
KeyFlds.Type(Y) = Zoned;
other;
KeyFlds.Type(Y) = LstFld100.QUSDT;
endsl;
KeyFlds.Bytes(Y) = LstFld100.QUSFLB;
KeyFlds.VarLen(Y) = LstFld100.QUSVLFI;
KeyFlds.BfrStrPos(Y) = LstFld100.QUSIBP;
KeyFlds.Scale(Y) = LstFld100.QUSDP;
KeyFlds.Digits(Y) = LstFld100.QUSigits;
endif;
endif;
endfor;
FileXVar = %trimr(Lib_In) + '/' + %trimr(File_In);
open FileX;
endsr;
/end-free
*********************************************************************
p LogNbrError b
d LogNbrError pi
/free
if (not RecIDLogged);
LogRecIDVals();
endif;
FldName = NumFlds.FldName(X);
if %subst(Source :1 :NumFlds.Bytes(X)) = *blanks;
if (CurLine + 1) >= OFLine;
write Heading;
LogRecIDVals();
endif;
Fld_Data = 'BLANKS FOUND';
write Fld_Vals_C;
BlnkNbr += 1;
else;
if (CurLine + 2) >= OFLine;
write Heading;
LogRecIDVals();
endif;
Fld_Data = %subst(Source :1 :NumFlds.Bytes(X));
write Fld_Vals_C;
Fld_Data = *blanks;
if NumFlds.Bytes(X) < 50;
CvtFrmNibbles(Fld_Data :%subst(Source :1 :NumFlds.Bytes(X))
:(NumFlds.Bytes(X) * 2));
%subst(Fld_Data :((NumFlds.Bytes(X) * 2) + 1) :1) = '''';
else;
CvtFrmNibbles(Fld_Data :%subst(Source :1 :49) :98);
%subst(Fld_Data :99 :1) = '''';
endif;
write Fld_Vals_H;
NonBlnkNbr += 1;
endif;
/end-free
p LogNbrError e
*********************************************************************
p LogRecIDVals b
d LogRecIDVals pi
/free
if (CurLine + 5) >= OFLine;
write Heading;
endif;
if CurNbrKeyFlds > 0;
MapKeyVal(1);
write Key_Vals;
for Y = 2 to CurNbrKeyFlds;
MapKeyVal(Y);
write MoreKeyVs;
endfor;
endif;
RelNo_C = %char(RelNo);
write RRN_Val;
RecIDLogged = *on;
/end-free
p LogRecIDVals e
*********************************************************************
p MapKeyVal b
d MapKeyVal pi
d myY 10i 0 value
/free
Key_Name = %trimr(KeyFlds.FldName(myY)) + ':';
Key_Ptr = %addr(InpBfr) + KeyFlds.BfrStrPos(myY) - 1;
monitor;
select;
when KeyFlds.Type(myY) = Integer;
ZonedScale = KeyFlds.Scale(myY);
ZonedDigits = KeyFlds.Digits(myY);
IntSrcAttr.Length = KeyFlds.Bytes(myY);
Key_Data = *blanks;
CpyN(Key_Data :ZonedView
:Key.KeyValue :IntSrcAttr);
when ((KeyFlds.Type(myY) = Packed) or
(KeyFlds.Type(myY) = Zoned));
ZonedScale = KeyFlds.Scale(myY);
ZonedDigits = KeyFlds.Digits(myY);
Key_Data = *blanks;
CpyN(Key_Data :ZonedView
:Key.KeyValue :KeyFlds.SrcAttr(myY));
when ((KeyFlds.Type(myY) = 'A') and
(KeyFlds.VarLen(myY) = '0'));
// Fixed length alphanumeric
Key_Data =
%subst(Key.KeyValue :1 :KeyFlds.Bytes(myY));
when ((KeyFlds.Type(myY) = 'A') and
(KeyFlds.VarLen(myY) = '1'));
// Variable length alphanumeric
if Key.KeyVarLen > 0;
Key_Data =
%subst(Key.KeyValue :3 :Key.KeyVarLen);
else;
Key_Data = *blanks;
endif;
when KeyFlds.Type(myY) = 'L';
Key_Data = %char(Key.KeyDateVal :*USA);
when KeyFlds.Type(myY) = 'T';
Key_Data = %char(Key.KeyTimeVal :*HMS:);
when KeyFlds.Type(myY) = 'Z';
Key_Data = %char(Key.KeyTimeStampVal);
other;
Key_Data = '** Left for you ***';
endsl;
on-error *all;
Key_Data = 'Unable to access key value';
endmon;
/end-free
p MapKeyVal e
*********************************************************************
p SndSysMsg b
d SndSysMsg pi
/free
if ErrCde.Hdr.QUSBAvl <= 16;
SndEscMsg(ErrCde.Hdr.QUSEI :' ');
else;
SndEscMsg(ErrCde.Hdr.QUSEI
:%subst(ErrCde.MsgDta :1
:(ErrCde.Hdr.QUSBAvl - 16)));
endif;
/end-free
p SndSysMsg e
*********************************************************************
p SndEscMsg b
d SndEscMsg pi
d MsgID_In 7a const
d MsgDta_In 256a const
/free
SndPgmMsg(MsgID_In :'QCPFMSG *LIBL'
:MsgDta_In :%len(%trimr(MsgDta_In))
:'*ESCAPE' :'*PGMBDY' :1
:MsgKey :QUSEC);
/end-free
p SndEscMsg e
*********************************************************************
p GetFDefn b
d GetFDefn pi
/free
// Get File_In definition and record format name
RtvUsrSpcPtr('QDBRTVFD QTEMP' :myQDBQ25_Ptr :ErrCde);
if ErrCde.Hdr.QUSBAvl > 0;
if ErrCde.Hdr.QUSEI = 'CPF9801';
// Create user space if not found
CrtUsrSpc('QDBRTVFD QTEMP' :' ' :SpcSize :x'00'
:'*ALL' :'UsrSpc for QDBRTVFD output'
:'*YES' :QUSEC :'*USER' :0 :'1');
RtvUsrSpcPtr('QDBRTVFD QTEMP' :myQDBQ25_Ptr :QUSEC);
else;
// Any other error is a hard failure
SndSysMsg();
endif;
endif;
RtvFD(myQDBQ25 :SpcSize :QualNameRtn :'FILD0100'
:(File_In + Lib_In) :'*FIRST' :'0' :'*LCL'
:'*EXT' :ErrCde);
if ErrCde.Hdr.QUSBAvl > 0;
SndSysMsg();
endif;
if %bitand(%subst(myQDBQ25.QDBBits27 :1 :1) :x'20') = x'20';
MsgDta = %trimr(Lib_In) + '/' + %trimr(File_In) +
' is not a table/physical file. Command ended';
SndEscMsg('CPF9898' :MsgDta);
endif;
// Get record format name
myQDBQ36_Ptr = myQDBQ25_Ptr + myQDBQ25.QDBFOS;
RcdFmt = myQDBQ36.QDBFT01;
if %bitand(%subst(myQDBQ25.QDBBits27 :1 :1) :x'02') = x'02';
// Keyed sequence access path, get key information
for CurNbrKeyFlds = 1 to myQDBQ36.QDBFBGKy;
// Load key field names
if CurNbrKeyFlds = 1;
myQDBQ39_Ptr = myQDBQ25_Ptr + myQDBQ36.QDBFKSOF;
else;
myQDBQ39_Ptr += %size(QDBQ39);
endif;
KeyFlds.FldName(CurNbrKeyFlds) = myQDBQ39.QDBFKFld;
endfor;
CurNbrKeyFlds -= 1;
endif;
/end-free
p GetFDefn e
Following the processing flow of FNDDDE, one of the first things done in the *inzsr subroutine is running the GetFDefn (Get File Definition) procedure. The GetFDefn procedure performs the following functions:
- 1.Creates a *USRSPC for use as the receiver variable for the Retrieve Database File Description (QDBRTVFD) API
- 2.Calls the QDBRTVFD API
- 3.Extracts and reformats information from the QDBRTVFD API receiver variable
While the GetFDefn procedure has been doing points 1 and 2 since the first article in this series, I deferred discussion of the procedure until later. Now is that "later."
I chose to use a *USRSPC as the receiver variable for a few reasons. First, FNDDDE is intended to run on systems as early as V5R4, and RPG in V5R4 does not allow data structures to exceed 65535 bytes in length. I don't know for sure that any file definition returned by QDBRTVFD, for one of your files, will ever exceed this size, but the API does return just about everything you might ever want to know about a file—and I just didn't want to worry about the size. So FNDDDE creates a *USRSPC with a size of 1MB, which I suspect is more than sufficient, to contain the results returned by the QDBRTVFD API. Second, I wanted to avoid cluttering the mainline of FNDDDE, which currently does one thing—finds and reports decimal data errors—with the details of file information extraction. The file characteristics are all established, directly or indirectly, by way of the *inzsr subroutine, so FNDDDE needs to return with *inlr "on" in order to enable multiple files to be analyzed within a given job (given that file detail extraction is in the *inzsr). This makes allocation of storage using %alloc a bit more work if I want to try to avoid multiple allocations when FNDDDE happens to run multiple times within the same job. Using a *USRSPC in QTEMP, and always trying to resolve a pointer to the *USRSPC prior to creating the *USRSPC, provides an easy way to get the size of receiver variable I wanted and ensure that the receiver variable was allocated only once per job. Last but not least, I did first take the approach of calling the QDBRTVFD API with a "small" receiver variable in order to access the Bytes Available from the API, allocating the amount of storage reflected by Bytes available, and then calling the API a second time with the re-sized receiver variable. I unfortunately discovered that using this approach could require multiple iterations of calling the API in order to get the full picture—a discovery that I have reported to IBM as a possible defect.
In any case, FNDDDE allocates a receiver variable sufficient to hold the file definition of FileX and calls the QDBRTVFD API requesting format FILD0100.
If you review the QDBRTVFD API documentation, you may feel overwhelmed. As mentioned earlier, this API tells you just about everything you can imagine about a file. Fortunately, once you find the information you want in the API documentation, the actual program access to the information is generally very straightforward. And while it may take some time to find what you're looking for in the QDBRTVFD API documentation, I would much rather have too much information than too little.
In the case of FNDDDE, we want to first verify that FileX is indeed a physical file. The program does this by checking to see if the third bit of the file attributes field is "on." The file attributes field is defined in QSYSINC/QRPGLESRC source member QDBRTVFD as field QDBBits27 of data structure QDBQ25. QDBQ25 is the first data structure found in the QDBRTVFD receiver variable after calling the API and using format FILD0100. If the bit is on, then the file being accessed is a logical file, and, as I have no desire to process a logical file that may have multiple record formats, multiple physical files, field mapping, etc., the program ends with an error message. If the bit is not on, then we're working with a physical file (as the API itself will return an error, in the Error code parameter, if anything other than a database physical or logical file is requested).
Having verified that FileX is a physical file, FNDDDE then accesses the record format name of the file. The record name is a required input to the QUSLFLD API that is subsequently called. The record name is located in the File Scope array, which is provided in the QSYSINC include as data structure QDBQ36. The QDBQ36 data structure is accessed using field QDBFOS of structure QDBQ25.
These two steps (verifying file type and getting the record format name) have been in FNDDDE since the first article "In Search of Decimal Data Errors." The next step is new to FNDDDE.
FNDDDE now examines the seventh bit of the file attributes field (field QDBBits27 of QDBQ25). If this bit is on, then FileX is defined with a keyed sequence access path. If off, then FileX is accessed in arrival sequence. If keys are defined over FileX, FNDDDE then loads the array KeyFlds.FldName with the name of each key field used to access FileX. The number of key fields defined, found at field QDBFBGKy of structure QDBQ36, is used as the control for loading the key field names. The key fields are located in the Key Specification array, which is provided in the QSYSINC include as data structure QDBQ39. The first element of the array is accessed using field QDBFKSOF of structure QDBQ36, with subsequent key fields accessed by adding the size of the QDBQ39 structure.
Having loaded the array of key field names, and setting the variable CurNbrKeyFlds to the number of key fields loaded, the GetFDefn procedure returns to the *inzsr subroutine. The *inzsr subroutine, as it has in previous articles, now calls the QUSLFLD API to access information about each field in FileX and maintains the NumFldsArray whenever a zoned-decimal or packed-decimal field is encountered. What's new this month is a KeyFldsArray that will now also be maintained.
If the field CurNbrKeyFlds, previously set by GetFDefn, is greater than 0, then FNDDDE uses the %lookup built-in to determine if the QUSLFLD field being processed is found in the previously loaded array of key field names. If it is found, FNDDDE then maintains a KeyFldsArray that contains many of the same field attributes as the NumFldsArray (number of bytes allocated for the field, data type of the field, starting buffer position, etc.) used to store information about packed and zoned numeric fields. The few differences from the NumFldsArray are:
- 1.All data types are loaded (alphanumeric, binary, date, time, etc.).
- 2.Subfield Type is adjusted with a special value for the Binary data type using the named constant Integer (in the same manner as Type was set to the special values Packed and Zoned in NumFldsArray).
- 3.Subfield VarLen is added to indicate whether a field is defined as varying length.
When all fields returned by QUSLFLD have been examined, the *inzsr subroutine completes and the mainline of FNDDDE is run. The mainline logic remains the same as last month: every zoned and packed field of each record in FileX is tested for a decimal data error, and when an error is encountered, the LogNbrError procedure is called.
The next, and last, change to FNDDDE is within the LogRecIDVals procedure, which is called by LogNbrError when a decimal data problem is encountered for the first time within a record. Previously, LogRecIDVals simply wrote the relative record number of the record containing an error to the printer file and returned. The updated LogRecIDVals procedure now tests the field CurNbrKeyFlds to determine if FileX is keyed (CurNbrKeyFlds is greater than 0) and, if so, runs the new procedure MapKeyVal for each key field defined for the record. MapKeyVal formats the value of each key field in a manner suitable for printing and, upon return, LogRecIDVals then prints each key field value. After all key field values have been printed, LogRecIDVals prints the relative record number of the record having bad data and returns for LogNbrError to print the data in error.
MapKeyVal essentially formats a print line for LogRecIDVals. The print line consists of the name of the key field and up to the first 100 bytes of the field value. Using the information previously stored in KeyFldsArray, MapKeyVal, when the data type of the key field is numeric (integer, packed, or zoned), uses the Copy Numeric Value API to convert the key value to a zoned decimal format. For other key value data types (date, time, character, etc.), MapKeyVal uses overlay definitions of the key value. All of the data formatting is done under a monitor as there's nothing to say the decimal data problem isn't in one of the key fields.
The Copy Numeric Value API was previously used in the mainline of FNDDDE to detect decimal data errors by copying data without any change to the format of the data (the same structure was used for both the second and the fourth parameters). In MapKeyVal, the second parameter (receiver attributes) is set to the structure ZonedView, which instructs the API to return the key value in zoned decimal format (subfield ZonedType is set to x'02') using the number of digits and scale found in the definition of the key field. The fourth parameter (source attributes), in the case of packed and zoned key fields, is the same as what was used in the mainline. The fourth parameter in the case of integer (or binary) key values is, however, defined in a different manner. For integer inputs, the Copy Numeric Value API needs to know only the number of bytes used by the field. This number of bytes is passed in the third field (Length) of the source attributes parameter.
Assuming that you store the preceding source in member FNDDDE of QRPGLESRC, then you can create the utility program using this command:
CRTBNDRPG PGM(FNDDDE)
Testing the Find Decimal Data Errors Program
Using our test file from earlier articles, we can run our updated version of FNDDDE using this command:
CALL PGM(FNDDDE) PARM(DDEDATA *LIBL)
This should result in a printed report similar to what's shown below (the headings are left out due to margin considerations).
***********************
KEY FIELD(S): SOMEKEY: Bad_Data?_1
RRN: 2
FIELD: ZNDFLD1 BLANKS FOUND
FIELD: PKDFLD1 BLANKS FOUND
FIELD: PKDFLD2 001
X'F0F0F1'
FIELD: ZNDFLD3 BLANKS FOUND
***********************
KEY FIELD(S): SOMEKEY: Bad_Data?_2
RRN: 4
FIELD: PKDFLD1 at
X'81A3'
FIELD: PKDFLD2 oss
X'96A2A2'
FIELD: ZNDFLD3 ibleHere
X'89829385C8859985'
SUMMARY OF NUMERIC DATA ANALYSIS
VALID NUMERIC VALUES: 23
BLANK VALUES FOUND: 3
NON-BLANK VALUES FOUND: 4
Data analysis was completed successfully.
As you can see, the values for the key field SOMEKEY are now included in the report.
To test some of the numeric formatting of FNDDDE, edit the DDS source for test file DDEDATA and add the key fields ZndFld2 and PkdFld1 as shown below.
A …
A ZNDFLD3 8S 0
A K SOMEKEY
A K ZNDFLD2
A K PKDFLD1
Now reformat the file and rerun the report using the following two commands:
CHGPF FILE(DDEDATA) SRCFILE(QDDSSRC)
CALL PGM(FNDDDE) PARM(DDEDATA *LIBL)
You should now have a report similar to the following:
***********************
KEY FIELD(S): SOMEKEY: Bad_Data?_1
ZNDFLD2: 001
PKDFLD1: Unable to access key value
RRN: 2
FIELD: ZNDFLD1 BLANKS FOUND
FIELD: PKDFLD1 BLANKS FOUND
FIELD: PKDFLD2 001
X'F0F0F1'
FIELD: ZNDFLD3 BLANKS FOUND
***********************
KEY FIELD(S): SOMEKEY: Bad_Data?_2
ZNDFLD2: 92P
PKDFLD1: Unable to access key value
RRN: 4
FIELD: PKDFLD1 at
X'81A3'
FIELD: PKDFLD2 oss
X'96A2A2'
FIELD: ZNDFLD3 ibleHere
X'89829385C8859985'
SUMMARY OF NUMERIC DATA ANALYSIS
VALID NUMERIC VALUES: 23
BLANK VALUES FOUND: 3
NON-BLANK VALUES FOUND: 4
Data analysis was completed successfully.
In this report, we can see the values for the key field ZndFld2, and we can see that the values for PkdFld1 cannot be accessed (but can be found in the body of the report as being decimal data errors). You might also notice that ZndFld2's key value for relative record number 2 includes leading zeroes (001) and that ZndFld2's key value for relative record number 4 includes a P as the last digit. A P as the last digit of a zoned decimal field indicates that ZndFld2 is a negative number with the last digit being a 7. Removal of the leading zeroes and the proper display of negative numbers can be handled using APIs that were discussed nearly two years ago in the article "Dynamically Editing a Numeric Value." The APIs are QECCVTEC and QECEDT and, as the article title suggests, allow you to dynamically apply an edit code to an arbitrary numeric value.
This completes our work on finding decimal data errors within an arbitrary physical file on your system, and along the way we've looked at several APIs: QUSLFLD, QDBRTVFD, CPYNV, and cvthc. I suspect you may find uses for these APIs in areas of your system other than just decimal data error reporting.
As usual, if you have any API questions, send them to me at
Bruce Vining is president and co-founder of Bruce Vining Services, LLC, a firm providing contract programming and consulting services to the System i community. He began his career in 1979 as an IBM Systems Engineer in St. Louis, Missouri, and then transferred to Rochester, Minnesota, in 1985, where he continues to reside. From 1992 until leaving IBM in 2007, Bruce was a member of the System Design Control Group responsible for OS/400 and i5/OS areas such as System APIs, Globalization, and Software Serviceability. He is also the designer of Control Language for Files (CLF).A frequent speaker and writer, Bruce can be reached at
MC Press books written by Bruce Vining available now on the MC Press Bookstore.
 |
||
 |
|
IBM System i APIs at Work Leverage the power of APIs with this definitive resource. List Price $89.95 Now On Sale
|
More than ever, there is a demand for IT to deliver innovation. Your IBM i has been an essential part of your business operations for years. However, your organization may struggle to maintain the current system and implement new projects. The thousands of customers we've worked with and surveyed state that expectations regarding the digital footprint and vision of the company are not aligned with the current IT environment.
TRY the one package that solves all your document design and printing challenges on all your platforms. Produce bar code labels, electronic forms, ad hoc reports, and RFID tags – without programming! MarkMagic is the only document design and print solution that combines report writing, WYSIWYG label and forms design, and conditional printing in one integrated product. Make sure your data survives when catastrophe hits. Request your trial now! Request Now.
Forms of ransomware has been around for over 30 years, and with more and more organizations suffering attacks each year, it continues to endure. What has made ransomware such a durable threat and what is the best way to combat it? In order to prevent ransomware, organizations must first understand how it works.
Disaster protection is vital to every business. Yet, it often consists of patched together procedures that are prone to error. From automatic backups to data encryption to media management, Robot automates the routine (yet often complex) tasks of iSeries backup and recovery, saving you time and money and making the process safer and more reliable. Automate your backups with the Robot Backup and Recovery Solution. Key features include:
Business users want new applications now. Market and regulatory pressures require faster application updates and delivery into production. Your IBM i developers may be approaching retirement, and you see no sure way to fill their positions with experienced developers. In addition, you may be caught between maintaining your existing applications and the uncertainty of moving to something new.
IT managers hoping to find new IBM i talent are discovering that the pool of experienced RPG programmers and operators or administrators with intimate knowledge of the operating system and the applications that run on it is small. This begs the question: How will you manage the platform that supports such a big part of your business? This guide offers strategies and software suggestions to help you plan IT staffing and resources and smooth the transition after your AS/400 talent retires. Read on to learn:
LATEST COMMENTS
MC Press Online