23
Mon, Dec
2 New Articles

The API Corner: What Was the Change in This Record?

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

Let's discuss some things you should know about flexibly tracking field values.

 

Last month, in So Just What Changed in This Record?, we saw how a program could identify by name each field that was changed by an update operation on a record. We accomplished this using the database trigger support of the IBM i along with the List Record Formats (QUSLRCD) and List Fields (QUSLFLD) APIs. This month, we'll extend that program to display not only the names of the fields changed, but also the original and new values of the field.

When accessing the before and after values of a field, some data types (alphanumeric, date, time, timestamp) are relatively easy to handle. For example, the value of a fixed-length alphanumeric field can be accessed using an approach similar to how we determined if the value had changed. Last month, the procedure FindChgs() used the following to determine if a field (that either did not support null values or had both before and after values set to non-null values) changed:

      select;                                                      
         when ((FldEntry.QUSNVA = '0') or                          
               (%subst(B4NullValue :X :1) = '0' and                
                %subst(AftNullValue :X :1) = '0')) and             
               %subst(B4Image :FldEntry.QUSOBP :FldEntry.QUSFLB) <>
               %subst(AftImage :FldEntry.QUSOBP :FldEntry.QUSFLB); 
                                                                   
              dsply (%trimr(FldEntry.QUSFN02) +                    
                     ' value changed');                

To access the before and after values for display purposes would just be displaying the results of the %subst operations (with the additional consideration that if using the DSPLY operation code you would also need to check that the field length in bytes (FldEntry.QUSFLB) did not exceed the maximum length supported by DSPLY52 bytes). Accessing the before and after values of a variable-length alphanumeric field is slightly more effort (and shown later in this article) but still along the same lines.

Numeric fields, however, pose more of a challenge when trying to display before and after values, and they'll be the focus of this article. Most language functions, like ILE RPG's %CHAR built-in function, want to know at compile time the characteristics of the variables being operated on. For instance, in the following assignment of Value, the compiler wants to know at compile time if SomeNbr is defined as packed decimal 9.2, packed decimal 10.2, zoned decimal 11.0, a 2-byte integer, or something else.

Value = %char(SomeNbr);

Fortunately, though not used in last month's article, the QUSLFLD API returns a lot more than just the name of each field within a record (FldEntry.QUSFN02), the offset to the field within a record (FldEntry.QUSOBP), and the length of the field in bytes (FldEntry.QUSFLB). Also provided is the data type (FldEntry.QUSDT) and, for fields of a numeric data type, the number of digits (FldEntry.QUSigits) along with the number of decimal positions (FldEntry.QUSDP).

Using this additional information, we have a variety of ways that we could use to convert a given numeric value to a displayable format.

One approach might be to extend how we previously used the based variables B4Image and AftImage. Rather than just basing these two alphanumeric variables (and the basing pointers B4ImagePtr and AftImagePtr, respectively), we could also define based variables on these pointers for each possible numeric variable definitionthat is, based variables named such as Pkd15_0, Pkd15_1, and Pkd15_2 that would be used when the data type is packed decimal (FldEntry.QUSDT = 'P'), the number of digits is 15 (FldEntry.QUSigits = 15), and the number of decimal positions is 0, 1, or 2, respectively. In conjunction with IF and/or SELECT/WHEN logic, this would then allow us to provide the correct field name to the %CHAR function (as in Value = %char(Pkd15_2); when FldEntry.QUSDT = 'P', FldEntry.QUSigits = 15, and QUSDP = 2). This approach, to my way of thinking anyway, is very painful. For packed-decimal fields, you can have from 1 to 63 digits and from 0 to 63 decimal positions (as long as the decimal positions value doesn't exceed the digits value). This leaves us with, well, lots and lots of field definitions and logic checks to code if we want to handle all possible numeric definitions. Not an approach I would recommend.

Another approach might be to use the various %BIT* built-in functions provided by RPG to "de-compress" packed-decimal fields accessed by way of B4Image and AftImage. That is, work through the substringed B4Image and AftImage fields (as was done to determine if the field value had changed), determining for each nibble the appropriate character value ('0' to '9') the nibble represents and in addition, for the last byte of the data, what sign (positive or negative) should be assigned. While this approach might prove to be highly educational, it's still not one I would recommend.

My preference is to use APIs that can be told at run time, rather than compile time, what type(s) of numeric data we're working with and then have the APIs return the value in a format suitable for DSPLYing. Along these lines, here is an updated version of last month's AUDDTACHG program.

h dftactgrp(*no)                                                  
                                                                  
d AudDtaChg       pr                                              
d  TrgBfr                             likeds(QDBTB)               
d  LenTrgBfr                    10i 0 const                       
                                                                  
d AudDtaChg       pi                                              
d  TrgBfr                             likeds(QDBTB)               
d  LenTrgBfr                    10i 0 const                       
                                                                  
 **************************************************************** 
                                                                  
d CpyNV           pr                  extproc('_LBCPYNV')         
d  CpyNVResult                        like(CpyNVResult)           
d  TgtDtaAttr                         const likeds(TgtDtaAttr)    
d  SourceValue                  63a   const                       
d  SrcDtaAttr                         const likeds(SrcDtaAttr)    
                                                                  
d CrtUsrSpc       pr                  extpgm('QUSCRTUS')          
d  QualUsrSpcN                  20a   const                         
d  XAttr                        10a   const                         
d  IntSize                      10i 0 const                         
d  IntValue                      1a   const                         
d  PubAut                       10a   const                         
d  TxtDesc                      50a   const                         
d  ReplaceOpt                   10a   const options(*nopass)        
d  ErrCde                             likeds(QUSEC) options(*nopass)
d  Domain                       10a   const options(*nopass)        
d  TfrSize                      10i 0 const options(*nopass)        
d  OptSpcAlgn                    1a   const options(*nopass)        
                                                                    
d EdtNbr          pr                                                
d  SrcPtr                         *   const                         
                                                                    
d FindChgs        pr                                                
                                                                    
d GetEdtDta       pr                  extpgm('QECEDT')              
d  RcvVar                      256a                                 
d  LenRcvVar                    10i 0 const                         
d  SrcDta                      256a   const                
d  SrcClass                     10a   const                
d  Precision                    10i 0 const                
d  EdtMsk                      256a   const                
d  LenEdtMsk                    10i 0 const                
d  FillChr                       1a   const                
d  ErrCde                             likeds(QUSEC)        
                                                           
d GetEdtMsk       pr                  extpgm('QECCVTEC')   
d  EdtMsk                      256a                        
d  LenEdtMsk                    10i 0                      
d  LenRcvVar                    10i 0                      
d  FillChr                       1a                        
d  EdtCde                        1a   const                
d  FillFloat                     1a   const                
d  Precision                    10i 0 const                
d  ScaleIn                      10i 0 const                
d  ErrCde                             likeds(QUSEC)        
                                                           
d GetValue        pr            52a                        
d  SrcPtr                         *   const                          
                                                                     
d LstFlds         pr                  extpgm('QUSLFLD')              
d  UsrSpcName                   20a   const                          
d  Format                        8a   const                          
d  QualFilNam                   20a   const                          
d  RcdFmt                       10a   const                          
d  OvrPrc                        1a   const                          
d  ErrCde                             likeds(QUSEC) options(*nopass) 
                                                                     
d LstRcdFmts      pr                  extpgm('QUSLRCD')              
d  UsrSpcName                   20a   const                          
d  Format                        8a   const                          
d  QualFilNam                   20a   const                          
d  OvrPrc                        1a   const                          
d  ErrCde                             likeds(QUSEC) options(*nopass) 
                                                                     
d RtvUsrSpcPtr    pr                  extpgm('QUSPTRUS')             
d  QualUsrSpcN                  20a   const                          
d  UsrSpcPtr                      *                                  
d  ErrCde                             likeds(QUSEC) options(*nopass) 
                                                                     
 ****************************************************************    
                                                                     
d SpcPtr          s               *                                  
d ListHdr         ds                  likeds(QUSH0100)               
d                                     based(SpcPtr)                  
                                                                     
d FldEntryPtr     s               *                                  
d FldEntry        ds                  likeds(QUSL0100)               
d                                     based(FldEntryPtr)             
                                                                     
d RcdEntryPtr     s               *                                  
d RcdEntry        ds                  likeds(QUSL010001)             
d                                     based(RcdEntryPtr)             
                                                                     
d SrcDtaAttr      ds                  qualified                      
d  Type                          1a                                  
d  Length                        5i 0                                
d  Reserved                      4a   inz(x'00000000')               
                                                                 
d TgtDtaAttr      ds                  qualified                  
d  Type                          1a   inz(x'02')                 
d  Length                        5i 0                            
d  FracDigits                    3i 0 overlay(Length)            
d  TotalDigits                   3i 0 overlay(Length :2)         
d  Reserved                      4a   inz(x'00000000')           
                                                                 
d ErrCde          ds                  qualified                  
d  Hdr                                likeds(QUSEC)              
d  MsgDta                      256a                              
                                                                 
 ****************************************************************
                                                                 
d AftImagePtr     s               *                              
d AftImage        s          32766a   based(AftImagePtr)         
d AftNullPtr      s               *                              
d AftNullValue    s           8000a   based(AftNullPtr)          
d B4ImagePtr      s               *                              
d B4Image         s          32766a   based(B4ImagePtr)          
d B4NullPtr       s               *                                
d B4NullValue     s           8000a   based(B4NullPtr)             
d CpyNVResult     s             63a                                
d EdtMsk          s            256a                                
d EdtRcvVar       s            256a                                
d FillChr         s              1a                                
d GetOut          s               n                                
d LenEdtMsk       s             10i 0                              
d LenEdtRcvVar    s             10i 0                              
d MaxLen          s             10i 0                              
d RcdFmt          s             10a                                
d Scale           s             10i 0                              
d SpcName         s             20a   inz('AUDDTACHG QTEMP')       
d Value           s             52a                                
                                                                   
d X               s             10i 0                              
                                                                   
 ****************************************************************  
                                                                   
 /copy qsysinc/qrpglesrc,trgbuf                                    
 /copy qsysinc/qrpglesrc,qusec                                   
 /copy qsysinc/qrpglesrc,qusgen                                  
 /copy qsysinc/qrpglesrc,quslfld                                 
 /copy qsysinc/qrpglesrc,quslrcd                                 
                                                                 
 ****************************************************************
                                                                 
 /free                                                           
                                                                 
  if (GetOut);                                                   
     *inlr = *on;                                                
     return;                                                     
  endif;                                                         
                                                                 
  select;                                                        
     when TrgBfr.QDBTE = '1';                                    
          // Insert operation -- not a concern today             
                                                                 
     when TrgBfr.QDBTE = '2';                                    
          // Delete operation -- not a concern today             
                                                            
     when TrgBfr.QDBTE = '3';                               
          // Update operations have before and after images 
                                                            
          B4ImagePtr = %addr(TrgBfr) + TrgBfr.QDBORO;       
          B4NullPtr = %addr(TrgBfr) + TrgBfr.QDBORNBM;      
                                                            
          AftImagePtr = %addr(TrgBfr) + TrgBfr.QDBNRO;      
          AftNullPtr = %addr(TrgBfr) + TrgBfr.QDBNRNBM;     
                                                            
          FindChgs();                                       
                                                            
     other;                                                 
          // Basically Read operations which should never   
          // trigger this program...                        
                                                            
  endsl;                                                    
                                                            
  *inlr = *on;                                              
  return;                                                   
                                                                  
  // *************************************************************
                                                                  
  begsr *inzsr;                                                   
                                                                  
    QUSBPrv = 0;                                                  
    ErrCde.Hdr.QUSBPrv = %size(ErrCde);                           
                                                                  
    RtvUsrSpcPtr(SpcName :SpcPtr :ErrCde);                        
                                                                  
    select;                                                       
       when ErrCde.Hdr.QUSBAvl = 0;                               
            // User space previously created                      
                                                                  
       when ErrCde.Hdr.QUSEI = 'CPF9801';                         
            // UsrSpc not found, so create it                     
                                                                  
            CrtUsrSpc(SpcName :' ' :4096 :x'00' :'*ALL' :' '      
                      :'*YES' :ErrCde :'*DEFAULT' :0 :'1');       
                                                                  
            if ErrCde.Hdr.QUSBAvl <> 0;                     
               dsply ('Unable to create *USRSPC: ' +        
                      ErrCde.Hdr.QUSEI);                    
               GetOut = *on;                                
            else;                                           
               // Get accessibility to user space           
                                                            
               RtvUsrSpcPtr(SpcName :SpcPtr :ErrCde);       
               if ErrCde.Hdr.QUSBAvl <> 0;                  
                  dsply ('Unable to access *USRSPC: ' +     
                      ErrCde.Hdr.QUSEI);                    
                  GetOut = *on;                             
               endif;                                       
            endif;                                          
       other;                                               
            // Something seriously wrong.                   
                                                            
            dsply ('Serious Error found: ' +                
                  ErrCde.Hdr.QUSEI);                        
            GetOut = *on;                                   
    endsl;                                                      
                                                                
    if (not GetOut);                                            
       LstRcdFmts(SpcName :'RCDL0100'                           
                  :(TrgBfr.QDBFILN02 + TrgBfr.QDBLIBN02)        
                  :'0' :ErrCde);                                
                                                                
       select;                                                  
          when ErrCde.Hdr.QUSBAvl <> 0;                         
               dsply ('Unable to access record formats: ' +     
                      ErrCde.Hdr.QUSEI);                        
               GetOut = *on;                                    
                                                                
          when ListHdr.QUSIS <> 'C';                            
               dsply ('Unable to access all record formats: ' + 
                      ErrCde.Hdr.QUSEI);                        
               GetOut = *on;                                    
                                                                
          when ListHdr.QUSNbrLE <> 1;                           
               dsply ('More than one record format found');     
               GetOut = *on;                               
                                                           
          other;                                           
               RcdEntryPtr = SpcPtr + ListHdr.QUSOLD;      
               RcdFmt = RcdEntry.QUSFN05;                  
       endsl;                                              
    endif;                                                 
                                                           
    if (not GetOut);                                       
       LstFlds(SpcName :'FLDL0100'                         
               :(TrgBfr.QDBFILN02 + TrgBfr.QDBLIBN02)      
               :RcdFmt :'0' :ErrCde);                      
                                                           
       select;                                             
          when ErrCde.Hdr.QUSBAvl <> 0;                    
               dsply ('Unable to access field info: ' +    
                      ErrCde.Hdr.QUSEI);                   
               GetOut = *on;                               
                                                           
          when ListHdr.QUSIS <> 'C';                       
               dsply ('Unable to access all fields');            
               GetOut = *on;                                     
                                                                 
          other;                                                 
               // Continue on                                    
       endsl;                                                    
    endif;                                                       
                                                                 
  endsr;                                                         
                                                                 
 /end-free                                                       
                                                                 
 *****************************************************************
                                                                 
p FindChgs        b                                              
d FindChgs        pi                                             
                                                                 
 /free                                                           
                                                                 
  for X = 1 to ListHdr.QUSNbrLE;                                 
      if X = 1;                                                     
         FldEntryPtr = SpcPtr + ListHdr.QUSOLD;                     
      else;                                                         
         FldEntryPtr += ListHdr.QUSSEE;                             
      endif;                                                        
                                                                    
      select;                                                       
         when ((FldEntry.QUSNVA = '0') or                           
               (%subst(B4NullValue :X :1) = '0' and                 
                %subst(AftNullValue :X :1) = '0')) and              
               %subst(B4Image :FldEntry.QUSOBP :FldEntry.QUSFLB) <> 
               %subst(AftImage :FldEntry.QUSOBP :FldEntry.QUSFLB);  
                                                                    
              dsply (%trimr(FldEntry.QUSFN02) +                     
                     ' value changed from:');                       
              dsply GetValue(B4ImagePtr);                           
                                                                    
              dsply ('to:');                                        
              dsply GetValue(AftImagePtr);                          
                                                                    
         when %subst(B4NullValue :X :1) = '1' and      
              %subst(AftNullValue :X :1) = '1';        
              // Both are null, so no change           
                                                       
         when %subst(B4NullValue :X :1) = '1' and      
              %subst(AftNullValue :X :1) = '0';        
                                                       
              dsply (%trimr(FldEntry.QUSFN02) +        
                     ' changed from null to:');        
              dsply GetValue(AftImagePtr);             
                                                       
         when %subst(B4NullValue :X :1) = '0' and      
              %subst(AftNullValue :X :1) = '1';        
                                                       
              dsply (%trimr(FldEntry.QUSFN02) +        
                     ' changed to null from:');        
              dsply GetValue(B4ImagePtr);              
                                                       
      endsl;                                           
                                                       
  endfor;                                                        
                                                                 
 /end-free                                                       
                                                                 
p FindChgs        e                                              
                                                                 
 *****************************************************************
                                                                 
p GetValue        b                                              
d GetValue        pi            52a                              
d  mySrcPtr                       *   const                      
                                                                 
d VarLenPtr       s               *                              
d VarLen          s              5u 0 based(VarLenPtr)           
d SrcValue        s          32766a   based(mySrcPtr)            
                                                                 
 /free                                                           
                                                                 
  select;                                                        
     when ((FldEntry.QUSDT = 'A') and                            
           (FldEntry.QUSVLFI = '0'));                             
                                                                  
          if FldEntry.QUSFLB <= %size(Value);                     
             Value =                                              
               %subst(SrcValue :FldEntry.QUSOBP :FldEntry.QUSFLB);
          else;                                                   
             Value =                                              
               %subst(SrcValue :FldEntry.QUSOBP :%size(Value));   
          endif;                                                  
                                                                  
     when ((FldEntry.QUSDT = 'A') and                             
           (FldEntry.QUSVLFI = '1'));                             
                                                                  
          VarLenPtr = mySrcPtr + FldEntry.QUSOBP;                 
                                                                  
          select;                                                 
             when VarLen = 0;                                     
                  Value = *blanks;                                
                                                                  
             when VarLen <= %size(Value);                         
                  Value =                                                 
                    %subst(SrcValue :(FldEntry.QUSOBP + 2) :VarLen);      
             other;                                                       
                  Value =                                                 
                    %subst(SrcValue :(FldEntry.QUSOBP + 2) :%size(Value));
          endsl;                                                          
                                                                          
     when FldEntry.QUSDT = 'B';                                           
          SrcDtaAttr.Type = x'00';                                        
          SrcDtaAttr.Length = FldEntry.QUSFLB;                            
          TgtDtaAttr.Length = FldEntry.QUSIGITS;                          
          EdtNbr(mySrcPtr);                                               
                                                                          
     when FldEntry.QUSDT = 'L';                                           
          Value =                                                         
            %subst(SrcValue :FldEntry.QUSOBP :10);                        
                                                                          
     when FldEntry.QUSDT = 'P';                                           
          SrcDtaAttr.Type = x'03';                                        
          SrcDtaAttr.Length = FldEntry.QUSIGITS;                          
          TgtDtaAttr.Length = FldEntry.QUSIGITS;       
          EdtNbr(mySrcPtr);                            
                                                       
     when FldEntry.QUSDT = 'S';                        
          SrcDtaAttr.Type = x'02';                     
          SrcDtaAttr.Length = FldEntry.QUSIGITS;       
          TgtDtaAttr.Length = FldEntry.QUSIGITS;       
          EdtNbr(mySrcPtr);                            
                                                       
     when FldEntry.QUSDT = 'T';                        
          Value =                                      
            %subst(SrcValue :FldEntry.QUSOBP :8);      
                                                       
     when FldEntry.QUSDT = 'Z';                        
          Value =                                      
            %subst(SrcValue :FldEntry.QUSOBP :26);     
                                                       
     other;                                            
          Value = *blanks;                             
  endsl;                                               
                                                                
  return Value;                                                 
                                                                
 /end-free                                                      
                                                                
p GetValue        e                                             
                                                                
 ****************************************************************
                                                                
p EdtNbr          b                                             
d EdtNbr          pi                                            
d  mySrcPtr                       *   const                     
                                                                
d SrcValue        s          32766a   based(mySrcPtr)           
                                                                
 /free                                                          
                                                                
  monitor;                                                      
     CpyNV(CpyNVResult :TgtDtaAttr                              
           :%subst(SrcValue :FldEntry.QUSOBP :FldEntry.QUSFLB)  
           :SrcDtaAttr);                                          
  on-error;                                                       
     Value = *blanks;                                             
     return;                                                      
  endmon;                                                         
                                                                  
  if ((FldEntry.QUSIGITS <> MaxLen) or                            
      (FldEntry.QUSDP <> Scale));                                 
     // Reuse previous mask if MaxLen and Scale have not changed  
                                                                  
     MaxLen = FldEntry.QUSIGITS;                                  
     Scale = FldEntry.QUSDP;                                      
     GetEdtMsk(EdtMsk :LenEdtMsk :LenEdtRcvVar :FillChr           
               :'L' :' ' :MaxLen :Scale :ErrCde);                 
  endif;                                                          
                                                                  
  GetEdtDta(EdtRcvVar :LenEdtRcvVar :CpyNVResult :'*ZONED'        
            :MaxLen :EdtMsk :LenEdtMsk :FillChr :ErrCde);         
                                                                  
  if ErrCde.Hdr.QUSBAvl = 0;                                      
     Value = %triml(%subst(EdtRcvVar :1 :LenEdtRcvVar));     
  else;                                                      
     Value = *blanks;                                        
  endif;                                                     
                                                             
 /end-free                                                   
                                                             
p EdtNbr          e                                          

A summary of the changes being made (with the details to follow) are:

  • New prototypes named CpyNV (Copy Numeric Value), EdtNbr (Edit Number), GetEdtDta (Get Edited Data), GetEdtMsk (Get Edit Mask), and GetValue (Get Field Value)
  • New data structures named SrcDtaAttr (Source Data Attributes) and TgtDtaAttr (Target Data Attributes)
  • New standalone fields CpyNVResult (Copy Numeric Value Result), EdtMsk (Edit Mask), EdtRcvVar (Edit Receiver Variable), FillChr (Fill Character for Editing using an edit mask), LenEdtMsk (Length of Edit Mask), LenEdtRcvVar (Length of Edit Receiver Variable), MaxLen (Maximum Length), Scale, and Value
  • Minor changes to the DSPLY operations used in the procedure FindChgs()
  • New procedures named GetValue and EdtNbr

The first code change can be found in the procedure FindChgs(). Last month, FindChgs() simply displayed text indicating if a given field was changed. This month, FindChgs() displays text that includes the field before and after values related to that change. This is done by DSPLYing the return value of procedure GetValue().

The GetValue() procedure is prototyped as taking one input, the address of the record buffer (before or after image) to be processed, and providing an alphanumeric return value with a size of 52 bytes, which is the limit that the DSPLY operation can display. GetValue() also defines three local fields:

  • VarLenPtrA pointer to the first byte associated with a variable-length field
  • VarLenAn unsigned 2-byte integer based on the pointer variable VarLenPtr. This is used to determine the actual length of the variable-length field.
  • SrcValueA based alphanumeric variable with a length of 32,766 bytes. This is used to access field values in the same manner as B4Image and AftImage, but without having to be concerned with whether the value is before or after.

GetValue() processing is a SELECT group based on the data type (FldEntry.QUSDT) of the field currently being processed. Processing of the "simple" data types is quite direct. When the data type is:

  • 'A' (alphanumeric) and not variable-length (FldEntry.QUSVLFI = '0'), set the variable Value to the actual length (or truncated length if the length exceeds 52 bytes) of the field being processed
  • 'A' (alphanumeric) and variable-length (FldEntry.QUSVLFI = '1'), set VarLenPtr to the start of the field being processed, determine the actual length of the variable field using the based variable VarLen, and set the variable Value to the actual length (or truncated length if the actual length exceeds 52 bytes) of the field being processed. When accessing the field value, the starting offset of the %SUBST operation is also adjusted to bypass the 2-byte length value.
  • 'L' (date), set the variable Value to the 10-byte date value of the field being processed
  • 'T' (time), set the variable Value to the 8-byte time value of the field being processed
  • 'Z' (timestamp), set the variable Value to the 26-byte timestamp value of the field being processed

For the fields with numeric data types ('B' for binary/integer, 'P' for packed decimal, and 'S' for zoned decimal), GetValue() does some "prep" work and then calls the procedure EdtNbr. This "prep" work will be explained after an introduction to EdtNbr().

Within EdtNbr(), after setting a MONITOR to catch "bad" numeric data values, the Copy Numeric Value (CPYNV) machine instruction is run. The CPYNV instruction is rather handy in that it will:

  • Copy numeric values from one field (the source) to another (the target)
  • Allow you to dynamically define the attributes of the source and target fields in terms of data type, number of digits, and number of decimal positions
  • Automatically convert the source format to the target format if the data attributes are different

In other words, just what we need to get a variety of numeric values converted to a consistent format.

The CPYNV instruction is passed four parameters. They are the target field, the attributes of the target field, the source field, and the attributes of the source field. The attributes are passed as a 7-byte data structure defined in the documentation of the Set Data Pointer Attributes (SETDPAT) machine instruction. Within the AUDDTACHG program, there are two instances of this data structure declaredSrcDtaAttr to define the source field as it's defined in the record image and TgtDtaAttr to define the target field that we want the source value to be converted to.

The "prep" work being done in the GetValue() procedure is where the appropriate SrcDtaAttr and TgtDtaAttr data structure subfields are being set in preparation of EdtNbr() running the CPYNV instruction. Some fields, like TgtDtaAttr.Type, are static and set one time when the data structures are initialized. For example, in the case of TgtDtaAttr.Type the static value is x'02', indicating that we always want the source numeric value to be returned in the target field as a zoned-decimal format. Other fields, like SrcDtaAttr.Type, need to be set on a field-by-field basis. For example, when the source data type (FldEntry.QUSDT) is:

  • 'B' (binary), then SrcDtaAttr.Type is set to x'00', SrcDtaAttr.Length is set to the length in bytes of the source field (which will be either 2, 4, or 8), and TgtDtaAttr.Length is set to the number of digits found in the source field
  • 'P' (packed), then SrcDtaAttr.Type is set to x'03' and both SrcDtaAttr.Length and TgtDtaAttr.Length to the number of digits found in the source field
  • 'S' (signed), then SrcDtaAttr.Type is set to x'02' and both SrcDtaAttr.Length and TgtDtaAttr.Length to the number of digits found in the source field

Returning to our discussion of the EdtNbr procedure, EdtNbr() runs the CPYNV instruction using the data attribute structures set by GetValue() and has the result of the copy operation returned in variable CpyNVResult. At this point, CpyNVResult is set to the zoned-decimal representation of the field being processed. But in order to display that value in a meaningful way, we need to edit it by inserting a decimal point where appropriate, a negative sign for negative values, etc. To accomplish this, AUDDTACHG uses two additional APIsConvert Edit Code (QECCVTEC), prototyped as GetEdtMsk, and Edit (QECEDT), prototyped as GetEdtDta.

The QECCVTEC API can be used to dynamically create an edit mask appropriate for the proper editing (decimal point, sign, etc.) of a given numeric value. As a minor performance improvement, AUDDTACHG when creating an edit mask stores the number of digits and number of decimal positions in variables MaxLen and Scale, respectively. So prior to creating an edit mask, a check is made to determine if the last created edit mask happens to match the characteristics of the current field to be edited. If not, which will certainly be the case for the first numeric changed field to be processed by AUDDTACHG, then QECCVTEC is called (as GetEdtMsk). If the characteristics do match, then the previous edit mask is re-used.

The QECCVTEC API is passed the edit code to be used ('L' in the example program), the way in which zero suppression should be handled (a blank in the example program), the number of digits (MaxLen, which is set to the FldEntry.QUSigits value of the current field), and the number of decimal positions (Scale, which is set to the FldEntry.QUSDP value of the current field). The API returns four fields:

  • EdtMskThe edit mask to use based on the inputs to the API (edit code, zero suppression option, etc.)
  • LenEdtMskThe length of the edit mask returned (EdtMsk)
  • LenEdtRcvVarThe length required to return the edited value after applying the edit mask
  • FillChrThe fill character to pass subsequently pass to the QECEDT API

Having gotten an appropriate edit mask, the QECEDT API is called (as GetEdtDta) in order to access the edited value. The API defines one receiver variable where the formatted numeric value is to be returned (EdtRcvVar) and several input parameters. These inputs are the length of the EdtRcvVar variable (LenEdtRcvVar, previously returned by QECCVTEC), the numeric value to be formatted (CpyNVResult, previously returned by the CPYNV API), the data type found in CpyNVResult (the value '*ZONED' as we previously hardcoded the TgtDtaAttr structure used with the CPYNV instruction to return zoned-decimal data), the number of digits (MaxLen), the edit mask to use (EdtMsk, previously returned by QECCVTEC), the length of the edit mask (LenEdtMsk, previously returned by QECCVTEC), and the fill character to be used (FillChr, previously returned by QECCVTEC).

The returned EdtRcvVar value is then returned by EdtNbr() to GetValue() by way of assigning Value to the contents of the %TRIML value of EdtRcvVar for a length of LenEdtRcvVar. GetValue() in turn returns Value to FindChgs() for DSPLYing to the user (as either a before value or an after value).

While the formatting of numeric values is not as straightforward as that found for data types such as alphanumeric, date, time, etc., it can be accomplished using system APIs, in a quite dynamic nature, without too much work. You may find the CPYNV, QECCVTEC, and QECEDT APIs to be just what you need in other applications to stream line some code.

To compile and test AUDDTACHG, please refer to the earlier article So Just What Changed in This Record?.

Before closing a few points:

  • Some careful readers may have noticed that, while the data attributes structure used by CPYNV allows the specification of the total number of digits (TotalDigits) and the number of decimal point digits (FracDigits), AUDDTACHG only sets the Length (effectively, just the TotalDigits variable) portion of the structure. There is nothing wrong with setting TotalDigits and FracDigits to the appropriate values (and for some applications, that will be the right thing to do), but, in the case of AUDDTACHG, I "know" that the subsequent edit APIs will be the final decider in terms of decimal point location. In the case of AUDDTACHG's use of CPYNV, the important item is to get all of the digits defined for the field. Decimal location can be introduced on the field later (which it is in EdtNbr()).
  • Others may have noticed that the QECEDT API directly supports data types of binary, packed decimal, and zoned decimal and wondered why the CPYNV API was needed at all (as QECEDT could handle the various data types). AUDDTACHG uses both APIs for the following two primary reasons. First, not all applications will want to have the numeric value formatted as an edited string, so general knowledge of the CPYNV API is of value. Second, when the i introduced 8-byte integer support, for some reason (I suspect oversight), this support was not added to QECEDT. CPYNV, however, does support this length and, as this length may very well exist in some of your files, the use of CPYNV in copying the 8-byte integer value to a zoned-decimal value allows the value to be properly edited (and DSPLYed) by EdtNbr().
  • The EdtRcvVar passed to QECEDT is actually declared with a length of 256 bytes though the API call uses the value of LenEdtRcvVar returned by QECCVTEC. LenEdtRcvVar will always be 256 bytes or less, and it's the value that you must pass to QECEDT. Any other value passed to the API will result in CPF27AF – Edit mask not valid.
  • The EdtNbr() statement Value = %triml(%subst(EdtRcvVar :1 :LenEdtRcvVar)); runs the risk of a truncation error due to Value being defined as only 52 bytes in length while LenEdtRcvVar may be a larger number. In a production environment, I would anticipate that Value would really be a variabl- length field (of much greater maximum size than 52 bytes) written to an audit file and, in order to avoid adding code to handle the DSPLY limitation of 52 bytes, I simply accepted the risk of truncation (as I really don't expect any "real" application to simply DSPLY the before or after values).

Have Some System API Questions?

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

BLOG COMMENTS POWERED BY DISQUS

LATEST COMMENTS

Support MC Press Online

$

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: