A Handy RPG FUNction
November 9, 2005 Ted Holt
I like functions. I like the ones built into RPG, like %SUBST and %DATE and %CHAR and %FOUND. I like the ones built into SQL, like UPPER and DIGITS. Functions accomplish a lot of work with little effort because the code inside a function does not need to be included in the routines that call the function. I enjoy writing my own functions and using them in my programming. Today, I’m going to share a function I recently wrote that is proving to be useful to me. You may like it, too.
Not long ago, I was working on an RPG program and needed to display a Y or N to indicate whether certain fields were true or not. I had a lot of five-line tests like this:
if Type = 'E'; EDICust = 'Y'; else; EDICust = 'N'; endif;
Something about this looked familiar, and I finally realized what it was. I thought back to my System/34 and System/36 RPG II days, when I would look at RPG III code in the trade magazines and see things like this:
C TYPE IFEQ 'E' C MOVE '1' *IN25 C ELSE C MOVE '0' *IN25 C END
This type of code looked strange to me at the time, since I was used to accomplishing the same task with one COMP operation.
C* HILOEQ C TYPE COMP 'E' 25
Anyway, back to the present. I had the nagging thought that I should be able to replace the five-line IF-ELSE-ENDIF structure with one line, even in free-format RPG IV. Finally it dawned on me that I had used such a technique in Microsoft Access and Visual Basic. In a few minutes, I had my own IIF function.
IIF is a very simple function. It accepts three arguments: a condition, a value to return if the condition is true, and a value to return if the condition is false. Here is the prototype:
D iif pr 256a varying D Condition n value D TrueValue 256a varying value D FalseValue 256a varying value
And here is the function itself:
P iif b
D pi 256a varying
D Condition n value
D TrueValue 256a varying value
D FalseValue 256a varying value
/free
if Condition;
return TrueValue;
else;
return FalseValue;
endif;
/end-free
P e
Using IIF, I was able to reduce the many five-line tests to one line each. Here’s the first example again:
if Type = 'E'; EDICust = 'Y'; else; EDICust = 'N'; endif;
Here’s the same code, using the IIF function.
EDICust = iif (Type = 'E': 'Y': 'N');
Notice that my IIF function works with character data only. It would be nice to have another IIF function for numeric values, but I haven’t needed one yet. If I decide to write a numeric IIF, I will have to give it another name, since IBM doesn’t allow different functions of the same name in RPG. (At least, not yet. I hope we’ll see function overloading in a future release.)
|
There is no need for an IIF function to set indicator variables. Setting indicator variables with one operation is easily handled with the present RPG syntax. For example, this:
C TYPE IFEQ 'E' C MOVE '1' *IN25 C ELSE C MOVE '0' *IN25 C END
is easily replaced by this:
*in25 = (type = 'E')
If type has a value of E, indicator 25 turns on. If not, indicator 25 turns off. You can do the same thing in CL, by the way.
dcl &in25 type(*lgl) chgvar var(&in25) value(&TYPE *EQ 'E')
Here is a short program interested professionals can compile and play with. Each test is done twice; the long way comes first, followed by the IIF version.
H option(*srcstmt: *nodebugio)
H dftactgrp(*no) actgrp(*new)
D iif pr 256a varying
D Condition n value
D TrueValue 256a varying value
D FalseValue 256a varying value
D DropShipCode s 1a
D ShipMsg s 3a
D Option s 1a
D Balance s 7p 2
D Age s 3p 0
D AgeCategory s 12a
/free
// 1. If DropShipCode = 'X', print Yes, else print blanks.
if DropShipCode = 'X';
ShipMsg = 'Yes';
else;
ShipMsg = *blanks;
endif;
ShipMsg = iif (DropShipCode = 'X': 'Yes': *blanks);
// 2. If Option is blank, assume Option = 'A'
if Option = *blank;
Option = 'A';
endif;
Option = iif (Option = *blank: 'A': Option);
// 3. Place into categories by age.
if Age < 6;
AgeCategory = 'Preschool';
elseif Age < 18;
AgeCategory = 'School age';
else;
AgeCategory = 'Graduate';
endif;
AgeCategory = iif(Age<6: 'Preschool':
iif(Age<18:'School Age': 'Graduate'));
// 4. If Balance <= *zero, turn on indicator 25.
if Balance <= *zero;
*in25 = *on;
else;
*in25 = *off;
endif;
*in25 = (Balance <= *zero);
*inlr = *on;
/end-free
* ====================================================
P iif b
D pi 256a varying
D Condition n value
D TrueValue 256a varying value
D FalseValue 256a varying value
/free
if Condition;
return TrueValue;
else;
return FalseValue;
endif;
/end-free
P e
I continually look for ideas for new functions to help me in my work. I hope you like IIF, and if you are not writing your own functions, I hope you will learn to do so soon. If you have a useful function you’d like to share with readers of Four Hundred Guru, please email it to me.
Free-form version of iif
dcl-proc iif;
// Conditional IF
// If the first parm is *on, return the second parm,
// otherwise return the third parm.
dcl-pi *n varchar(256);
inCondition ind value;
inTrueValue varchar(256) value;
inFalseValue varchar(256) value;
end-pi;
if inCondition;
return inTrueValue;
else;
return inFalseValue;
endif;
end-proc iif;
Yes, I still use this thing. It’s handy!
Be aware that the arguments to iif have to be valid.
This won’t work:
dcl-s OldStatus char(3) dim(4) ctdata perrcd(1);
dcl-s NewStatus char(1) dim(4) alt(OldStatus);
dcl-s Ax uns(3);
Ax = %lookup(EmployeeStatus: OldStatus);
Stat = iif(Ax > *zero: NewStatus (Ax): ‘?’);
This will:
Ax = %lookup(EmployeeStatus: OldStatus);
if Ax > *zero;
Stat = NewStatus (Ax);
else;
Stat = ‘?’;
endif;