56 lines
2.3 KiB
Plaintext
56 lines
2.3 KiB
Plaintext
**FREE
|
|
// ====================================================================
|
|
// Contains BASE36ADD procedure to increments by 1 a Character value.
|
|
// Pass in a value and it returns the value incremtented by 1.
|
|
// ====================================================================
|
|
// - It works on any string length up to an arbitrary 50 characters.
|
|
// So the value must be passed in as varying character and the
|
|
// incremented value is returned as varying character.
|
|
// - It is the callers responsibility to ensure that if the absolute
|
|
// maximum value is returned then some action must be taken to
|
|
// report/handle the situation where no more values are available.
|
|
// If called with the maximum value it will roll over to the minimum
|
|
// value. E.g., call with 999 and AAA will be returned.
|
|
// - This code is based on the 36 character set A-Z and 0-9.
|
|
// - As coded, the sequence of the values follows the EBCDIC raw
|
|
// sorting sequence.
|
|
// - If a different character set is needed, e.g., you wish to omit
|
|
// O and L because they look to much like 0 and 1, simply
|
|
// remove them from the "From" and "To" strings.
|
|
//
|
|
// 1) CRTRPGMOD MODULE(SRV_BASE36)
|
|
// 2) CRTSRVPGM SRVPGM(SRV_BASE36) EXPORT(*ALL) TEXT('BASE36 Service Pgm')
|
|
// 3) ADDBNDDIRE BNDDIR(SRV_BASE36) OBJ((SRV_BASE36 *SRVPGM *DEFER))
|
|
|
|
ctl-opt debug nomain option(*nodebugio: *srcstmt) ;
|
|
|
|
/include BASE36,BASE36_P
|
|
|
|
dcl-proc BASE36ADD export ;
|
|
dcl-pi BASE36ADD varchar(50);
|
|
PI_Value varchar(50) const; // Input value
|
|
end-pi BASE36ADD;
|
|
|
|
dcl-s wkValue like(PI_Value);
|
|
dcl-s inx int(10);
|
|
|
|
// Ascending values of a postion is A,B,...,Y,Z,0,1,2,...,7,8,9.
|
|
dcl-c From 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
|
|
dcl-c To 'BCDEFGHIJKLMNOPQRSTUVWXYZ0123456789A';
|
|
|
|
wkValue = PI_Value;
|
|
// Increment the last position in the input value. If it now is
|
|
// equal to the last character in "To" then it has rolled over,
|
|
// so move to the prior input value field and repeat.
|
|
inx = %len(PI_Value);
|
|
dow inx > 0;
|
|
%subst(wkValue:inx:1) = %xlate(From:To:%subst(wkValue:inx:1));
|
|
// if %subst(wkValue:inx:1) <> 'A'; // Not rolled over
|
|
if %subst(wkValue:inx:1) <> %subst(To:%size(To):1) ; // Not rolled over
|
|
leave;
|
|
endif;
|
|
inx -= 1;
|
|
enddo;
|
|
return wkValue; // return incremented value
|
|
end-proc BASE36ADD;
|