Function OV@P936 OV_INCREMENT_DATE
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_166);
********** COMMENT(Function .......: OV@P936);
********** COMMENT(Created on .....: 21/01/00 at 14:43:32);
********** COMMENT(Created using template BBRDMLBIF);
********** COMMENT(Description ....: Increment a date by a month or a year);
********** COMMENT(Version.........: 1);
**********;
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(increment a date by a month or a year);
**********;
********** 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('Increment a date by months or years ') DEFAULT(OV_INCREMENT_DATE);
********** COMMENT(=======================================================);
********** COMMENT(Built-In Function Arguments);
********** COMMENT(=======================================================);
********** COMMENT(Argument 01, Date to be incremented);
DEFINE FIELD(#BIF_ARG01) TYPE(*DEC) LENGTH(8) DECIMALS(0) DESC('Date to be incremented');
********** COMMENT(Argument 02, Format of date to be incremented);
DEFINE FIELD(#BIF_ARG02) TYPE(*CHAR) LENGTH(20) DESC('Format of date to be incremented');
********** COMMENT(Argument 03, Format of output date);
DEFINE FIELD(#BIF_ARG03) TYPE(*CHAR) LENGTH(20) DESC('Format of output date');
********** COMMENT(Argument 04, Number of months or years to increment);
DEFINE FIELD(#BIF_ARG04) TYPE(*DEC) LENGTH(12) DECIMALS(0) DESC('Number of months or years to increment');
********** COMMENT(Argument 05, MONTH or YEAR);
DEFINE FIELD(#BIF_ARG05) TYPE(*CHAR) LENGTH(5) DESC('MONTH or YEAR');
********** COMMENT(=======================================================);
********** COMMENT(Built-In Function Return Values);
********** COMMENT(=======================================================);
********** COMMENT(Return Value 01, Returned Date);
DEFINE FIELD(#BIF_RET01) TYPE(*DEC) LENGTH(8) DECIMALS(0) DESC('Returned Date');
********** 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_166FFM1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#S_166TFM1) 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');
DEFINE FIELD(#S_MONTHS) REFFLD(#BIF_ARG04);
********** COMMENT(=======================================================);
********** COMMENT(Function Mainline : SET166U);
********** COMMENT(=======================================================);
********** COMMENT(This is an evaluation call);
********** COMMENT( );
IF COND('*BIF_SHUTDOWN *NE Y');
********** COMMENT(Work Fields);
CHANGE FIELD(#BIF_RET02) TO(OK);
EXECUTE SUBROUTINE(TRANSLATE) WITH_PARMS(#BIF_ARG02 #S_166FFM1);
EXECUTE SUBROUTINE(TRANSLATE) WITH_PARMS(#BIF_ARG03 #S_166TFM1);
IF COND('#S_166FFM1 *ne J');
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#BIF_ARG01 #S_166FFM1 J) TO_GET(#BIF_ARG01);
ENDIF;
********** COMMENT(break down the from-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');
CASE OF_FIELD(#BIF_ARG05);
WHEN VALUE_IS('= MONTH');
********** COMMENT(handle large numbers of months);
********** COMMENT(88 or more months overflows two digits);
********** COMMENT(handle negative months);
CHANGE FIELD(#S_MONTHS) TO('#BIF_ARG04 + #S_MM');
DOWHILE COND('(#S_MONTHS *GT 12) *OR (#S_MONTHS *LE 0)');
CASE OF_FIELD(#S_MONTHS);
WHEN VALUE_IS('> 12');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY + 1');
CHANGE FIELD(#S_MONTHS) TO('#S_MONTHS - 12');
WHEN VALUE_IS('*LE 0');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY - 1');
CHANGE FIELD(#S_MONTHS) TO('#S_MONTHS + 12');
ENDCASE;
ENDWHILE;
CHANGE FIELD(#S_MM) TO(#S_MONTHS);
WHEN VALUE_IS('= YEAR');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY + #BIF_ARG04');
OTHERWISE;
CHANGE FIELD(#BIF_RET02) TO(ER);
ENDCASE;
********** COMMENT(Adjust the day if beyond the last day of the month);
CASE OF_FIELD(#S_MM);
WHEN VALUE_IS('= 1' '= 3' '= 5' '= 7' '= 8' '= 10' '= 12');
IF COND('#S_DD *GT 31');
CHANGE FIELD(#S_DD) TO(31);
ENDIF;
WHEN VALUE_IS('= 4' '= 6' '= 9' '= 11');
IF COND('#S_DD *GT 30');
CHANGE FIELD(#S_DD) TO(30);
ENDIF;
WHEN VALUE_IS('= 2');
IF COND('#S_DD *GT 28');
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;
ENDIF;
ENDCASE;
IF COND('#BIF_RET02 *EQ OK');
CHANGE FIELD(#BIF_RET01) TO('(#S_YYYY * 10000) + (#S_MM * 100) + #S_DD');
IF COND('#S_166TFM1 *ne J');
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#BIF_RET01 J #S_166TFM1) 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;
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_166);
********** COMMENT(Function .......: OV@P936);
********** COMMENT(Created on .....: 21/01/00 at 14:43:32);
********** COMMENT(Created using template BBRDMLBIF);
********** COMMENT(Description ....: Increment a date by a month or a year);
********** COMMENT(Version.........: 1);
**********;
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(increment a date by a month or a year);
**********;
********** 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('Increment a date by months or years ') DEFAULT(OV_INCREMENT_DATE);
********** COMMENT(=======================================================);
********** COMMENT(Built-In Function Arguments);
********** COMMENT(=======================================================);
********** COMMENT(Argument 01, Date to be incremented);
DEFINE FIELD(#BIF_ARG01) TYPE(*DEC) LENGTH(8) DECIMALS(0) DESC('Date to be incremented');
********** COMMENT(Argument 02, Format of date to be incremented);
DEFINE FIELD(#BIF_ARG02) TYPE(*CHAR) LENGTH(20) DESC('Format of date to be incremented');
********** COMMENT(Argument 03, Format of output date);
DEFINE FIELD(#BIF_ARG03) TYPE(*CHAR) LENGTH(20) DESC('Format of output date');
********** COMMENT(Argument 04, Number of months or years to increment);
DEFINE FIELD(#BIF_ARG04) TYPE(*DEC) LENGTH(12) DECIMALS(0) DESC('Number of months or years to increment');
********** COMMENT(Argument 05, MONTH or YEAR);
DEFINE FIELD(#BIF_ARG05) TYPE(*CHAR) LENGTH(5) DESC('MONTH or YEAR');
********** COMMENT(=======================================================);
********** COMMENT(Built-In Function Return Values);
********** COMMENT(=======================================================);
********** COMMENT(Return Value 01, Returned Date);
DEFINE FIELD(#BIF_RET01) TYPE(*DEC) LENGTH(8) DECIMALS(0) DESC('Returned Date');
********** 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_166FFM1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#S_166TFM1) 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');
DEFINE FIELD(#S_MONTHS) REFFLD(#BIF_ARG04);
********** COMMENT(=======================================================);
********** COMMENT(Function Mainline : SET166U);
********** COMMENT(=======================================================);
********** COMMENT(This is an evaluation call);
********** COMMENT( );
IF COND('*BIF_SHUTDOWN *NE Y');
********** COMMENT(Work Fields);
CHANGE FIELD(#BIF_RET02) TO(OK);
EXECUTE SUBROUTINE(TRANSLATE) WITH_PARMS(#BIF_ARG02 #S_166FFM1);
EXECUTE SUBROUTINE(TRANSLATE) WITH_PARMS(#BIF_ARG03 #S_166TFM1);
IF COND('#S_166FFM1 *ne J');
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#BIF_ARG01 #S_166FFM1 J) TO_GET(#BIF_ARG01);
ENDIF;
********** COMMENT(break down the from-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');
CASE OF_FIELD(#BIF_ARG05);
WHEN VALUE_IS('= MONTH');
********** COMMENT(handle large numbers of months);
********** COMMENT(88 or more months overflows two digits);
********** COMMENT(handle negative months);
CHANGE FIELD(#S_MONTHS) TO('#BIF_ARG04 + #S_MM');
DOWHILE COND('(#S_MONTHS *GT 12) *OR (#S_MONTHS *LE 0)');
CASE OF_FIELD(#S_MONTHS);
WHEN VALUE_IS('> 12');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY + 1');
CHANGE FIELD(#S_MONTHS) TO('#S_MONTHS - 12');
WHEN VALUE_IS('*LE 0');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY - 1');
CHANGE FIELD(#S_MONTHS) TO('#S_MONTHS + 12');
ENDCASE;
ENDWHILE;
CHANGE FIELD(#S_MM) TO(#S_MONTHS);
WHEN VALUE_IS('= YEAR');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY + #BIF_ARG04');
OTHERWISE;
CHANGE FIELD(#BIF_RET02) TO(ER);
ENDCASE;
********** COMMENT(Adjust the day if beyond the last day of the month);
CASE OF_FIELD(#S_MM);
WHEN VALUE_IS('= 1' '= 3' '= 5' '= 7' '= 8' '= 10' '= 12');
IF COND('#S_DD *GT 31');
CHANGE FIELD(#S_DD) TO(31);
ENDIF;
WHEN VALUE_IS('= 4' '= 6' '= 9' '= 11');
IF COND('#S_DD *GT 30');
CHANGE FIELD(#S_DD) TO(30);
ENDIF;
WHEN VALUE_IS('= 2');
IF COND('#S_DD *GT 28');
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;
ENDIF;
ENDCASE;
IF COND('#BIF_RET02 *EQ OK');
CHANGE FIELD(#BIF_RET01) TO('(#S_YYYY * 10000) + (#S_MM * 100) + #S_DD');
IF COND('#S_166TFM1 *ne J');
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#BIF_RET01 J #S_166TFM1) 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;