RDML Function OV@P934

LANSA

previous page next page
RDML Function OV@P934

* =======================================================;
* Process ........: SET_179;
* Function .......: OV@P934;
* Created on .....: 21/01/00 at 14:43:32;
* Created using template BBRDMLBIF;
* Description ....: Format the case of a string;
* Version.........: 1;
*;
* Full Description: The purpose of this function is to;
* Format the case of a string;
*;
* Disclaimer: The following material is supplied as;
* sample material only. No warranty concerning the;
* material or its use in any way whatsoever is;
* expressed or implied.;
*;
* Minimum LANSA release: 8.0;
*;
* =======================================================;
FUNCTION OPTIONS(*BUILTIN *DIRECT *LIGHTUSAGE);
* =======================================================;
* Special field to name the Built-In Function;
* =======================================================;
* Builtin Function specification;
DEFINE FIELD(#BIF_NAME) TYPE(*CHAR) LENGTH(020) DESC('Format Case of a string') DEFAULT(OV_FORMAT_CASE);
* A R G U M E N T S;
DEFINE FIELD(#BIF_ARG01) TYPE(*CHAR) LENGTH(256) DESC('Text string to be formatted');
* Function caters for a variety of return formats;
* LOWERCASE - All characters A - Z returned as lower case;
* e.g. - convert to lowercase;
* TITLE - All lower except the first letter of each;
* word;
* e.g. - Convert To Lowercase;
* SENTENCE - First letter of the sentence after .] or ?;
* e.g. - Convert to lowercase. Convert to uppercase;
DEFINE FIELD(#BIF_ARG02) TYPE(*CHAR) LENGTH(009) DESC('Format - LOWERCASE/TITLE/SENTENCE') DEFAULT(LOWERCASE);
* List of characters to force conversion to uppercase;
DEFINE FIELD(#BIF_ARG03) TYPE(*CHAR) LENGTH(020) DESC('Always convert to uppercase after') INPUT_ATR(LC) DEFAULT('');
* R E T U R N V A L U E S;
DEFINE FIELD(#BIF_RET01) TYPE(*CHAR) LENGTH(256) DESC('Formatted return value');
* Upper and lower case characters;
DEFINE FIELD(#S_LOWER) TYPE(*CHAR) LENGTH(026);
DEFINE FIELD(#S_UPPER) TYPE(*CHAR) LENGTH(026);
CHANGE FIELD(#S_UPPER) TO(ABCDEFGHIJKLMNOPQRSTUVWXYZ);
CHANGE FIELD(#S_LOWER) TO('''abcdefghijklmnopqrstuvwxyz''');
* Array indices;
DEFINE FIELD(#UL) REFFLD(#STD_IDNOS);
DEFINE FIELD(#IO) REFFLD(#STD_IDNOS);
DEFINE FIELD(#FR) REFFLD(#STD_IDNOS);
* Other fields;
DEFINE FIELD(#S_PREVCHR) REFFLD(#STD_CODES);
DEFINE FIELD(#S_SETTOUP) REFFLD(#STD_CODES);
* Array definitions;
* Upper case characters;
DEF_ARRAY NAME(#UPA) INDEXES(#UL) OVERLAYING(#S_UPPER) TYPE(*CHAR) TOT_ENTRY(0026) ENTRY_LEN(001);
* Lower case characters;
DEF_ARRAY NAME(#LOA) INDEXES(#UL) OVERLAYING(#S_LOWER) TYPE(*CHAR) TOT_ENTRY(0026) ENTRY_LEN(001);
* Input Field;
DEF_ARRAY NAME(#INP) INDEXES(#IO) OVERLAYING(#BIF_ARG01) TYPE(*CHAR) TOT_ENTRY(0256) ENTRY_LEN(001);
* List of characters to force conversion to uppercase;
DEF_ARRAY NAME(#FRC) INDEXES(#FR) OVERLAYING(#BIF_ARG03) TYPE(*CHAR) TOT_ENTRY(0020) ENTRY_LEN(001);
* Output field;
DEF_ARRAY NAME(#OUT) INDEXES(#IO) OVERLAYING(#BIF_RET01) TYPE(*CHAR) TOT_ENTRY(0256) ENTRY_LEN(001);
*;
DEF_COND NAME(*PREV_NULL) COND('#S_PREVCHR = *BLANKS');
DEF_COND NAME(*IS_UPPER) COND('#INP#IO = #UPA#UL');
DEF_COND NAME(*IS_LOWER) COND('#OUT#IO = #LOA#UL');
DEF_COND NAME(*SENTENCE) COND('#BIF_ARG02 = SENTENCE');
DEF_COND NAME(*END_SENT) COND('((#S_PREVCHR = ''?'') OR (#S_PREVCHR = ''.'') OR (#S_PREVCHR = '']'')) AND (#OUT#IO = *BLANKS)');
DEF_COND NAME(*SET_TO_UP) COND('#S_SETTOUP = Y');
*;
* BIF mainline code;
*;
*;
IF COND('*BIF_SHUTDOWN = Y');
RETURN;
ENDIF;
* Always convert to lower case;
EXECUTE SUBROUTINE(LOWERCASE);
CASE OF_FIELD(#BIF_ARG02);
* First character of each word to uppercase;
WHEN VALUE_IS('= TITLE');
EXECUTE SUBROUTINE(TITLE);
* First non blank character of sentence to uppercase;
WHEN VALUE_IS('= SENTENCE');
EXECUTE SUBROUTINE(SENTENCE);
ENDCASE;
* Force conversion after characters in list;
EXECUTE SUBROUTINE(FORCE_CONV);
*;
RETURN;
* =======================================================;
* Subroutine ....: LOWERCASE;
* Description....: Convert to lower case;
* =======================================================;
SUBROUTINE NAME(LOWERCASE);
* Loop through characters in the input string;
BEGIN_LOOP USING(#IO) TO(256);
* Assume existing value is okay. It will be overwritten;
* if found in A-Z or a-z;
CHANGE FIELD(#OUT#IO) TO(#INP#IO);
* Only convert if current character is not blank;
IF COND('#INP#IO *NE *BLANKS');
* Find character in upper case array;
BEGIN_LOOP USING(#UL) TO(26);
* Change to lower case character in output field;
IF COND(*IS_UPPER);
CHANGE FIELD(#OUT#IO) TO(#LOA#UL);
LEAVE;
ENDIF;
END_LOOP;
ENDIF;
END_LOOP;
ENDROUTINE;
* =======================================================;
* Subroutine ....: TITLE;
* Description....: Convert to title case;
* =======================================================;
SUBROUTINE NAME(TITLE);
CHANGE FIELD(#S_PREVCHR) TO(*BLANKS);
BEGIN_LOOP USING(#IO) TO(256);
* If previous character was blank;
IF COND(*PREV_NULL);
* Find character in lower case and translate;
EXECUTE SUBROUTINE(SET_LOWER);
ENDIF;
* Store previous character;
CHANGE FIELD(#S_PREVCHR) TO(#INP#IO);
END_LOOP;
ENDROUTINE;
* =======================================================;
* Subroutine ....: SENTENCE;
* Description....: Convert to sentence case;
* =======================================================;
SUBROUTINE NAME(SENTENCE);
CHANGE FIELD(#S_PREVCHR) TO(*BLANKS);
* Force first character to be set to upper case;
CHANGE FIELD(#S_SETTOUP) TO(Y);
*;
BEGIN_LOOP USING(#IO) TO(256);
* If end of sentence;
IF COND(*END_SENT);
CHANGE FIELD(#S_SETTOUP) TO(Y);
ENDIF;
* If previous character was blank and force set to upper;
IF COND('*PREV_NULL AND *SET_TO_UP');
CONTINUE IF('#OUT#IO = *BLANKS');
CHANGE FIELD(#S_SETTOUP) TO(*BLANKS);
* Find character in lower case and translate;
EXECUTE SUBROUTINE(SET_LOWER);
ENDIF;
* Store previous character;
CHANGE FIELD(#S_PREVCHR) TO(#INP#IO);
END_LOOP;
ENDROUTINE;
* =======================================================;
* Subroutine ....: FORCE_CONV;
* Description....: Force conversion to upper after;
* =======================================================;
SUBROUTINE NAME(FORCE_CONV);
BEGIN_LOOP USING(#IO) TO(256);
* Ignore if blank;
IF COND('#OUT#IO = *BLANKS');
CHANGE FIELD(#S_SETTOUP) TO(*BLANKS);
CONTINUE;
ENDIF;
* Set to upper;
IF COND(*SET_TO_UP);
EXECUTE SUBROUTINE(SET_LOWER);
CHANGE FIELD(#S_SETTOUP) TO(*BLANKS);
ENDIF;
*;
BEGIN_LOOP USING(#FR) TO(20);
* Ignore if blank character in force string;
CONTINUE IF('#FRC#FR *EQ *BLANKS');
* If current character is found in force list, set flag;
* for next character to be set to upper case;
IF COND('#FRC#FR = #INP#IO');
CHANGE FIELD(#S_SETTOUP) TO(Y);
LEAVE;
ENDIF;
END_LOOP;
END_LOOP;
ENDROUTINE;
* =======================================================;
* Subroutine ....: SET_LOWER;
* Description....: Convert to lower case;
* =======================================================;
SUBROUTINE NAME(SET_LOWER);
BEGIN_LOOP USING(#UL) TO(26);
IF COND(*IS_LOWER);
CHANGE FIELD(#OUT#IO) TO(#UPA#UL);
LEAVE;
ENDIF;
END_LOOP;
ENDROUTINE
previous page start next page