String Expressions in RPG
BIFs can simplify string operations.
BIF operations allow some complex instructions when the values are derived from expressions. The code as written extracts the digits from a text string, trimming blanks and stripping out the decimal point with just text string manipulation. The same operation could have been performed using arrays. And I’m sure if I spent more time, I could make this routine somewhat simpler and cleaner, perhaps by using the %XLATE BIF to flip all blanks after the decimal point to zero. But it seems to serve the purpose.
The following code is an exercise in using the BIFs with expressions. The code was necessary to interpret HTML form data into 2 position numeric value. The really isn’t any such creature in HTML. Input on a form is a form field, which by nature is a string object. It may contain characters, or numbers, and fixed decimal representation is a myth in HTML.
Parsing the text box
D $weight 7 2
D wgt_in 1 7
D #VALID C CONST(' .0123456789')
D #ZPAD S 8 INZ('00000000')
.
.
Fig. 1
If the form contained only a single decimal field, I would probably write a client-side JavaScript routine to validate the form data. But in this case, the text box is part of a table. There might be anywhere from 1 to 30 entries, each containing weight. So I passed the table to an RPG program to validate and update the database file.
So, aware that the incoming text data could contain anything, the only thing assured, was that the length will not exceed 8 characters ( by using the HTML INPUT tag attribute: maxlength=”8”). It may contain a decimal point or, it may not. The following code is an attempt to decide whether or not the string contains a valid data and if it contains merely numbers or numbers and a decimal point!
ndRow = ndRow + 1;
ndCol = 1; // Get weight
ndRC = dtw_GetV(ndTable:%addr(ndValue):ndRow:ndCol);
z$wght = %trim(%str(ndValue:8));
IF z$wght = *blanks;
p$err = 'MNF0003';
EXSR @exit;
ENDIF;
.
.
.
pos = %check(#valid:z$wght); // Make weight contains valid characters
IF pos > 0;
p$err = 'MNF0003';
EXSR @exit;
ENDIF;
.
.
Fig. 2
I start by getting the value of the table data for the weight using the DTW API’s. The value is a text string 8 characters long from the
address of the table value in the specified row and column. Notice the use of the address BIF (%ADDR) to determine the location of the
table row and column. The string pointer(%STR) is used to make sure the length only includes characaters up to the string terminator
(Hex'00')--in essense finding the maximum length of the string. Using the constant of digits, plus the decimal point (#VALID), I peform
a quick check to see if I have a valid number; (no point in continuing if it does not contain digits).
I use the length BIF to return the length of the weight that was entered. Then I use the %SCAN BIF to find the position of the decimal point in the string. If there are more than two digits to the right of the decimal point, I use the %SUBST BIF with the expression B + 2 as the third argument to truncate the string two positions following the decimal point.
// *-------------------------------------------------------------
// * Check for decimal point. If there are more than two decimal
// * positions, truncate the number.
// *-------------------------------------------------------------
IF %scan('.':z$wght) > 0;
A = %len(%trim(z$wght));
B = %len(%scan('.':z$wght));
D = A - B;
IF D > 2;
z$wght = %subst(z$wght:1: B + 2);
ENDIF;
.
.
.
//*-------------------------------------------------------------------
//* Right adjust only the numeric value after the decimal point
//*-------------------------------------------------------------------
EVALR w$wrk8 = %trim(%subst(z$wght: %scan('.':z$wght)+1)) +
%subst(#ZPAD:1:2 - %len(%trim(%subst(z$wght:
%scan('.':z$wght)+1))));
.
.
Fig. 3
The next set of instructions uses EVALR to load a work field with the rightmost digits after the decimal point. Of course it is not quite that simple. If there are less than two digits to the right of the decimal point, it has to be padded to with zeros. The trim and substring BIF have values that are the result of an expression. The first half of the EVALR uses substring to get the value from the work field Z$WGHT beginning at the position of the decimal point + 1. It is concatenated with the necessary zero padding to insure the resulting string does not contain blanks. This expression takes advantage of the BIF's ability to accept expressions as an element of the function's argument list.
Having retrieved the digits to the right of the decimal point, the next step is to grab the digits to the left of the decimal point. Using the substring BIF the digits are retrieved starting at the first position for the length returned by using the scan BIF as an expression (position of decimal minus one).
//*-------------------------------------------------------------------
//* Get the substring of the value left of the decimal. Right adjust
// * and concatenate with the value to the right of the decimal‚
//*-------------------------------------------------------------------
IF %scan('.':z$wght) > 1;
EVALR w$wrk8 = %trim(%subst(z$wght:1:
%scan('.':z$wght)-1)) +
%trim(w$wrk8);
ENDIF;
EVALR wgt_in = w$wrk8;
w$wght = $weight;
.
.
.
ELSE;
len = 8 - %len(%trim(z$wght));
z$wght = %subst(#ZPAD:1:len) + %trim(z$wght);
EVALR wgt_in = z$wght;
w$wght = $weight * 100;
ENDIF;
IF w$wght = 0;
p$err = 'MNF0003';
EXSR @exit;
ENDIF;
.
.
Fig. 4
Of course if no decimal point is present the process is much simpler. The length of the string is determined. Then the value is right
adjusted and padded with zeros. I move the result into a work field then multiply 100 to create the additional two decimal positions.
String Parser Module
The string parsing function is a simple mechanism for returning the value of a character string to a field. The following code is from a program designed to parse inbound XML statements. In addition to the XML tag, the statement may contain a quoted string value, or in some instances, multiple quoted values.
IF LineItemEntry ;
SELECT ;
WHEN %subst (wrkstmt:2:17) = 'requestedQuantity' ;
doruom = ExtractNext(Wrkstmt:dqt) ;
dorqty = %dec(ExtractNext(Wrkstmt:dqt):11:2) ;
WHEN %subst (wrkstmt:2:24)= 'itemIdentifier itemNumbe';
dcitem = ExtractNext(wrkstmt:dqt) ;
In the sample of program code, when a line item entry is detected the unit of measure and the quantity ordered need to be extracted from the record. The ExtractString function is used to populate the DB2 fields, DORUOM and DORQTY. Note the parsing function is called in succession. The ExtractString function extracts and returns a value and trims the string being passed.
p ExtractNext B Export
d ExtractNext PI 128
d wrkstmt 200
d dl 1a CONST
D i S 3 0
D l S 3 0
D x S 3 0
D pos S 3 0
D StringOut S 128
d*qt s 1a inz(X'7D')
d*dqt s 1a inz(X'7F')
/free
StringOut = *blanks ;
pos = 0 ;
// find the start, then end of string to calculate length
i = %scan(dl: wrkstmt: 1) ;
i = i + 1 ;
l = %scan(dl: wrkstmt: i) ;
x = l - i ;
IF x > 0 ;
StringOut = %subst(wrkstmt: i: x) ;
ENDIF ;
IF StringOut <> *blanks;
StringOut = UpperCase(StringOut:%size(StringOut)) ;
StringOut = %trim(StringOut) ;
ENDIF ;
wrkstmt = %subst(wrkstmt: l + 1) ;
RETURN StringOut ;
/end-free
p ExtractNext e
The procedure prototype takes in a 200-byte string and a single-byte delimiter—making the parse function fairly generic. The hex value of ‘7D’ represents a single quote mark The hex value of ‘7F’ represents a double quote mark in the case of most ASCII to EBCDIC conversions. Essentially, any single byte character may be specified as a delimiter, such as a colon, comma, or a space. Basically the module works like the IBM rational EGL construct, or java class getNextToken(). You can use it to assign values, (or tokens in the EGL system function) for as many delimited values (tokens) as the string contains. If the function doesn’t find any more values, the return variable is blank.