© 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