©
serviceprofessionalgmbh
Über diese Funktion sind die meisten der gängigen Datumsfunktionen ausführbar.
Die Anwendung der Funktion (mögliche Parameter und deren Auswirkung) kann aus dem Hinweis am Programmende
entnommen werden.
Oftmals wird in Seminaren nach sinnvollen Aufgaben gefragt. Hier eine kleine Anregung für eine Erweiterung dieser Funktion:
Per Parameter könnte abgefragt werden, ob ein bestimmtes Datum ein Arbeitstag ist (kein Sa, So oder Feiertag),
oder wie viele Tage es bis zum nächsten Arbeitstag sind. Viel Spaß bei der Lösung.
/* REXX * XDATE
Benutzung siehe Programmende
*/
parse source . PTYP PNAME .
if PTYP = "FUNCTION" then arg FKT,PARM1,PARM2,PARM3,DUMMY
else arg FKT PARM1 PARM2 PARM3 .
select
when abbrev("NEU",FKT,1) then ERG = date_new(PARM1,PARM2,PARM3)
when abbrev("DIFF",FKT,1) then ERG = date_diff(PARM1,PARM2)
when abbrev("WTAG",FKT,1) then ERG = wochentag(PARM1)
when abbrev("OSO",FKT,1) then ERG = ostersonntag(PARM1)
when abbrev("FTAG",FKT,1) then ERG = feiertage(PARM1,PARM2)
when abbrev("SJ",FKT,1) then ERG = schaltjahr(PARM1)
otherwise ERG = "12 Incorrect CALL to routine"
end
return erg
/* SUBROUTINES *******************************************************/
date_new: procedure
arg DATUM,ANZ,DOW
if ^date_OK(DATUM) then return "12 Datum1 formal falsch"
if ^datatype(ANZ,"W") then return "12 Anzahl Tage falsch"
BASE = date("B",DAT,TYP) + ANZ
NEW_DATE = date("S",BASE,"B")
parse var NEW_DATE 1 JJJJ 5 MM 7 TT
NEWDATE = TT"."MM"."right(jjjj,JLEN)
ERG = 0 NEWDATE
if DOW = "WTAG" then ERG = ERG word(wochentag(NEWDATE),2)
return ERG
date_diff: procedure
arg DAT1,DAT2
if ^date_OK(DAT1) then return "12 Datum1 ("DAT1") formal falsch"
BASE1 = date("B",DAT,TYP)
if ^date_OK(DAT2) then return "12 Datum2 ("DAT2") formal falsch"
BASE2 = date("B",DAT,TYP)
if BASE1 > BASE2 then do
BASE1 = bitxor(BASE1,BASE2)
BASE2 = bitxor(BASE2,BASE1)
BASE1 = bitxor(BASE1,BASE2)
end
return 0 BASE2 - BASE1
ostersonntag: procedure
arg JAHR
if JAHR < 1582 ! JAHR > 2300 then do
return "12 Jahr ("JAHR") ungültig. Nur 1582 bis 2300"
end
a=JAHR // 19
b=JAHR // 4
c=JAHR // 7
d=((19 * a + 24) // 30)
e=((2 * b + 4 * c + 6 * d + 5) // 7)
f=22 + d + e
IF f = 57 THEN f =50
IF f = 56 & d = 28 & e = 6 & a > 10 THEN f = 49
IF f <= 31 THEN monat = "03"
ELSE DO
f = f-31
monat = "04"
END
return 0 right(f,2,'0')'.'monat'.'JAHR
feiertage: procedure
arg JAHR,DOW
if JAHR < 1582 ! JAHR > 2300 then do
return "12 Jahr ("JAHR") ungültig. Nur 1582 bis 2300"
end
parse value ostersonntag(JAHR) with . OSO
ftage = "" !! ,
"01.01."JAHR "Neujahr" ,
"06.01."JAHR "3_König" ,
word(date_new(OSO,-2),2) "Karfreitag" ,
OSO "Ostersonntag" ,
word(date_new(OSO,1),2) "Ostermontag" ,
"01.05."JAHR "Tag_der_Arbeit" ,
word(date_new(OSO,39),2) "Christi_Himmelfahrt" ,
word(date_new(OSO,49),2) "Pfingstsonntag" ,
word(date_new(OSO,50),2) "Pfingstmontag" ,
"15.08."JAHR "Maria_Himmelfahrt" ,
"03.10."JAHR "Tag_der_Einheit" ,
"25.12."JAHR "1.Weihnachtstag" ,
"26.12."JAHR "2.Weihnachtstag" ,
""
if DOW = "WTAG" then do
do I = words(FTAGE) to 1 by -2
FDATUM = word(FTAGE,I-1)
DOW = word(wochentag(FDATUM),2)
FTAGE = subword(FTAGE,1,I-1) DOW subword(FTAGE,I)
end
end
return 0 FTAGE
wochentag: procedure
arg DATUM
TAGE = "Monday Montag Tuesday Dienstag Wednesday Mittwoch Thursday" ,
"Donnerstag Friday Freitag Saturday Samstag Sunday Sonntag"
if ^date_OK(DATUM) then return "12 Datum ("DATUM") formal falsch"
DOW = date("W",DAT,TYP)
P = wordpos(DOW,TAGE)
return 0 word(TAGE,P+1)
schaltjahr: procedure
arg JAHR
if ^datatype(JAHR,"W") then do
return "12 Jahr ("JAHR") nicht numerisch"
end
return 0 (JAHR//4=0) - (JAHR//100=0) + (JAHR//400=0)
date_ok: procedure expose dat typ jlen
arg DATUM
DATUM = space(translate(DATUM," ","./"),0)
DAT_LEN = length(DATUM)
if datatype(DATUM) <> "NUM" ! wordpos(DAT_LEN,"6 8") = 0 then do
return 0
end
parse var DATUM 1 TT 3 MM 5 JJJJ
JLEN = length(JJJJ)
if JLEN = 4 then do
DAT = JJJJ !! MM !! TT
TYP = "S"
end
else do
DAT = TT"/"MM"/"JJJJ
TYP = "E"
end
FEB = 28 + word(schaltjahr(JJJJ),2)
TIM = "31" FEB "31 30 31 30 31 31 30 31 30 31"
if MM < 1 ! MM > 12 then return 0
if TT > word(TIM,MM) then return 0
return 1
/* USAGE ***************************************************************
>>----- xdate(fkt,--parm1--+-----------------+------><
| |
+-,parm2-+--------+
| |
+-,parm3-+
fkt parm1 parm2 parm3 result
------ ---------- ---------- ------- -------------------------------
NEU tt.mm.jjjj +/- tage RC tt.mm.jjjj (neu)
NEU tt.mm.jjjj +/- tage TAG RC tt.mm.jjjj wochentag
DIFF tt.mm.jjjj tt.mm.jjjj RC anzahl tage differenz
TAG tt.mm.jjjj kein RC wochentag deutsch
OSO jjjj kein RC jj.mm.jjjj ostersonntag
FTAG jjjj kein RC datum name... (alle feiert.)
FTAG jjjj TAG RC datum wochentag name...
Beispiel:
OLD_DATE ="22.02.2002"
parse value xdate(OLD_DATE,4,"WTAG") with RC INFO
if RC > 0 then do
say INFO
...
end
else do
parse var INFO NEW_DATE WEEK_DAY
say "Neues Datum:" NEW_DATE >> 26.02.2002
say "Wochentag..:" WEEK_DAY >> Dienstag
...
end
zurück zu Datum & Zeit