H/TITLE BEWEFE
H DEBUG DECEDIT('0,') DATEDIT(*ymd.) datfmt(*iso)
H OPTION(*NODEBUGIO:*SRCSTMT) ALWNULL(*USRCTL)
H COPYRIGHT('© kiitos GmbH 2014 ')
H DftActGrp(*NO)
H BNDDIR('QC2LE')
// Franz Vieracker, kiitos GmbH, Diese E-Mail-Adresse ist vor Spambots geschützt! Zur Anzeige muss JavaScript eingeschaltet sein!
// Das PGM kann mit einer Jahreszahl (Alpha) aufgerufen werden, fuer welches dann die Daten in die Datei Kalender geschrieben werden,
// nach vorheriger Löschung dieser Jahresdaten.
// Die Feiertage (beweglich & fix werden mit Hilfe der Daten aus der Datei Feiertag ergaenzt.
// Wird das PGM ohne Parameter aufgerufen, wird das aktuelle Jahr verwendet.
Dds_FT e ds extname(feiertag ) prefix(f)
Dds_KA e ds extname(kalender ) prefix(k)
d j s 4s 0
d k s 11s 0
d tmp s 11s 0
d m s 11s 0
d s s 11s 0
d a s 11s 0
d d s 11s 0
d r s 11s 0
d x s 11s 0
d og s 11s 0
d sz s 11s 0
d oe s 11s 0
d os s 2s 0
d KALDATE s d
d ENDDATE s d
d FDatum s d
d ds
d d_osA 8a
d d_osN 8s 0 overlay(d_osa:1)
d d_osd 2a overlay(d_osa:7)
d d_osdN 2s 0 overlay(d_osa:7)
d d_osm 2a overlay(d_osa:5)
d d_osmN 2s 0 overlay(d_osa:5)
d d_osj 4a overlay(d_osa:1)
dWK ds qualified
d j 4s 0
d m 2s 0
d d 2s 0
d wotag 10a
// Workfelder Individuell *
D nDayOfWeek S 10I 0
D nDays S 10I 0
// ------------------------------------------------------------------------
Ddayofweek PR 10i 0
D InputDate D
// ------------------------------------------------------------------------
Dweekday PR 10a
D WKDAY 10a
D InputDate d
//*************************************************************************
D BEWEFE PR
D jahr 4A OPTIONS(*NOPASS)
D BEWEFE PI
D jahr 4A OPTIONS(*NOPASS)
/Free
Exec Sql set option commit = *none, datfmt = *iso, timfmt = *iso ;
select;
when %parms = 1 and jahr <> '0000';
j = %dec(jahr:4:0);
other;
j = %subdt(%date(*date) : *years);
endsl;
// Ostersonntag berechnen mit Gaußscher Osterformel
// inkl Ergaenzung von Lichtenberg
k = j/100;
tmp = (3*k +3) /4;
m = 15 + tmp - (8*k +13)/25;
s = 2 - tmp;
a = %rem(j : 19);
d = %rem((19*a + m):30);
r = (d/29)+(d/28 - d/29) * (a / 11);
og = 21 + d - r;
x = (j + (j/4) + s);
sz = 7 - %rem(x:7);
oe = 7 - %rem((og - sz):7);
os = og + oe ;
if os > 31;
os = os - 31;
d_osM = '04';
else;
d_osM = '03';
ENDIF;
d_osJ = %editc(j:'C');
d_osd = %editc(os:'C');
Fdatum = %date(d_osn:*iso);
// DB Kalender fuellen
exec sql delete from kalender where jahr = :J;
D_OSJ = Jahr;
D_OSM = '01';
D_OSD = '01';
KALDATE = %date(d_osn:*iso);
D_OSM = '12';
D_OSD = '31';
ENDDATE = %date(d_osn:*iso);
dow kaldate <= enddate;
wk.j = %subdt(kaldate : *years);
wk.m = %subdt(kaldate : *months);
wk.d = %subdt(kaldate : *days);
exec sql select * into :ds_ft from feiertag
where monat = :wk.m and tag = :wk.d
fetch first row only
;
if sqlcode <> 0;
ftext = *blanks;
ftagart = *blanks;
fberart = *blanks;
endIf;
wk.wotag = *blanks;
kwotag = weekday(wk.wotag:kaldate);
exec sql insert into kalender
(Datum, jahr, monat, tag, text, tagart, berart, wotag)
values
(:kaldate, :wk.j, :wk.m, :wk.d, :ftext, :ftagart, :fberart, :kwotag);
kaldate = kaldate + %days(1);
endDo;
// Bewegliche Feiertage nachtragen
exec SQL declare d0 cursor for
select * from feiertag where berart ='B'
order by rcdcnt ;
exec SQL open d0;
exec SQL fetch next from d0 into :ds_ft;
dow sqlcode = 0;
kaldate = Fdatum + %days(fdiff);
exec sql
update kalender set text = :Ftext, Berart=:FBERART
, tagart = :ftagart
where datum = :kaldate;
exec SQL fetch next from d0 into :ds_ft;
endDo;
*inlr = *On ;
return;
/END-FREE
//*************************************************************************
P DayOfWeek B EXPORT
D DayOfWeek PI 10i 0
D InputDate D
D BaseDate S D Static INZ(D'1582-10-14')
/FREE
TEST(E) InputDate;
If %ERROR;
Return -1;
Endif;
SELECT;
WHEN inputdate >= basedate;
nDAYOFWEEK =
%rem(%diff(inputdate:d'0001-01-01':*D):7)+1;
WHEN inputdate <= basedate;
nDAYOFWEEK =
%rem(%diff(inputdate:d'0001-01-05':*D):7)+1;
OTHER;
nDAYOFWEEK = 0;
ENDSL;
Return ndayofweek;
/END-FREE
P DayOfWeek E
//*************************************************************************
P WeekDay B EXPORT
D WeekDay PI 10a
D WKDAY 10A
D InputDate D
D DS
D Days 70A INZ('Montag +
D Dienstag +
D Mittwoch +
D Donnerstag+
D Freitag +
D Samstag +
D Sonntag ')
D Day 10A Dim(7) Overlay(Days)
/FREE
TEST(E) InputDate;
If %ERROR;
Return 'Invalid Date';
Endif;
return Day(DayOfWeek(InputDate));
/END-FREE
P WeekDay E
//*************************************************************************