code

Name
Astradyne (UK) Ltd
Scriptlanguage
Plain Text
Tabwidth
1
Date
Thu, 03 May 2007 15:03:48 +0100
IP
192.168.0.33

If you have a need to evaluate dynamic calculations in RPG, you can use embedded SQL to make this easier. The example source below provides two sub-procedures; Calculate and SubValue, that can be used to replace variables within a formula with their values and to perform the actual calculation.

  1.     H DftActGrp(*No) ActGrp(*New)
  2.  
  3.     D Result          s            30  9 Inz(0)
  4.  
  5.     D Amount          s            15  4 Inz(12000.00)
  6.     D Term            s            15  4 Inz(36)
  7.     D Rate            s            15  4 Inz(5.00)
  8.  
  9.     D Formula        s            256a  Inz('(amount/term) * rate')
  10.  
  11.     D Lo              c                  Const('abcdefghijklmnopqrstuvwxyz')
  12.     D Up              c                  Const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  13.  
  14.     D SubValue        pr          256a
  15.     D  iString                    256a  Value
  16.     D  iVariable                    10a  Value
  17.     D  iValue                      15  5 Value
  18.  
  19.     D Calculate      pr            30  9
  20.     D  iFormula                    256a  Value
  21.  
  22.     C*‚First convert the Formula to upper case...
  23.     C                  Eval      Formula = %Xlate(Lo:Up:Formula)
  24.  
  25.     C*‚Substitute any variables...
  26.     C                  Eval      Formula = SubValue(Formula:'AMOUNT':Amount)
  27.     C                  Eval      Formula = SubValue(Formula:'TERM'  :Term)
  28.     C                  Eval      Formula = SubValue(Formula:'RATE'  :Rate)
  29.  
  30.     C*‚And perform the calculation...
  31.     C                  Eval      Result = Calculate(Formula)
  32.  
  33.     C                  Eval      *InLR = *On
  34.  
  35.     P*‚-------------------------------------------------------------------------
  36.     P* Procedure: Substitute numeric value into string
  37.     P*‚-------------------------------------------------------------------------
  38.     P Calculate      b
  39.  
  40.     D Calculate      pi            30  9
  41.     D  iFormula                    256a  Value
  42.  
  43.     D SqlStmt        s          1024a  Inz(*Blanks)
  44.     D oResult        s            30  9 Inz(*Zeros)
  45.  
  46.     C*‚Build an SQL statement to calculate the formula...
  47.     C                  Eval      SqlStmt = 'SELECT ' + %Trim(iFormula) +
  48.     C                              ' From SYSIBM/SYSDUMMY1'
  49.  
  50.     C*‚Prepare the SQL statement for execution...
  51.     C/Exec SQL
  52.     C+ Prepare prpCALC from :SqlStmt
  53.     C/End-Exec
  54.  
  55.     C*‚Declare a cursor to read the file...
  56.     C/Exec SQL
  57.     C+ Declare csrCALC Cursor for prpCALC
  58.     C/End-Exec
  59.  
  60.     C*‚Open the cursor...
  61.     C/Exec SQL
  62.     C+ Open csrCALC
  63.     C/End-Exec
  64.  
  65.     C*‚...and evaluate the calculation...
  66.     C/Exec SQL
  67.     C+ Fetch csrCALC into :oResult
  68.     C/End-Exec
  69.  
  70.     C*‚Finally, close the cursor...
  71.     C/Exec SQL
  72.     C+ Close csrCALC
  73.     C/End-Exec
  74.  
  75.     C*‚Return the calculated result...
  76.     C                  Return    oResult
  77.  
  78.     P Calculate      e
  79.  
  80.     P*‚-------------------------------------------------------------------------
  81.     P* Procedure: Substitute numeric value into string
  82.     P*‚-------------------------------------------------------------------------
  83.     P SubValue        b
  84.  
  85.     D SubValue        pi          256a
  86.     D  iString                    256a  Value
  87.     D  iVariable                    10a  Value
  88.     D  iValue                      15  5 Value
  89.  
  90.     D  wPos          s              3  0
  91.     D  wVarLen        s              3  0
  92.     D  wValLen        s              3  0
  93.     D  wString        s            256a
  94.     D  wValue        s            32a
  95.  
  96.     C*‚Default the return string with the value passed as a parameter...
  97.     C                  Eval      wString = iString
  98.  
  99.     C*‚Get an editted version of the numeric value to use as a replacement...
  100.     C                  Eval      wValue = %Trim(%EditC(iValue : 'L'))
  101.     C                  Eval      wValLen = %Len(%Trim(wValue))
  102.  
  103.     C                  Eval      wVarLen = %Len(%TrimR(iVariable))
  104.  
  105.     C*‚Now read through the complete forumula, and replace all occurrences of
  106.     C*‚iVariable with the editted value in wValue...
  107.     C                  DoU      wPos = *Zeros
  108.     C                  Eval      wPos = %Scan(%Subst(iVariable:1:wVarLen):
  109.     C                                          wString)
  110.     C                  If        wPos > *Zeros
  111.     C                  Eval      wString = %Replace(%Subst(wValue:1:wValLen) :
  112.     C                                                wString : wPos : wVarLen)
  113.     C                  EndIf
  114.     C                  EndDo
  115.  
  116.     C*‚Return the new string to the calling routine...
  117.     C                  Return    wString
  118.  
  119.     P SubValue        e