Function SET169B - Calendar
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_169);
********** COMMENT(Function .......: SET169B);
********** COMMENT(Created on .....: 21/01/00 at 14:43:32);
********** COMMENT(Description ....: Calendar);
********** COMMENT(Version.........: 1);
**********;
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(pop up a calendar and allow the user to select a 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(=======================================================);
********** COMMENT(Function control options);
FUNCTION OPTIONS(*DIRECT);
**********;
********** COMMENT(Group and field definitions);
**********;
DEFINE FIELD(#S_LDAY) TYPE(*DEC) LENGTH(2) DECIMALS(0) DESC('the last day on the month');
DEFINE FIELD(#S_OFFSET) TYPE(*DEC) LENGTH(1) DECIMALS(0) DESC('Column in calendar');
DEFINE FIELD(#S_DOW) TYPE(*CHAR) LENGTH(3) DESC('Day of the week MON TUE etc');
DEFINE FIELD(#S_COL) TYPE(*DEC) LENGTH(3) DECIMALS(0) DESC('Column Number');
DEFINE FIELD(#S_ROW) TYPE(*DEC) LENGTH(3) DECIMALS(0) DESC('Row Number');
DEFINE FIELD(#S_YYYYMMC) TYPE(*CHAR) LENGTH(6) DESC('YYYYMM Date (character)');
DEF_LIST NAME(#S_LSTCAL) FIELDS(#S_DAY1 #S_DAY2 #S_DAY3 #S_DAY4 #S_DAY5 #S_DAY6 #S_DAY7) SEL_ENTRY(#LISTENTRY);
********** COMMENT(returned fields);
********** COMMENT(Mainline);
**********;
**********;
DEF_COND NAME(*AS400) COND('*CPUTYPE = AS400');
IF COND(*AS400);
ELSE;
MESSAGE MSGTXT('Double click on a date to select');
********** COMMENT(In order for the column of the cursor to be returned);
********** COMMENT(correctly, the day fields must be input capable.);
********** COMMENT(only applies to PC version);
SET_MODE TO(*ADD);
ENDIF;
EXECUTE SUBROUTINE(DSPMONTH) WITH_PARMS(#S_YYYY #S_MONTH #S_MTHNAM);
BEGIN_LOOP;
POP_UP FIELDS((#S_MONTH *L3 *P2 *INPUT) (#S_YYYY *L4 *P2 *INPUT) (#S_MTHNAM *L3 *P26 *OUTPUT *NOID)) IDENTIFY(*DESC) AT_LOC(5 22) WITH_SIZE(40 16) BROWSELIST(#S_LSTCAL) EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO) USER_KEYS((07 *MTXTDPV *NEXT *NONE)(08 *MTXTDNX)) CURSOR_LOC(#S_ROW #S_COL);
********** COMMENT(validate);
BEGINCHECK;
CHANGE FIELD(#YYYYMMDD) TO('(#S_YYYY * 10000) + (#S_MONTH * 100) + 1');
DATECHECK FIELD(#YYYYMMDD) IN_FORMAT(*YYYYMMDD) MSGTXT('Year or Month specified is invalid');
ENDCHECK;
********** COMMENT(get the date if a date has been selected);
********** COMMENT((field #LISTENTRY automatically returns );
********** COMMENT(the number of the browselist entry that the cursor was );
********** COMMENT(on));
EXECUTE SUBROUTINE(RETURNDATE) WITH_PARMS(#LISTENTRY #S_COL #S_DATE);
IF COND('#S_DATE *GT 0');
********** COMMENT(exchange this value back to the field that was prompted);
********** COMMENT( on);
USE BUILTIN(EXCHANGE_NUMERIC_VAR) WITH_ARGS(#PROMPT$FN #S_DATE);
RETURN;
ENDIF;
********** COMMENT(if user took the next month or last month options);
IF COND('#IO$KEY *EQ ''07''');
CHANGE FIELD(#S_MONTH) TO('#S_MONTH - 1');
ENDIF;
IF COND('#IO$KEY *EQ ''08''');
CHANGE FIELD(#S_MONTH) TO('#S_MONTH + 1');
ENDIF;
EXECUTE SUBROUTINE(DSPMONTH) WITH_PARMS(#S_YYYY #S_MONTH #S_MTHNAM);
END_LOOP;
**********;
********** COMMENT(Subroutine RETURNDATE - Return the date selected by the);
********** COMMENT( cursor);
**********;
SUBROUTINE NAME(RETURNDATE) PARMS((#LISTENTRY *RECEIVED) (#S_COL *RECEIVED) (#S_DATE *RETURNED));
**********;
CHANGE FIELD(#S_DATE) TO(*NULL);
IF COND('(#LISTENTRY *NE 0) *AND (#S_COL *GE 23) *AND (#S_COL *LE 49)');
GET_ENTRY NUMBER(#LISTENTRY) FROM_LIST(#S_LSTCAL);
CASE OF_FIELD(#S_COL);
WHEN VALUE_IS('*LE 26');
CHANGE FIELD(#S_DAY) TO(#S_DAY1);
WHEN VALUE_IS('*LE 30');
CHANGE FIELD(#S_DAY) TO(#S_DAY2);
WHEN VALUE_IS('*LE 34');
CHANGE FIELD(#S_DAY) TO(#S_DAY3);
WHEN VALUE_IS('*LE 38');
CHANGE FIELD(#S_DAY) TO(#S_DAY4);
WHEN VALUE_IS('*LE 42');
CHANGE FIELD(#S_DAY) TO(#S_DAY5);
WHEN VALUE_IS('*LE 46');
CHANGE FIELD(#S_DAY) TO(#S_DAY6);
WHEN VALUE_IS('*LE 49');
CHANGE FIELD(#S_DAY) TO(#S_DAY7);
ENDCASE;
IF COND('#S_DAY *NE 0');
CHANGE FIELD(#S_DATE) TO('(#S_YYYY * 10000) + (#S_MONTH * 100) + #S_DAY');
********** COMMENT(Convert date to system format);
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#S_DATE D A) TO_GET(#S_DATE);
ENDIF;
ENDIF;
ENDROUTINE;
**********;
********** COMMENT(Subroutine DSPMONTH - Build the calendar browselist);
**********;
SUBROUTINE NAME(DSPMONTH) PARMS((#S_YYYY *BOTH) (#S_MONTH *BOTH) (#S_MTHNAM *RETURNED));
********** COMMENT(handle month overflow);
CASE OF_FIELD(#S_MONTH);
WHEN VALUE_IS('*GT 12');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY + 1');
CHANGE FIELD(#S_MONTH) TO('#S_MONTH - 12');
WHEN VALUE_IS('*LT 1');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY - 1');
CHANGE FIELD(#S_MONTH) TO('#S_MONTH + 12');
ENDCASE;
********** COMMENT(get the date of the last day of the month);
CHANGE FIELD(#S_YYYYMM) TO('(#S_YYYY * 100) + #S_MONTH');
USE BUILTIN(OV_MONTH_LASTDAY) WITH_ARGS(#S_YYYYMM YYYYMM YYYYMMDD) TO_GET(#S_LDAY #S_RETCDA2);
********** COMMENT(get the day of the week of the first day of the month);
SUBSTRING FIELD(#S_YYYYMM) INTO_FIELD(#S_YYYYMMC);
USE BUILTIN(CONVERTDATE) WITH_ARGS(#S_YYYYMMC Y R) TO_GET(#S_DOW);
USE BUILTIN(CONVERTDATE) WITH_ARGS(#S_YYYYMMC Y U) TO_GET(#S_MTHNAM);
CASE OF_FIELD(#S_DOW);
WHEN VALUE_IS('= MON');
CHANGE FIELD(#S_OFFSET) TO(1);
WHEN VALUE_IS('= TUE');
CHANGE FIELD(#S_OFFSET) TO(2);
WHEN VALUE_IS('= WED');
CHANGE FIELD(#S_OFFSET) TO(3);
WHEN VALUE_IS('= THU');
CHANGE FIELD(#S_OFFSET) TO(4);
WHEN VALUE_IS('= FRI');
CHANGE FIELD(#S_OFFSET) TO(5);
WHEN VALUE_IS('= SAT');
CHANGE FIELD(#S_OFFSET) TO(6);
WHEN VALUE_IS('= SUN');
CHANGE FIELD(#S_OFFSET) TO(7);
ENDCASE;
**********;
********** COMMENT(initialise the list & field values);
**********;
CLR_LIST NAMED(#S_LSTCAL);
CHANGE FIELD(#S_LSTCAL) TO(*NULL);
**********;
********** COMMENT(load the dates into the days);
**********;
BEGIN_LOOP USING(#DAY) TO(#S_LDAY);
CASE OF_FIELD(#S_OFFSET);
WHEN VALUE_IS('= 1');
CHANGE FIELD(#S_DAY1) TO(#DAY);
WHEN VALUE_IS('= 2');
CHANGE FIELD(#S_DAY2) TO(#DAY);
WHEN VALUE_IS('= 3');
CHANGE FIELD(#S_DAY3) TO(#DAY);
WHEN VALUE_IS('= 4');
CHANGE FIELD(#S_DAY4) TO(#DAY);
WHEN VALUE_IS('= 5');
CHANGE FIELD(#S_DAY5) TO(#DAY);
WHEN VALUE_IS('= 6');
CHANGE FIELD(#S_DAY6) TO(#DAY);
WHEN VALUE_IS('= 7');
CHANGE FIELD(#S_DAY7) TO(#DAY);
ADD_ENTRY TO_LIST(#S_LSTCAL);
********** COMMENT(initialize for the next browselist entry);
CHANGE FIELD(#S_OFFSET) TO(*NULL);
CHANGE FIELD(#S_LSTCAL) TO(*NULL);
ENDCASE;
CHANGE FIELD(#S_OFFSET) TO('#S_OFFSET + 1');
END_LOOP;
********** COMMENT(add the last browselist entry if required);
IF COND('#S_OFFSET *NE 1');
ADD_ENTRY TO_LIST(#S_LSTCAL);
ENDIF;
ENDROUTINE;
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_169);
********** COMMENT(Function .......: SET169B);
********** COMMENT(Created on .....: 21/01/00 at 14:43:32);
********** COMMENT(Description ....: Calendar);
********** COMMENT(Version.........: 1);
**********;
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(pop up a calendar and allow the user to select a 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(=======================================================);
********** COMMENT(Function control options);
FUNCTION OPTIONS(*DIRECT);
**********;
********** COMMENT(Group and field definitions);
**********;
DEFINE FIELD(#S_LDAY) TYPE(*DEC) LENGTH(2) DECIMALS(0) DESC('the last day on the month');
DEFINE FIELD(#S_OFFSET) TYPE(*DEC) LENGTH(1) DECIMALS(0) DESC('Column in calendar');
DEFINE FIELD(#S_DOW) TYPE(*CHAR) LENGTH(3) DESC('Day of the week MON TUE etc');
DEFINE FIELD(#S_COL) TYPE(*DEC) LENGTH(3) DECIMALS(0) DESC('Column Number');
DEFINE FIELD(#S_ROW) TYPE(*DEC) LENGTH(3) DECIMALS(0) DESC('Row Number');
DEFINE FIELD(#S_YYYYMMC) TYPE(*CHAR) LENGTH(6) DESC('YYYYMM Date (character)');
DEF_LIST NAME(#S_LSTCAL) FIELDS(#S_DAY1 #S_DAY2 #S_DAY3 #S_DAY4 #S_DAY5 #S_DAY6 #S_DAY7) SEL_ENTRY(#LISTENTRY);
********** COMMENT(returned fields);
********** COMMENT(Mainline);
**********;
**********;
DEF_COND NAME(*AS400) COND('*CPUTYPE = AS400');
IF COND(*AS400);
ELSE;
MESSAGE MSGTXT('Double click on a date to select');
********** COMMENT(In order for the column of the cursor to be returned);
********** COMMENT(correctly, the day fields must be input capable.);
********** COMMENT(only applies to PC version);
SET_MODE TO(*ADD);
ENDIF;
EXECUTE SUBROUTINE(DSPMONTH) WITH_PARMS(#S_YYYY #S_MONTH #S_MTHNAM);
BEGIN_LOOP;
POP_UP FIELDS((#S_MONTH *L3 *P2 *INPUT) (#S_YYYY *L4 *P2 *INPUT) (#S_MTHNAM *L3 *P26 *OUTPUT *NOID)) IDENTIFY(*DESC) AT_LOC(5 22) WITH_SIZE(40 16) BROWSELIST(#S_LSTCAL) EXIT_KEY(*NO) MENU_KEY(*YES *RETURN) PROMPT_KEY(*NO) USER_KEYS((07 *MTXTDPV *NEXT *NONE)(08 *MTXTDNX)) CURSOR_LOC(#S_ROW #S_COL);
********** COMMENT(validate);
BEGINCHECK;
CHANGE FIELD(#YYYYMMDD) TO('(#S_YYYY * 10000) + (#S_MONTH * 100) + 1');
DATECHECK FIELD(#YYYYMMDD) IN_FORMAT(*YYYYMMDD) MSGTXT('Year or Month specified is invalid');
ENDCHECK;
********** COMMENT(get the date if a date has been selected);
********** COMMENT((field #LISTENTRY automatically returns );
********** COMMENT(the number of the browselist entry that the cursor was );
********** COMMENT(on));
EXECUTE SUBROUTINE(RETURNDATE) WITH_PARMS(#LISTENTRY #S_COL #S_DATE);
IF COND('#S_DATE *GT 0');
********** COMMENT(exchange this value back to the field that was prompted);
********** COMMENT( on);
USE BUILTIN(EXCHANGE_NUMERIC_VAR) WITH_ARGS(#PROMPT$FN #S_DATE);
RETURN;
ENDIF;
********** COMMENT(if user took the next month or last month options);
IF COND('#IO$KEY *EQ ''07''');
CHANGE FIELD(#S_MONTH) TO('#S_MONTH - 1');
ENDIF;
IF COND('#IO$KEY *EQ ''08''');
CHANGE FIELD(#S_MONTH) TO('#S_MONTH + 1');
ENDIF;
EXECUTE SUBROUTINE(DSPMONTH) WITH_PARMS(#S_YYYY #S_MONTH #S_MTHNAM);
END_LOOP;
**********;
********** COMMENT(Subroutine RETURNDATE - Return the date selected by the);
********** COMMENT( cursor);
**********;
SUBROUTINE NAME(RETURNDATE) PARMS((#LISTENTRY *RECEIVED) (#S_COL *RECEIVED) (#S_DATE *RETURNED));
**********;
CHANGE FIELD(#S_DATE) TO(*NULL);
IF COND('(#LISTENTRY *NE 0) *AND (#S_COL *GE 23) *AND (#S_COL *LE 49)');
GET_ENTRY NUMBER(#LISTENTRY) FROM_LIST(#S_LSTCAL);
CASE OF_FIELD(#S_COL);
WHEN VALUE_IS('*LE 26');
CHANGE FIELD(#S_DAY) TO(#S_DAY1);
WHEN VALUE_IS('*LE 30');
CHANGE FIELD(#S_DAY) TO(#S_DAY2);
WHEN VALUE_IS('*LE 34');
CHANGE FIELD(#S_DAY) TO(#S_DAY3);
WHEN VALUE_IS('*LE 38');
CHANGE FIELD(#S_DAY) TO(#S_DAY4);
WHEN VALUE_IS('*LE 42');
CHANGE FIELD(#S_DAY) TO(#S_DAY5);
WHEN VALUE_IS('*LE 46');
CHANGE FIELD(#S_DAY) TO(#S_DAY6);
WHEN VALUE_IS('*LE 49');
CHANGE FIELD(#S_DAY) TO(#S_DAY7);
ENDCASE;
IF COND('#S_DAY *NE 0');
CHANGE FIELD(#S_DATE) TO('(#S_YYYY * 10000) + (#S_MONTH * 100) + #S_DAY');
********** COMMENT(Convert date to system format);
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#S_DATE D A) TO_GET(#S_DATE);
ENDIF;
ENDIF;
ENDROUTINE;
**********;
********** COMMENT(Subroutine DSPMONTH - Build the calendar browselist);
**********;
SUBROUTINE NAME(DSPMONTH) PARMS((#S_YYYY *BOTH) (#S_MONTH *BOTH) (#S_MTHNAM *RETURNED));
********** COMMENT(handle month overflow);
CASE OF_FIELD(#S_MONTH);
WHEN VALUE_IS('*GT 12');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY + 1');
CHANGE FIELD(#S_MONTH) TO('#S_MONTH - 12');
WHEN VALUE_IS('*LT 1');
CHANGE FIELD(#S_YYYY) TO('#S_YYYY - 1');
CHANGE FIELD(#S_MONTH) TO('#S_MONTH + 12');
ENDCASE;
********** COMMENT(get the date of the last day of the month);
CHANGE FIELD(#S_YYYYMM) TO('(#S_YYYY * 100) + #S_MONTH');
USE BUILTIN(OV_MONTH_LASTDAY) WITH_ARGS(#S_YYYYMM YYYYMM YYYYMMDD) TO_GET(#S_LDAY #S_RETCDA2);
********** COMMENT(get the day of the week of the first day of the month);
SUBSTRING FIELD(#S_YYYYMM) INTO_FIELD(#S_YYYYMMC);
USE BUILTIN(CONVERTDATE) WITH_ARGS(#S_YYYYMMC Y R) TO_GET(#S_DOW);
USE BUILTIN(CONVERTDATE) WITH_ARGS(#S_YYYYMMC Y U) TO_GET(#S_MTHNAM);
CASE OF_FIELD(#S_DOW);
WHEN VALUE_IS('= MON');
CHANGE FIELD(#S_OFFSET) TO(1);
WHEN VALUE_IS('= TUE');
CHANGE FIELD(#S_OFFSET) TO(2);
WHEN VALUE_IS('= WED');
CHANGE FIELD(#S_OFFSET) TO(3);
WHEN VALUE_IS('= THU');
CHANGE FIELD(#S_OFFSET) TO(4);
WHEN VALUE_IS('= FRI');
CHANGE FIELD(#S_OFFSET) TO(5);
WHEN VALUE_IS('= SAT');
CHANGE FIELD(#S_OFFSET) TO(6);
WHEN VALUE_IS('= SUN');
CHANGE FIELD(#S_OFFSET) TO(7);
ENDCASE;
**********;
********** COMMENT(initialise the list & field values);
**********;
CLR_LIST NAMED(#S_LSTCAL);
CHANGE FIELD(#S_LSTCAL) TO(*NULL);
**********;
********** COMMENT(load the dates into the days);
**********;
BEGIN_LOOP USING(#DAY) TO(#S_LDAY);
CASE OF_FIELD(#S_OFFSET);
WHEN VALUE_IS('= 1');
CHANGE FIELD(#S_DAY1) TO(#DAY);
WHEN VALUE_IS('= 2');
CHANGE FIELD(#S_DAY2) TO(#DAY);
WHEN VALUE_IS('= 3');
CHANGE FIELD(#S_DAY3) TO(#DAY);
WHEN VALUE_IS('= 4');
CHANGE FIELD(#S_DAY4) TO(#DAY);
WHEN VALUE_IS('= 5');
CHANGE FIELD(#S_DAY5) TO(#DAY);
WHEN VALUE_IS('= 6');
CHANGE FIELD(#S_DAY6) TO(#DAY);
WHEN VALUE_IS('= 7');
CHANGE FIELD(#S_DAY7) TO(#DAY);
ADD_ENTRY TO_LIST(#S_LSTCAL);
********** COMMENT(initialize for the next browselist entry);
CHANGE FIELD(#S_OFFSET) TO(*NULL);
CHANGE FIELD(#S_LSTCAL) TO(*NULL);
ENDCASE;
CHANGE FIELD(#S_OFFSET) TO('#S_OFFSET + 1');
END_LOOP;
********** COMMENT(add the last browselist entry if required);
IF COND('#S_OFFSET *NE 1');
ADD_ENTRY TO_LIST(#S_LSTCAL);
ENDIF;
ENDROUTINE;