17
Wed, Apr
5 New Articles

The API Corner: Determining Key Values

APIs
Typography
  • Smaller Small Medium Big Bigger
  • Default Helvetica Segoe Georgia Times

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. 1.Creates a *USRSPC for use as the receiver variable for the Retrieve Database File Description (QDBRTVFD) API
  2. 2.Calls the QDBRTVFD API
  3. 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 fileand 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 thingfinds and reports decimal data errorswith 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 picturea 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. 1.All data types are loaded (alphanumeric, binary, date, time, etc.).
  2. 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. 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 This email address is being protected from spambots. You need JavaScript enabled to view it.. I'll see what I can do about answering your burning questions in future columns.

Bruce Vining

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 This email address is being protected from spambots. You need JavaScript enabled to view it.. 


MC Press books written by Bruce Vining available now on the MC Press Bookstore.

IBM System i APIs at Work IBM System i APIs at Work
Leverage the power of APIs with this definitive resource.
List Price $89.95

Now On Sale

BLOG COMMENTS POWERED BY DISQUS

LATEST COMMENTS

Support MC Press Online

$0.00 Raised:
$

Book Reviews

Resource Center

  • SB Profound WC 5536 Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application. You can find Part 1 here. In Part 2 of our free Node.js Webinar Series, Brian May teaches you the different tooling options available for writing code, debugging, and using Git for version control. Brian will briefly discuss the different tools available, and demonstrate his preferred setup for Node development on IBM i or any platform. Attend this webinar to learn:

  • SB Profound WP 5539More 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.

  • SB HelpSystems ROBOT Generic IBM announced the E1080 servers using the latest Power10 processor in September 2021. The most powerful processor from IBM to date, Power10 is designed to handle the demands of doing business in today’s high-tech atmosphere, including running cloud applications, supporting big data, and managing AI workloads. But what does Power10 mean for your data center? In this recorded webinar, IBMers Dan Sundt and Dylan Boday join IBM Power Champion Tom Huntington for a discussion on why Power10 technology is the right strategic investment if you run IBM i, AIX, or Linux. In this action-packed hour, Tom will share trends from the IBM i and AIX user communities while Dan and Dylan dive into the tech specs for key hardware, including:

  • Magic MarkTRY 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.

  • SB HelpSystems ROBOT GenericForms 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.

  • SB HelpSystems ROBOT GenericIT security is a top priority for businesses around the world, but most IBM i pros don’t know where to begin—and most cybersecurity experts don’t know IBM i. In this session, Robin Tatam explores the business impact of lax IBM i security, the top vulnerabilities putting IBM i at risk, and the steps you can take to protect your organization. If you’re looking to avoid unexpected downtime or corrupted data, you don’t want to miss this session.

  • SB HelpSystems ROBOT GenericCan you trust all of your users all of the time? A typical end user receives 16 malicious emails each month, but only 17 percent of these phishing campaigns are reported to IT. Once an attack is underway, most organizations won’t discover the breach until six months later. A staggering amount of damage can occur in that time. Despite these risks, 93 percent of organizations are leaving their IBM i systems vulnerable to cybercrime. In this on-demand webinar, IBM i security experts Robin Tatam and Sandi Moore will reveal:

  • FORTRA 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:

  • FORTRAManaging messages on your IBM i can be more than a full-time job if you have to do it manually. Messages need a response and resources must be monitored—often over multiple systems and across platforms. How can you be sure you won’t miss important system events? Automate your message center with the Robot Message Management Solution. Key features include:

  • FORTRAThe thought of printing, distributing, and storing iSeries reports manually may reduce you to tears. Paper and labor costs associated with report generation can spiral out of control. Mountains of paper threaten to swamp your files. Robot automates report bursting, distribution, bundling, and archiving, and offers secure, selective online report viewing. Manage your reports with the Robot Report Management Solution. Key features include:

  • FORTRAFor over 30 years, Robot has been a leader in systems management for IBM i. With batch job creation and scheduling at its core, the Robot Job Scheduling Solution reduces the opportunity for human error and helps you maintain service levels, automating even the biggest, most complex runbooks. Manage your job schedule with the Robot Job Scheduling Solution. Key features include:

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

  • LANSAWhen it comes to creating your business applications, there are hundreds of coding platforms and programming languages to choose from. These options range from very complex traditional programming languages to Low-Code platforms where sometimes no traditional coding experience is needed. Download our whitepaper, The Power of Writing Code in a Low-Code Solution, and:

  • LANSASupply Chain is becoming increasingly complex and unpredictable. From raw materials for manufacturing to food supply chains, the journey from source to production to delivery to consumers is marred with inefficiencies, manual processes, shortages, recalls, counterfeits, and scandals. In this webinar, we discuss how:

  • The MC Resource Centers bring you the widest selection of white papers, trial software, and on-demand webcasts for you to choose from. >> Review the list of White Papers, Trial Software or On-Demand Webcast at the MC Press Resource Center. >> Add the items to yru Cart and complet he checkout process and submit

  • Profound Logic Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application.

  • SB Profound WC 5536Join us for this hour-long webcast that will explore:

  • Fortra 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: