This is the source code for the program explained in the "Flexible Calculations" article in the Sept 2007 edition of the Extra newsletter. Sorry about the rather unimaginative name - I could not find any inspiration for a better one!
|
|
// number is used as the base for defining all of the numeric fields
// used in the program
D number s 15p 5
D calc Pr ExtProc(currentOpPtr) Like(number)
D f1 Like(number)
D f2 Like(number)
D add Pr Like(number)
D f1 Like(number)
D f2 Like(number)
D subtract Pr Like(number)
D f1 Like(number)
D f2 Like(number)
D divide Pr Like(number)
D f1 Like(number)
D f2 Like(number)
D multiply Pr Like(number)
D f1 Like(number)
D f2 Like(number)
// Request data is in format VOV where V = a variable name (A, B, C or D)
// and O = the operation code (+ - or /)
D request DS
D var1 1a
D operation 1a
D var2 1a
D opIndex s 5i 0
D v1Index s 5i 0
D v2Index s 5i 0
// Basing pointers for v1 and v2 will be set to the releveant pointer
// from the pVariable array. Both could be set to the same address
// e.g. If the calculation was A+A
D v1 s Like(number) Based(pV1)
D v2 s Like(number) Based(pV2)
D result s Like(number)
D currentOpPtr s * ProcPtr
// In reality the variables would simply be in the database
// for this example they are defined here in the program.
D variables DS
D A 5s 0 Inz(4)
D B 5p 0 Inz(100)
D
D C 9s 3 Inz(.333)
D D 10i 0 Inz(123456789)
// These are the working copies of the variables in a common format
D work DS Qualified
D A Like(number)
D B Like(number)
D C Like(number)
D D Like(number)
// This array lists the names of all variables available to use
// They _must_ be in the same sequience as the pVariables array
D varNames DS
D 10a Inz('A')
D 10a Inz('B')
D 10a Inz('C')
D 10a Inz('D')
D varName 10a Dim(4) Overlay(varNames)
D
// This array supplies the adresses of all the varaiables
D pVariables DS
D pA * Inz(%Addr(work.A))
D pB * Inz(%Addr(work.B))
D pC * Inz(%Addr(work.C))
D pD * Inz(%Addr(work.D))
D pVariable * Dim(4) Overlay(pVariables)
D operations DS
D opAdd 1a Inz('+')
D opSubtract 1a Inz('-')
D opDivide 1a Inz('/')
D opMultiply 1a Inz('*')
D opList 1a Dim(4) Overlay(operations)
D pProcedures Ds
D pAdd * ProcPtr Inz(%PAddr('ADD'))
D pSub * ProcPtr Inz(%PAddr('SUBTRACT'))
D pDiv * ProcPtr Inz(%PAddr('DIVIDE'))
D pMult * ProcPtr Inz(%PAddr('MULTIPLY'))
D pProcedure * Dim(4) Overlay(pProcedures) ProcPtr
/Free
// Set up working copies of variables - would normally be done following
// the CHAIN/READ that retrieved the data for this calculation.
Dsply ( 'Program (currently) supports variables A, B, C and D' );
Dsply ( ' and operation codes +, -, * and /.' );
work.A = A;
work.B = B;
work.C = C;
work.D = D;
DoU operation = 'x';
Dsply ('Enter operation in format VOV - or xxx to exit') ' ' request;
If operation = 'x';
Leave;
Endif;
// Validate requested variable names and operation code
// Issue error message if any of them are unknown
// If this program was "for real" we'd issue better diagnostics
v1Index = %LookUp( var1: varname );
v2Index = %LookUp( var2: varname );
opIndex = %LookUp( operation: opList );
If ( v1Index = 0 ) Or ( v2Index = 0 ) Or ( opIndex = 0 );
Dsply ( 'Invalid request - please check and re-enter' );
Iter;
EndIf;
// Now set the pointers for the variables and the calculation
pV1 = pVariable(v1Index);
pV2 = pVariable(v2Index);
currentOpPtr = pProcedure(opIndex);
// And go ahead and perform the calculation
result = calc( v1 : v2 );
dsply ('Result is: ' + %Char(result));
EndDo;
*InLR = *On;
/End-Free
P add b
D PI Like(number)
D f1 Like(number)
D f2 Like(number)
/Free
return f1 + f2;
/End-Free
P add e
P subtract b
D PI Like(number)
D f1 Like(number)
D f2 Like(number)
/Free
return f1 - f2;
/End-Free
P subtract e
P divide b
D PI Like(number)
D f1 Like(number)
D f2 Like(number)
/Free
return f1 / f2;
/End-Free
P divide e
P multiply b
D PI Like(number)
D f1 Like(number)
D f2 Like(number)
/Free
return f1 * f2;
/End-Free
P multiply e
Want more
information?
Got a question or comment about the site?
Please feel free to Contact
Us at any time.}