.CM  SCRIPT , Version - 1.1 , last edited by B.Morgeneyer
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 1996-2004 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VIN42$
.tt 2 $$$
.TT 3 $$Date-arithmetic and -conversion$1995-11-01$
***********************************************************
.nf

.nf


    ========== licence begin  GPL
    Copyright (c) 1996-2004 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end

.fo


.fo
.nf
.sp
MODULE  : Date-arithmetic-and-conversion
=========
.sp
Purpose : calculation of day_of_year etc.
.CM *-END-* purpose -------------------------------------
.sp
Define  :
 
        PROCEDURE
              i42dayofyear (
                    dat      : tsp00_C8;
                    VAR year : integer;
                    VAR yday : integer);
 
        PROCEDURE
              i42ydaytodate (
                    year    : integer;
                    yday    : integer;
                    VAR dat : tsp00_C8);
 
        PROCEDURE
              i42weekandday (
                    VAR dat  : tsp00_C8;
                    VAR year : integer;
                    VAR week : integer;
                    VAR wday : weekday);
 
        PROCEDURE
              i42usweekandday (
                    VAR dat  : tsp00_C8;
                    VAR year : integer;
                    VAR week : integer;
                    VAR wday : weekday);
 
        PROCEDURE
              i42wkdaytodate (
                    year    : integer;
                    week    : integer;
                    wday    : weekday;
                    VAR dat : tsp00_C8);
 
        PROCEDURE
              i42dadd (
                    VAR dat : tsp00_C8;
                    diff    : tsp00_Int4);
 
        FUNCTION
              i42ddifference (
                    VAR date1 : tsp00_C8;
                    VAR date2 : tsp00_C8) : tsp00_Int4 ;
 
        FUNCTION
              i42iddifference (
                    year1  : tsp00_Int2 ;
                    month1 : tsp00_Int2 ;
                    day1   : tsp00_Int2 ;
                    year2  : tsp00_Int2 ;
                    month2 : tsp00_Int2 ;
                    day2   : tsp00_Int2 ) : tsp00_Int4 ;
 
        FUNCTION
              i42days_of_month (
                    year, month : integer) : integer;
              (* ================================ *)
              (* Zeitarithmetik und -Konversionen *)
              (* ================================ *)
 
        PROCEDURE
              i42tstimetosecs
                    (   time : tsp00_C8;
                    VAR secs : tsp00_Int4);
 
        PROCEDURE
              i42istimetosecs
                    ( hours  : tsp00_Int2 ;
                    minutes  : tsp00_Int2 ;
                    seconds  : tsp00_Int2 ;
                    VAR secs : tsp00_Int4);
 
        PROCEDURE
              i42stsecstotime
                    (   secs : tsp00_Int4;
                    VAR time : tsp00_C8);
 
        PROCEDURE
              i42ttoreal (
                    VAR time       : tsp00_C8;
                    unit           : time_unit;
                    VAR time_value : real);
 
        PROCEDURE
              i42realtotime (
                    time_value : real;
                    unit       : time_unit;
                    VAR time   : tsp00_C8);
 
        PROCEDURE
              i42tadd (
                    VAR time1            : tsp00_C8;
                    time2                : tsp00_C8;
                    is_add               : boolean;
                    VAR carry_round_days : tsp00_Int4);
 
        PROCEDURE
              i42tdifference (
                    VAR time1 : tsp00_C8;
                    time2     : tsp00_C8);
 
        FUNCTION
              in4230 : tsp00_Int4;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : 
.sp
.cp 3
Created : 1985-10-01
.sp
.cp 3
Version : 1996-12-04
.pb '$'
.cp 3
Release :  6.1.2     Date : 1995-11-01
.sp
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
Dieser Modul enth?alt Prozeduren zur Datums-und Zeitkonversion
und -arithmetik.
.sp;Alle Datums- und Zeitangaben vom Typ C6 sind in der Form
YYMMDD bzw. HHMMSS angegeben.
.sp;Im 00-Papier werden hierf?ur folgende Konstanten und Typen
definiert:
.sp 2;.nf
CONST
      monday = 1;
      tuesday = 2;
      wednesday = 3;
      thursday = 4;
      friday = 5;
      saturday = 6;
      sunday = 7;
 
TYPE
      weekday = monday .. sunday;
      time_unit = (seconds, minutes, hours);
.sp 2;.fo;.cp 12;Die Prozeduren:
.sp 2;.nf
        PROCEDURE
              i42dayofyear (
                    dat      : c8;
                          VAR year : integer;
                          VAR yday : integer);
.sp 2;.fo
wandelt ein Datum (YYYYMMDD)
in die Darstellung (Jahr, lfd. Tag im Jahr) um.
.sp 2;.nf;.cp 12
        PROCEDURE
              i42ydaytodate (
                    year    : integer;
                    day     : integer;
                          VAR dat : c8);
.sp 2;.fo
Wandelt ein Datum in der Form (Jahr, lfd. Tag) in YYYYMMDD um.
.sp 2;.nf;.cp 12
        PROCEDURE
              i42weekandday (
                    VAR dat  : c8;
                          VAR year : integer;
                          VAR week : integer;
                          VAR wday : weekday);
.sp 2;.fo
Zu einem Datum (YYYYMMDD) werden Jahr, Kalenderwoche und Wochentag
(1=Montag, ... , 7=Sonntag) bestimmt.
.sp 2;.nf;.cp 12
        PROCEDURE
              i42usweekandday (
                    VAR dat  : c8;
                          VAR year : integer;
                          VAR week : integer;
                          VAR wday : weekday);
.sp 2;.fo
wie oben, nur nach US-Zhlung ( Sonntag=1, erste Woche im Jahr zhlt voll)
.sp 2;.nf;.cp 12
        PROCEDURE
              i42wkdaytodate (
                    year    : integer;
                    week    : integer;
                    wday    : weekday;
                          VAR dat : c8);
.sp 2;.fo
Wandelt Jahr, Kalenderwoche und Wochentag in (YYYYMMDD) um.
.sp 2;.nf;.cp 12
        PROCEDURE
              i42dadd (
                    VAR dat : c8;
                          diff    : tsp00_Int4);
.sp 2;.fo
addiert zu einem Datum (YYYYMMDD) DIFF Tage und gibt ein korrektes Datum
(YYYYMMDD) zur?uck.
.sp 2;.nf;.cp 12
        FUNCTION
              i42ddifference (
                    VAR date1 : c8;
                          VAR date2 : c8) : integer;
.sp 2;.fo
Berechnet die Differenz (in Tagen) zwischen zwei Datumsangaben.
.sp 2;.nf;.cp 15
        FUNCTION
              i42iddifference (
                    year1  : tsp00_Int2 ;
                    month1 : tsp00_Int2 ;
                    day1   : tsp00_Int2 ;
                    year2  : tsp00_Int2 ;
                    month2 : tsp00_Int2 ;
                    day2   : tsp00_Int2 ) : tsp00_Int4 ;
.sp 2;.fo
wie i42ddifference; Daten werden als Integers angegeben.
.sp 2;.nf;.cp 15
              (* ================================ *)
              (* Zeitarithmetik und -Konversionen *)
              (* ================================ *)
        PROCEDURE
              i42ttoreal (
                    VAR time       : c8;
                    unit           : time_unit;
                          VAR time_value : real);
.sp 2;.fo
Wandelt eine Uhrzeit in Sekunden (UNIT=SECONDS), Minuten (UNIT=MINUTES)
oder Stunden (UNIT=HOURS) um. Die Zeiteinheit (UNIT) mu?z vorher
entsprechend belegt sein.
.sp 2;.nf;.cp 12
        PROCEDURE
              i42realtotime (
                    time_value : real;
                    unit       : time_unit;
                    VAR time   : c8);
.sp 2;.fo
Umkehroperation zu I42_T_TO_REAL. UNIT siehe dort.
.sp 2;.nf;.cp 12
        PROCEDURE
              i42tadd(
                    VAR time1            : c8;
                    time2                : c8;
                    is_add               : boolean;
              VAR carry_round_days : int4);
.sp 2;.fo
Addiert zu einer Zeitangabe TIME1 die Zeitangabe TIME2.
Der Parameter IS_ADD gibt an, ob addiert oder subtrahiert werden soll.
.sp;CARRY_ROUND_DAYS enth?alt als Ergebnis den eventuellen ?Ubertrag
in Tagen.
.sp 2;.nf;.cp 12
        FUNCTION
              i42tdifference (
                    time1 : c8;
                          time2 : c8;
                    unit  : time_unit) : real;
.sp 2;.fo
Berechnet zu zwei Uhrzeitangaben die Differenz in der Zeiteinheit,
die mit UNIT bestimmt wird.
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.oc _/1;Anmerkung zur Kalenderwoche:
.sp;Nach Studium einiger Taschenkalender habe ich geschlossen, da?z
folgende ?Ubereinkunft zu gelten scheint:
.sp;Liegt der erste Januar eines Jahres
.oc _/1;vor
einem Freitag (also Montag bis Donnerstag), so z?ahlt die
erste angebrochene Woche des Jahres bereits
.oc _/1;voll
zum neuen Jahr, einschlie?zlich der Tage des Vorjahres dieser Woche.
.sp;Anderenfalls ist die gesamte Woche die
.oc _/1;letzte Woche des Vorjahres.
.sp;.oc _/1;Beispiel:
.br;Ist der 1. Januar ein Donnerstag, so beginnt die Kalenderwoche 1
des neuen Jahres bereits am Montag, dem 29.12.
.br;Ist der 1. Januar dagegen ein Freitag, so liegt auch noch
Sonntag, der 3.1. in der letzten Woche des Vorjahres.
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      monday   = 1;
      friday   = 5;
      saturday = 6;
      sunday   = 7;
 
TYPE
      weekday = monday .. sunday;
      time_unit = (seconds, minutes, hours);
 
      date_rec = RECORD
            CASE (* Datum *) boolean OF
                true:
                    (year  : integer;
                    month : integer;
                    day   : integer);
                false:
                    (hour : integer;
                    minute : integer;
                    second : integer);
                END;
            (*ENDCASE*) 
 
 
 
(*------------------------------*) 
 
FUNCTION
      in4230 : tsp00_Int4;
 
BEGIN
(* linkcheck function *)
in4230 := 219001031;
END; (* in4230 *)
 
(*------------------------------*) 
 
PROCEDURE
      i42dayofyear (
            dat      : tsp00_C8;
            VAR year : integer;
            VAR yday : integer);
 
VAR
      internal_date : date_rec;
      year2, yday2 : tsp00_Int2 ;
 
BEGIN
convert_to_date (dat, internal_date);
dayofyear ( internal_date, year2, yday2 );
year := year2 ;
yday := yday2 ;
END; (* i42dayofyear *)
 
(*------------------------------*) 
 
PROCEDURE
      dayofyear (
            VAR internal_date : date_rec ;
            VAR year          : tsp00_Int2;
            VAR yday          : tsp00_Int2 ) ;
 
VAR
      i : integer ;
 
BEGIN
WHILE internal_date.month < 1 DO
    BEGIN
    internal_date.year := internal_date.year - 1;
    internal_date.month := internal_date.month + 12 ;
    END ;
(*ENDWHILE*) 
WHILE internal_date.month > 12 DO
    BEGIN
    internal_date.year := internal_date.year + 1;
    internal_date.month := internal_date.month - 12 ;
    END ;
(*ENDWHILE*) 
WHILE internal_date.day < 1 DO
    BEGIN
    IF  internal_date.month > 1
    THEN
        internal_date.month := internal_date.month - 1
    ELSE
        BEGIN
        internal_date.month := 12 ;
        internal_date.year := internal_date.year - 1;
        END ;
    (*ENDIF*) 
    internal_date.day := internal_date.day +
          i42days_of_month ( internal_date.year, internal_date.month ) ;
    END ;
(*ENDWHILE*) 
WHILE internal_date.day >
      i42days_of_month ( internal_date.year, internal_date.month ) DO
    BEGIN
    internal_date.day := internal_date.day -
          i42days_of_month ( internal_date.year, internal_date.month ) ;
    IF  internal_date.month < 12
    THEN
        internal_date.month := internal_date.month + 1
    ELSE
        BEGIN
        internal_date.month := 1 ;
        internal_date.year := internal_date.year + 1;
        END ;
    (*ENDIF*) 
    END ;
(*ENDWHILE*) 
year := internal_date.year;
yday := 0;
FOR i := 1 TO internal_date.month -1 DO
    yday := yday + i42days_of_month(internal_date.year,i);
(*ENDFOR*) 
yday := yday + internal_date.day;
END; (* dayofyear *)
 
(*------------------------------*) 
 
FUNCTION
      day_of_year (
            VAR year : tsp00_Int2 ;
            month    : tsp00_Int2 ;
            day      : tsp00_Int2 ) : tsp00_Int2 ;
 
VAR
      internal_date : date_rec;
      yday          : tsp00_Int2 ;
 
BEGIN
internal_date . year   := year ;
internal_date . month  := month ;
internal_date . day    := day ;
dayofyear ( internal_date, year, yday );
day_of_year := yday ;
END; (* day_of_year *)
 
(*------------------------------*) 
 
PROCEDURE
      i42ydaytodate (
            year    : integer;
            yday    : integer;
            VAR dat : tsp00_C8);
 
VAR
      internal_date : date_rec;
      mdays         : integer;
 
BEGIN
internal_date.year := year;
WITH internal_date DO
    BEGIN
    month := 1;
    day := yday;
    mdays := i42days_of_month(internal_date.year,month);
    WHILE day > mdays DO
        BEGIN
        day := day - mdays;
        month := month + 1;
        mdays := i42days_of_month(internal_date.year,month);
        END;
    (*ENDWHILE*) 
    END;
(*ENDWITH*) 
convert_from_date(internal_date,dat);
END; (* i42ydaytodate *)
 
(* Rule : 1. The first thursday in the year          *)
(*           determines the first week of the year   *)
(*                                                   *)
(*           ==> IF JAN 1st is                       *)
(*               monday, tuesday, wednesday, thursday*)
(*               THEN   the week is 1 of current year*)
(*               ELSE   the week is last of last year*)
(*        2. IF JAN 1st is                           *)
(*               friday the week is 53 of last year  *)
(*               saturday and last year was leap     *)
(*                      the week is 53 of last year  *)
(*               saturday and last year was not leap *)
(*                      the week is 52 of last year  *)
(*               sunday the week is 52 of last year  *)
(*------------------------------*) 
 
PROCEDURE
      i42weekandday (
            VAR dat  : tsp00_C8;
            VAR year : integer;
            VAR week : integer;
            VAR wday : weekday);
 
CONST
      first_jan = 1;
 
VAR
      first_jan_day : weekday;
      yday          : integer;
 
BEGIN
i42dayofyear(dat,year,yday);
wday := week_day(year,yday);
first_jan_day := week_day(year,first_jan);
yday := yday + first_jan_day - 2;
IF  first_jan_day >= friday
THEN
    yday := yday - 7;
(*ENDIF*) 
IF  yday >= 0
THEN
    BEGIN
    week := (yday DIV 7) + 1;
    IF  week >= 53
    THEN
        BEGIN
        first_jan_day := week_day ( year + 1, first_jan );
        IF  first_jan_day < friday
        THEN
            BEGIN
            year := year + 1;
            week := 1;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END
ELSE
    BEGIN
    year := year - 1;
    (* yday < 0 may only occur, if first_jan_day >= friday *)
    CASE first_jan_day OF
        friday :
            week := 53;
        saturday :
            IF  is_leap_year ( year )
            THEN
                week := 53
            ELSE
                week := 52;
            (*ENDIF*) 
        sunday :
            week := 52;
        END;
    (*ENDCASE*) 
    END;
(*ENDIF*) 
END; (* i42weekandday *)
 
(*------------------------------*) 
 
PROCEDURE
      i42usweekandday (
            VAR dat  : tsp00_C8;
            VAR year : integer;
            VAR week : integer;
            VAR wday : weekday);
 
CONST
      first_jan = 1;
 
VAR
      first_jan_day : weekday;
      yday          : integer;
 
BEGIN
i42dayofyear(dat,year,yday);
wday := us_weekday ( week_day(year,yday) );
first_jan_day := us_weekday ( week_day(year,first_jan) );
yday := yday + first_jan_day - 2;
week := (yday DIV 7) + 1;
END; (* i42usweekandday *)
 
(*------------------------------*) 
 
FUNCTION
      us_weekday (
            wday : weekday ) : weekday ;
 
VAR
      temp : integer ;
 
BEGIN
temp := wday + 1;
IF  temp > 7
THEN
    temp := temp - 7;
(*ENDIF*) 
us_weekday := temp ;
END; (* us_weekday *)
 
(*------------------------------*) 
 
PROCEDURE
      i42wkdaytodate (
            year    : integer;
            week    : integer;
            wday    : weekday;
            VAR dat : tsp00_C8);
 
CONST
      first_jan = 1;
 
VAR
      first_jan_day : weekday;
      yday          : integer;
 
BEGIN
yday := (week - 1) * 7;
first_jan_day := week_day(year,first_jan);
yday := yday - first_jan_day + 2;
yday := yday + wday - 1;
IF  first_jan_day >= friday
THEN
    yday := yday + 7;
(*ENDIF*) 
IF  yday <= 0
THEN
    BEGIN
    year := year - 1;
    yday := yday + days_of_year(year);
    END
ELSE
    IF  yday > days_of_year(year)
    THEN
        BEGIN
        yday := yday - days_of_year(year);
        year := year + 1;
        END;
    (*ENDIF*) 
(*ENDIF*) 
i42ydaytodate(year,yday,dat);
END; (* i42wkdaytodate *)
 
(*------------------------------*) 
 
PROCEDURE
      i42dadd (
            VAR dat : tsp00_C8;
            diff    : tsp00_Int4);
 
VAR
      year : integer;
      yday : integer;
 
BEGIN
IF  diff > 0
THEN
    date_add(dat,diff,year,yday)
ELSE
    IF  diff < 0
    THEN
        date_sub(dat,-diff,year,yday);
    (*ENDIF*) 
(*ENDIF*) 
IF  diff <> 0
THEN
    i42ydaytodate(year,yday,dat);
(*ENDIF*) 
END; (* i42dadd *)
 
(*------------------------------*) 
 
FUNCTION
      i42ddifference (
            VAR date1 : tsp00_C8;
            VAR date2 : tsp00_C8) : tsp00_Int4 ;
 
VAR
      year1 : integer;
      day1  : integer;
      year2 : integer;
      day2  : integer;
 
BEGIN
i42dayofyear(date1,year1,day1);
i42dayofyear(date2,year2,day2);
IF  date1 < date2
THEN
    i42ddifference := pos_date_difference(year1,day1,year2,day2)
ELSE
    i42ddifference := - pos_date_difference(year2,day2,year1,day1);
(*ENDIF*) 
END; (* i42ddifference *)
 
(*------------------------------*) 
 
FUNCTION
      i42iddifference (
            year1  : tsp00_Int2 ;
            month1 : tsp00_Int2 ;
            day1   : tsp00_Int2 ;
            year2  : tsp00_Int2 ;
            month2 : tsp00_Int2 ;
            day2   : tsp00_Int2 ) : tsp00_Int4 ;
 
VAR
      yday1 : integer;
      yday2 : integer;
 
BEGIN
yday1 := day_of_year(year1,month1,day1);
yday2 := day_of_year(year2,month2,day2);
IF  ( year1 < year2 ) OR ( ( year1 = year2 ) AND ( yday1 < yday2 ) )
THEN
    i42iddifference := pos_date_difference(year1,yday1,year2,yday2)
ELSE
    i42iddifference := - pos_date_difference(year2,yday2,year1,yday1);
(*ENDIF*) 
END; (* i42iddifference *)
 
(* ================================ *)
(* Zeitarithmetik und -Konversionen *)
(* ================================ *)
(*------------------------------*) 
 
PROCEDURE
      i42tstimetosecs
            (   time : tsp00_C8;
            VAR secs : tsp00_Int4 );
 
VAR
      internal_time : date_rec;
 
BEGIN
convert_to_date(time,internal_time);
WITH internal_time DO
    secs := time_to_seconds ( hour, minute, second );
(*ENDWITH*) 
END; (* i42tstimetosecs *)
 
(*------------------------------*) 
 
PROCEDURE
      i42istimetosecs
            ( hours  : tsp00_Int2 ;
            minutes  : tsp00_Int2 ;
            seconds  : tsp00_Int2 ;
            VAR secs : tsp00_Int4);
 
BEGIN
secs := time_to_seconds ( hours, minutes, seconds );
END ;
 
(*------------------------------*) 
 
FUNCTION
      time_to_seconds
            ( hours  : tsp00_Int4 ;
            minutes  : tsp00_Int4 ;
            seconds  : tsp00_Int4 ) : tsp00_Int4 ;
 
VAR
      secs : tsp00_Int4 ;
 
BEGIN
secs := seconds;
secs := secs + minutes * 60;
secs := secs + hours * 3600;
time_to_seconds := secs ;
END; (* i42istimetosecs *)
 
(*------------------------------*) 
 
PROCEDURE
      i42stsecstotime
            (   secs : tsp00_Int4;
            VAR time : tsp00_C8);
 
VAR
      internal_time : date_rec;
 
BEGIN
WITH internal_time DO
    BEGIN
    hour := secs DIV 3600;
    secs := secs MOD 3600;
    minute := secs DIV 60;
    second := secs MOD 60;
    END;
(*ENDWITH*) 
convert_from_date(internal_time,time);
END; (* i42stsecstotime *)
 
(*------------------------------*) 
 
PROCEDURE
      i42ttoreal (
            VAR time       : tsp00_C8;
            unit           : time_unit;
            VAR time_value : real);
 
VAR
      internal_time : date_rec;
      secs          : tsp00_Int4;
 
BEGIN
convert_to_date(time,internal_time);
WITH internal_time DO
    BEGIN
    secs := second;
    secs := secs + minute * 60;
    secs := secs + hour * 3600;
    END;
(*ENDWITH*) 
time_value := secs;
CASE unit OF
    hours:
        time_value := time_value / 3600.0;
    minutes:
        time_value := time_value / 60.0;
    seconds: ;
    END;
(*ENDCASE*) 
END; (* i42ttoreal *)
 
(*------------------------------*) 
 
PROCEDURE
      i42realtotime (
            time_value : real;
            unit       : time_unit;
            VAR time   : tsp00_C8);
 
VAR
      internal_time : date_rec;
      secs          : integer;
 
BEGIN
CASE unit OF
    hours:
        secs := round(time_value * 3600.0);
    minutes:
        secs := round(time_value * 60.0);
    seconds:
        secs := round(time_value);
    END;
(*ENDCASE*) 
WITH internal_time DO
    BEGIN
    hour := secs DIV 3600;
    secs := secs MOD 3600;
    minute := secs DIV 60;
    second := secs MOD 60;
    END;
(*ENDWITH*) 
convert_from_date(internal_time,time);
END; (* i42realtotime *)
 
(*------------------------------*) 
 
PROCEDURE
      i42tadd (
            VAR time1            : tsp00_C8;
            time2                : tsp00_C8;
            is_add               : boolean;
            VAR carry_round_days : tsp00_Int4);
 
CONST
      one_day = 86400;
 
VAR
      tim1,tim2 : tsp00_Int4;
 
BEGIN
i42tstimetosecs(time1,tim1);
i42tstimetosecs(time2,tim2);
carry_round_days := 0;
IF  is_add
THEN
    BEGIN
    tim1 := tim1 + tim2;
    END
ELSE
    BEGIN
    tim1 := tim1 - tim2;
    END;
(*ENDIF*) 
(* Die Ergebnisse werden immer auf eine Uhrzeit projeziert *)
WHILE tim1 < 0 DO
    BEGIN
    tim1 := tim1 + one_day;
    carry_round_days := carry_round_days - 1;
    END;
(*ENDWHILE*) 
WHILE tim1 >= one_day DO
    BEGIN
    tim1 := tim1 - one_day;
    carry_round_days := carry_round_days + 1;
    END;
(*ENDWHILE*) 
i42stsecstotime(tim1,time1);
END; (* i42tadd *)
 
(*------------------------------*) 
 
PROCEDURE
      i42xadd (
            VAR time             : tsp00_C8;
            unit                 : time_unit;
            diff                 : real;
            VAR carry_round_days : tsp00_Int4);
      (* Alte Version von i42tadd mit reals, die wegen Rundungsfehlern
      durch tsp00_Int4 ersetzt wurden. MK 92.09.14 *)
 
VAR
      time_value : real;
      one_day    : integer;
 
BEGIN
i42ttoreal(time,unit,time_value);
time_value := time_value + diff;
carry_round_days := 0;
CASE unit OF
    seconds:
        one_day := 86400;
    minutes:
        one_day := 1440;
    hours:
        one_day := 24;
    END;
(*ENDCASE*) 
WHILE time_value < 0 DO
    BEGIN
    time_value := time_value + one_day;
    carry_round_days := carry_round_days - 1;
    END;
(*ENDWHILE*) 
WHILE time_value >= one_day DO
    BEGIN
    time_value := time_value - one_day;
    carry_round_days := carry_round_days + 1;
    END;
(*ENDWHILE*) 
i42realtotime(time_value,unit,time);
END; (* i42xadd *)
 
(*------------------------------*) 
 
FUNCTION
      i42xdifference (
            time1 : tsp00_C8;
            time2 : tsp00_C8;
            unit  : time_unit) : real;
 
VAR
      time_value_1 : real;
      time_value_2 : real;
 
BEGIN
i42ttoreal(time1,unit,time_value_1);
i42ttoreal(time2,unit,time_value_2);
i42xdifference := time_value_2 - time_value_1;
END; (* i42xdifference *)
 
(*------------------------------*) 
 
PROCEDURE
      i42tdifference (
            VAR time1 : tsp00_C8;
            time2     : tsp00_C8 );
 
VAR
      tim1, tim2 : tsp00_Int4;
 
BEGIN
i42tstimetosecs ( time1, tim1 );
i42tstimetosecs ( time2, tim2 );
IF  tim1 >= tim2
THEN
    tim1 := tim1 - tim2
ELSE
    tim1 := tim2 - tim1;
(*ENDIF*) 
i42stsecstotime ( tim1, time1 );
END; (* i42tdifference *)
 
(*------------------------------*) 
 
PROCEDURE
      convert_to_date (
            VAR cdate : tsp00_C8;
            VAR dat   : date_rec);
 
VAR
      century : integer;
 
BEGIN
WITH dat DO
    BEGIN
    convert_to_integer(cdate,1,century);
    convert_to_integer(cdate,3,year );
    year := century * 100 + year;
    convert_to_integer(cdate,5,month);
    convert_to_integer(cdate,7,day  );
    END;
(*ENDWITH*) 
END; (* convert_to_date *)
 
(*------------------------------*) 
 
PROCEDURE
      convert_from_date (
            VAR dat   : date_rec;
            VAR cdate : tsp00_C8);
 
VAR
      century : integer;
      ok      : boolean;
 
BEGIN
WITH dat DO
    BEGIN
    century := year DIV 100;
    year := year MOD 100;
    convert_from_integer(century,  1, cdate, ok);
    IF  ok
    THEN
        convert_from_integer(year,  3, cdate, ok);
    (*ENDIF*) 
    IF  ok
    THEN
        convert_from_integer(month, 5, cdate, ok);
    (*ENDIF*) 
    IF  ok
    THEN
        convert_from_integer(day,   7, cdate, ok);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
IF  NOT ok
THEN
    cdate := '********';
(*ENDIF*) 
END; (* convert_from_date *)
 
(*------------------------------*) 
 
PROCEDURE
      convert_to_integer (
            VAR cdate  : tsp00_C8;
            pos        : integer;
            VAR result : integer);
 
BEGIN
result := 10 * ( ord( cdate [pos ] ) - ord('0') );
result := result + ( ord( cdate [pos + 1 ] ) - ord('0') );
END; (* convert_to_integer *)
 
(*------------------------------*) 
 
PROCEDURE
      convert_from_integer (
            integ     : integer;
            pos       : integer;
            VAR cdate : tsp00_C8;
            VAR ok    : boolean);
 
VAR
      digit : integer;
 
BEGIN
ok := (integ < 100) AND (integ >= 0);
IF  ok
THEN
    BEGIN
    digit := integ DIV 10;
    cdate [ pos ] := chr( digit + ord('0') );
    digit := integ MOD 10;
    cdate [ pos + 1 ] := chr( digit + ord('0') );
    END;
(*ENDIF*) 
END; (* convert_from_integer *)
 
(*------------------------------*) 
 
PROCEDURE
      date_add (
            VAR indat : tsp00_C8;
            diff      : tsp00_Int4;
            VAR year  : integer;
            VAR yday  : integer);
 
VAR
      rest_of_year : integer;
      ydays        : integer;
 
BEGIN
i42dayofyear(indat,year,yday);
REPEAT
    ydays := days_of_year(year);
    rest_of_year := ydays - yday;
    IF  rest_of_year > diff
    THEN
        rest_of_year := diff;
    (*ENDIF*) 
    yday := yday + rest_of_year;
    diff := diff - rest_of_year;
    IF  diff > 0
    THEN
        BEGIN
        year := year + 1;
        yday := 0;
        END;
    (*ENDIF*) 
UNTIL
    diff = 0;
(*ENDREPEAT*) 
END; (* date_add *)
 
(*------------------------------*) 
 
PROCEDURE
      date_sub (
            VAR indat : tsp00_C8;
            diff      : tsp00_Int4;
            VAR year  : integer;
            VAR yday  : integer);
 
VAR
      sub_days : integer;
 
BEGIN
i42dayofyear(indat,year,yday);
REPEAT
    IF  diff < yday
    THEN
        sub_days := diff
    ELSE
        sub_days := yday;
    (*ENDIF*) 
    yday := yday - sub_days;
    diff := diff - sub_days;
    IF  yday = 0
    THEN
        BEGIN
        year := year - 1;
        yday := days_of_year(year);
        END;
    (*ENDIF*) 
UNTIL
    diff = 0;
(*ENDREPEAT*) 
END; (* date_sub *)
 
(*------------------------------*) 
 
FUNCTION
      i42days_of_month (
            year, month : integer) : integer;
 
VAR
      days : integer;
 
BEGIN
CASE month OF
    1:
        days := 31;
    2:
        IF  is_leap_year(year)
        THEN
            days := 29
        ELSE
            days := 28;
        (*ENDIF*) 
    3:
        days := 31;
    4:
        days := 30;
    5:
        days := 31;
    6:
        days := 30;
    7:
        days := 31;
    8:
        days := 31;
    9:
        days := 30;
    10:
        days := 31;
    11:
        days := 30;
    12:
        days := 31;
    END;
(*ENDCASE*) 
i42days_of_month := days;
END; (* i42days_of_month *)
 
(*------------------------------*) 
 
FUNCTION
      days_of_year (
            year : integer) : integer;
 
VAR
      days : integer;
 
BEGIN
IF  is_leap_year(year)
THEN
    days := 366
ELSE
    days := 365;
(*ENDIF*) 
days_of_year := days;
END; (* days_of_year *)
 
(*------------------------------*) 
 
FUNCTION
      is_leap_year (
            year : integer) : boolean;
 
VAR
      leap_year : boolean;
 
BEGIN
IF  year MOD 4 <> 0
THEN
    leap_year := false
ELSE
    IF  year MOD 100 <> 0
    THEN
        leap_year := true
    ELSE
        IF  year MOD 400 <> 0
        THEN
            leap_year := false
        ELSE
            leap_year := true;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDIF*) 
is_leap_year := leap_year;
END; (* is_leap_year *)
 
(*------------------------------*) 
 
FUNCTION
      pos_date_difference (
            year1 : integer;
            day1  : integer;
            year2 : integer;
            day2  : integer) : tsp00_Int4 ;
 
VAR
      date_difference : tsp00_Int4;
 
BEGIN
date_difference := 0;
WHILE year1 < year2 DO
    BEGIN
    date_difference := date_difference + days_of_year(year1);
    year1 := year1 + 1;
    END;
(*ENDWHILE*) 
date_difference := date_difference + (day2 - day1);
pos_date_difference := date_difference;
END; (* pos_date_difference *)
 
(*------------------------------*) 
 
FUNCTION
      week_day (
            year : integer;
            yday : integer) : weekday;
 
CONST
      (* 06.01.86 ist Montag *)
      year_1 = 1986;
      yday_1 = 6;
 
VAR
      date_difference : tsp00_Int4;
      tmp_week_day    : integer;
 
BEGIN
IF  (year < year_1)
    OR ( (year = year_1) AND (yday <= yday_1) )
THEN
    date_difference := - pos_date_difference(year,yday,year_1,yday_1)
ELSE
    date_difference := pos_date_difference(year_1,yday_1,year,yday);
(*ENDIF*) 
(* Korrektur von MOD fuer TARGON35 ( kann < 0 sein) *)
tmp_week_day := monday + (date_difference MOD 7);
IF  tmp_week_day < 1
THEN
    tmp_week_day := tmp_week_day + 7 ;
(*ENDIF*) 
week_day := tmp_week_day ;
END; (* week_day *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        258
*-PRETTY-*  lines of code :        990        PRETTY  3.09 
*-PRETTY-*  lines in file :       1332         1992-11-23 
.PA 
