|
midrange.com
This is a multi-part message in MIME format.
--
[ Picked text/plain from multipart/alternative ]
The following uses an algorithym found on the internet to calculate the next
Day to change the hour and creates a job to run that day (calling itself)
through the scheduler. The Data required to calculate the next run is stored
in a data area.
100 PGM
04/02/01
200 DCL VAR(&YEAR) TYPE(*CHAR) LEN(4) VALUE('2000')
04/03/01
300 DCL VAR(&YDEC) TYPE(*DEC) LEN(4 0) VALUE(2000)
04/03/01
400 DCL VAR(&REM) TYPE(*DEC) LEN(6 2)
04/02/01
500 DCL VAR(&LEAP) TYPE(*CHAR) LEN(6)
04/02/01
600 DCL VAR(&DATC) TYPE(*CHAR) LEN(7)
04/02/01
700 DCL VAR(&SDATE) TYPE(*CHAR) LEN(8)
04/02/01
800 DCL VAR(&FDATE) TYPE(*CHAR) LEN(8)
04/02/01
900 DCL VAR(&LAST) TYPE(*CHAR) LEN(1)
04/02/01
1000 DCL VAR(&DATDEC) TYPE(*DEC) LEN(7 0)
04/02/01
1100 DCL VAR(&DAYS) TYPE(*DEC) LEN(1 0) VALUE(1)
04/03/01
1200 DCL VAR(&TIME) TYPE(*CHAR) LEN(2)
04/03/01
1300 DCL VAR(&TIMDEC) TYPE(*DEC) LEN(2 0)
04/03/01
1400 DCL VAR(&YR2) TYPE(*CHAR) LEN(2)
04/03/01
1500
04/02/01
1600 RTVDTAARA DTAARA(DATSAV (1 8)) RTNVAR(&SDATE)
04/02/01
1700 RTVDTAARA DTAARA(DATSAV (9 8)) RTNVAR(&FDATE)
04/02/01
1800 RTVDTAARA DTAARA(DATSAV (17 1)) RTNVAR(&LAST)
04/02/01
1900 RTVSYSVAL SYSVAL(QYEAR) RTNVAR(&YR2)
04/03/01
2000 CHGVAR VAR(%SST(&YEAR 3 2)) VALUE(&YR2)
04/03/01
2100 CHGVAR VAR(&YDEC) VALUE(&YEAR)
04/02/01
2200 IF COND(&LAST *EQ 'S') THEN(DO)
04/03/01
2300 CHGVAR VAR(&YDEC) VALUE(&YDEC + 1)
04/03/01
2400 CHGVAR VAR(&YEAR) VALUE(&YDEC)
04/03/01
2500 CHGVAR VAR(&YR2) VALUE(%SST(&YEAR 3 2))
04/03/01
2600 ENDDO
04/03/01
2700
04/02/01
2800 CHGVAR VAR(&REM) VALUE(&YDEC / 4)
04/02/01
2900 CHGVAR VAR(&LEAP) VALUE(&REM)
04/02/01
3000 IF COND(%SST(&LEAP 5 2) *EQ '00') THEN(CHGVAR +
04/03/01
3100 VAR(&DAYS) VALUE(2))
04/03/01
3200 IF COND(&LAST *EQ 'S') THEN(GOTO CMDLBL(FALL))
04/02/01
3300 IF COND(&LAST *EQ 'F') THEN(GOTO CMDLBL(SPRING))
04/02/01
3400
04/02/01
3500 SPRING: RTVSYSVAL SYSVAL(QHOUR) RTNVAR(&TIME)
04/02/01
3600 CHGVAR VAR(&TIMDEC) VALUE(&TIME)
04/02/01
3700 CHGVAR VAR(&TIMDEC) VALUE(&TIMDEC + 1)
04/02/01
3800 CHGVAR VAR(&TIME) VALUE(&TIMDEC)
04/03/01
3900 CHGSYSVAL SYSVAL(QHOUR) VALUE(&TIME)
04/02/01
4000
04/02/01
4100 IF COND(%SST(&FDATE 1 4) *EQ '1025') +
04/02/01
4200 THEN(CHGVAR VAR(%SST(&FDATE 1 4)) +
04/02/01
4300 VALUE('1032'))
04/03/01
4400 IF COND((&DAYS Ð2) *AND (%SST(&FDATE 1 4) *EQ +
04/02/01
4500 '1026')) THEN(CHGVAR VAR(%SST(&FDATE 1 +
04/02/01
4600 4)) VALUE('1033'))
04/03/01
4700
04/02/01
4800 CHGVAR VAR(&DATDEC) VALUE(%SST(&FDATE 3 2))
04/03/01
4900 CHGVAR VAR(&DATDEC) VALUE(&DATDEC - &DAYS)
04/02/01
5000 CHGVAR VAR(%SST(&FDATE 3 2)) VALUE(&DATDEC)
04/03/01
5100 CHGVAR VAR(%SST(&FDATE 5 4)) VALUE(&YEAR)
04/03/01
5150 /* Recalls Itself here
04/03/01
5200 ADDJOBSCDE JOB(DATSAV) CMD(CALL PGM(KOGAPP/DATSAV)) +
10/29/01
5300 FRQ(*ONCE) SCDDATE(&FDATE) SCDTIME('02:01')
10/29/01
5400 CHGVAR VAR(&LAST) VALUE('S')
04/03/01
5500 GOTO CMDLBL(END)
04/02/01
5600
04/02/01
5700 FALL: RTVSYSVAL SYSVAL(QHOUR) RTNVAR(&TIME)
04/02/01
5800 CHGVAR VAR(&TIMDEC) VALUE(&TIME)
04/02/01
5900 CHGVAR VAR(&TIMDEC) VALUE(&TIMDEC - 1)
04/02/01
6000 CHGVAR VAR(&TIME) VALUE(&TIMDEC)
04/03/01
6100 CHGSYSVAL SYSVAL(QHOUR) VALUE(&TIME)
04/02/01
6200
04/02/01
6300 IF COND(%SST(&SDATE 1 4) *EQ '0401') +
04/02/01
6400 THEN(CHGVAR VAR(%SST(&SDATE 1 4)) +
04/02/01
6500 VALUE('0408'))
04/02/01
6600 IF COND((&DAYS Ð2) *AND (%SST(&SDATE 1 4) *EQ +
04/02/01
6700 '0402')) THEN(CHGVAR VAR(%SST(&SDATE 1 +
04/02/01
6800 4)) VALUE('0409'))
04/02/01
6900
04/03/01
7000 CHGVAR VAR(&DATDEC) VALUE(%SST(&SDATE 3 2))
04/03/01
7100 CHGVAR VAR(&DATDEC) VALUE(&DATDEC - &DAYS)
04/03/01
7200 CHGVAR VAR(%SST(&SDATE 3 2)) VALUE(&DATDEC)
04/03/01
7300 CHGVAR VAR(%SST(&SDATE 5 4)) VALUE(&YEAR)
04/03/01
7350 /* Recalls Itself here
04/03/01
7400 ADDJOBSCDE JOB(DATSAV) CMD(CALL PGM(KOGAPP/DATSAV)) +
10/29/01
7500 FRQ(*ONCE) SCDDATE(&SDATE) SCDTIME('02:01')
10/29/01
7600 CHGVAR VAR(&LAST) VALUE('F')
04/03/01
7700 GOTO CMDLBL(END)
04/02/01
7800
04/02/01
7900 END: CHGDTAARA DTAARA(KOGAPP/DATSAV (1 20)) VALUE(&SDATE +
04/03/01
8000 *CAT &FDATE *CAT &LAST)
04/03/01
8100 ENDPGM
04/03/01
--
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.
