Function SET012A: Convert Number to Words

LANSA

previous page next page
Function SET012A: Convert Number to Words

********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_012);
********** COMMENT(Function .......:);
********** COMMENT(Created on .....: 21/01/00 at 14:43:32);
********** COMMENT(Description ....: Convert a number to words);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(convert a number to words.);
********** COMMENT(e.g. 103405 becomes one hundred and three thousand four);
********** COMMENT( hundred and five.);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as an);
********** COMMENT(example only. No warranty is expressed or implied.);
********** COMMENT();
********** COMMENT(=======================================================);
********** COMMENT(Function control options);
FUNCTION OPTIONS(*DIRECT);
********** COMMENT();
********** COMMENT(Group and field definitions);
********** COMMENT();
OVERRIDE FIELD(#STD_IDNOL) DESC('Number to be converted');
DEF_LIST NAME(#S_LSTTXT) FIELDS(#STD_TEXTL);
********** COMMENT(Mainline);
********** COMMENT();
********** COMMENT();
DEFINE FIELD(#S_DATFIL) TYPE(*CHAR) LENGTH(065);
DEFINE FIELD(#S_RETCDE) TYPE(*CHAR) LENGTH(002);
DEFINE FIELD(#S_COUNT) TYPE(*DEC) LENGTH(003) DECIMALS(0);
DEFINE FIELD(#S_NUMBER) TYPE(*DEC) LENGTH(012) DECIMALS(0);
DEFINE FIELD(#S_DIVISOR) TYPE(*DEC) LENGTH(012) DECIMALS(0);
DEFINE FIELD(#S_WORD) TYPE(*CHAR) LENGTH(256) INPUT_ATR(LC);
DEFINE FIELD(#S_ANDFLG) TYPE(*CHAR) LENGTH(001);
DEFINE FIELD(#S_TRIPLET) TYPE(*DEC) LENGTH(003) DECIMALS(0);
DEFINE FIELD(#S_HUNV) TYPE(*DEC) LENGTH(001) DECIMALS(0);
DEFINE FIELD(#S_TENV) TYPE(*DEC) LENGTH(001) DECIMALS(0);
DEFINE FIELD(#S_TENV2) TYPE(*DEC) LENGTH(002) DECIMALS(0);
DEFINE FIELD(#S_ONEV) TYPE(*DEC) LENGTH(001) DECIMALS(0);
DEFINE FIELD(#S_ONEV2) TYPE(*DEC) LENGTH(002) DECIMALS(0);
DEFINE FIELD(#S_TRPNAM) TYPE(*CHAR) LENGTH(100) INPUT_ATR(LC);
DEFINE FIELD(#S_NAM) TYPE(*CHAR) LENGTH(020) INPUT_ATR(LC);
********** COMMENT(triplet component words - in the example four hundred);
********** COMMENT(and fifty six thousand);
DEFINE FIELD(#S_NAM1) REFFLD(#S_NAM) LABEL('four');
DEFINE FIELD(#S_NAM2) REFFLD(#S_NAM) LABEL('hundred');
DEFINE FIELD(#S_NAM3) REFFLD(#S_NAM) LABEL('and');
DEFINE FIELD(#S_NAM4) REFFLD(#S_NAM) LABEL('fifty');
DEFINE FIELD(#S_NAM5) REFFLD(#S_NAM) LABEL('six');
DEFINE FIELD(#S_NAM6) REFFLD(#S_NAM) LABEL('thousand');
DEFINE FIELD(#S_LNUM) TYPE(*DEC) LENGTH(012) DECIMALS(0);
DEFINE FIELD(#S_LNAM) TYPE(*CHAR) LENGTH(020) INPUT_ATR(LC);
DEF_LIST NAME(#S_LSTNAME) FIELDS((#S_LNUM)(#S_LNAM)) TYPE(*WORKING);
********** COMMENT();
********** COMMENT(Load List);
********** COMMENT();
DEF_COND NAME(*AS400) COND('*CPUTYPE = AS400');
IF COND(*AS400);
CLR_LIST NAMED(#S_LSTNAME);
SELECT FIELDS((#S_DATNUM1)(#S_DATCHR1)) FROM_FILE(SETDATL1) WITH_KEY('S012A');
CHANGE FIELD(#S_LNUM) TO(#S_DATNUM1);
CHANGE FIELD(#S_LNAM) TO(#S_DATCHR1);
ADD_ENTRY TO_LIST(#S_LSTNAME);
ENDSELECT;
ELSE;
CHANGE FIELD(#S_DATFIL) TO(*PART_DIR_SOURCE);
USE BUILTIN(TCONCAT) WITH_ARGS(#S_DATFIL 'S_012NAM.DAT') TO_GET(#S_DATFIL);
USE BUILTIN(TRANSFORM_FILE) WITH_ARGS(#S_LSTNAME #S_DATFIL T) TO_GET(#S_RETCDE);
********** COMMENT();
ENDIF;
BEGIN_LOOP;
REQUEST FIELDS(#STD_IDNOL) DESIGN(*DOWN) IDENTIFY(*DESC) BROWSELIST(#S_LSTTXT);
CHANGE FIELD(#S_NUMBER) TO(#STD_IDNOL);
BEGINCHECK;
RANGECHECK FIELD(#STD_IDNOL) RANGE((1 999999999999)) MSGTXT('Value out of range');
ENDCHECK;
********** COMMENT();
CHANGE FIELD(#S_DIVISOR) TO(1);
CHANGE FIELD(#S_WORD) TO(*NULL);
CHANGE FIELD(#S_ANDFLG) TO(N);
BEGIN_LOOP TO(4);
CHANGE FIELD(#S_TRIPLET) TO('#S_NUMBER / #S_DIVISOR');
IF COND('#S_TRIPLET *NE 0');
CHANGE FIELD(#S_NAM1 #S_NAM2 #S_NAM3 #S_NAM4 #S_NAM5 #S_NAM6) TO(*NULL);
EXECUTE SUBROUTINE(TRIPLET) WITH_PARMS(#S_TRIPLET #S_TRPNAM);
IF COND('#S_DIVISOR *NE 1');
********** COMMENT(billion, million, thousand);
LOC_ENTRY IN_LIST(#S_LSTNAME) WHERE('#S_DIVISOR *EQ #S_LNUM');
CHANGE FIELD(#S_NAM6) TO(#S_LNAM);
IF COND('#S_ANDFLG *EQ Y');
********** COMMENT(100020 one hundred thousand AND twenty);
********** COMMENT(1000020 one million AND twenty);
********** COMMENT(1001020 one million one hundred thousand AND twenty);
USE BUILTIN(BCONCAT) WITH_ARGS(#S_NAM6 'and') TO_GET(#S_NAM6);
CHANGE FIELD(#S_ANDFLG) TO(N);
ENDIF;
ELSE;
IF COND('#S_TRIPLET *LT 100');
********** COMMENT(100020 one hundred thousand AND twenty);
********** COMMENT(1000020 one million AND twenty);
********** COMMENT(1001020 one million one hundred thousand AND twenty);
CHANGE FIELD(#S_ANDFLG) TO(Y);
ENDIF;
ENDIF;
USE BUILTIN(BCONCAT) WITH_ARGS(#S_TRPNAM #S_NAM6 #S_WORD) TO_GET(#S_WORD);
ENDIF;
CHANGE FIELD(#S_DIVISOR) TO('#S_DIVISOR * 1000');
END_LOOP;
********** COMMENT(Move the finished word into a list for display);
CLR_LIST NAMED(#S_LSTTXT);
BEGIN_LOOP USING(#S_COUNT) TO(226) STEP(0000075);
SUBSTRING FIELD(#S_WORD #S_COUNT) INTO_FIELD(#STD_TEXTL 1);
ADD_ENTRY TO_LIST(#S_LSTTXT);
END_LOOP;
END_LOOP;
SUBROUTINE NAME(TRIPLET) PARMS((#S_TRIPLET *RECEIVED) (#S_TRPNAM *RETURNED));
********** COMMENT(Split the triplet into its component digits);
CHANGE FIELD(#S_HUNV) TO('#S_TRIPLET / 100');
CHANGE FIELD(#S_TENV) TO('#S_TRIPLET / 10');
CHANGE FIELD(#S_TENV2) TO('#S_TENV * 10');
CHANGE FIELD(#S_ONEV) TO(#S_TRIPLET);
CHANGE FIELD(#S_ONEV2) TO(#S_TRIPLET);
********** COMMENT(Process the hundreds);
IF COND('#S_HUNV *GT 0');
********** COMMENT(four);
LOC_ENTRY IN_LIST(#S_LSTNAME) WHERE('#S_HUNV *EQ #S_LNUM');
CHANGE FIELD(#S_NAM1) TO(#S_LNAM);
********** COMMENT(hundred);
LOC_ENTRY IN_LIST(#S_LSTNAME) WHERE('100 *EQ #S_LNUM');
CHANGE FIELD(#S_NAM2) TO(#S_LNAM);
ENDIF;
********** COMMENT(Process the tens and ones);
IF COND('#S_TENV *GE 2');
********** COMMENT(fifty);
LOC_ENTRY IN_LIST(#S_LSTNAME) WHERE('#S_TENV2 *EQ #S_LNUM');
CHANGE FIELD(#S_NAM4) TO(#S_LNAM);
IF COND('#S_ONEV *NE 0');
********** COMMENT(six);
LOC_ENTRY IN_LIST(#S_LSTNAME) WHERE('#S_ONEV *EQ #S_LNUM');
CHANGE FIELD(#S_NAM5) TO(#S_LNAM);
ENDIF;
ELSE;
IF COND('#S_ONEV2 *NE 0');
********** COMMENT(seventeen);
LOC_ENTRY IN_LIST(#S_LSTNAME) WHERE('#S_ONEV2 *EQ #S_LNUM');
CHANGE FIELD(#S_NAM5) TO(#S_LNAM);
ENDIF;
ENDIF;
IF COND('(#S_NAM1 *NE *BLANKS) *AND ((#S_NAM4 *NE *BLANKS) *OR (#S_NAM5 *NE *BLANKS))');
********** COMMENT(101 - one hundred AND one,);
********** COMMENT(450 - four hundred AND fifty);
CHANGE FIELD(#S_NAM3) TO('''and''');
ENDIF;
USE BUILTIN(BCONCAT) WITH_ARGS(#S_NAM1 #S_NAM2 #S_NAM3 #S_NAM4 #S_NAM5) TO_GET(#S_TRPNAM);
ENDROUTINE;
previous page start next page