RPGLE convert alpha string to numeric data

There are so many ways to convert a alpha or character value to numeric or decimal. You can use various built-in funtion provided by the system for Version V5R2 and above releases. You can pass character strings to the %DEC, %DECH, %INT, %INTH, %UNS, %UNSH, and %FLOAT built-in functions. If the character string contains invalid data, the system generates an exception with status code 105.


Usage: %DEC(expression:digits:decimals)
D Stringdata      s             50               
D Number          s             15p 2


 /free                                           
   monitor;        
      Number = %dec(Stringdata:15:2);         
   on-error 105;
      // Error handling logic goes here        
   endmon;        
 /end-free

The data my come you from any other system in the form of CSV file, XML file other flat files. RPG will translate positive (+) or negative (-) signs either at the beginning or end of the numeric data. A decimal point can be specified and blanks are allowed. However, it won't accept currency symbols, thousands separators, and asterisks. If you know that other characters are there in the data then you must preprocess that before you use any of the built-in functions using the %XLATE function.

For example, if Amount has a value of '$85,325.67-**' you could use %XLATE first to convert the currency symbol, asterisks, and commas to blanks. The %DEC function doesn't mind the embedded blanks, so your program would get a seven digit packed return value of -85325.67. 

Usage: %DEC(%XLATE('$*,':'   ':Amount) :15 : 2 )
 Monitor;
  Number = %Dec(  %Xlate('$,*' : '   ' : Stringdata) : 15 : 2);
 On-Error 105;
   // Error handling logic goes here
 EndMon;

You can also also using C progamming to convert string data to numeric. You have include the C binding directory QC2LE.
H Option(*SrcStmt : *NoDebugIO) bnddir('QC2LE')

datof             pr             8f   extproc('atof')    
d string                          *   options(*string)   
d    
                                value   

 /free                                           
     Number = %dech(atof(%trim(string)):15:2);     
 /end-free

%dech will half-adjust the result.If you don't, the extracted number may not match the string. Also invalid data returns a zero so you have make sure the input data is all good.

The old fashined way. I wrote this program long time back, works like a charm all the time.
d $alpha          s             50                              
d $numeric        s             15  5                            
d i               s              3  0                            
d #div            s             10  0                            
d dec             s              1                               
d neg             s              1                               
                                                                 
d arr             s              1    dim(50)                    
                                                                 
c     *entry        plist                                        
c                   parm                    $alpha               
c                   parm                    $numeric             

c                   movea     $alpha        arr                                
c                   move      'N'           dec                                
c                   move      'N'           neg                                
c                   eval      $numeric = *zeros                                
                                                                               
c     1             do        50            i                                  
c                   select                                                     
                                                                               
c                   when      arr(i) = '.'                                     
c                   move      'Y'           dec                                
c                   z-add     10            #div                               
                                                                               
c                   when      arr(i) = '-'                                     
c                   move      'Y'           neg                                
                                                                               
c                   when      arr(i)<>' ' and dec <> 'Y' 
c                   if        arr(i) >= '0' and arr(i) <= '9'                           
c                   move      arr(i)        n                 1 0              
c     10            mult      $numeric      $numeric                           
c                   add       n             $numeric   
c                   endif                          

                                                                                
c                   when      arr(i)<>' ' and dec = 'Y'       
c                   if        arr(i) >= '0' and arr(i) <= '9'                        
c                   move      arr(i)        n                 1 0               
c     #div          mult      $numeric      $numeric                            
c                   add       n             $numeric                            
c     $numeric      div(h)    #div          $numeric                            
c     10            mult      #div          #div      
c                   endif                            
                                                                                
c                   endsl                                                       
c                   enddo                                                       
                                                                                
c                   if        neg = 'Y'                                         
c                   eval      $numeric = $numeric * -1                          
c                   endif                                                       
                                                                                
c                   eval      *inlr = *on                                       
c                   return                  

No comments :

Post a Comment