This tool enables the FndDDE program to easily find all numeric fields, which is a pre-req to finding field values that result in a decimal data error.

Have you ever had an application program that failed with message MCH1202 – Decimal data error? If not, good for you! But for everyone else, and there are many of us, this is one dreaded error message. Alex M. recently asked if a utility program could meet the following requirements:

1. 1.Work with any externally described physical file defined using DDS
2. 2.Identify all numeric fields, by name, whose current value would cause a MCH1202
3. 3.Print the value of the numeric field that would cause a MCH1202
4. 4.If a keyed physical file, print the key field values for the record containing the numeric field(s) in error
5. 5.Print the relative record number of the record containing the numeric field(s) in error

Such a utility could be written using a variety of approaches. As this is the "API Corner," you shouldn't be too surprised to find that my solution is based on rather intensive use of system APIs. Over the next few API Corner articles, we will look at several APIs—some that have not been used in previous articles along with a few that we've seen before.

The first iteration of our utility program is shown below. The program name is Find Decimal Data Errors (FndDDE) and can, assuming you store the source in QRPGLESRC as member FNDDDE, be compiled using this command:

CRTBNDRPG PGM(FNDDDE)

h DftActGrp(*No)                                                    

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 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 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 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 MaxNbrNumFlds   c                  const(1000)                    

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)            

* 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 ErrCde         ds                 qualified                      

d Hdr                              likeds(QUSEC)                  

d MsgDta                     256a                                  

*********************************************************************

d MsgDta         s           256a                                  

d MsgKey         s             4a                                  

d QualNameRtn     s            20a                                  

d RcdFmt         s             10a                                  

d X               s             10i 0                                

*********************************************************************

/copy qsysinc/qrpglesrc,qdbrtvfd                                    

/copy qsysinc/qrpglesrc,qusec                                        

/copy qsysinc/qrpglesrc,qusgen                                      

/copy qsysinc/qrpglesrc,quslfld                                      

*********************************************************************

/free                                                                

dsply ('List of ' +                                                

         %trimr(File_In) +                                            

         ' fields to be tested:');                                    

for X = 1 to CurNbrNumFlds;                                        

     dsply NumFlds.FldName(X);                                      

endfor;                                                            

dsply 'Press Enter to continue' ' ' MsgKey;                        

*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;                                                      

   endfor;                                                          

endsr;                                                            

/end-free                                                          

*********************************************************************

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;                      

/end-free                                          

p GetFDefn       e                                

The FndDDE program expects two parameters to be passed when it's called: File_In and Lib_In. The first parameter is the name of the file to be scanned for decimal data errors; the second is the library where the file can be located. The library parameter can be a library name or one of the special values *LIBL or *CURLIB.

In the initialization subroutine (*INZSR), the program first sets two instances of the standard API error code structure. The first instance, QUSEC, has the Error code Bytes Provided (QUSBPrv) field set to 0. This instance of the Error code structure is used when FndDDE is not anticipating any error being encountered by the called API. If the API finds an error, the API will send an escape message and FndDDE will end abnormally. The second instance, ErrCde, has the Error code Bytes Provided (ErrCde.Hdr.QUSBPrv) field set to the size of the ErrCde data structure. This size includes space for up to 256 bytes of error-related message replacement data. This instance of the Error code structure is used when FndDDE anticipates that some errors may be encountered by the called API. If the error is one that FndDDE will handle, then the program takes the appropriate action and continues. If the error is one that FndDDE is not prepared to handle, then the function SndSysMsg() is used to resend the error message as an escape, again causing FndDDE to end abnormally.

Anyplace in FndDDE you see the use of QUSEC as the error code parameter when calling an API, you can replace that with ErrCde and then, after calling the API, use the following test:

if ErrCde.Hdr.QUSBAvl > 0;

   SndSysMsg();

endif;        

Using QUSEC in the manner described above is simply a way to avoid more code cluttering our discussion.

Having set the two instances of the API error code structure, FndDDE then calls the function GetFDefn(). For now, we'll just say that this function verifies that the file to be scanned for decimal data errors is indeed a physical file and sets field RcdFmt to the record format name associated with File_In. In the March timeframe, we'll look at the API being used—Retrieve Database File Definition (QDBRTVFD)—and what's being done in the code currently provided. Then we'll add quite a bit to our use of the QDBRTVFD API.

Following the call to GetFDefn(), the program prepares to use the List Fields (QUSLFLD) API, which is the meat of this article. The QUSLFLD API is a standard list-type API that returns a list of the fields defined within a database file along with many of the attributes associated with each field. These attributes include information such as the name of the field, the data type (character, packed decimal, zoned decimal, date, timestamp, etc.) of the field, edit codes and edit words associated with numeric fields, and column headings for the field. If you are not familiar with list-type APIs, you may want to refer to the IBM Information Center. In addition, there are earlier API Corner articles, such as "Finding Modules in a *SRVPGM" (Part 2 of a series of articles under the general name of "Module, Module, Who's Got My Module?") that introduce you to the processing of list API output.

If FndDDE is to test each numeric field of every record in a file to determine if the current value would generate a decimal data error, then QUSLFLD provides an easy way of having the system tell us what fields in a given file are defined as numeric.

To prepare for calling the QUSLFLD API, FndDDE first attempts to get a pointer (LstFldHdr_Ptr) to the user space QUSLFLD in QTEMP using the Retrieve Pointer to User Space (QUSPTRUS) API (prototyped as RtvUsrSpcPtr). The name of the user space can be any valid name, and I chose to use the API name just to help document what the user space is being used for. In this case, the QUSLFLD user space will be used to hold the output of the QUSLFLD API. If RtvUsrSpcPtr() returns with no error (ErrCde.Hdr.QUSBAvl = 0), then the user space currently exists in QTEMP (most likely from a previous call to FndDDE) and FndDDE will simply reuse the user space.

If RtvUsrSpcPtr() returns an error (ErrCde.Hdr.QUSBAvl is greater than 0), then the error message sent by the API is examined. If the message ID (ErrCde.Hdr.QUSEI) is CPF9801 – Object in library not found, then FndDDE creates the user space using the Create User Space (QUSCRTUS) API (prototyped as CrtUsrSpc) and again calls RtvUsrSpcPtr() to get a pointer to the (now created) user space. If any unexpected error is encountered (the first use of RtvUsrSpcPtr resulting in an error other than CPF9801, an error when creating the user space, or an error in obtaining a pointer with the second use of RtvUsrSpcPtr), then an escape message ends the program.

Having obtained a pointer to the user space, FndDDE now calls the QUSLFLD API (prototyped as LstFld) and falls into a FOR loop to process each list entry returned by the API. Within the FOR loop, each field is examined to determine if its data type is zoned decimal (field LstFld100.QUSDT is the value 'S') or packed decimal (LstFld100.QUSDT is the value 'P'). If the field is one of these two data types, then the field's name (LstFld100.QUSFN02), length in bytes (LstFld100.FLD), type, decimal position (LstFld100.QUSDP), number of digits (LstFld100.QUSigits), and starting position within the record (LstFld100.QUSIBP) are copied to an entry in the array NumFldsArray (Numeric Fields Array). During this processing, there is also some mapping of data values being performed in that zoned decimal fields are set to a type of x'02' rather than the 'S' returned by the QUSLFLD API, packed decimal fields are set to a type of x'03' rather than 'P', and both the decimal positions and digits values are stored as 1-byte integer values rather than the 4-byte integer values returned by QUSLFLD.

The copying of the zoned decimal and packed decimal field information to a separate array is to avoid having to process all of the field definitions (the character fields, integer fields, etc.) for every record read by FndDDE. FndDDE can now simply loop through the NumFldsArray in order to locate all fields within a record that might have a decimal data error. The mapping of values is done for a reason that will become clear in the January API Corner—namely, getting everything ready to call another API.

You may have noticed that not all numeric fields are being copied to NumFldsArray. This is because the numeric data types of binary/integer and floating point do not cause decimal data errors. Other types of errors are possible, but not MCH1202s.

Having loaded all zoned decimal and packed decimal fields into NumFldsArray, the initialization subroutine returns to the main procedure of the program. The main procedure currently enters into a FOR loop to DSPLY the names of all the numeric fields found in NumFldArray. Next month, we'll be replacing this display of the field names with the actual testing of each NumFldArray named field across all records read from the file specified by variables File_In and Lib_In. For now, the main procedure simply provides a testing mechanism for you to see what fields have been selected for testing within the initialization subroutine.

To test FndDDE, we'll create a keyed physical file. The file name will be DDEData, for Decimal Data Error Data, and the following DDS defines the file/record layout.

     A         R RECORD                

     A           SOMEKEY       12A      

     A           CHRFLD1       2A      

     A           ZNDFLD1       2S 0    

     A           PKDFLD1       3P 0    

     A           CHRFLD2       1A      

     A           ZNDFLD2       3S 1    

     A           PKDFLD2       5P 2    

     A           ZNDFLD3       8S 0    

     A         K SOMEKEY                

Assuming that the previous DDS source is stored in member DDEDATA of source file QDDSSRC, you can create DDEData with this command:

CRTPF FILE(DDEDATA)

DDEData defines a record format named Record, which is keyed by the character field SomeKey. There are two alphanumeric fields defined (besides SomeKey): ChrFld1 and ChrFld2; three zoned decimal fields: ZndFld1, ZondFld2, and ZndFld3; and two packed decimal fields: PkdFld1 and PkdFld2. Next month, we'll populate DDEData with both "good" and "bad" data in order to test the ability of the FndDDE program to find decimal data errors. For now using the command CALL PGM(FndDDE) PARM(DDEData *Libl) should result in a display similar to what's shown below.

DSPLY List of DDEDATA fields to be tested:

DSPLY ZNDFLD1                              

DSPLY PKDFLD1                            

DSPLY ZNDFLD2                            

DSPLY PKDFLD2                            

DSPLY ZNDFLD3                            

DSPLY Press Enter to continue            

To conduct additional testing of FndDDE, you can also, for any externally described physical file X in library Y, see what fields of X would be selected for testing by running this command:

CALL PGM(FNDDDE) PARM(X Y)

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

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 Leverage the power of APIs with this definitive resource. List Price $89.95 Now On Sale

Also Read

The API Corner: Moving Jobs Within and Across Job Queues

The API Corner: What Time Zone Do You Want That Date and Time In?

The API Corner: How Do You Want That Date and Time?