Function OV@P935 OV_MONTH_LASTDAY

LANSA

previous page next page
Function OV@P935 OV_MONTH_LASTDAY

********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_167);
********** COMMENT(Function .......: OV@P935);
********** COMMENT(Created on .....: 21/01/00 at 14:43:32);
********** COMMENT(Created using template BBRDMLBIF);
********** COMMENT(Description ....: Date of the last day of the month);
********** COMMENT(Version.........: 1);
**********;
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(get the date of last day of the month for a given date);
**********;
********** COMMENT(Disclaimer: The following material is supplied as);
********** COMMENT(sample material only. No warranty concerning the);
********** COMMENT(material or its use in any way whatsoever is);
********** COMMENT(expressed or implied.);
**********;
********** COMMENT(Minimum LANSA release: 8.0);
**********;
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*DIRECT *NOMESSAGES *HEAVYUSAGE *MLOPTIMISE *BUILTIN);
********** COMMENT(=======================================================);
********** COMMENT(Special field to name the Built-In Function);
********** COMMENT(=======================================================);
DEFINE FIELD(#BIF_NAME) TYPE(*CHAR) LENGTH(20) DESC('Date of the last day of the month') DEFAULT(OV_MONTH_LASTDAY);
********** COMMENT(=======================================================);
********** COMMENT(Built-In Function Arguments);
********** COMMENT(=======================================================);
********** COMMENT(Argument 01, Input Date);
DEFINE FIELD(#BIF_ARG01) TYPE(*DEC) LENGTH(8) DECIMALS(0) DESC('Input Date');
********** COMMENT(Argument 02, Format of input date);
DEFINE FIELD(#BIF_ARG02) TYPE(*CHAR) LENGTH(20) DESC('Format of input date');
********** COMMENT(Argument 03, Format for last day date);
DEFINE FIELD(#BIF_ARG03) TYPE(*CHAR) LENGTH(20) DESC('Format for last day date');
********** COMMENT(=======================================================);
********** COMMENT(Built-In Function Return Values);
********** COMMENT(=======================================================);
********** COMMENT(Return Value 01, Date of the last day of the month);
DEFINE FIELD(#BIF_RET01) TYPE(*DEC) LENGTH(8) DECIMALS(0) DESC('Date of the last day of the month');
********** COMMENT(Return Value 02, Return Code (OK or ER));
DEFINE FIELD(#BIF_RET02) TYPE(*CHAR) LENGTH(2) DESC('Return Code (OK or ER)') DEFAULT(*BLANK);
********** COMMENT(=======================================================);
********** COMMENT(Working fields, lists and groups);
********** COMMENT(=======================================================);
DEFINE FIELD(#S_167FFM1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#S_167TFM1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#S_FORMAT) TYPE(*CHAR) LENGTH(20);
DEFINE FIELD(#S_FMT) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#S_DD) TYPE(*DEC) LENGTH(2) DECIMALS(0);
DEFINE FIELD(#S_MM) TYPE(*DEC) LENGTH(2) DECIMALS(0);
DEFINE FIELD(#S_LEAP) TYPE(*CHAR) LENGTH(1) DESC('Leap year Y/N');
********** COMMENT(=======================================================);
********** COMMENT(Function Mainline : SET167U);
********** COMMENT(=======================================================);
********** COMMENT(This is an evaluation call);
********** COMMENT( );
IF COND('*BIF_SHUTDOWN *NE Y');
**********;
CHANGE FIELD(#BIF_RET02) TO(OK);
EXECUTE SUBROUTINE(TRANSLATE) WITH_PARMS(#BIF_ARG02 #S_167FFM1);
EXECUTE SUBROUTINE(TRANSLATE) WITH_PARMS(#BIF_ARG03 #S_167TFM1);
IF COND('#S_167FFM1 *ne J');
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#BIF_ARG01 #S_167FFM1 J) TO_GET(#BIF_ARG01);
ENDIF;
********** COMMENT(break down the date into its components);
CHANGE FIELD(#S_DD) TO(#BIF_ARG01);
CHANGE FIELD(#S_MM) TO('#BIF_ARG01 / 100');
CHANGE FIELD(#S_YYYY) TO('#BIF_ARG01 / 10000');
********** COMMENT(Adjust the day to the last day of the month);
CASE OF_FIELD(#S_MM);
WHEN VALUE_IS('= 1' '= 3' '= 5' '= 7' '= 8' '= 10' '= 12');
CHANGE FIELD(#S_DD) TO(31);
WHEN VALUE_IS('= 4' '= 6' '= 9' '= 11');
CHANGE FIELD(#S_DD) TO(30);
WHEN VALUE_IS('= 2');
EXECUTE SUBROUTINE(LEAP) WITH_PARMS(#S_YYYY #S_LEAP);
IF COND('#S_LEAP *EQ Y');
CHANGE FIELD(#S_DD) TO(29);
ELSE;
CHANGE FIELD(#S_DD) TO(28);
ENDIF;
ENDCASE;
IF COND('#BIF_RET02 *EQ OK');
CHANGE FIELD(#BIF_RET01) TO('(#S_YYYY * 10000) + (#S_MM * 100) + #S_DD');
IF COND('#S_167TFM1 *ne J');
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#BIF_RET01 J #S_167TFM1) TO_GET(#BIF_RET01);
ENDIF;
ELSE;
CHANGE FIELD(#BIF_RET01) TO(0);
ENDIF;
ELSE;
RETURN;
ENDIF;
********** COMMENT(Return control to the invoker);
RETURN;
SUBROUTINE NAME(TRANSLATE) PARMS((#S_FORMAT *RECEIVED) (#S_FMT *RETURNED));
CASE OF_FIELD(#S_FORMAT);
WHEN VALUE_IS('= SYSTEM' '= SYSFMT' '= A');
CHANGE FIELD(#S_FMT) TO(A);
WHEN VALUE_IS('= DDMMYY' '= B');
CHANGE FIELD(#S_FMT) TO(B);
WHEN VALUE_IS('= YYMMDD' '= D');
CHANGE FIELD(#S_FMT) TO(D);
WHEN VALUE_IS('= MMDDYY' '= F');
CHANGE FIELD(#S_FMT) TO(F);
WHEN VALUE_IS('= DDMMYYYY' '= H');
CHANGE FIELD(#S_FMT) TO(H);
WHEN VALUE_IS('= YYYYMMDD' '= J');
CHANGE FIELD(#S_FMT) TO(J);
WHEN VALUE_IS('= MMDDYYYY' '= L');
CHANGE FIELD(#S_FMT) TO(L);
WHEN VALUE_IS('= SYSTEM8' '= SYSFMT8' '= V');
CHANGE FIELD(#S_FMT) TO(V);
WHEN VALUE_IS('= YYMM' '= W');
CHANGE FIELD(#S_FMT) TO(W);
WHEN VALUE_IS('= MMYY' '= X');
CHANGE FIELD(#S_FMT) TO(X);
WHEN VALUE_IS('= YYYYMM' '= Y');
CHANGE FIELD(#S_FMT) TO(Y);
WHEN VALUE_IS('= MMYYYY' '= Z');
CHANGE FIELD(#S_FMT) TO(Z);
OTHERWISE;
CHANGE FIELD(#BIF_RET02) TO(ER);
ENDCASE;
ENDROUTINE;
SUBROUTINE NAME(LEAP) PARMS((#S_YYYY *RECEIVED) (#S_LEAP *RETURNED));
DEFINE FIELD(#S_LEAPWRK) TYPE(*DEC) LENGTH(4) DECIMALS(4);
CHANGE FIELD(#S_LEAPWRK) TO('#S_YYYY / 4');
IF COND('#S_LEAPWRK *NE 0');
********** COMMENT(not divisible by 4 - is not a leap year (e.g. 1999 2001);
CHANGE FIELD(#S_LEAP) TO(N);
ELSE;
CHANGE FIELD(#S_LEAPWRK) TO('#S_YYYY / 100');
IF COND('#S_LEAPWRK *NE 0');
********** COMMENT(divisible by 4 but not divisible by 100 - is a leap);
********** COMMENT(year (e.g. 1996 2004));
CHANGE FIELD(#S_LEAP) TO(Y);
ELSE;
CHANGE FIELD(#S_LEAPWRK) TO('#S_YYYY / 400');
IF COND('#S_LEAPWRK *NE 0');
********** COMMENT(divisible by 100 but not divisible by 400 - is not a );
********** COMMENT(leap year (e.g. 1900, 2100));
CHANGE FIELD(#S_LEAP) TO(N);
ELSE;
********** COMMENT(divisible by 400 - is a leap year (e.g. 2000));
CHANGE FIELD(#S_LEAP) TO(Y);
ENDIF;
ENDIF;
ENDIF;
ENDROUTINE;
previous page start next page