**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;