code

Name
Astradyne (UK) Ltd
Scriptlanguage
Plain Text
Tabwidth
4
Date
Sun, 01 Jul 2007 11:18:19 +0100
IP
192.168.0.35

A subprocedure to remove trailing zeros from the decimal portion of a value, for example 123.4560000 is formatted as 123.456.

  1.     D* Prototype...                                                   
  2.     D RemoveZeros    pr            64a                               
  3.     D  iValue                      30p 9 Const                       
  4.                                                                        
  5.     D* Work Values...                                                 
  6.     D  wCharValue    s            32a                               
  7.     D  wNumber        s            15p 5 Inz(1132.557)               
  8.                                                                        
  9.     C                  Eval      wCharValue = RemoveZeros(123.567000) 
  10.     C    wCharValue    Dsply                                         
  11.     C                  Eval      wCharValue = RemoveZeros(wNumber)   
  12.     C    wCharValue    Dsply                                         
  13.     C                  Eval      wCharValue = RemoveZeros(999.000000) 
  14.     C    wCharValue    Dsply                                         
  15.     C                  Eval      *InLR = *On                         
  16.                                                                        
  17.                                                                        
  18.     P RemoveZeros    b                                               
  19.                                                                        
  20.     D RemoveZeros    pi            64a                                     
  21.     D  iValue                      30p 9 Const                             
  22.                                                                              
  23.     D wRtnVal        s            64a                                     
  24.     D wPos            s              3p 0                                   
  25.     D Ix              s              3p 0                                   
  26.     D cDecChar        c                  Const('.')                         
  27.                                                                              
  28.     C* First convert the value to a string...                               
  29.     C                  Eval      wRtnVal = %Trim(%EditC(iValue : 'L'))     
  30.                                                                              
  31.     C* Only trim the value if it contains a decimal character...             
  32.     C                  Eval      wPos = %Scan(cDecChar : wRtnVal)           
  33.     C                  If        wPos > *Zeros                             
  34.                                                                              
  35.     C*  Read from the end of the value to the decimal point until a non-zero
  36.     C*  character is found and replace any zeros with blanks...             
  37.     C                  For      Ix = %Len(%Trim(wRtnVal)) DownTo wPos     
  38.     C                  If        %Subst(wRtnVal : Ix : 1) = '0'             
  39.     C                  Eval      %Subst(wRtnVal : Ix : 1) = *Blanks         
  40.     C                  Else                                                         
  41.     C                  Leave                                                         
  42.     C                  EndIf                                                         
  43.     C                  EndFor                                                       
  44.                                                                                        
  45.     C*  If there is a blank after the decimal character then remove the decimal     
  46.     C*  character too so we don't get something like 153. or just a decimal character
  47.     C*  on its own...                                                               
  48.     C                  If        %Subst(wRtnVal : wPos + 1 : 1) = *Blanks           
  49.     C                  Eval      %Subst(wRtnVal : wPos : 1) = *Blanks               
  50.     C                  EndIf                                                         
  51.     C                  EndIf                                                         
  52.                                                                                        
  53.     C* Return the trimmed value...                                                   
  54.     C                  Return    wRtnVal                                             
  55.                                                                                        
  56.     P RemoveZeros    e