|
Here is the way I do it. This job runs every Sunday morning at 2 AM.
/* ADJUST FOR DAYLIGHT SAVINGS TIME IF NEEDED */
/* NOTE: THIS JOB RUNS AS A SCHEDULED JOB EVERY SUNDAY AT 2 AM */
PGM
DCL VAR(&MONTH) TYPE(*CHAR) LEN(2)
DCL VAR(&QDAY) TYPE(*CHAR) LEN(2)
DCL VAR(&DAY) TYPE(*DEC) LEN(2 0)
DCL VAR(&QHOUR) TYPE(*CHAR) LEN(2)
DCL VAR(&HOUR) TYPE(*DEC) LEN(2 0)
DCL VAR(&DIRECTION) TYPE(*DEC) LEN(1)
DCL VAR(&DOW) TYPE(*CHAR) LEN(4)
DCL VAR(&DLSTADJ) TYPE(*CHAR) LEN(1)
RTVDTAARA DTAARA(DLSTADJ) RTNVAR(&DLSTADJ)
/* DAYLIGHT SAVINGS NOT VALID FOR THIS MACHINE */
IF COND(&DLSTADJ *EQ 'N') THEN(GOTO CMDLBL(END))
/* IF THIS IS NOT SUNDAY THEN THE AS/400 WAS DOWN ON SUNDAY */
/* TIME MAY HAVE BEEN SET MANUALLY. */
/* SEND MESSAGE TO SYSTEM OPERATOR TO CHECK THE TIME */
RTVSYSVAL SYSVAL(QDAYOFWEEK) RTNVAR(&DOW)
IF COND(&DOW *NE '*SUN') THEN(DO)
SNDPGMMSG MSG('The job to check for daylight savings +
adjustment did not run on Sunday. Verify +
the time is set correctly.') TOMSGQ(*SYSOPR)
GOTO CMDLBL(END)
ENDDO
RTVSYSVAL SYSVAL(QMONTH) RTNVAR(&MONTH)
RTVSYSVAL SYSVAL(QDAY) RTNVAR(&QDAY)
CHGVAR VAR(&DAY) VALUE(&QDAY)
/* SPRING FORWARD */
/* LOOK FOR THE FIRST SUNDAY IN APRIL */
IF COND(&MONTH *EQ '04') THEN(DO)
IF COND(&DAY *GT 7) THEN(GOTO CMDLBL(END))
/* BYPASS IF SPING ADJUSTMENT ALREADY DONE */
IF COND(&DLSTADJ *EQ 'S') THEN(GOTO CMDLBL(END))
/* ADJUST TIME */
CHGDTAARA DTAARA(DLSTADJ) VALUE('S')
CHGVAR VAR(&DIRECTION) VALUE(1)
GOTO CMDLBL(ADJUST)
ENDDO
/* FALL BACK */
/* LOOK FOR THE LAST SUNDAY IN OCTOBER */
IF COND(&MONTH *EQ '10') THEN(DO)
IF COND(&DAY *LT 25) THEN(GOTO CMDLBL(END))
/* BYPASS IF FALL ADJUSTMENT ALREADY DONE */
IF COND(&DLSTADJ *EQ 'F') THEN(GOTO CMDLBL(END))
CHGDTAARA DTAARA(DLSTADJ) VALUE('F')
CHGVAR VAR(&DIRECTION) VALUE(-1)
GOTO CMDLBL(ADJUST)
ENDDO
GOTO CMDLBL(END)
ADJUST:
RTVSYSVAL SYSVAL(QHOUR) RTNVAR(&QHOUR)
CHGVAR VAR(&HOUR) VALUE(&QHOUR)
CHGVAR VAR(&HOUR) VALUE(&HOUR + &DIRECTION)
CHGVAR VAR(&QHOUR) VALUE(&HOUR)
CHGSYSVAL SYSVAL(QHOUR) VALUE(&QHOUR)
SNDPGMMSG MSG('The time was adjusted for daylight +
savings.') TOMSGQ(*SYSOPR)
END:
ENDPGM
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.