.pb '~'
.ad 8
.ll 73
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VKB79$
.tt 2 $$$
.TT 3 $JuergenA$KB_date_time$2000-08-25$
***********************************************************
.nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 2000-2005 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  : KB_date_time
=========
.sp
Purpose : Date and time functions
.CM *-END-* purpose -------------------------------------
.sp
Define  :
 
        FUNCTION
              k79date_time (
                    VAR t    : tgg00_TransContext;
                    VAR sel  : tgg00_SelectFieldsParam;
                    VAR st   : tgg00_StackEntry) : tgg00_BasisError;
 
        PROCEDURE
              k79new_pos_ora_number_format (
                    last_fmt : tkb07_ora_number_fmt_elem;
                    VAR pos  : tsp00_Int4);
 
        FUNCTION
              k79n_dest_len_ora_number_format (
                    VAR format : tsp00_MoveObj;
                    fmt_pos : tsp00_Int4;
                    fmt_len : tsp00_Int4) : tsp00_Int2;
 
        FUNCTION
              k79ora_number_format (
                    VAR format : tsp00_MoveObj;
                    len : tsp00_Int4;
                    pos : tsp00_Int4) : tkb07_ora_number_fmt_elem;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              KB_get : VKB71;
 
        PROCEDURE
              k71code_operand (
                    VAR sel              : tgg00_SelectFieldsParam;
                    wanted_code          : char;
                    VAR operand_addr     : tsp00_MoveObjPtr;
                    VAR len              : integer;
                    operand_st_addr      : tgg00_StEntryAddr;
                    VAR e                : tgg00_BasisError);
 
        PROCEDURE
              k71get_operand (
                    VAR sel             : tgg00_SelectFieldsParam;
                    check_spec_null     : boolean;
                    VAR operand_addr    : tsp00_MoveObjPtr;
                    VAR len             : integer;
                    VAR e               : tgg00_BasisError);
 
        PROCEDURE
              k71num_err_to_b_err (
                    num_err : tsp00_NumError;
                    VAR e : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01code : tgg04_CodeGlobals;
 
      ------------------------------ 
 
        FROM
              Codetransformation_and_Coding : VGG02;
 
        VAR
              g02codetables : tgg04_CodeTables;
 
        PROCEDURE
              g02pebcdic_pos_ascii(
                    VAR source : tsp00_Date;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_MoveObj;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              Check-Date-Time : VGG03;
 
        VAR
              g03short_daynames : tgg04_ShortDaynames;
 
        PROCEDURE
              g03dchange_format_date (
                    VAR sbuf : tsp00_MoveObj;
                    VAR dbuf : tsp00_MoveObj;
                    spos     : tsp00_Int4;
                    dpos     : tsp00_Int4;
                    format   : tgg00_DateTimeFormat;
                    VAR e    : tgg00_BasisError);
 
        PROCEDURE
              g03fdcheck_date (
                    VAR sbuf  : tsp00_MoveObj;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    actlen    : integer;
                    dt_format : tgg00_DateTimeFormat;
                    ch_code   : boolean;
                    VAR e     : tgg00_BasisError);
 
        PROCEDURE
              g03ftcheck_time (
                    VAR sbuf  : tsp00_MoveObj;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    actlen    : integer;
                    dt_format : tgg00_DateTimeFormat;
                    ch_code   : boolean;
                    VAR e     : tgg00_BasisError);
 
        PROCEDURE
              g03ftscheck_timestamp (
                    VAR sbuf  : tsp00_MoveObj;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    actlen    : integer;
                    dt_format : tgg00_DateTimeFormat;
                    language  : tsp00_C3;
                    ch_code   : boolean;
                    VAR e     : tgg00_BasisError);
 
        PROCEDURE
              g03tchange_format_time (
                    VAR sbuf : tsp00_MoveObj;
                    VAR dbuf : tsp00_MoveObj;
                    spos     : tsp00_Int4;
                    dpos     : tsp00_Int4;
                    format   : tgg00_DateTimeFormat;
                    VAR e    : tgg00_BasisError);
 
        PROCEDURE
              g03tschange_format_timestamp (
                    VAR sbuf : tsp00_MoveObj;
                    VAR dbuf : tsp00_MoveObj;
                    spos     : tsp00_Int4;
                    dpos     : tsp00_Int4;
                    format   : tgg00_DateTimeFormat;
                    language : tsp00_C3;
                    VAR e    : tgg00_BasisError);
 
        FUNCTION
              g03date_error_to_b_err (date_e : tsp6_date_error)
                    : tgg00_BasisError;
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalFill  (
                    mod_id         : tsp00_C6;
                    mod_intern_num : tsp00_Int4;
                    source_upb     : tsp00_Int4;
                    source         : tsp00_MoveObjPtr;
                    source_pos     : tsp00_Int4;
                    length         : tsp00_Int4;
                    fill_char      : char;
                    VAR e          : tgg00_BasisError);
 
        PROCEDURE
              SAPDB_PascalMove (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
        PROCEDURE
              g10mv (
                    mod_id      : tsp00_C6;            
                    mod_num     : tsp00_Int4;
                    source_upb  : tsp00_Int4;          
                    dest_upb    : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;       
                    src_pos     : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;       
                    dest_pos    : tsp00_Int4;
                    length      : tsp00_Int4;
                    VAR e       : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        PROCEDURE
              s30cmp (
                    VAR buf1     : tsp00_MoveObj;
                    fieldpos1    : tsp00_Int4;
                    fieldlength1 : tsp00_Int4;
                    VAR buf2     : tsp00_MoveObj;
                    fieldpos2    : tsp00_Int4;
                    fieldlength2 : tsp00_Int4;
                    VAR l_result : tsp00_LcompResult);
 
        PROCEDURE
              s30map (
                    VAR code_t   : tsp00_Ctable;
                    VAR source   : tsp00_MoveObj;
                    spos         : tsp00_Int4;
                    VAR dest     : tsp00_C3;
                    dpos         : tsp00_Int4;
                    length       : tsp00_Int4);
 
        FUNCTION
              s30lnr_defbyte (
                    str       : tsp00_MoveObjPtr;
                    defbyte   : char;
                    start_pos : tsp00_Int4;
                    length    : tsp00_Int4) : tsp00_Int4;
 
      ------------------------------ 
 
        FROM
              GET-Conversions : VSP40;
 
        PROCEDURE
              s40glint (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    VAR dest    : tsp00_Int4;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s40glrel (
                    VAR buf  : tsp00_MoveObj;
                    pos      : tsp00_Int4;
                    len      : integer;
                    VAR dest : tsp00_Longreal;
                    VAR res  : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41plint (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    frac        : integer;
                    source      : tsp00_Int4;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s41psint (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    frac        : integer;
                    source      : tsp00_Int2;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s41plrel (
                    VAR buf : tsp00_MoveObj;
                    pos     : tsp00_Int4;
                    len     : integer;
                    frac    : integer;
                    source  : tsp00_Longreal;
                    VAR res : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              PUTSTRING-Conversions : VSP43;
 
        PROCEDURE
              s43pstr (
                    VAR buf    : tsp00_Number;
                    pos        : tsp00_Int4;
                    len        : integer;
                    frac       : integer;
                    VAR source : tsp00_Number;
                    spos       : tsp00_Int4;
                    slen       : integer;
                    VAR res    : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              Number-Arithmetic : VSP51;
 
        PROCEDURE
              s51div (
                    VAR left       : tsp00_Number;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_C5;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51mul (
                    VAR left       : tsp00_Number;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_C5;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51neg (
                    VAR source     : tsp00_Number;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51abs (
                    VAR source     : tsp00_MoveObj;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51sub (
                    VAR left       : tsp00_Number;
                    lpos           : tsp00_Int4;
                    llen           : integer;
                    VAR right      : tsp00_Number;
                    rpos           : tsp00_Int4;
                    rlen           : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
        PROCEDURE
              s51trunc (
                    VAR source     : tsp00_Number;
                    spos           : tsp00_Int4;
                    slen           : integer;
                    trunc          : integer;
                    VAR result     : tsp00_Number;
                    respos         : tsp00_Int4;
                    reslen         : integer;
                    resfrac        : integer;
                    VAR resbytelen : integer;
                    VAR ret        : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              date_time_formatting : VSP78;
 
        PROCEDURE
              s78ints_to_buf (
                    VAR buf       : tsp00_MoveObj;
                    pos           : tsp00_Int4;
                    VAR timestamp : tsp6_timestamp_array);
 
        PROCEDURE
              s78year_and_day (
                    VAR datbuf : tsp00_MoveObj;
                    datpos    : tsp00_Int4;
                    VAR year  : integer;
                    VAR day   : integer;
                    VAR e     : tsp6_date_error);
 
        PROCEDURE
              s78ints_from_buf (
                    VAR buf       : tsp00_MoveObj;
                    pos           : tsp00_Int4;
                    VAR timestamp : tsp6_timestamp_array;
                    VAR e         : tsp6_date_error);
 
        PROCEDURE
              s78year_month_day (
                    VAR datbuf : tsp00_MoveObj;
                    datpos    : tsp00_Int4;
                    VAR year  : integer;
                    VAR month : integer;
                    VAR day   : integer;
                    VAR e     : tsp6_date_error);
 
        PROCEDURE
              s78week_and_day (
                    VAR datbuf      : tsp00_MoveObj;
                    datpos          : tsp00_Int4;
                    VAR week        : integer;
                    VAR day_of_week : integer;
                    VAR e           : tsp6_date_error);
 
        PROCEDURE
              s78df_len1 (
                    format_addr : tsp00_MoveObjPtr;
                    format_len  : tsp00_Int2;
                    VAR df_elem : tsp6_date_fmt_elem;
                    VAR e       : tsp6_date_error);
 
        PROCEDURE
              s78time_from_buf (
                    VAR buf  : tsp00_MoveObj;
                    timepos  : tsp00_Int4;
                    timelen  : integer;
                    VAR hour : integer;
                    VAR min  : integer;
                    VAR sec  : integer;
                    VAR e    : tsp6_date_error);
 
        PROCEDURE
              s78val_from_buf (
                    VAR buf       : tsp00_MoveObj;
                    pos           : tsp00_Int4;
                    VAR year_hour : integer;
                    VAR month_min : integer;
                    VAR day_sec   : integer;
                    ret_error     : tsp6_date_error;
                    VAR e         : tsp6_date_error);
 
        PROCEDURE
              s78val_to_buf (
                    VAR buf   : tsp00_MoveObj;
                    pos       : tsp00_Int4;
                    year_hour : integer;
                    month_min : integer;
                    day_sec   : integer);
 
        FUNCTION
              s78day_sec (
                    VAR datbuf : tsp00_MoveObj;
                    datpos : tsp00_Int4;
                    VAR e  : tsp6_date_error) : integer;
 
        FUNCTION
              s78is_leap_year (year : integer) : boolean;
 
        FUNCTION
              s78days_of_year (year : integer) : integer;
 
        FUNCTION
              s78days_of_month (year : integer; month : integer): integer;
 
        FUNCTION
              s78diff_year_day (
                    year1 : integer;
                    day1  : integer;
                    year2 : integer;
                    day2  : integer) : tsp00_Int4;
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              Test_Procedures : VTA01;
 
        PROCEDURE
              t01int4 (
                    debug : tgg00_Debug;
                    nam : tsp00_Sname;
                    int : tsp00_Int4);
 
        PROCEDURE
              t01moveobj (
                    debug    : tgg00_Debug;
                    VAR buf  : tsp00_MoveObj;
                    startpos : tsp00_Int4;
                    endpos   : tsp00_Int4);
 
        PROCEDURE
              t01buf (
                    debug    : tgg00_Debug;
                    VAR buf  : tsp00_Number;
                    startpos : integer;
                    endpos   : integer);
 
        PROCEDURE
              t01p2int4 (
                    debug : tgg00_Debug;
                    nam_1 : tsp00_Sname;
                    int_1 : tsp00_Int4;
                    nam_2 : tsp00_Sname;
                    int_2 : tsp00_Int4);
 
        PROCEDURE
              t01sname (debug : tgg00_Debug; nam : tsp00_Sname);
 
        PROCEDURE
              t01stackentry (
                    debug          : tgg00_Debug;
                    VAR st         : tgg00_StackEntry;
                    entry_index    : integer);
 
        PROCEDURE
              t01real (
                    debug    : tgg00_Debug;
                    nam      : tsp00_Sname;
                    r        : tsp00_Longreal;
                    digits   : integer);
&       endif
 
      ------------------------------ 
 
        FROM
              KB_build_in_func: VKB78;
 
        PROCEDURE
              k78unicode_transform (
                    VAR op             : tgg00_StackEntry;
                    VAR sel            : tgg00_SelectFieldsParam;
                    operand_addr       : tsp00_MoveObjPtr;
                    len                : integer;
                    VAR e              : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              Pointer-Arithmetik: VSP35;
 
        FUNCTION
              s35add_moveobj_ptr (
                    buf_addr : tsp00_MoveObjPtr;
                    pos : tsp00_Int4) : tsp00_MoveObjPtr;
 
        FUNCTION
              s35inc_st (
                    addr : tgg00_StEntryAddr;
                    pos : tsp00_Int4) : tgg00_StEntryAddr;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              g02pebcdic_pos_ascii;
 
              tsp00_MoveObj tsp00_Date
 
        PROCEDURE
              s30map;
 
              tsp00_MoveObj tsp00_C3
 
        PROCEDURE
              s43pstr;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51abs;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51neg;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51sub;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51trunc;
 
              tsp00_MoveObj tsp00_Number
 
        PROCEDURE
              s51div;
 
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_C5
 
        PROCEDURE
              s51mul;
 
              tsp00_MoveObj tsp00_Number
              tsp00_MoveObj tsp00_C5
 
        FUNCTION
              s35add_moveobj_ptr;
 
              tsp00_Int4 tsp00_MoveObjPtr
&             ifdef trace
 
        PROCEDURE
              t01buf;
 
              tsp00_Buf tsp00_Number;
&             endif
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : JuergenA
.sp
.cp 3
Created : 1985-10-01
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-08-25
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.sp
This module contains procedures for date and time conversion and
arithmetic (origin: VIN42).
.sp
All date and time entries are contained in a buffer whose position
points to the defined byte. The 9 byte entries have the
specified form dYYYYMMDD or dHHHHMMSS (d~=~defined~byte).
For time entries, the digits can be omitted except for the last second.
.sp 2;.cp 3
Procedure K79DATE_TIME
.sp
Distributor for date and time functions.
.sp 2;.cp 4
Procedure KB79ADD_DATE
.sp
Adds a number of days (ADD_DAYS) to a date from the buffer INDAT
and assigns the new date to the buffer OUTDAT.
.sp 2;.cp 4
Procedure KB79ADD_MONTH
.sp
Adds a number of month (ADD_MONTH) to a date from the buffer INDAT
and assigns the new date to the buffer OUTDAT.
.sp 2;.cp 4
Procedure KB79ADD_TIME
.sp
Adds the time contained in the buffer TIMEBUF2
to the time contained in the buffer TIMEBUF1 and assignes
the new time to the buffer RESULTBUF.
.sp 2;.cp 4
Procedure KB79BUF_DATE_SUB
.sp
Calculates the difference between two date values and returns a number
which contains the number of year, month and days like this: 'yyyymmdd'.
.sp 2;.cp 4
Procedure KB79BUF_TIME_SUB
.sp
Calculates the difference between two time values and returns a number
which contains the number of hours,
minutes and seconds like this : 'hhmmss'.
.sp 2;.cp 4
Procedure KB79CHECK_STAMP_VALUES
.sp
Checks a values of a timestamp. 'adjusted' will be set to true, if at
least one part of the timestamp was changed.
.sp 2;.cp 4
Procedure KB79DATE_ADD_SUB
.sp
Processes the arithmetic on date values and durations. INDAT contains
a bufferaddress where the date value is stored and DURATION is the
second parameter. The result is stored in OUTDAT.
If a date duration
is given, IS_LABELED is false. Otherwise IS_LABELED is true and
DUARTION_TYPE contains information about the type of labeled duration.
IS_ADD is true if an addition must be done otherwise false.
.sp 2;.cp 4
Procedure KB79DATE_DIFF
.sp
Calculates the difference DAYS between two date entries contained in
the buffers DATBUF1 and DATBUF2.
.sp 2;.cp 4
Procedure KB79DATETIME_ARITH
.sp
Processes the arithmetical operations on date, time or timestamp values.
OP.EPOS specifies the type of the first operand (0 for date, 1 for
time and 2 for timestamp)
and OP.ELEN_VAR the type of the second operand (0 for same type as the
first, 1 for number, i.e a date_duration or time_duration, and 2 for
a labeled duration). In case of a labeled duration OP.ECOL_TAB[ 1 ]
contains the type of duration (year, ..., microsecond).
.in +5;.cp 5;.nf
.sp;DATE -   DATE          ==>  KB79BUF_DATE_SUB
.br;DATE -/+ DURATION      ==>  KB79DATE_ADD_SUB
.sp;TIME -   TIME          ==>  KB79BUF_TIME_SUB
.br;TIME -/+ DURATION      ==>  KB79TIME_ADD_SUB
.sp;TIMESTAMP -/+ DURATION ==>  KB79TIMESTAMP_ADD_SUB
.in -5;.fo
.sp 2;.cp 4
Function KB79DAY_SEC
.sp
Returns the seconds from begin of the day.
.sp 2;.cp 4
Procedure KB79DAY_YEAR_TO_DATE
.sp
Converts a date in the form (year, day) to dYYYYMMDD and
writes it with the defined byte to the buffer.
.sp 2;.cp 3
Procedure S78DAYS_OF_MONTH
.sp
Returns the number of days for a specified month.
.sp 2;.cp 3
PROCEDURE K79DAYS_OF_YEAR
.sp
Returns the number of days in a specified year.
.sp 2;.cp 4
Procedure S78DIFF_YEAR_DAY
.sp
Returns the difference (in days) between two entries consisting of
year and day.
.sp 2;.cp 3
Procedure S78INT_FROM_BUF
.sp
Reads an integer from a buffer.
.sp 2;.cp 3
Procedure KB79INT_TO_BUF
.sp
Writes an integer to a buffer.
.sp 2;.cp 3
Procedure K79IS_LEAP_YEAR
.sp
Returns true, if the specified year is a leap year.
.sp 2;.cp 4
Procedure KB79MAKE_DATE
.sp
Converts a year and a day into a date entry and assignes the entry
to the buffer OUTDATE.
.sp 2;.cp 5
Procedure KB79OP_CHECK_FORMAT
.sp
The procedure checks the format of a time, date or timestamp value.
OP.ELEN_VAR specifies the actual date_time format and
OP.EPOS specifies whether a date, time or timestamp must be tested.
.sp 2;.cp 3
Procedure KB79OP_DATE
.sp
Processes the function DATE. The function supplies a date, which is
evaluated as the n-1 th day after '01010001'.
.in +5;.nf
.sp;DATE (726126)  ==>  '19890124'
.in -5;.fo
.sp 2;.cp 7
Procedure KB79OP_DATE_ADD_SUB
.sp
Processes the ADDDATE or SUBDATE function.  The result supplied is
the date, consisting of a date plus/minus a number of days.
.in +5;.nf
.br;ADDDATE ('19880423', 10)  ==>  '19880503'
.br;SUBDATE ('19880423', 10)  ==>  '19880413'
.in -5;.fo
.sp 2;.cp 3
Procedure KB79OP_DATE_FROM_TIMESTAMP
.sp
Processes the functions OP_DATE_FROM_TIMESTAMP and OP_TIME.
The function supplies the timepart of a given timestamp value.
.in +5;.nf
.sp;TIME ('19890124184605003210')  ==>  '00184605'
.in -5;.fo
.sp 2;.cp 4
Procedure KB79OP_DATEDIFF
.sp
Processes the DATEDIFF function. The result supplied is the
number of days between the two date entries.
.in +5;.nf
DATEDIFF ('19880423', '19880503')  ==>  10
.in -5;.fo
.sp 2;.cp 4
Procedure KB79OP_DATETIME
.sp
Processes the DATETIME function.
.sp 2;.cp 3
Procedure KB79OP_DAY_WEEK
.sp
Processes the DAYOFWEEK, DAYOFYEAR or WEEKOFYEAR function.  For the
specified date, the value Monday through Sunday is evaluated for
DAYOFWEEK in the form of the numbers 1 to 7, the number of the day
in relation to the year is evaluated for DAYOFYEAR and the week
number is evaluated for WEEKOFYEAR.  Since only the week number appears
in the case of WEEKOFYEAR and not the number of the year, the number
1 or 52 can be assigned twice for one year if one of the numbers
refers to the previous or following year.
.in +5;.cp 3;.nf
.br;DAYOFWEEK  ('19880423')  ==>    6
.br;DAYOFYEAR  ('19880423')  ==>  114
.br;WEEKOFYEAR ('19880423')  ==>   16
.in -5;.fo
.sp 2;.cp 6
Procedure KB79OP_DAYS
.sp
The procedure processes the function DAYS. The result supplied is the
number of days since 31.12.0000 up to the given date.
.in +5;.nf
.sp;DAYS('19890124') ==> 726126
.in -5;.fo
.sp 2;.cp 3
Procedure KB79OP_FORMAT_CHANGE
.sp
Changes the internal format of a given date, time or timestamp value
to the specified format. OP.ECOL_TAB[ 1 ] specifies the type of the
operand ('0' for date, '1' for time and '2' for timestamp) and
OP.ECOL_TAB[ 2 ] the format to change to. In case of a time value it is
possible, that the hourpart contains a hour greater than 99 (if format
= USA then greater than 23). Then in procedure G03_TCHANGE_FORMAT
the hour is corrected modulo 99 (23) and e is set to
E_TIME_VALUE_TOO_LONG. This basis_error is changed to E_OK and
WARN11_TIME_VALUE_TOO_LONG is set.
.sp 2;.cp 6
Procedure KB79OP_LAST_DAY
.sp
Supplies the date in the date of the last day of this month.
.in +5;.nf
LAST_DAY ('19920701')  ==>  '19920731')
.in -5;.fo
.sp 2;.cp 6
Procedure KB79OP_MAKEDATE
.sp
Processes the MAKEDATE function. The result date is calculated from
the two operands year and day of year.
.in +5;.nf
MAKEDATE (1988, 114)  ==>  '19880423'
.in -5;.fo
.sp 2;.cp 6
Procedure KB79OP_MAKETIME
.sp
Processes the MAKETIME function. The result is calculated from
the three operands hour, minute and second.
.in +5;.nf
MAKETIME (17, 44, 30)  ==> '00174430'
.in -5;.fo
.sp 2;.cp 8
Procedure KB79OP_MONTH_ADD_SUB
.sp
The procedure processes the ADDMONTH or SUBMONTH function. The result
value is calculated from a time plus/minus a number of months.
.in +5;.nf
ADD_MONTHS ('19920710', 10)  ==>  '19930510'
ADD_MONTHS ('19920710',-10)  ==>  '19910910'
.in -5;.fo
.sp 2;.cp 8
Procedure KB79OP_MONTHS_BETWEEN
.sp
Supplies the different of two dates by month number. If the same day
of month in the both dates then the result is a integer value. If a
different between the days of month, then the result is part of the
days and time.
.in +5;.nf
MONTHS_BETWEEN ('19920710', '19930510') ==> -10
MONTHS_BETWEEN ('19920712', '19930710') ==> 0.0645161290
.in -5;.fo
.sp 2;.cp 8
Procedure KB79OP_TIME_ADD_SUB
.sp
The procedure processes the ADDTIME or SUBTIME function. The result value
is calculated from a time plus/minus a number of hours, minutes
and seconds. The minutes and seconds may exceed the value 60.
.in +5;.nf
ADDTIME ('00174430', '00113843')  ==>  '00292313'
SUBTIME ('00174430', '00113843')  ==>  '00060547'
.in -5;.fo
.sp 2;.cp 6
Procedure KB79OP_TIMEDIFF
.sp
Processes the TIMEDIFF function. The result supplied is the time
consisting of the difference between two times.
.in +5;.nf
TIMEDIFF ('00113843', '00174430')  ==>  '00060547'
.in -5;.fo
.sp 2;.cp 3
Procedure KB79OP_TIMESTAMP
.sp
Supplies a timestamp value, which is evaluated as the concatenation of
the first operand ( a date value ) and the second ( a time value ).
The microsecondpart is filled with zeros. If the hourpart of the given
timevalue is greater than 23, the number of days specified by the hours
are added to the datevalue (with KB79ADD_DATE).
.in +5;.nf
.sp;TIMESTAMP ('19890124','00184605')  ==>  '19890124184605000000'
.in -5;.fo
.sp 2;.cp 3
Procedure KB79SEC_GET
.sp
Converts the specified hours, minutes and seconds into seconds.
.sp 2;.cp 3
Procedure KB79SEC_PUT
.sp
Converts the specified seconds into hours, minutes and seconds.
.sp 2;.cp 4
Procedure KB79SUB_DATE
.sp
Subtracts a number of days (SUB_DAYS) from a date in the buffer
INDAT and assignes the new date to the buffer OUTDAT.
.sp 2;.cp 4
Procedure KB79SUB_MONTH
.sp
Subs a number of month (SUB_MONTH) to a date from the buffer INDAT
and assigns the new date to the buffer OUTDAT.
.sp 2;.cp 4
Procedure KB79SUB_TIME
.sp
Subtracts the time in the buffer TIMEBUF2 from a time in the buffer
TIMEBUF1 and assignes the new time to the buffer RESULTBUF.
.sp 2;.cp 4
Procedure KB79TIME_ADD_SUB
.sp
Processes the arithmetic on time values and durations. INTIM contains
a bufferaddress where the time value is stored and DURATION is the
second parameter. The result is stored in OUTTIM.
If a time duration
is given, IS_LABELED is false. Otherwise IS_LABELED is true and
DURATION_TYPE contains information about the typ of labeled duration.
IS_ADD is true if an addition must be done otherwise false.
.sp 2;.cp 4
Procedure KB79TIME_FROM_BUF
.sp
Converts a time entry contained in the buffer BUF into the
hour, minutes and seconds.
.sp 2;.cp 4
Procedure KB79TIMESTAMP_ADD_SUB
.sp
Processes the arithmetic on timestamp values and durations.
INTIM contains
a bufferaddress where the timestamp value is stored
and DURATION is the
second parameter. The result is stored in OUTTIM.
Only labeled dauration can be given.
DURATION_TYPE contains information about the typ of labeled duration.
IS_ADD is true if an addition must be done otherwise false.
.sp 2;.cp 4
Procedure KB79VAL_FROM_BUF
.sp
Reads a date or time entry consisting of three integers from a buffer,
where they are stored as a 9 byte string with a defined byte.
.sp 2;.cp 4
Procedure KB79VAL_TO_BUF
.sp
Writes a date or time entry consisting of three integers to a buffer
as a 9 byte string with a defined byte.
.sp 2;.cp 4
Procedure K79WEEK_AND_DAY
.sp
Converts a date entry contained in the buffer DATBUF into the
week and the day of week (1~=~Monday, ...~, 7~=~Sunday).
.sp 2;.cp 4
Procedure KB79WEEKDAY
.sp
Returns the day of the week (1~=~Monday, ...~, 7~=~Sunday) for the
specified day of a year.
.sp 2;.cp 4
PROCEDURE KB79YEAR_AND_DAY
.sp
Converts a date entry contained in the buffer DATBUF into the
year, and the day of year.
.sp 2;.cp 4
PROCEDURE K79_YEAR_MONTH_DAY
.sp
Converts a date entry contained in the buffer DATBUF into the
year, the month and the day.
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.sp
.oc _/1;Notes concerning the calender week:
.sp;If the first of January for a particular year comes
.oc _/1;before
a Friday (i.e. Monday through Thursday), this first week of the
year, which has already begun, belongs
.oc _/1;completely
to the new year, including the days of this week that are in the
previous year.
.sp;Otherwise, the entire week is the
.oc _/1;last week of the previous year.
.sp;.oc _/1;Example:
.br;If January 1st is a Thursday, the 1st calender week of the new
year begins on Monday, December 29.
.br;If, on the other hand, January 1st is a Friday, then Sunday,
January 3 is still part of the last week of the previous year.
.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
      max_days       =  3652059;
      max_seconds    = 35999999;
      max_year       =     9999;
      max_months     =   121735;
      max_sec_of_day =    86400;
      c_date         = 0;
      c_time         = 1;
      c_timestamp    = 2;
      c_value        = 0;
      c_number       = 1;
      c_duration     = 2;
      c_year         = 0;
      c_month        = 1;
      c_day          = 2;
      c_hour         = 3;
      c_minute       = 4;
      c_second       = 5;
      c_microsec     = 6;
      c_timestamp_len   = 20;
      c_timestamp_iolen = 12;
      (* *)
      c_check_spec_null = true;
      c_is_labeled      = true;
      c_positive        = true;
      c_add_wanted      = true;
 
 
(*------------------------------*) 
 
FUNCTION
      k79date_time (
            VAR t    : tgg00_TransContext;
            VAR sel  : tgg00_SelectFieldsParam;
            VAR st   : tgg00_StackEntry) : tgg00_BasisError;
 
BEGIN
IF  st.etype = st_build_in_func
THEN
    CASE st.eop_build_in OF
        op_b_check_format:
            kb79op_check_format (st, sel, t.trError_gg00);
        op_b_datetime:
            kb79op_datetime (st, sel, t.trError_gg00);
        op_b_format_change:
            kb79op_format_change (st, sel, t.trWarning_gg00, t.trError_gg00);
        op_b_next_day :
            kb79op_next_day (st, sel, t.trError_gg00);
        op_b_ts_trunc, op_b_ts_round :
            kb79op_trunc_ts (st, sel, t.trError_gg00);
        op_b_new_time :
            kb79op_new_time (sel, t.trError_gg00);
        op_b_dayofmonth :
            kb79op_day_month (sel, t.trError_gg00);
        OTHERWISE
            t.trError_gg00 := e_stack_op_illegal
        END
    (*ENDCASE*) 
ELSE
    IF  st.etype = st_datetime_arith
    THEN
        kb79datetime_arith (st, sel, t.trWarning_gg00, t.trError_gg00)
    ELSE
        CASE st.eop OF
            op_adddate, op_subdate:
                kb79op_date_add_sub (st.eop, sel, t.trError_gg00);
            op_addmonth, op_submonth:
                kb79op_month_add_sub (st.eop, sel, t.trError_gg00);
            op_addtime, op_subtime:
                kb79op_time_add_sub (st.eop, sel, t.trError_gg00);
            op_date:
                kb79op_date (sel, t.trError_gg00);
            op_date_from_timestamp, op_time:
                kb79op_date_from_timestamp (st.eop, sel, t.trError_gg00);
            op_datediff:
                kb79op_datediff (sel, t.trError_gg00);
            op_dayofweek, op_dayofyear, op_weekofyear:
                kb79op_day_week (st.eop, sel, t.trError_gg00);
            op_days:
                kb79op_days (sel, t.trError_gg00);
            op_last_day:
                kb79op_last_day (sel, t.trError_gg00);
            op_makedate :
                kb79op_makedate (sel, t.trError_gg00);
            op_maketime:
                kb79op_maketime (sel, t.trError_gg00);
            op_months_between:
                kb79op_months_between( sel, t.trError_gg00);
            op_timediff:
                kb79op_timediff (sel, t.trError_gg00);
            op_timestamp:
                kb79op_timestamp (sel, t.trError_gg00);
            OTHERWISE
                t.trError_gg00 := e_stack_op_illegal
            END;
        (*ENDCASE*) 
    (*ENDIF*) 
(*ENDIF*) 
k79date_time := t.trError_gg00
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79add_date (
            VAR indat  : tsp00_MoveObj;
            inpos      : tsp00_Int4;
            VAR outdat : tsp00_MoveObj;
            outpos     : tsp00_Int4;
            add_days   : tsp00_Int4;
            VAR e      : tsp6_date_error);
 
VAR
      day          : integer;
      year         : integer;
      rest_of_year : integer;
      diff         : tsp00_Int4;
 
LABEL
      999;
 
BEGIN
e := sp6de_ok;
IF  add_days > max_days
THEN
    BEGIN
    e := sp6de_num_invalid;
    goto 999;
    END
ELSE
    s78year_and_day (indat, inpos, year, day, e);
(*ENDIF*) 
diff := add_days;
REPEAT
    rest_of_year := s78days_of_year(year) - day;
    IF  rest_of_year >= diff
    THEN
        BEGIN
        day  := day + diff;
        diff := 0
        END
    ELSE
        BEGIN
        diff := diff - rest_of_year;
        IF  year >= max_year
        THEN
            BEGIN
            e := sp6de_invalid_date;
            goto 999;
            END
        ELSE
            year := year + 1;
        (*ENDIF*) 
        day  := 0
        END
    (*ENDIF*) 
UNTIL
    (diff <= 0);
(*ENDREPEAT*) 
kb79day_year_to_date (day, year, outdat, outpos);
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79add_month (
            VAR indat  : tsp00_MoveObj;
            inpos      : tsp00_Int4;
            VAR outdat : tsp00_MoveObj;
            outpos     : tsp00_Int4;
            add_months : tsp00_Int4;
            VAR e      : tsp6_date_error);
 
VAR
      day              : integer;
      month            : integer;
      year             : integer;
      max_day_of_month : integer;
      diff             : tsp00_Int4;
 
LABEL
      999;
 
BEGIN
e := sp6de_ok;
IF  add_months > max_months
THEN
    BEGIN
    e := sp6de_num_invalid;
    goto 999;
    END
ELSE
    s78year_month_day (indat, inpos, year, month, day, e);
(*ENDIF*) 
year := year + add_months DIV 12;
diff := add_months MOD 12;
IF  month + diff > 12
THEN
    BEGIN
    year  := succ(year);
    month := month + diff - 12 ;
    END
ELSE
    month := month + diff;
(*ENDIF*) 
max_day_of_month := s78days_of_month (year, month);
IF  max_day_of_month < day
THEN
    day := max_day_of_month;
(*ENDIF*) 
s78val_to_buf (outdat, outpos, year, month, day);
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79add_time (
            VAR timebuf1  : tsp00_MoveObj;
            timepos1      : tsp00_Int4;
            timelen1      : integer;
            VAR timebuf2  : tsp00_MoveObj;
            timepos2      : tsp00_Int4;
            timelen2      : integer;
            VAR resultbuf : tsp00_MoveObj;
            resultpos     : tsp00_Int4;
            VAR e         : tsp6_date_error);
 
VAR
      hour    : integer;
      min     : integer;
      sec     : integer;
      seconds : tsp00_Int4;
 
LABEL
      999;
 
BEGIN
e := sp6de_ok;
s78time_from_buf (timebuf1, timepos1, timelen1, hour, min, sec, e);
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
seconds := kb79sec_get (hour, min, sec);
s78time_from_buf (timebuf2, timepos2, timelen2, hour, min, sec, e);
seconds := seconds + kb79sec_get (hour, min, sec);
IF  (seconds < 0) OR (seconds > max_seconds)
THEN
    BEGIN
    e := sp6de_invalid_time;
    goto 999;
    END;
(*ENDIF*) 
kb79sec_put (seconds, hour, min, sec);
s78val_to_buf (resultbuf, resultpos, hour, min, sec);
999: ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79buf_date_sub (
            VAR indat1 : tsp00_MoveObj;
            inpos1     : tsp00_Int4;
            VAR indat2 : tsp00_MoveObj;
            inpos2     : tsp00_Int4;
            VAR result : tsp00_Int4;
            VAR e      : tsp6_date_error);
 
CONST
      year_duration  = 10000;
      month_duration = 100;
      max_month      = 12;
 
VAR
      year, year1   : integer;
      month, month1 : integer;
      day, day1     : integer;
      res_year      : integer;
      res_month     : integer;
      res_day       : integer;
 
BEGIN
(* Note: The result of this operation is a duration, so that even   *)
(*       months greater 12 or 0 and days greater 31 or 0 are valid. *)
e := sp6de_ok;
s78val_from_buf (indat1, inpos1, year, month, day,
      sp6de_invalid_date, e);
s78val_from_buf (indat2, inpos2, year1, month1, day1,
      sp6de_invalid_date, e);
&ifdef TRACE
t01p2int4 (kb_qual, 'year        ', year
      ,             'year1       ', year1);
t01p2int4 (kb_qual, 'month       ', month
      ,             'month1      ', month1);
t01p2int4 (kb_qual, 'day         ', day
      ,             'day1        ', day1);
&endif
res_day := day - day1;
IF  day1 > day
THEN
    BEGIN
    (* PTS 1105511 E.Z. *)
    res_day := res_day + s78days_of_month (year1, month1);
    month1 := succ(month1);
    END;
(*ENDIF*) 
IF  month1 <= month
THEN
    res_month := month - month1
ELSE
    BEGIN
    res_month := max_month + month - month1;
    year1     := year1 + 1
    END;
(*ENDIF*) 
res_year := year - year1;
result   := res_year  * year_duration
      +     res_month * month_duration
      +     res_day;
&ifdef TRACE
t01int4 (kb_qual, 'res_year    ', res_year );
t01int4 (kb_qual, 'res_month   ', res_month);
t01int4 (kb_qual, 'res_day     ', res_day  );
t01int4 (kb_qual, 'result      ', result   );
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79buf_time_sub (
            VAR intim1 : tsp00_MoveObj;
            inpos1     : tsp00_Int4;
            VAR intim2 : tsp00_MoveObj;
            inpos2     : tsp00_Int4;
            VAR result : tsp00_Int4;
            VAR e      : tsp6_date_error);
 
CONST
      hour_duration   = 10000;
      minute_duration = 100;
      max_minute      = 60;
      max_second      = 60;
 
VAR
      hour, hour1     : integer;
      minute, minute1 : integer;
      second, second1 : integer;
      res_hour        : integer;
      res_minute      : integer;
      res_second      : integer;
 
BEGIN
e := sp6de_ok;
s78val_from_buf (intim1, inpos1, hour, minute, second,
      sp6de_invalid_time, e);
s78val_from_buf (intim2, inpos2, hour1, minute1, second1,
      sp6de_invalid_time, e);
&ifdef TRACE
t01p2int4 (kb_qual, 'hour        ', hour
      ,             'hour1       ', hour1);
t01p2int4 (kb_qual, 'minute      ', minute
      ,             'minute1     ', minute1);
t01p2int4 (kb_qual, 'second      ', second
      ,             'second1     ', second1);
&endif
IF  second1 <= second
THEN
    res_second := second - second1
ELSE
    BEGIN
    res_second := max_second + second - second1;
    minute1    := minute1 + 1
    END;
(*ENDIF*) 
IF  minute1 <= minute
THEN
    res_minute := minute - minute1
ELSE
    BEGIN
    res_minute := max_minute + minute - minute1;
    hour1      := hour1 + 1
    END;
(*ENDIF*) 
res_hour := hour - hour1;
IF  res_hour > 99
THEN
    BEGIN
    e := sp6de_invalid_time;
    result := 0
    END
ELSE
    result := res_hour   * hour_duration
          +   res_minute * minute_duration
          +   res_second;
(*ENDIF*) 
&ifdef TRACE
t01int4 (kb_qual, 'res_hour    ', res_hour  );
t01int4 (kb_qual, 'res_minute  ', res_minute);
t01int4 (kb_qual, 'res_second  ', res_second);
t01int4 (kb_qual, 'result      ', result    );
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79buf_tstamp_sub (
            VAR indat1 : tsp00_MoveObj;
            inpos1     : tsp00_Int4;
            VAR indat2 : tsp00_MoveObj;
            inpos2     : tsp00_Int4;
            VAR result : tsp00_Longreal;
            VAR e      : tsp6_date_error);
 
CONST
      time_len = 7;
      time_pos = 8;
 
VAR
      days         : tsp00_Int4;
      hour         : tsp00_Int4;
      min          : tsp00_Int4;
      sec          : tsp00_Int4;
      seconds      : tsp00_Int4;
 
LABEL
      999;
 
BEGIN
e := sp6de_ok;
kb79date_diff (indat1, inpos1, indat2, inpos2, days, e);
IF  (e <> sp6de_ok)
THEN
    goto 999;
&ifdef TRACE
(*ENDIF*) 
t01int4 (kb_qual, 'Cnt of days ', days );
&endif
s78time_from_buf (indat1, inpos1 + time_pos, time_len,
      hour, min, sec, e);
IF  (e <> sp6de_ok)
THEN
    goto 999;
(*ENDIF*) 
seconds := kb79sec_get (hour, min, sec);
IF  (seconds > max_sec_of_day)
THEN
    BEGIN
    e := sp6de_invalid_date;
    goto 999;
    END;
(*ENDIF*) 
s78time_from_buf (indat2, inpos2 + time_pos, time_len,
      hour, min, sec, e);
IF  (e <> sp6de_ok)
THEN
    goto 999;
(*ENDIF*) 
seconds := seconds - kb79sec_get (hour, min, sec);
IF  (seconds > max_sec_of_day)
THEN
    BEGIN
    e := sp6de_invalid_date;
    goto 999;
    END;
(*ENDIF*) 
result := days + (seconds / max_sec_of_day);
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79lbuf_tstamp_sub_labeled (
            VAR indat1  : tsp00_MoveObj;
            inpos1      : tsp00_Int4;
            VAR indat2  : tsp00_MoveObj;
            inpos2      : tsp00_Int4;
            VAR res_num : tsp00_Number;
            VAR e       : tsp6_date_error);
 
VAR
      timestamp     : tsp6_timestamp_array;
      timestamp1    : tsp6_timestamp_array;
      res_timestamp : tsp6_timestamp_array;
      curr_type     : integer;
      increase      : integer;
      num_buf       : tsp00_C20;
      num_mptr      : tsp00_MoveObjPtr;
      num_err       : tsp00_NumError;
 
LABEL
      999;
 
BEGIN
e := sp6de_ok;
s78ints_from_buf (indat1, inpos1, timestamp, e);
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
s78ints_from_buf (indat2, inpos2, timestamp1, e);
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
FOR curr_type := 7 DOWNTO 1 DO
    BEGIN
    IF  timestamp1[ curr_type ] <= timestamp[ curr_type ]
    THEN
        res_timestamp[ curr_type ] :=
              + timestamp [ curr_type ]
              - timestamp1[ curr_type ]
    ELSE
        IF  curr_type > 1
        THEN (* overflow on years couldn't happen... *)
            BEGIN
            CASE curr_type OF
                2: (* month *)
                    increase := 12;
                3: (* day *)
                    increase := s78days_of_month (timestamp1[ 1 ],
                          timestamp1[ 2 ]);
                4: (* hour *)
                    increase := 24;
                5: (* minutes *)
                    increase := 60;
                6: (* seconds *)
                    increase := 60;
                7: (* microseconds *)
                    increase := 1000000;
                END;
            (*ENDCASE*) 
            res_timestamp[ curr_type ] := increase
                  + timestamp [ curr_type ]
                  - timestamp1[ curr_type ];
            timestamp1[ curr_type-1 ]  := succ (timestamp1[ curr_type-1 ])
            END
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDFOR*) 
num_mptr := @num_buf;
s78ints_to_buf (num_mptr^, 1, res_timestamp);
s43pstr (res_num, 1, csp_fixed,
      csp_float_frac, num_buf, 1,
      sizeof (num_buf), num_err);
IF  (num_err <> num_ok) AND (num_err <> num_trunc)
THEN
    BEGIN
    e := sp6de_num_invalid;
    goto 999;
    END;
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79check_stamp_values (
            VAR values   : tsp6_timestamp_array;
            val_type     : integer;
            positive     : boolean;
            VAR adjusted : boolean);
 
VAR
      i             : integer;
      check_val     : integer;
      offset        : integer;
      days_of_month : integer;
 
BEGIN
adjusted := false;
FOR i := val_type DOWNTO 2 DO
    BEGIN
    CASE i OF
        2 : (* Months. *)
            BEGIN
            IF  positive
            THEN
                check_val := 12
            ELSE
                check_val := 1;
            (*ENDIF*) 
            offset := 12
            END;
        3 : (* Days; special treatment, look below. *)
            BEGIN
            END;
        4 : (* Hours. *)
            BEGIN
            IF  positive
            THEN
                check_val := 23
            ELSE
                check_val := 0;
            (*ENDIF*) 
            offset := 24
            END;
        5, 6 : (* Minutes or Seconds. *)
            BEGIN
            IF  positive
            THEN
                check_val := 59
            ELSE
                check_val := 0;
            (*ENDIF*) 
            offset := 60
            END;
        7 : (* Microseconds. *)
            BEGIN
            IF  positive
            THEN
                check_val := 999999
            ELSE
                check_val := 0;
            (*ENDIF*) 
            offset := 1000000
            END
        END;
    (*ENDCASE*) 
    IF  i <> 3
    THEN
        IF  positive
        THEN
            BEGIN
            IF  values[ i ] > check_val
            THEN
                BEGIN
                adjusted      := true;
                values[ i   ] := values[ i   ] - offset;
                values[ i-1 ] := values[ i-1 ] + 1
                END
            (*ENDIF*) 
            END
        ELSE
            BEGIN
            IF  values[ i ] < check_val
            THEN
                BEGIN
                adjusted      := true;
                values[ i   ] := values[ i   ] + offset;
                values[ i-1 ] := values[ i-1 ] - 1
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
    ELSE
        BEGIN (* Days are special, because the count per month depends. *)
        days_of_month := s78days_of_month (values[ 1 ], values[ 2 ]);
        IF  values[ 3 ] > days_of_month
        THEN
            BEGIN
            adjusted    := true;
            values[ 3 ] := values[ 3 ] - days_of_month;
            values[ 2 ] := values[ 2 ] + 1;
            IF  values[ 2 ] > 12
            THEN
                BEGIN
                values[ 2 ] := values[ 2 ] - 12;
                values[ 1 ] := values[ 1 ] +  1
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  values[ 3 ] < 1
        THEN
            BEGIN
            adjusted    := true;
            values[ 2 ] := values[ 2 ] - 1;
            IF  values[ 2 ] < 1
            THEN
                BEGIN
                values[ 2 ] := values[ 2 ] + 12;
                values[ 1 ] := values[ 1 ] -  1
                END;
            (*ENDIF*) 
            values[ 3 ] := values[ 3 ] +
                  s78days_of_month (values[ 1 ], values[ 2 ]);
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79date_add_sub (
            VAR indat     : tsp00_MoveObj;
            inpos         : tsp00_Int4;
            date_duration : tsp00_Int4;
            VAR outdat    : tsp00_MoveObj;
            outpos        : tsp00_Int4;
            add_wanted    : boolean;
            is_labeled    : boolean;
            duration_type : char;
            VAR e         : tsp6_date_error);
 
CONST
      year_duration  = 10000;
      month_duration = 100;
 
VAR
      is_add       : boolean;
      i            : integer;
      year         : integer;
      month        : integer;
      day          : integer;
      abs_duration : tsp00_Int4;
      duration     : ARRAY [ 1..3 ] OF integer;
 
LABEL
      999;
 
BEGIN
e := sp6de_ok;
&ifdef TRACE
t01p2int4 (kb_qual, 'date_duratio', date_duration
      ,             'add_wanted  ', ord(add_wanted));
t01p2int4 (kb_qual, 'is_labeled  ', ord(is_labeled)
      ,             'durationtype', ord(duration_type));
&endif
IF  date_duration < 0
THEN
    BEGIN
    is_add       := NOT add_wanted;
    abs_duration := - date_duration
    END
ELSE
    BEGIN
    is_add       := add_wanted;
    abs_duration := date_duration
    END;
(*ENDIF*) 
&ifdef TRACE
t01p2int4 (kb_qual, 'abs_duratio ', abs_duration
      ,             'is_add      ', ord(is_add));
t01p2int4 (kb_qual, 'is_labeled  ', ord(is_labeled)
      ,             'durationtype', ord(duration_type));
&endif
FOR i := 1 TO 3 DO
    IF  is_labeled
    THEN
        IF  ord(duration_type) + 1 = i
        THEN
            duration[ i ] := abs_duration
        ELSE
            duration[ i ] := 0
        (*ENDIF*) 
    ELSE
        CASE i OF
            1 :
                duration[ i ] := abs_duration DIV year_duration;
            2 :
                duration[ i ] := (abs_duration MOD year_duration)
                      DIV month_duration;
            3 :
                duration[ i ] := abs_duration MOD month_duration
            END;
        (*ENDCASE*) 
    (*ENDIF*) 
(*ENDFOR*) 
s78val_from_buf (indat, inpos, year, month, day,
      sp6de_invalid_date, e);
&ifdef TRACE
t01p2int4 (kb_qual, 'year        ', year
      ,             'year_duratio', duration[ 1 ]);
t01p2int4 (kb_qual, 'month       ', month
      ,             'month_durati', duration[ 2 ]);
t01p2int4 (kb_qual, 'day         ', day
      ,             'day_duration', duration[ 3 ]);
&endif
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
IF  is_add
THEN
    year := year + duration[ 1 ]
ELSE
    year := year - duration[ 1 ];
(*ENDIF*) 
IF  is_add
THEN
    month := month + duration[ 2 ]
ELSE
    month := month - duration[ 2 ];
(*ENDIF*) 
WHILE month > 12 DO
    BEGIN
    month := month - 12;
    year  := year  +  1
    END;
(*ENDWHILE*) 
WHILE month < 1 DO
    BEGIN
    month := month + 12;
    year  := year - 1
    END;
(*ENDWHILE*) 
IF  duration[ 3 ] = 0
THEN
    BEGIN
    IF  day > s78days_of_month(year, month)
    THEN
        BEGIN
        e   := sp6de_end_of_month_adjustment;
        day := s78days_of_month (year, month);
        END
    (*ENDIF*) 
    END
ELSE
    BEGIN
    IF  is_add
    THEN
        day := day + duration[ 3 ]
    ELSE
        day := day - duration[ 3 ];
    (*ENDIF*) 
    WHILE day > s78days_of_month (year, month) DO
        BEGIN
        day   := day   - s78days_of_month (year, month);
        month := month + 1;
        IF  month > 12
        THEN
            BEGIN
            month := month - 12;
            year  := year  +  1
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    WHILE day < 1 DO
        BEGIN
        month := month - 1;
        IF  month < 1
        THEN
            BEGIN
            month := month + 12;
            year  := year  -  1
            END;
        (*ENDIF*) 
        day := day + s78days_of_month (year, month)
        END
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
IF  (year > max_year) OR (year < 1)
THEN
    BEGIN
    e := sp6de_invalid_date;
    goto 999;
    END
ELSE
    s78val_to_buf (outdat, outpos, year, month, day);
(*ENDIF*) 
&ifdef TRACE
IF  (e = sp6de_ok) OR (e = sp6de_end_of_month_adjustment)
THEN
    BEGIN
    t01int4 (kb_qual, 'year        ', year );
    t01int4 (kb_qual, 'month       ', month);
    t01int4 (kb_qual, 'day         ', day  );
    END;
&endif
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79date_diff (
            VAR datbuf1 : tsp00_MoveObj;
            datpos1     : tsp00_Int4;
            VAR datbuf2 : tsp00_MoveObj;
            datpos2     : tsp00_Int4;
            VAR days    : tsp00_Int4;
            VAR e       : tsp6_date_error);
 
VAR
      day1   : integer;
      day2   : integer;
      year1  : integer;
      year2  : integer;
 
LABEL
      999;
 
BEGIN
e := sp6de_ok;
s78year_and_day (datbuf1, datpos1, year1, day1, e);
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
s78year_and_day (datbuf2, datpos2, year2, day2, e);
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
days := s78diff_year_day (year1, day1, year2, day2);
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79datetime_arith (
            VAR op    : tgg00_StackEntry;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR warn  : tsp00_WarningSet;
            VAR e     : tgg00_BasisError);
 
CONST
      operand_count    = 2;
      date_durationlen = 5;
      time_durationlen = 4;
      c_million        = '\C7\10\00\00\00';
 
VAR
      add_wanted    : boolean;
      num_err       : tsp00_NumError;
      i             : integer;
      num           : tsp00_Int4;
      real_num      : tsp00_Longreal;
      comp_result   : tsp00_LcompResult;
      million       : tsp00_C5;
      micro_seconds : tsp00_Number;
      num_nptr      : ^tsp00_Number;
      num_len       : integer;
      undef         : ARRAY [ 1..2 ] OF boolean;
      len           : ARRAY [ 1..2 ] OF integer;
      operand_addr  : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      date_e        : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e := e_ok;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
FOR i := 1 TO operand_count DO
    undef[ i ] := false;
(*ENDFOR*) 
i := operand_count;
WHILE (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ], len[ i ], e);
    IF  e <> e_ok
    THEN
        goto 999;
&   ifdef TRACE
    (*ENDIF*) 
    t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&   endif
    undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    i := i - 1
    END;
(*ENDWHILE*) 
IF  NOT undef[ 1 ] AND NOT undef[ 2 ]
THEN
    BEGIN
    IF  (op.elen_var <> 0)
    THEN
        BEGIN (* len[ 2 ] has iolen *)
        IF  (op.epos = c_timestamp)
        THEN
            IF  op.elen_var = c_duration
            THEN (* Duration to add is a fraction. *)
                s40glrel (operand_addr[ 2 ]^, 2,
                      2 * (len [ 2 ] - 2), real_num, num_err)
            ELSE
                num_err := num_ok
            (*ENDIF*) 
        ELSE (* Duration to add is an integer. *)
            s40glint (operand_addr[ 2 ]^, 2,
                  2 * (len [ 2 ] - 2), num, num_err);
        (*ENDIF*) 
        IF  (num_err <> num_ok)
        THEN
            BEGIN
            k71num_err_to_b_err (num_err, e);
            IF  (e <> e_ok)
            THEN
                goto 999;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        len[ 2 ] := 1 + s30lnr_defbyte (@operand_addr[ 2 ]^,
              operand_addr[ 2 ]^[ 1 ], 2, len[ 2 ] - 1);
        IF  (op.epos = c_date) AND (len[ 2 ] <> 1 + mxsp_date)
        THEN
            BEGIN
            e := e_invalid_date;
            goto 999;
            END
        ELSE
            IF  (op.epos = c_time) AND (len[ 2 ] <> 1 + mxsp_time)
            THEN
                BEGIN
                e := e_invalid_time;
                goto 999;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    len[ 1 ] := 1 + s30lnr_defbyte (@operand_addr[ 1 ]^,
          operand_addr[ 1 ]^[ 1 ], 2, len[ 1 ] - 1);
    IF  (op.epos = c_date) AND (len[ 1 ] <> 1 + mxsp_date)
    THEN
        BEGIN
        e := e_invalid_date;
        goto 999;
        END
    ELSE
        IF  ((op.epos = c_time) AND (len[ 1 ] <> 1 + mxsp_time))
            OR
            ((op.epos = c_timestamp) AND
            ( len[ 1 ] <> 1 + mxsp_timestamp))
        THEN
            BEGIN
            e := e_invalid_time;
            goto 999;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  NOT undef[ 1 ] AND NOT undef [ 2 ]
THEN
    BEGIN
    IF  (operand_addr[ 1 ]^[ 1 ] <> operand_addr [ 2 ]^[ 1 ])
        AND
        (operand_addr[ 2 ]^[ 1 ] <> csp_defined_byte)
    THEN
        k71code_operand (sel, operand_addr[ 1 ]^[ 1 ],
              operand_addr[ 2 ], len[ 2 ],
              s35inc_st (sel.sfp_work_st_top, 2), e)
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype         := st_result;
    eop           := op_none;
    epos          := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  undef[ 1 ] OR undef [ 2 ]
THEN
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    date_e     := sp6de_ok;
    add_wanted := (op.eop = op_plus);
    CASE op.epos OF
        c_date:
            IF  sel.sfp_workbuf_len + mxsp_date > sel.sfp_workbuf_size
            THEN
                BEGIN
                e := e_stack_overflow;
                goto 999;
                END
            ELSE
                BEGIN
                CASE op.elen_var OF
                    c_value: (* DATE - DATE *)
                        BEGIN
                        s30cmp (operand_addr[ 1 ]^, 2, len[ 1 ]-1,
                              operand_addr[ 2 ]^,
                              2, len[ 2 ]-1, comp_result);
                        IF  comp_result = l_equal
                        THEN
                            num := 0
                        ELSE
                            IF  comp_result = l_greater
                            THEN
                                kb79buf_date_sub (operand_addr[ 1 ]^, 2,
                                      operand_addr[ 2 ]^, 2,
                                      num, date_e)
                            ELSE
                                BEGIN
                                kb79buf_date_sub (operand_addr[ 2 ]^, 2,
                                      operand_addr[ 1 ]^, 2,
                                      num, date_e);
                                num := - num
                                END;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        s41plint (sel.sfp_workbuf_addr^,
                              sel.sfp_workbuf_len + 1,
                              csp_fixed, csp_float_frac,
                              num, num_err);
                        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]
                              := csp_defined_byte;
                        sel.sfp_work_st_top^.elen_var :=
                              1 + date_durationlen;
                        sel.sfp_workbuf_len := sel.sfp_workbuf_len +
                              date_durationlen
                        END;
                    c_number: (* DATE - NUMBER *)
                        BEGIN
                        kb79date_add_sub (operand_addr[ 1 ]^, 2, num,
                              sel.sfp_workbuf_addr^,
                              sel.sfp_workbuf_len, add_wanted,
                              NOT c_is_labeled, chr(0), date_e);
                        sel.sfp_work_st_top^.elen_var :=
                              1 + mxsp_date;
                        sel.sfp_workbuf_len := sel.sfp_workbuf_len +
                              mxsp_date
                        END;
                    c_duration: (* DATE - DURATION *)
                        BEGIN
                        kb79date_add_sub (operand_addr[ 1 ]^, 2, num,
                              sel.sfp_workbuf_addr^,
                              sel.sfp_workbuf_len, add_wanted,
                              c_is_labeled, op.ecol_tab[ 1 ], date_e);
                        sel.sfp_work_st_top^.elen_var :=
                              1 + mxsp_date;
                        sel.sfp_workbuf_len := sel.sfp_workbuf_len +
                              mxsp_date
                        END
                    END
                (*ENDCASE*) 
                END;
            (*ENDIF*) 
        c_time:
            IF  sel.sfp_workbuf_len + mxsp_time > sel.sfp_workbuf_size
            THEN
                BEGIN
                e := e_stack_overflow;
                goto 999;
                END
            ELSE
                BEGIN
                CASE op.elen_var OF
                    c_value: (* TIME - TIME *)
                        BEGIN
                        s30cmp (operand_addr[ 1 ]^, 2, len[ 1 ]-1,
                              operand_addr[ 2 ]^, 2, len[ 2 ]-1,
                              comp_result);
                        IF  comp_result = l_equal
                        THEN
                            num := 0
                        ELSE
                            IF  comp_result = l_greater
                            THEN
                                kb79buf_time_sub (operand_addr[ 1 ]^, 2,
                                      operand_addr[ 2 ]^, 2, num, date_e)
                            ELSE
                                BEGIN
                                kb79buf_time_sub (operand_addr[ 2 ]^, 2,
                                      operand_addr[ 1 ]^, 2, num, date_e);
                                num := - num
                                END;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        s41plint (sel.sfp_workbuf_addr^,
                              sel.sfp_workbuf_len + 1,
                              csp_fixed, csp_float_frac,
                              num, num_err);
                        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]
                              := csp_defined_byte;
                        sel.sfp_work_st_top^.elen_var :=
                              1 + time_durationlen;
                        sel.sfp_workbuf_len := sel.sfp_workbuf_len +
                              time_durationlen
                        END;
                    c_number: (* TIME - NUMBER *)
                        BEGIN
                        kb79time_add_sub (operand_addr[ 1 ]^, 2, num,
                              sel.sfp_workbuf_addr^,
                              sel.sfp_workbuf_len, add_wanted,
                              NOT c_is_labeled, chr(0), date_e);
                        sel.sfp_work_st_top^.elen_var :=
                              1 + mxsp_time;
                        sel.sfp_workbuf_len := sel.sfp_workbuf_len +
                              mxsp_time
                        END;
                    c_duration: (* TIME - DURATION *)
                        BEGIN
                        kb79time_add_sub (operand_addr[ 1 ]^, 2, num,
                              sel.sfp_workbuf_addr^,
                              sel.sfp_workbuf_len, add_wanted,
                              c_is_labeled, op.ecol_tab[ 1 ], date_e);
                        sel.sfp_work_st_top^.elen_var :=
                              1 + mxsp_time;
                        sel.sfp_workbuf_len := sel.sfp_workbuf_len +
                              mxsp_time
                        END
                    END
                (*ENDCASE*) 
                END;
            (*ENDIF*) 
        c_timestamp: (* TIMESTAMP *)
            BEGIN
            CASE op.elen_var OF
                c_value:
                    BEGIN
                    (*  ORACLE-Mode: <timestamp t1> - <timestamp t2>  *)
                    (*  The result is the float-number of days        *)
                    (*  between t1 and t2                             *)
                    IF  (sel.sfp_workbuf_len + NUMBER_MXGG04 >
                        sel.sfp_workbuf_size)
                    THEN
                        BEGIN
                        e := e_stack_overflow;
                        goto 999;
                        END;
                    (*ENDIF*) 
                    s30cmp (operand_addr[ 1 ]^, 2, len[ 1 ] - 1,
                          operand_addr[ 2 ]^, 2, len[ 2 ] - 1,
                          comp_result);
                    IF  op.ecol_tab[ 1 ] = chr(1)
                    THEN (* labeled_result *)
                        BEGIN
                        IF  (comp_result = l_equal)
                        THEN
                            BEGIN
                            sel.sfp_workbuf_addr^[sel.sfp_workbuf_len + 1] :=
                                  csp_zero_exponent;
                            sel.sfp_work_st_top^.elen_var := 2;
                            sel.sfp_workbuf_len := sel.sfp_workbuf_len
                                  + sel.sfp_work_st_top^.elen_var;
                            END
                        ELSE
                            BEGIN
                            IF  (comp_result = l_greater)
                            THEN
                                kb79lbuf_tstamp_sub_labeled (operand_addr[1]^,
                                      2, operand_addr[ 2 ]^, 2,
                                      micro_seconds, date_e)
                            ELSE
                                kb79lbuf_tstamp_sub_labeled (operand_addr[2]^,
                                      2, operand_addr[ 1 ]^, 2,
                                      micro_seconds, date_e);
                            (*ENDIF*) 
                            IF  comp_result = l_less
                            THEN
                                s51neg (micro_seconds, 1,
                                      sizeof (micro_seconds),
                                      micro_seconds, 1,
                                      sizeof (micro_seconds),
                                      csp_float_frac, num_len, num_err)
                            ELSE
                                num_len := c_timestamp_iolen;
                            (*ENDIF*) 
                            million  := c_million;
                            num_nptr := @sel.sfp_workbuf_addr^;
                            s51div (micro_seconds, 1, num_len,
                                  million, 1, sizeof (million),
                                  num_nptr^, sel.sfp_workbuf_len + 1,
                                  c_timestamp_len, csp_float_frac,
                                  num_len, num_err);
                            sel.sfp_work_st_top^.elen_var := num_len;
                            sel.sfp_workbuf_len := sel.sfp_workbuf_len
                                  + sel.sfp_work_st_top^.elen_var;
                            END
                        (*ENDIF*) 
                        END
                    ELSE
                        BEGIN
                        IF  (comp_result = l_equal)
                        THEN
                            real_num := 0.0
                        ELSE
                            IF  (comp_result = l_greater)
                            THEN
                                kb79buf_tstamp_sub (operand_addr[ 1 ]^, 1,
                                      operand_addr[ 2 ]^, 1, real_num, date_e)
                            ELSE
                                BEGIN
                                kb79buf_tstamp_sub (operand_addr[ 2 ]^, 1,
                                      operand_addr[ 1 ]^, 1, real_num, date_e);
                                real_num := -real_num
                                END;
                            (*ENDIF*) 
                        (*ENDIF*) 
                        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] :=
                              csp_defined_byte;
                        s41plrel (sel.sfp_workbuf_addr^,
                              sel.sfp_workbuf_len + 1, csp_fixed,
                              csp_float_frac, real_num, num_err);
                        sel.sfp_work_st_top^.elen_var := NUMBER_MXGG04;
                        sel.sfp_workbuf_len := sel.sfp_workbuf_len
                              + NUMBER_MXGG04 - 1;
                        END
                    (*ENDIF*) 
                    END;
                c_number :
                    BEGIN
                    kb79tn_timestamp_add_sub_number (operand_addr[ 1 ]^, 2,
                          operand_addr[ 2 ]^, len[ 2 ],
                          sel.sfp_workbuf_addr^,
                          sel.sfp_workbuf_len + 1,
                          add_wanted, date_e);
                    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] :=
                          csp_ascii_blank;
                    sel.sfp_work_st_top^.elen_var :=
                          1 + mxsp_timestamp;
                    sel.sfp_workbuf_len :=
                          sel.sfp_workbuf_len + mxsp_timestamp
                    END;
                c_duration :
                    BEGIN
                    IF  (sel.sfp_workbuf_len + mxsp_timestamp + 1 >
                        sel.sfp_workbuf_size)
                    THEN
                        BEGIN
                        date_e := sp6de_overflow;
                        goto 999;
                        END;
                    (*ENDIF*) 
                    kb79timestamp_add_sub (operand_addr[ 1 ]^, 2, real_num,
                          sel.sfp_workbuf_addr^,
                          sel.sfp_workbuf_len + 1,
                          add_wanted, op.ecol_tab[ 1 ], date_e);
                    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    :=
                          csp_ascii_blank;
                    sel.sfp_work_st_top^.elen_var :=
                          1 + mxsp_timestamp;
                    sel.sfp_workbuf_len                             :=
                          sel.sfp_workbuf_len + mxsp_timestamp
                    END;
                OTHERWISE:
                    BEGIN
                    e := e_stack_type_illegal;
                    goto 999;
                    END;
                END;
            (*ENDCASE*) 
            END
        END;
    (*ENDCASE*) 
    END;
(*ENDIF*) 
&ifdef trace
t01int4 (kb_qual, 'date_e     1', ord (date_e));
t01int4 (kb_qual, 'e          1', ord (e));
&endif
IF  date_e = sp6de_end_of_month_adjustment
THEN
    BEGIN
    date_e := sp6de_ok;
    warn   := warn + [ warn0_exist, warn6_end_of_month_adjustment ]
    END;
&ifdef trace
(*ENDIF*) 
t01int4 (kb_qual, 'date_e     2', ord (date_e));
t01int4 (kb_qual, 'e          2', ord (e));
&endif
IF  date_e <> sp6de_ok
THEN
    e := g03date_error_to_b_err (date_e);
&ifdef TRACE
(*ENDIF*) 
t01int4 (kb_qual, 'date_e     3', ord (date_e));
t01int4 (kb_qual, 'e          3', ord (e));
IF  (e = e_ok)
THEN
    BEGIN
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
    END;
&endif
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79day_year_to_date (
            day_of_year : integer;
            year       : integer;
            VAR datbuf : tsp00_MoveObj;
            datpos     : tsp00_Int4);
 
VAR
      day        : integer;
      month      : integer;
      month_days : integer;
 
BEGIN
&ifdef TRACE
t01p2int4 (kb_qual, 'day_of_year ', day_of_year
      ,             'year        ', year);
&endif
month      := 1;
day        := day_of_year;
month_days := s78days_of_month (year, month);
WHILE day > month_days DO
    BEGIN
    day        := day   - month_days;
    month      := month + 1;
    month_days := s78days_of_month (year, month);
    END;
(*ENDWHILE*) 
s78val_to_buf (datbuf, datpos, year, month, day);
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79make_date (
            VAR outdate : tsp00_MoveObj;
            outpos      : tsp00_Int4;
            year        : integer;
            day_of_year : tsp00_Int4;
            VAR e       : tgg00_BasisError);
 
VAR
      number_of_days : integer;
      day            : tsp00_Int4;
      year_counter   : tsp00_Int4;
 
LABEL
      999;
 
BEGIN
e := e_ok;
IF  day_of_year > max_days
THEN
    BEGIN
    e := e_invalid_date;
    goto 999;
    END;
(*ENDIF*) 
day            := day_of_year;
year_counter   := year;
number_of_days := 365;
IF  day > 0
THEN
    BEGIN
    IF  year_counter > max_year
    THEN
        BEGIN
        e := e_invalid_date;
        goto 999;
        END;
    (*ENDIF*) 
    IF  s78is_leap_year (year_counter)
    THEN
        number_of_days := 366;
    (*ENDIF*) 
    WHILE (day > number_of_days) DO
        BEGIN
        day := day - number_of_days;
        IF  year_counter >= max_year
        THEN
            BEGIN
            e := e_invalid_date;
            goto 999;
            END
        ELSE
            year_counter := year_counter + 1;
        (*ENDIF*) 
        IF  s78is_leap_year (year_counter)
        THEN
            number_of_days := 366
        ELSE
            number_of_days := 365
        (*ENDIF*) 
        END
    (*ENDWHILE*) 
    END
ELSE
    IF  day < 0
    THEN
        BEGIN
        WHILE (day < 0) DO
            BEGIN
            year_counter := year_counter - 1;
            IF  s78is_leap_year (year_counter)
            THEN
                number_of_days := 366
            ELSE
                number_of_days := 365;
            (*ENDIF*) 
            IF  year_counter < 0
            THEN
                BEGIN
                e := e_invalid_date;
                goto 999;
                END
            ELSE
                day := day + number_of_days
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  year_counter > max_year
        THEN
            BEGIN
            e := e_invalid_date;
            goto 999
            END;
        (*ENDIF*) 
        day := day + 1
        END
    ELSE
        BEGIN
        e := e_invalid_date;
        goto 999;
        END;
    (*ENDIF*) 
(*ENDIF*) 
kb79day_year_to_date (day, year_counter, outdate, outpos);
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_check_format (
            VAR op    : tgg00_StackEntry;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
VAR
      dummy_st     : tgg00_StackEntry;
      operand_addr : tsp00_MoveObjPtr;
      ch_code      : boolean;
      len          : integer;
      res_len      : integer;
      def_byte     : char;
      dt_format    : tgg00_DateTimeFormat;
 
LABEL
      999;
 
BEGIN
e := e_ok;
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
def_byte := operand_addr^[ 1 ];
len := s30lnr_defbyte(@operand_addr^, def_byte, 2, len-1) + 1;
&ifdef TRACE
t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
dt_format := op.eformat;
IF  op.edatatype = dtimestamp
THEN
    BEGIN
    IF  sel.sfp_workbuf_len + 1 + mxsp_timestamp > sel.sfp_workbuf_size
    THEN
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END
    (*ENDIF*) 
    END
ELSE
    IF  sel.sfp_workbuf_len + 1 + mxsp_date > sel.sfp_workbuf_size
    THEN
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END;
    (*ENDIF*) 
(*ENDIF*) 
IF  (def_byte = csp_undef_byte)
THEN
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
    res_len := 1;
    END
ELSE
    BEGIN
    IF  def_byte = csp_unicode_def_byte
    THEN
        BEGIN
        WITH dummy_st DO
            BEGIN
            etype         := st_dummy;
            eop           := op_none;
            IF  op.edatatype = dtimestamp
            THEN
                elen_var      := mxsp_exttimestamp + 1
            ELSE
                IF  op.edatatype = dtime
                THEN
                    elen_var      := mxsp_exttime + 1
                ELSE
                    elen_var      := mxsp_extdate + 1;
                (*ENDIF*) 
            (*ENDIF*) 
            ecol_tab[ 1 ] := chr(csp_unicode);
            ecol_tab[ 2 ] := chr(csp_ascii);
            END;
        (*ENDWITH*) 
        k78unicode_transform (dummy_st, sel, operand_addr, len, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        operand_addr := s35add_moveobj_ptr( sel.sfp_workbuf_addr,
              sel.sfp_work_st_top^.epos - 1);
        len := sel.sfp_work_st_top^.elen_var;
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr^, 1, len);
&       endif
        ch_code := true;
        END
    ELSE
        IF  ((def_byte      = csp_ascii_blank) AND
            ( g01code.ctype = csp_ascii) )
            OR
            ((def_byte      = csp_ebcdic_blank) AND
            ( g01code.ctype = csp_ebcdic) )
        THEN
            ch_code := true
        ELSE
            ch_code := false;
        (*ENDIF*) 
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_ascii_blank;
    CASE op.edatatype OF
        ddate:
            BEGIN
            g03fdcheck_date (operand_addr^,
                  sel.sfp_workbuf_addr^,
                  2, sel.sfp_workbuf_len + 1,
                  len-1, dt_format, ch_code, e);
            res_len := mxsp_date
            END;
        dtime:
            BEGIN
            g03ftcheck_time(operand_addr^,
                  sel.sfp_workbuf_addr^, 2,
                  sel.sfp_workbuf_len +1, len -1,
                  dt_format, ch_code, e);
            res_len := mxsp_time
            END;
        dtimestamp:
            BEGIN
            g03ftscheck_timestamp(operand_addr^,
                  sel.sfp_workbuf_addr^,
                  2, sel.sfp_workbuf_len+1,
                  len-1, dt_format, op.elanguage, ch_code, e);
            res_len := mxsp_timestamp
            END
        END;
    (*ENDCASE*) 
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    END;
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype    := st_result;
    eop      := op_none;
    epos     := sel.sfp_workbuf_len;
    elen_var := 1 + res_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + res_len;
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_date (
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
VAR
      num_err      : tsp00_NumError;
      len          : integer;
      undef        : boolean;
      operand_addr : tsp00_MoveObjPtr;
      days         : tsp00_Int4;
      year         : tsp00_Int4;
 
LABEL
      999;
 
BEGIN
e     := e_ok;
undef := false;
IF  sel.sfp_workbuf_len + 1 + mxsp_date > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
&ifdef TRACE
(*ENDIF*) 
t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
undef := (operand_addr^[ 1 ] = csp_undef_byte);
IF  NOT undef
THEN
    BEGIN
    s40glint (operand_addr^, 2, 2*(len-2), days, num_err);
&   ifdef TRACE
    t01int4 (kb_qual,'days        ', days);
&   endif
    IF  num_err <> num_ok
    THEN
        k71num_err_to_b_err (num_err, e);
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  undef
THEN
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    year := 1;
    sel.sfp_work_st_top^.elen_var := 1 + mxsp_date;
    kb79make_date (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
          year, days, e);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_date
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
          epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 :;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_date_add_sub (
            op        : tgg00_StackOpType;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
CONST
      operand_count = 2;
 
VAR
      len          : ARRAY [ 1..2 ] OF integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      is_add       : boolean;
      i            : integer;
      num_err      : tsp00_NumError;
      days         : tsp00_Int4;
      is_timestamp : boolean;
      date_e       : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e := e_ok;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
undef[ 1 ] := false;
undef[ 2 ] := false;
IF  sel.sfp_workbuf_len + 1 + mxsp_timestamp > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
i := operand_count;
WHILE (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ], len[ i ], e);
    IF  e <> e_ok
    THEN
        goto 999;
&   ifdef TRACE
    (*ENDIF*) 
    t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&   endif
    undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    i := i - 1
    END;
(*ENDWHILE*) 
IF  NOT undef[ 1 ] AND NOT undef[ 2 ]
THEN
    BEGIN
    s40glint (operand_addr[ 2 ]^, 2, 2*(len[ 2 ]-2), days, num_err);
    IF  num_err <> num_ok
    THEN
        BEGIN
        k71num_err_to_b_err (num_err, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    len[ 1 ] := 1 + s30lnr_defbyte (@operand_addr[ 1 ]^,
          operand_addr[ 1 ]^[ 1 ], 2, len[ 1 ] - 1);
    IF  (len[ 1 ] <> 1 + mxsp_timestamp) AND (len[ 1 ] <> 1 + mxsp_date)
    THEN
        BEGIN
        e := e_invalid_date;
        goto 999;
        END;
    (*ENDIF*) 
    is_timestamp := (len[ 1 ] = 1 + mxsp_timestamp);
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  undef[ 1 ] OR undef [ 2 ]
THEN
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    IF  is_timestamp
    THEN
        sel.sfp_work_st_top^.elen_var :=
              1 + mxsp_timestamp
    ELSE
        sel.sfp_work_st_top^.elen_var :=
              1 + mxsp_date;
    (*ENDIF*) 
    is_add := (op = op_adddate);
    IF  days < 0
    THEN
        BEGIN
        is_add := NOT is_add;
        days   := - days
        END;
    (*ENDIF*) 
    IF  is_add
    THEN
        kb79add_date (operand_addr[ 1 ]^, 1,
              sel.sfp_workbuf_addr^, sel.sfp_workbuf_len, days, date_e)
    ELSE
        kb79sub_date (operand_addr[ 1 ]^, 1,
              sel.sfp_workbuf_addr^, sel.sfp_workbuf_len, days, date_e);
    (*ENDIF*) 
    e := g03date_error_to_b_err (date_e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_date;
    IF  is_timestamp
    THEN
        BEGIN
        g10mv ('VKB79 ',   1,
              sizeof (operand_addr[ 1 ]^), sel.sfp_workbuf_size,
              @operand_addr[ 1 ]^, mxsp_date + 2,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              (mxsp_timestamp - mxsp_date), e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        sel.sfp_workbuf_len := sel.sfp_workbuf_len +
              (mxsp_timestamp - mxsp_date)
        END;
&   ifdef TRACE
    (*ENDIF*) 
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1)
&             endif
    (*ENDWITH*) 
    END;
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_date_from_timestamp (
            op        : tgg00_StackOpType;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
CONST
      mintimelength = 6;
 
VAR
      operand_addr : tsp00_MoveObjPtr;
      len          : integer;
      max_len      : integer;
 
LABEL
      999;
 
BEGIN
e := e_ok;
IF  op = op_date_from_timestamp
THEN
    max_len := mxsp_date
ELSE
    max_len := mxsp_time;
(*ENDIF*) 
IF  sel.sfp_workbuf_len + 1 + max_len > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
len := s30lnr_defbyte(@operand_addr^, operand_addr^[ 1 ], 2, len-1) + 1;
&ifdef TRACE
t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
IF  len > 0
THEN
    BEGIN
    IF  operand_addr^[ 1 ] = csp_undef_byte
    THEN
        len := 0
    (*ENDIF*) 
    END;
(* PTS 1121598 E.Z. *)
(*ENDIF*) 
IF  (len > 0) AND (len <> mxsp_timestamp + 1)
THEN
    BEGIN
    IF  op = op_date_from_timestamp
    THEN
        e := e_invalid_date
    ELSE
        e := e_invalid_time;
    (*ENDIF*) 
    goto 999;
    END;
(*ENDIF*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  len <= 0
THEN
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_ascii_blank;
    IF  op = op_date_from_timestamp
    THEN
        g10mv ('VKB79 ',   2,
              sizeof (operand_addr^), sel.sfp_workbuf_size,
              @operand_addr^, 2,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
              mxsp_date, e)
    ELSE
        BEGIN
        g10mv ('VKB79 ',   3,
              sizeof (operand_addr^), sel.sfp_workbuf_size,
              @operand_addr^, 2 + mxsp_date,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 3,
              mintimelength, e);
        SAPDB_PascalFill ('VKB79 ',   4,
              sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
              sel.sfp_workbuf_len + 1,
              mxsp_time - mintimelength, csp_ascii_zero, e)
        END;
    (*ENDIF*) 
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_work_st_top^.elen_var := 1 + max_len;
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + max_len
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
          epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_datediff (
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
CONST
      operand_count =  2;
 
VAR
      i            : integer;
      days         : tsp00_Int4;
      num_err      : tsp00_NumError;
      len          : ARRAY [ 1..2 ] OF integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      date_e       : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e := e_ok;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
undef[ 1 ] := false;
undef[ 2 ] := false;
IF  sel.sfp_workbuf_len + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
i := operand_count;
WHILE (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ], len[ i ], e);
    IF  e <> e_ok
    THEN
        goto 999;
&   ifdef TRACE
    (*ENDIF*) 
    t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&   endif
    undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
    IF  NOT undef[ i ]
    THEN
        BEGIN
        len[ i ] := 1 + s30lnr_defbyte (@operand_addr[ i ]^,
              operand_addr[ i ]^[ 1 ],
              1 + 1, len[ i ] - 1);
        IF  (len[ i ] <> 1 + mxsp_date) AND (len[ i ] <> 1 + mxsp_timestamp)
        THEN
            BEGIN
            e := e_invalid_date;
            goto 999;
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
    i := i - 1
    END;
(*ENDWHILE*) 
IF  NOT undef[ 1 ] AND NOT undef [ 2 ]
THEN
    BEGIN
    IF  (operand_addr[ 1 ]^[ 1 ] <> operand_addr [ 2 ]^[ 1 ])
        AND
        (operand_addr[ 2 ]^[ 1 ] <> csp_defined_byte)
    THEN
        k71code_operand (sel, operand_addr[ 1 ]^[ 1 ],
              operand_addr[ 2 ], len[ 2 ],
              s35inc_st (sel.sfp_work_st_top, 2), e)
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e <> e_ok
THEN
    goto 999;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  undef[ 1 ] OR undef [ 2 ]
THEN
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    kb79date_diff (operand_addr[ 1 ]^, 1,
          operand_addr[ 2 ]^, 1, days, date_e);
    e := g03date_error_to_b_err (date_e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_work_st_top^.elen_var := (7 + 1) DIV 2 + 2;
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] :=
          csp_defined_byte;
    s41plint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
          csp_fixed, csp_float_frac, days, num_err);
    IF  num_err <> num_ok
    THEN
        BEGIN
        k71num_err_to_b_err (num_err, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + (7 + 1) DIV 2 + 1;
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
          epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_datetime (
            VAR op    : tgg00_StackEntry;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
VAR
      negativ      : boolean;
      undef        : boolean;
      num_err      : tsp00_NumError;
      datapos      : integer;
      func         : integer;
      len          : integer;
      null         : integer;
      result       : tsp00_Int4;
      duration     : tsp00_Int4;
      operand_addr : tsp00_MoveObjPtr;
 
LABEL
      999;
 
BEGIN
e     := e_ok;
undef := false;
IF  sel.sfp_workbuf_len + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
&ifdef TRACE
(*ENDIF*) 
t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
undef := (operand_addr^[ 1 ] = csp_undef_byte);
IF  (operand_addr^[ 1 ] <> csp_defined_byte) AND NOT undef
THEN
    BEGIN
    IF  op.epos + op.elen_var > len
    THEN
        BEGIN
        e := e_stack_type_illegal;
        goto 999;
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  undef
THEN
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END;
(*ENDIF*) 
IF  NOT undef
THEN
    BEGIN
    func := ord(op.ecol_tab[ 1 ]);
    IF  operand_addr^[ 1 ] = csp_defined_byte (* DURATION *)
    THEN
        BEGIN
        s40glint (operand_addr^, 2, (len - 2) * 2, duration, num_err);
        IF  num_err <> num_ok
        THEN
            BEGIN
            IF  (func = c_year) OR (func = c_month) OR (func = c_day)
            THEN
                e := e_invalid_date
            ELSE
                e := e_invalid_time;
            (*ENDIF*) 
            goto 999;
            END;
        (*ENDIF*) 
        negativ := false;
        IF  duration < 0
        THEN
            BEGIN
            duration := - duration;
            negativ  := true
            END;
&       ifdef TRACE
        (*ENDIF*) 
        t01int4(kb_qual, 'duration    ', duration);
&       endif
        IF  (func = c_year) OR (func = c_month) OR (func = c_day)
        THEN
            BEGIN
            IF  duration > 99999999
            THEN
                BEGIN
                e := e_invalid_date;
                goto 999;
                END
            (*ENDIF*) 
            END
        ELSE
            IF  duration > 999999
            THEN
                BEGIN
                e := e_invalid_time;
                goto 999;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        CASE func OF
            c_year:
                BEGIN
                result := duration DIV 10000;
                IF  negativ
                THEN
                    result := -result;
                (*ENDIF*) 
                IF  (result < -9999) OR (result > 9999)
                THEN
                    BEGIN
                    e := e_invalid_date;
                    goto 999;
                    END
                (*ENDIF*) 
                END;
            c_hour:
                BEGIN
                result := duration DIV 10000;
                IF  negativ
                THEN
                    result := -result;
                (*ENDIF*) 
                IF  (result < -99) OR (result > 99)
                THEN
                    BEGIN
                    e := e_invalid_time;
                    goto 999;
                    END
                (*ENDIF*) 
                END;
            c_month, c_minute:
                BEGIN
                result := (duration MOD 10000) DIV 100;
                IF  negativ
                THEN
                    result := - result;
                (*ENDIF*) 
                IF  (result < -99) OR (result > 99)
                THEN
                    BEGIN
                    IF  func = c_month
                    THEN
                        e := e_invalid_date
                    ELSE
                        e := e_invalid_time;
                    (*ENDIF*) 
                    goto 999
                    END
                (*ENDIF*) 
                END;
            c_day, c_second:
                BEGIN
                result := duration MOD 100;
                IF  negativ
                THEN
                    result := - result;
                (*ENDIF*) 
                IF  (result < -99) OR (result > 99)
                THEN
                    BEGIN
                    IF  func = c_day
                    THEN
                        e := e_invalid_date
                    ELSE
                        e := e_invalid_time;
                    (*ENDIF*) 
                    goto 999
                    END
                (*ENDIF*) 
                END
            END
        (*ENDCASE*) 
        END;
    (*ENDIF*) 
    IF  operand_addr^[ 1 ] = csp_ascii_blank
    THEN (* NORMAL DATE/-TIME VALUES *)
        BEGIN
        null    := ord(csp_ascii_zero);
        datapos := 1 + op.epos;
        IF  ( func = c_year) OR
            ((func = c_hour) AND (op.elen_var = 4))
        THEN
            BEGIN
            result := (ord(operand_addr^[ datapos   ]) - null) * 1000
                  +   (ord(operand_addr^[ datapos+1 ]) - null) *  100
                  +   (ord(operand_addr^[ datapos+2 ]) - null) *   10
                  +   (ord(operand_addr^[ datapos+3 ]) - null);
            (* PTS 1107496 ff. E.Z. *)
            IF  (( func = c_year) AND (result < 1))
                OR (result < 0)
                OR (result > 9999)
            THEN
                BEGIN
                IF  func = c_year
                THEN
                    e := e_invalid_date
                ELSE
                    e := e_invalid_time;
                (*ENDIF*) 
                goto 999;
                END
            (*ENDIF*) 
            END
        ELSE
            IF  func = c_microsec
            THEN
                BEGIN
                result :=
                      (  ord(operand_addr^[ datapos   ]) - null) * 100000
                      + (ord(operand_addr^[ datapos+1 ]) - null) *  10000
                      + (ord(operand_addr^[ datapos+2 ]) - null) *   1000
                      + (ord(operand_addr^[ datapos+3 ]) - null) *    100
                      + (ord(operand_addr^[ datapos+4 ]) - null) *     10
                      + (ord(operand_addr^[ datapos+5 ]) - null);
                IF  (result < 0) OR (result > 999999)
                THEN
                    BEGIN
                    e := e_invalid_time;
                    goto 999
                    END
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                result := (ord(operand_addr^[ datapos   ]) - null) * 10
                      +   (ord(operand_addr^[ datapos+1 ]) - null);
                CASE func OF
                    c_month:
                        IF  (result < 1) OR (result > 12)
                        THEN
                            BEGIN
                            e := e_invalid_date;
                            goto 999;
                            END;
                        (*ENDIF*) 
                    c_day:
                        IF  (result < 1) OR (result > 31)
                        THEN
                            BEGIN
                            e := e_invalid_date;
                            goto 999;
                            END;
                        (*ENDIF*) 
                    c_hour:
                        IF  (result < 0) OR (result > 24)
                        THEN      (* Note, that this case is only for old *)
                            BEGIN (* compiled views or hour(timestamp).   *)
                            e := e_invalid_time;
                            goto 999;
                            END;
                        (*ENDIF*) 
                    c_minute, c_second:
                        IF  (result < 0) OR (result > 59)
                        THEN
                            BEGIN
                            e := e_invalid_time;
                            goto 999;
                            END;
                        (*ENDIF*) 
                    OTHERWISE
                        BEGIN
                        e := e_stack_type_illegal;
                        goto 999;
                        END
                    END
                (*ENDCASE*) 
                END;
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (operand_addr^[ 1 ] <> csp_defined_byte) AND
        (operand_addr^[ 1 ] <> csp_ascii_blank )
    THEN
        BEGIN
        IF  (func = c_year) OR (func = c_month) OR (func = c_day)
        THEN
            e := e_invalid_date
        ELSE
            e := e_invalid_time;
        (*ENDIF*) 
        goto 999;
        END;
&   ifdef TRACE
    (*ENDIF*) 
    t01p2int4 (kb_qual, 'function    ', func
          ,             'result      ', result);
&   endif
    sel.sfp_work_st_top^.elen_var := 1 + mxsp_number;
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] :=
          csp_defined_byte;
    s41plint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
          csp_fixed, csp_float_frac, result, num_err);
    IF  num_err <> num_ok
    THEN
        BEGIN
        k71num_err_to_b_err (num_err, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_number
    END;
&ifdef TRACE
(*ENDIF*) 
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
          epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_day_week (
            op            : tgg00_StackOpType;
            VAR sel       : tgg00_SelectFieldsParam;
            VAR e         : tgg00_BasisError);
 
VAR
      len          : integer;
      undef        : boolean;
      operand_addr : tsp00_MoveObjPtr;
      day          : integer;
      week         : integer;
      year         : integer;
      result       : integer;
      num_err      : tsp00_NumError;
      date_e       : tsp6_date_error;
 
BEGIN
e     := e_ok;
date_e:= sp6de_ok;
undef := false;
IF  sel.sfp_workbuf_len + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow
ELSE
    k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
&   ifdef TRACE
    t01moveobj (kb_qual, operand_addr^, 1, len);
&   endif
    undef := (operand_addr^[ 1 ] = csp_undef_byte);
    IF  NOT undef
    THEN
        BEGIN
        len := 1 + s30lnr_defbyte (@operand_addr^, operand_addr^[ 1 ],
              2, len - 1);
        IF  (len <> 1 + mxsp_date) AND (len <> 1 + mxsp_timestamp)
        THEN
            e := e_invalid_date
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype         := st_result;
        eop           := op_none;
        epos          := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        IF  op = op_dayofyear
        THEN
            BEGIN
            s78year_and_day (operand_addr^, 1, year, day, date_e);
            result := day
            END
        ELSE
            BEGIN
            s78week_and_day (operand_addr^, 1, week, day, date_e);
            IF  date_e = sp6de_ok
            THEN
                BEGIN
                IF  op = op_weekofyear
                THEN
                    result := week
                ELSE
                    result := day
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  date_e = sp6de_ok
        THEN
            BEGIN
            sel.sfp_work_st_top^.elen_var := 1 +
                  mxsp_number;
            sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    :=
                  csp_defined_byte;
            s41psint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  csp_fixed, csp_float_frac, result, num_err);
            IF  num_err <> num_ok
            THEN
                k71num_err_to_b_err (num_err, e);
            (*ENDIF*) 
            sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_number
            END
        ELSE
            e := g03date_error_to_b_err (date_e)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END;
(*ENDIF*) 
e := g03date_error_to_b_err (date_e)
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_day_month (
            VAR sel : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
VAR
      len          : integer;
      undef        : boolean;
      operand_addr : tsp00_MoveObjPtr;
      day          : integer;
      month        : integer;
      year         : integer;
      num_err      : tsp00_NumError;
      date_e       : tsp6_date_error;
 
BEGIN
e     := e_ok;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
undef := false;
IF  sel.sfp_workbuf_len + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow
ELSE
    k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
&   ifdef TRACE
    t01moveobj (kb_qual, operand_addr^, 1, len);
&   endif
    undef := (operand_addr^[ 1 ] = csp_undef_byte);
    IF  NOT undef
    THEN
        BEGIN
        len := 1 + s30lnr_defbyte (@operand_addr^, operand_addr^[ 1 ],
              2, len - 1);
        IF  (len <> 1 + mxsp_date) AND (len <> 1 + mxsp_timestamp)
        THEN
            e := e_invalid_date
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype         := st_result;
        eop           := op_none;
        epos          := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        s78year_month_day (operand_addr^, 1, year, month, day, date_e);
        IF  date_e = sp6de_ok
        THEN
            BEGIN
            sel.sfp_work_st_top^.elen_var := 1 +
                  mxsp_number;
            sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    :=
                  csp_defined_byte;
            s41psint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  csp_fixed, csp_float_frac, day, num_err);
            IF  num_err <> num_ok
            THEN
                k71num_err_to_b_err (num_err, e);
            (*ENDIF*) 
            sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_number
            END
        ELSE
            e := g03date_error_to_b_err (date_e)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_days (
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
VAR
      len          : integer;
      undef        : boolean;
      operand_addr : tsp00_MoveObjPtr;
      date_pos     : integer;
      days         : tsp00_Int4;
      num_err      : tsp00_NumError;
      mindate      : tsp00_Date;
      date_ptr     : ^tsp00_Date;
      date_e       : tsp6_date_error;
 
BEGIN
e       := e_ok;
undef   := false;
mindate := '00001231';
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
IF  sel.sfp_workbuf_len + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow
ELSE
    k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
&   ifdef TRACE
    t01moveobj (kb_qual, operand_addr^, 1, len);
&   endif
    undef := (operand_addr^[ 1 ] = csp_undef_byte);
    IF  NOT undef
    THEN
        BEGIN
        len := 1 + s30lnr_defbyte (@operand_addr^, operand_addr^[ 1 ],
              2, len - 1);
        IF  ( len <> 1 + mxsp_date ) AND
            ( len <> 1 + mxsp_timestamp )
        THEN
            e := e_invalid_date
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    IF  NOT undef
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_ascii_blank;
        IF  g01code.ctype = csp_ebcdic
        THEN
            g02pebcdic_pos_ascii (mindate, 1, sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len + 1, mxsp_date)
        ELSE
            BEGIN
            date_ptr  := @sel.sfp_workbuf_addr^[sel.sfp_workbuf_len+1];
            date_ptr^ := mindate;
            END;
        (*ENDIF*) 
        date_pos := sel.sfp_workbuf_len
        END;
    (*ENDIF*) 
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype         := st_result;
        eop           := op_none;
        epos          := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        kb79date_diff (operand_addr^, 1,
              sel.sfp_workbuf_addr^, date_pos, days, date_e);
        IF  date_e = sp6de_ok
        THEN
            BEGIN
            sel.sfp_work_st_top^.elen_var := 1 +
                  mxsp_number;
            sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    :=
                  csp_defined_byte;
            s41plint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  csp_fixed, csp_float_frac, days, num_err);
            IF  num_err <> num_ok
            THEN
                k71num_err_to_b_err (num_err, e);
            (*ENDIF*) 
            sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_number
            END
        ELSE
            e := g03date_error_to_b_err (date_e)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_format_change (
            VAR op    : tgg00_StackEntry;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR warn  : tsp00_WarningSet;
            VAR e     : tgg00_BasisError);
 
VAR
      len          : integer;
      undef        : boolean;
      operand_addr : tsp00_MoveObjPtr;
      dt_format    : tgg00_DateTimeFormat;
 
BEGIN
e := e_ok;
&ifdef TRACE
t01stackentry (kb_qual, op, 0);
&endif
IF  sel.sfp_workbuf_len + op.elength > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow;
(*ENDIF*) 
undef := false;
IF  e = e_ok
THEN
    BEGIN
    k71get_operand (sel, NOT c_check_spec_null, operand_addr, len, e);
    IF  e = e_ok
    THEN
        BEGIN
&       ifdef TRACE
        t01moveobj ( kb_qual, operand_addr^, 1, len);
&       endif
        undef := ( operand_addr^[ 1 ] = csp_undef_byte )
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype := st_result;
        eop   := op_none;
        epos  := sel.sfp_workbuf_len;
        IF  undef
        THEN
            elen_var := 1
        ELSE
            elen_var := op.elength;
        (*ENDIF*) 
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef
    THEN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte
    ELSE
        WITH op DO
            BEGIN
            dt_format := eformat;
            IF  eop_build_in = op_b_format_change
            THEN
                IF  edatatype = ddate
                THEN
                    g03dchange_format_date (operand_addr^,
                          sel.sfp_workbuf_addr^,
                          1, sel.sfp_workbuf_len, dt_format, e)
                ELSE
                    IF  edatatype = dtime
                    THEN
                        g03tchange_format_time ( operand_addr^,
                              sel.sfp_workbuf_addr^,
                              1, sel.sfp_workbuf_len, dt_format, e)
                    ELSE
                        IF  edatatype = dtimestamp
                        THEN
                            g03tschange_format_timestamp ( operand_addr^,
                                  sel.sfp_workbuf_addr^,
                                  1, sel.sfp_workbuf_len, dt_format,
                                  elanguage, e)
                        ELSE
                            e := e_stack_type_illegal;
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            sel.sfp_workbuf_len := sel.sfp_workbuf_len + elength - 1
            END
        (*ENDWITH*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_time_value_too_long
THEN
    BEGIN
    e    := e_ok;
    warn := warn + [ warn0_exist, warn11_time_value_too_long ]
    END;
&ifdef TRACE
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    t01sname ( kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj ( kb_qual, sel.sfp_workbuf_addr^, epos,
              epos + elen_var - 1 );
    (*ENDWITH*) 
    END
&endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_last_day (
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
LABEL
      999;
 
VAR
      len          : integer;
      undef        : boolean;
      operand_addr : tsp00_MoveObjPtr;
      day          : integer;
      month        : integer;
      year         : integer;
      date_e       : tsp6_date_error;
 
BEGIN
e     := e_ok;
undef := false;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
IF  sel.sfp_workbuf_len + 1 + mxsp_date > sel.sfp_workbuf_size
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
k71get_operand (sel, c_check_spec_null, operand_addr, len, e);
IF  e <> e_ok
THEN
    goto 999;
&ifdef TRACE
(*ENDIF*) 
t01moveobj (kb_qual, operand_addr^, 1, len);
&endif
undef := (operand_addr^[ 1 ] = csp_undef_byte);
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
IF  NOT undef
THEN
    BEGIN
    len := 1 + s30lnr_defbyte (@operand_addr^, operand_addr^[ 1 ],
          2, len - 1);
    IF  len <> 1 + mxsp_timestamp
    THEN
        BEGIN
        e := e_invalid_date;
        goto 999;
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  undef
THEN
    BEGIN
    sel.sfp_workbuf_addr^[sel.sfp_workbuf_len] := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    sel.sfp_work_st_top^.elen_var := 1 + mxsp_timestamp;
    s78year_month_day (operand_addr^, 1, year, month, day, date_e);
    e := g03date_error_to_b_err (date_e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    day := s78days_of_month (year, month);
    s78val_to_buf (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
          year, month, day);
    g10mv ('VKB79 ',   5,
          sizeof (operand_addr^), sel.sfp_workbuf_size,
          @operand_addr^, 2 + mxsp_date,
          @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1 + mxsp_date,
          mxsp_timestamp - mxsp_date, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_timestamp;
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
          epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999 : ;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_makedate (
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
VAR
      num_err      : tsp00_NumError;
      i            : integer;
      operand_cnt  : integer;
      len          : ARRAY [ 1..2 ] OF integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      date_int     : ARRAY [ 1..2 ] OF tsp00_Int4;
 
BEGIN
e := e_ok;
operand_cnt := 2;
undef[ 1 ]  := false;
undef[ 2 ]  := false;
IF  sel.sfp_workbuf_len + 1 + mxsp_date > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow;
(*ENDIF*) 
i := operand_cnt;
WHILE (e = e_ok) AND (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ], len[ i ], e);
    IF  e = e_ok
    THEN
        BEGIN
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&       endif
        undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top,  -1);
        i := i - 1
        END
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
IF  (e = e_ok) AND NOT undef[ 1 ] AND NOT undef[ 2 ]
THEN
    BEGIN
    i := 1;
    REPEAT
        s40glint (operand_addr[ i ]^, 2, 2*(len[ i ]-2),
              date_int[ i ], num_err);
        IF  num_err <> num_ok
        THEN
            k71num_err_to_b_err (num_err, e);
        (*ENDIF*) 
        i := i + 1
    UNTIL
        (e <> e_ok) OR (i > operand_cnt )
    (*ENDREPEAT*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype := st_result;
        eop   := op_none;
        epos  := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef[ 1 ] OR undef [ 2 ]
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        sel.sfp_work_st_top^.elen_var := 1 + mxsp_date;
        kb79make_date (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
              date_int[ 1 ], date_int[ 2 ], e);
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_date
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_maketime (
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
TYPE
      t_hour_min_sec = (hour, min, sec);
 
VAR
      num_err      : tsp00_NumError;
      hms          : t_hour_min_sec;
      seconds      : tsp00_Int4;
      sec_limit    : tsp00_Int4;
      len          : ARRAY [ t_hour_min_sec ] OF integer;
      undef        : ARRAY [ t_hour_min_sec ] OF boolean;
      operand_addr : ARRAY [ t_hour_min_sec ] OF tsp00_MoveObjPtr;
      time_int     : ARRAY [ t_hour_min_sec ] OF tsp00_Int4;
 
BEGIN
e := e_ok;
FOR hms := hour TO sec DO
    undef[ hms ] := false;
(*ENDFOR*) 
IF  sel.sfp_workbuf_len + 1 + mxsp_time > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow;
(*ENDIF*) 
hms := sec;
WHILE e = e_ok DO
    BEGIN
    k71get_operand (sel, c_check_spec_null,
          operand_addr[ hms ], len[ hms ], e);
    IF  e = e_ok
    THEN
        BEGIN
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr[ hms ]^, 1, len[ hms ]);
&       endif
        undef[ hms ] := (operand_addr[ hms ]^[ 1 ] = csp_undef_byte);
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
        IF  hms = hour
        THEN
            e := e_no_prev_record
        ELSE
            hms := pred (hms)
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
IF  e = e_no_prev_record
THEN
    e := e_ok;
(*ENDIF*) 
IF  (e = e_ok)
    AND NOT undef[ hour ] AND NOT undef[ min ] AND NOT undef[ sec ]
THEN
    BEGIN
    hms := hour;
    REPEAT
        s40glint (operand_addr[ hms ]^, 2, 2*(len[ hms ]-2),
              time_int[ hms ], num_err);
        IF  num_err <> num_ok
        THEN
            k71num_err_to_b_err (num_err, e);
        (*ENDIF*) 
        IF  e = e_ok
        THEN
            BEGIN
            IF  time_int[ hms ] < 0
            THEN
                e := e_num_invalid
            ELSE
                IF  hms = sec
                THEN
                    e := e_no_next_record
                ELSE
                    hms := succ (hms)
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    UNTIL
        e <> e_ok;
    (*ENDREPEAT*) 
    IF  e = e_no_next_record
    THEN
        e := e_ok
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype := st_result;
        eop   := op_none;
        epos  := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef[ hour ] OR undef [ min ] OR undef[ sec ]
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        sel.sfp_work_st_top^.elen_var := 1 + mxsp_time;
        e := e_ok;
&       ifdef TRACE
        t01int4 (kb_qual, 'hour        ', time_int[ hour ]);
        t01int4 (kb_qual, 'min         ', time_int[ min  ]);
        t01int4 (kb_qual, 'sec         ', time_int[ sec  ]);
&       endif
        IF  time_int[ sec ] > max_seconds
        THEN
            e := e_invalid_time
        ELSE
            BEGIN
            sec_limit := max_seconds - time_int[ sec ];
            IF  time_int[ min ] > sec_limit DIV 60
            THEN
                e := e_invalid_time
            ELSE
                BEGIN
                sec_limit := sec_limit - time_int[ min ] * 60;
                IF  time_int[ hour ] > sec_limit DIV 3600
                THEN
                    e := e_invalid_time
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  e = e_ok
        THEN
            BEGIN
            seconds := kb79sec_get (time_int[ hour ],
                  time_int[ min ], time_int[ sec ]);
            IF  seconds > max_seconds
            THEN
                e := e_invalid_time
            ELSE
                BEGIN
                kb79sec_put (seconds, time_int[ hour ],
                      time_int[ min ], time_int[ sec ]);
                s78val_to_buf (sel.sfp_workbuf_addr^,
                      sel.sfp_workbuf_len, time_int[ hour ],
                      time_int[ min ], time_int[ sec ])
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_time
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_month_add_sub (
            op        : tgg00_StackOpType;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
CONST
      operand_count = 2;
 
VAR
      len          : ARRAY [ 1..2 ] OF integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      is_add       : boolean;
      i            : integer;
      num_err      : tsp00_NumError;
      months       : tsp00_Int4;
      date_e       : tsp6_date_error;
 
BEGIN
e := e_ok;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
undef[ 1 ] := false;
undef[ 2 ] := false;
IF  sel.sfp_workbuf_len + 1 + mxsp_timestamp > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow;
(*ENDIF*) 
i := operand_count;
WHILE (e = e_ok) AND (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ], len[ i ], e);
    IF  e = e_ok
    THEN
        BEGIN
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&       endif
        undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
        i := i - 1
        END
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
IF  (e = e_ok) AND NOT undef[ 1 ] AND NOT undef[ 2 ]
THEN
    BEGIN
    s40glint (operand_addr[ 2 ]^, 2, 2*(len[ 2 ]-2), months, num_err);
    IF  num_err <> num_ok
    THEN
        k71num_err_to_b_err (num_err, e);
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype := st_result;
        eop   := op_none;
        epos  := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef[ 1 ] OR undef [ 2 ]
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        sel.sfp_work_st_top^.elen_var :=
              1 + mxsp_timestamp;
        is_add := (op = op_addmonth);
        IF  months < 0
        THEN
            BEGIN
            is_add := NOT is_add;
            months := - months
            END;
        (*ENDIF*) 
        IF  is_add
        THEN
            kb79add_month (operand_addr[ 1 ]^, 1,
                  sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
                  months, date_e)
        ELSE
            kb79sub_month (operand_addr[ 1 ]^, 1,
                  sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
                  months, date_e);
        (*ENDIF*) 
        e := g03date_error_to_b_err (date_e);
        g10mv ('VKB79 ',   6,
              sizeof (operand_addr [ 1 ]^), sel.sfp_workbuf_size,
              @operand_addr [ 1 ]^, 2 + mxsp_date,
              @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1 + mxsp_date,
              mxsp_timestamp - mxsp_date, e);
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_timestamp
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1)
&             endif
    (*ENDWITH*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_months_between (
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
CONST
      operand_count = 2;
 
VAR
      len          : ARRAY [ 1..2 ] OF integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      negativ      : boolean;
      i            : integer;
      year1        : integer;
      year2        : integer;
      month1       : integer;
      month2       : integer;
      day1         : integer;
      day2         : integer;
      day_sec1     : integer;
      day_sec2     : integer;
      day_diff     : tsp00_Longreal;
      sec_diff     : tsp00_Longreal;
      erg          : tsp00_Longreal;
      ergint       : tsp00_Int4;
      res          : tsp00_NumError;
      comp_result  : tsp00_LcompResult;
      date_e       : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e := e_ok;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
undef[ 1 ] := false;
undef[ 2 ] := false;
IF  sel.sfp_workbuf_len + 1 + mxsp_number > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow;
(*ENDIF*) 
i := operand_count;
WHILE (e = e_ok) AND (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ], len[ i ], e);
    IF  e = e_ok
    THEN
        BEGIN
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&       endif
        undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, - 1);
        i := i - 1
        END
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
IF  (e = e_ok) AND NOT undef[ 1 ] AND NOT undef[ 2 ]
THEN
    BEGIN
    len[ 1 ] := 1 + s30lnr_defbyte (@operand_addr[ 1 ]^,
          operand_addr[ 1 ]^[ 1 ], 2, len[ 1 ] - 1);
    IF  len[ 1 ] <> 1 + mxsp_timestamp
    THEN
        e := e_invalid_date;
    (*ENDIF*) 
    IF  e = e_ok
    THEN
        BEGIN
        len[ 2 ] := 1 + s30lnr_defbyte (@operand_addr[ 2 ]^,
              operand_addr[ 2 ]^[ 1 ], 2, len[ 2 ] - 1);
        IF  len[ 2 ] <> 1 + mxsp_timestamp
        THEN
            e := e_invalid_date;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype := st_result;
        eop   := op_none;
        epos  := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef[ 1 ] OR undef [ 2 ]
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        sel.sfp_work_st_top^.elen_var :=
              1 + mxsp_number;
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_defined_byte;
        s30cmp (operand_addr[ 1 ]^, 2, mxsp_date,
              operand_addr[ 2 ]^, 2, mxsp_date,
              comp_result);
        IF  comp_result = l_equal
        THEN
            BEGIN
            erg := 0.0;
            s41plrel (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  csp_fixed, csp_float_frac, erg, res);
            END
        ELSE
            BEGIN
            s30cmp (operand_addr[ 1 ]^, 2, len[ 1 ] - 1,
                  operand_addr[ 2 ]^, 2, len[ 2 ] - 1,
                  comp_result);
            negativ := comp_result = l_less;
            IF  negativ
            THEN
                BEGIN
                s78year_month_day (operand_addr[ 1 ]^, 1,
                      year2, month2, day2, date_e);
                s78year_month_day (operand_addr[ 2 ]^, 1,
                      year1, month1, day1, date_e);
                day_sec2 := s78day_sec (operand_addr[ 1 ]^, 1, date_e);
                day_sec1 := s78day_sec (operand_addr[ 2 ]^, 1, date_e);
                END
            ELSE
                BEGIN
                s78year_month_day (operand_addr[ 1 ]^, 1,
                      year1, month1, day1, date_e);
                s78year_month_day (operand_addr[ 2 ]^, 1,
                      year2, month2, day2, date_e);
                day_sec1 := s78day_sec (operand_addr[ 1 ]^, 1, date_e);
                day_sec2 := s78day_sec (operand_addr[ 2 ]^, 1, date_e);
                END;
            (*ENDIF*) 
            IF  date_e <> sp6de_ok
            THEN
                BEGIN
                e := g03date_error_to_b_err (date_e);
                goto 999
                END;
            (*ENDIF*) 
            IF  day1 = day2
            THEN
                BEGIN
                (* difference to normal behaviour, because 16th digit *)
                (* was <> 0 (vsp41-Problem), although for example 4   *)
                (* month difference and not 4.000000000000001         *)
                ergint := ((year1 - year2) * 12) + month1 - month2;
                IF  negativ
                THEN
                    ergint := -ergint;
                (*ENDIF*) 
                s41plint (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                      csp_fixed, csp_float_frac,
                      ergint, res)
                END
            ELSE
                BEGIN
                day_diff := day1 - day2;   (* Here we force the compiler *)
                day_diff := day_diff / 31; (* to use longreal arithmetic *)
                sec_diff := day_sec1 - day_sec2;
                sec_diff := sec_diff / (max_sec_of_day * 31);
                erg      := (year1 - year2) * 12 + month1 - month2 +
                      day_diff + sec_diff;
                IF  negativ
                THEN
                    erg := - erg;
                (*ENDIF*) 
                s41plrel (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                      csp_fixed, csp_float_frac, erg, res);
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  ((res <> num_ok) AND (res <> num_trunc))
        THEN
            e := e_num_invalid;
        (*ENDIF*) 
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_number + 1;
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1)
&             endif
    (*ENDWITH*) 
    END;
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_next_day (
            VAR op    : tgg00_StackEntry;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
CONST
      operand_count = 2;
 
VAR
      len          : ARRAY [ 1..2 ] OF integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      i            : integer;
      week         : integer;
      act_day      : integer;
      add_days     : integer;
      sql_db_day   : integer;
      act_language : integer;
      user_day     : tsp00_Int4;
      num_err      : tsp00_NumError;
      comp_result  : tsp00_LcompResult;
      dayname      : tsp00_C3;
      date_e       : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e            := e_ok;
user_day     := 0;
sql_db_day   := 1;
undef[ 1 ]   := false;
undef[ 2 ]   := false;
act_language := 1;
comp_result  := l_undef;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
(*   search for actuel language   *)
WHILE ((act_language <= cgg04_languages) AND (comp_result = l_undef)) DO
    IF  (g03short_daynames[ act_language ].language [ 1 ] <>
        op.elanguage[ 1 ]) OR
        (g03short_daynames[ act_language ].language [ 2 ] <>
        op.elanguage[ 2 ]) OR
        (g03short_daynames[ act_language ].language [ 3 ] <>
        op.elanguage[ 3 ])
    THEN
        act_language := succ (act_language)
    ELSE
        comp_result := l_equal;
    (*ENDIF*) 
(*ENDWHILE*) 
IF  (comp_result = l_undef)
THEN
    BEGIN
    e := e_invalid_date;
    goto 999;
    END;
&ifdef TRACE
(*ENDIF*) 
t01int4 (kb_qual, 'act_language', act_language);
&endif
IF  (sel.sfp_workbuf_len + 1 + mxsp_timestamp > sel.sfp_workbuf_size)
THEN
    BEGIN
    e := e_stack_overflow;
    goto 999;
    END;
(*ENDIF*) 
i := operand_count;
WHILE (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ],
          len[ i ], e);
    IF  e <> e_ok
    THEN
        goto 999;
&   ifdef TRACE
    (*ENDIF*) 
    t01sname (kb_qual, 'Operand new:');
    t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&   endif
    undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    i := i - 1
    END;
(*ENDWHILE*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
IF  (operand_addr[ 2 ]^[ 1 ] = csp_defined_byte)
THEN
    (*   it's the number of day in the week (between 1 and 7)   *)
    BEGIN
    IF  (ord (operand_addr[ 2 ]^[ 2 ]) <> 193)
    THEN
        BEGIN
        e := e_invalid_day_of_week;
        goto 999;
        END;
    (*ENDIF*) 
    s40glint (operand_addr[ 2 ]^, 2, (len[ 2 ] - 2) * 2,
          user_day, num_err);
    IF  num_err <> num_ok
    THEN
        BEGIN
        k71num_err_to_b_err (num_err, e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    comp_result  := l_undef;
    WITH g03short_daynames[ act_language ] DO
        (*   convert:  user_day_number -> sql_db_day   *)
        WHILE (sql_db_day <= cgg04_sunday) AND (comp_result = l_undef) DO
            IF  (days[ sql_db_day ].daynumber = user_day)
            THEN
                comp_result := l_equal
            ELSE
                sql_db_day := succ (sql_db_day);
            (*ENDIF*) 
        (*ENDWHILE*) 
    (*ENDWITH*) 
    END
ELSE
    IF  (NOT undef [ 2 ])
    THEN
        (*  it's the name of a day (Monday for example)  *)
        BEGIN
        IF  (len [ 2 ] < 4)
        THEN
            BEGIN
            e := e_invalid_day_of_week;
            goto 999;
            END;
        (*ENDIF*) 
        kb79upper (operand_addr[ 2 ], dayname);
        comp_result  := l_undef;
        WITH g03short_daynames [ act_language ] DO
            (*   convert:  user_day_name -> sql_db_day   *)
            WHILE (sql_db_day <= cgg04_sunday) AND
                  (comp_result = l_undef) DO
                IF  days[ sql_db_day ].dayname <> dayname
                THEN
                    sql_db_day := succ (sql_db_day)
                ELSE
                    comp_result := l_equal;
                (*ENDIF*) 
            (*ENDWHILE*) 
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
IF  (comp_result = l_undef)
THEN
    BEGIN
    e := e_invalid_day_of_week;
    goto 999;
    END;
(*ENDIF*) 
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  (undef[ 1 ] OR undef[ 2 ])
THEN
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    s78week_and_day (operand_addr[ 1 ]^, 1, week, act_day, date_e);
    e := g03date_error_to_b_err (date_e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    add_days := sql_db_day - act_day;
    IF  (add_days < cgg04_monday)
    THEN
        add_days := add_days + 7;
    (*ENDIF*) 
    kb79add_date (operand_addr[ 1 ]^, 1,
          sel.sfp_workbuf_addr^, sel.sfp_workbuf_len, add_days, date_e);
    e := g03date_error_to_b_err (date_e);
    IF  e <> e_ok
    THEN
        goto 999;
    (* Since kb79add_date only evaluates the date part of the timestamp *)
    (* we copy now the time part verbatim at the end of the result.     *)
    (*ENDIF*) 
    g10mv ('VKB79 ',   7,
          sizeof (operand_addr [1]^), sel.sfp_workbuf_size,
          @operand_addr [1]^,     mxsp_date + 2,
          @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + mxsp_date + 1,
          len [1] - mxsp_date - 1, e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_timestamp;
    WITH sel.sfp_work_st_top^ DO
        elen_var := 1 + mxsp_timestamp;
    (*ENDWITH*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^, epos,
              epos + elen_var - 1)
&             endif
    (*ENDWITH*) 
    END;
(*ENDIF*) 
999:;
END;   (*   end of procedure kb79op_next_day   *)
 
(*------------------------------*) 
 
PROCEDURE
      kb79upper (
            src_addr : tsp00_MoveObjPtr;
            VAR dest : tsp00_C3);
 
VAR
      to_code : integer;
 
BEGIN
IF  (src_addr^[ 1 ] = bsp_c1)
THEN
    IF  (g01code.ctype = csp_ascii)
    THEN
        to_code := cgg04_up_ascii
    ELSE
        to_code := cgg04_up_ebcdic
    (*ENDIF*) 
ELSE
    IF  (g01code.ctype = csp_ascii)
    THEN
        to_code := cgg04_to_up_ascii
    ELSE
        to_code := cgg04_to_up_ebcdic;
    (*ENDIF*) 
(*ENDIF*) 
s30map (g02codetables.tables[ to_code ], src_addr^, 2, dest, 1, 3);
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_time_add_sub (
            op        : tgg00_StackOpType;
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e     : tgg00_BasisError);
 
CONST
      operand_count = 2;
 
VAR
      i            : integer;
      len          : ARRAY [ 1..2 ] OF integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      hour         : integer;
      min          : integer;
      sec          : integer;
      seconds      : tsp00_Int4;
      date_e       : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e := e_ok;
undef[ 1 ] := false;
undef[ 2 ] := false;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
IF  sel.sfp_workbuf_len + 1 + mxsp_timestamp > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow;
(*ENDIF*) 
i := operand_count;
WHILE (e = e_ok) AND (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ], len[ i ], e);
    IF  e = e_ok
    THEN
        BEGIN
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&       endif
        undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
        IF  NOT undef[ i ]
        THEN
            len[ i ] := 1 + s30lnr_defbyte (@operand_addr[ i ]^,
                  operand_addr[ i ]^[ 1 ], 2, len[ i ] - 1);
        (*ENDIF*) 
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
        i := i - 1
        END
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
(* PTS 1121598 E.Z. *)
IF  NOT undef[ 1 ]
    AND
    NOT undef [ 2 ]
    AND
    (
    (len [ 2 ] <> mxsp_time + 1)       OR
    ((len [ 1 ] <> mxsp_time + 1) AND
    (len [ 1 ] <> mxsp_timestamp + 1))
    )
THEN
    BEGIN
    e := e_invalid_time;
    goto 999;
    END;
(*ENDIF*) 
IF  (e = e_ok) AND NOT undef[ 1 ] AND NOT undef [ 2 ]
THEN
    BEGIN
    IF  (operand_addr[ 1 ]^[ 1 ] <> operand_addr [ 2 ]^[ 1 ])
        AND
        (operand_addr[ 2 ]^[ 1 ] <> csp_defined_byte)
    THEN
        k71code_operand (sel, operand_addr[ 1 ]^[ 1 ],
              operand_addr[ 2 ], len[ 2 ],
              s35inc_st (sel.sfp_work_st_top, 2), e)
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype := st_result;
        eop   := op_none;
        epos  := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef[ 1 ] OR undef [ 2 ]
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        IF  (len [1] <> mxsp_time + 1)
        THEN
            BEGIN
            s78time_from_buf (operand_addr[ 2 ]^, 1, len[ 2 ],
                  hour, min, sec, date_e);
            seconds := kb79sec_get (hour, min, sec);
            kb79timestamp_add_sub (operand_addr [ 1 ]^, 2, seconds,
                  sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
                  (op = op_addtime), chr (5), date_e);
            sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_ascii_blank;
            (* PTS 1104354 E.Z. *)
            sel.sfp_work_st_top^.elen_var := 1 + mxsp_timestamp;
            sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1 + mxsp_timestamp;
            END
        ELSE
            BEGIN
            sel.sfp_work_st_top^.elen_var := 1
                  + mxsp_time;
            IF  op = op_addtime
            THEN
                kb79add_time (operand_addr[ 1 ]^, 1, len[ 1 ],
                      operand_addr[ 2 ]^, 1, len[ 2 ],
                      sel.sfp_workbuf_addr^, sel.sfp_workbuf_len, date_e)
            ELSE
                kb79sub_time (operand_addr[ 1 ]^, 1, len[ 1 ],
                      operand_addr[ 2 ]^, 1, len[ 2 ],
                      sel.sfp_workbuf_addr^, sel.sfp_workbuf_len, date_e);
            (*ENDIF*) 
            (* PTS 1104354 E.Z. *)
            sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1 + mxsp_time;
            END;
        (*ENDIF*) 
        e := g03date_error_to_b_err (date_e)
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END;
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_timediff (
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
CONST
      operand_count = 2;
 
VAR
      i            : integer;
      hour         : integer;
      min          : integer;
      sec          : integer;
      mindate      : tsp00_Date;
      date_ptr     : ^tsp00_Date;
      date_pos     : integer;
      seconds      : tsp00_Int4;
      days1        : tsp00_Int4;
      days2        : tsp00_Int4;
      day_sec1     : integer;
      day_sec2     : integer;
      len          : ARRAY [ 1..2 ] OF integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      date_e       : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e := e_ok;
undef[ 1 ] := false;
undef[ 2 ] := false;
mindate := '00001231';
(* PTS 1116313 E.Z. *)
date_e := sp6de_ok;
IF  sel.sfp_workbuf_len + 1 + mxsp_timestamp > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow;
(*ENDIF*) 
i := operand_count;
WHILE (e = e_ok) AND (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ], len[ i ], e);
    IF  e = e_ok
    THEN
        BEGIN
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&       endif
        undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
        IF  NOT undef[ i ]
        THEN
            len[ i ] := 1 + s30lnr_defbyte (@operand_addr[ i ]^,
                  operand_addr[ i ]^[ 1 ],
                  2, len[ i ] - 1);
        (*ENDIF*) 
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
        i := i - 1
        END
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
(* PTS 1121598 E.Z. *)
IF  NOT undef[ 1 ] AND NOT undef [ 2 ] AND
    (len [ 1 ] <> len [ 2 ])
THEN
    BEGIN
    e := e_invalid_time;
    goto 999;
    END;
(*ENDIF*) 
IF  (e = e_ok) AND NOT undef[ 1 ] AND NOT undef [ 2 ]
THEN
    BEGIN
    IF  (operand_addr[ 1 ]^[ 1 ] <> operand_addr [ 2 ]^[ 1 ])
        AND
        (operand_addr[ 2 ]^[ 1 ] <> csp_defined_byte)
    THEN
        k71code_operand (sel, operand_addr[ 1 ]^[ 1 ],
              operand_addr[ 2 ], len[ 2 ],
              s35inc_st (sel.sfp_work_st_top, 2), e)
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype := st_result;
        eop   := op_none;
        epos  := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef[ 1 ] OR undef [ 2 ]
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        IF  (len [ 1 ] <> mxsp_time + 1)
        THEN
            BEGIN
            sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_ascii_blank;
            IF  g01code.ctype = csp_ebcdic
            THEN
                g02pebcdic_pos_ascii (mindate, 1, sel.sfp_workbuf_addr^,
                      sel.sfp_workbuf_len + 1, mxsp_date)
            ELSE
                BEGIN
                date_ptr  := @sel.sfp_workbuf_addr^[sel.sfp_workbuf_len+1];
                date_ptr^ := mindate;
                END;
            (*ENDIF*) 
            date_pos := sel.sfp_workbuf_len;
            sel.sfp_work_st_top^.elen_var := 1 + mxsp_time;
            kb79date_diff (operand_addr[ 1 ]^, 1,
                  sel.sfp_workbuf_addr^, date_pos, days1, date_e);
            kb79date_diff (operand_addr[ 2 ]^, 1,
                  sel.sfp_workbuf_addr^, date_pos, days2, date_e);
            day_sec1 := s78day_sec (operand_addr[ 1 ]^, 1, date_e);
            day_sec2 := s78day_sec (operand_addr[ 2 ]^, 1, date_e);
            seconds := abs (((86400*days1)+day_sec1)
                  - ((86400*days2)+day_sec2));
            kb79sec_put (seconds, hour, min, sec);
            s78val_to_buf (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
                  hour, min, sec)
            END
        ELSE
            BEGIN
            sel.sfp_work_st_top^.elen_var := 1 + mxsp_time;
            s78time_from_buf (operand_addr[ 1 ]^, 1, len[ 1 ],
                  hour, min, sec, date_e);
            IF  date_e = sp6de_ok
            THEN
                BEGIN
                seconds := kb79sec_get (hour, min, sec);
                s78time_from_buf (operand_addr[ 2 ]^, 1, len[ 2 ],
                      hour, min, sec, date_e)
                END;
            (*ENDIF*) 
            IF  date_e = sp6de_ok
            THEN
                BEGIN
                seconds := seconds - kb79sec_get (hour, min, sec);
                IF  seconds < 0
                THEN
                    seconds := - seconds;
                (*ENDIF*) 
                kb79sec_put (seconds, hour, min, sec);
                s78val_to_buf (sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
                      hour, min, sec)
                END;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        e := g03date_error_to_b_err (date_e);
        sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_time
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END;
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_timestamp (
            VAR sel   : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
CONST
      operand_count = 2;
      mintimelength = 6;
 
VAR
      i            : integer;
      hour         : integer;
      days         : integer;
      len          : ARRAY [ 1..2 ] OF integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      date_e       : tsp6_date_error;
 
BEGIN
e := e_ok;
undef[ 1 ] := false;
undef[ 2 ] := false;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
IF  sel.sfp_workbuf_len + 1 + mxsp_timestamp > sel.sfp_workbuf_size
THEN
    e := e_stack_overflow;
(*ENDIF*) 
i := operand_count;
WHILE (e = e_ok) AND (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ], len[ i ], e);
    IF  e = e_ok
    THEN
        BEGIN
&       ifdef TRACE
        t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&       endif
        undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
        IF  NOT undef[ i ]
        THEN
            len[ i ] := 1 + s30lnr_defbyte (@operand_addr[ i ]^,
                  operand_addr[ i ]^[ 1 ],
                  2, len[ i ] - 1);
        (*ENDIF*) 
        sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
        i := i - 1
        END
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
IF  (e = e_ok) AND NOT undef[ 1 ] AND NOT undef [ 2 ]
THEN
    BEGIN
    IF  len[ 1 ] <> mxsp_date + 1
    THEN
        e := e_invalid_date
    ELSE
        IF  len[ 2 ] <> mxsp_time + 1
        THEN
            e := e_invalid_time;
        (*ENDIF*) 
    (*ENDIF*) 
    IF  operand_addr[ 1 ]^[ 1 ] <> csp_ascii_blank
    THEN
        k71code_operand (sel, csp_ascii_blank,
              operand_addr[ 1 ], len[ 1 ],
              s35inc_st (sel.sfp_work_st_top, 1), e);
    (*ENDIF*) 
    IF  (e = e_ok) AND
        (operand_addr[ 2 ]^[ 1 ] <> csp_ascii_blank)
    THEN
        k71code_operand (sel, csp_ascii_blank,
              operand_addr[ 2 ], len[ 2 ],
              s35inc_st (sel.sfp_work_st_top, 2), e);
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  e = e_ok
THEN
    BEGIN
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
    WITH sel.sfp_work_st_top^ DO
        BEGIN
        etype := st_result;
        eop   := op_none;
        epos  := sel.sfp_workbuf_len;
        ecol_tab[ 1 ] := chr(0);
        ecol_tab[ 2 ] := chr(0)
        END;
    (*ENDWITH*) 
    IF  undef[ 1 ] OR undef [ 2 ]
    THEN
        BEGIN
        sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_undef_byte;
        sel.sfp_work_st_top^.elen_var := 1
        END
    ELSE
        BEGIN
        i := ord (csp_ascii_zero);
        hour := (ord(operand_addr[ 2 ]^[ 2 ]) - i) * 1000
              + (ord(operand_addr[ 2 ]^[ 3 ]) - i) *  100
              + (ord(operand_addr[ 2 ]^[ 4 ]) - i) *   10
              + (ord(operand_addr[ 2 ]^[ 5 ]) - i);
        IF  hour > 24
        THEN
            BEGIN
            days := hour DIV 24;
            hour := hour MOD 24;
            kb79add_date (operand_addr[ 1 ]^, 1,
                  sel.sfp_workbuf_addr^, sel.sfp_workbuf_len,
                  days, date_e);
            e := g03date_error_to_b_err (date_e);
            sel.sfp_workbuf_len := sel.sfp_workbuf_len +1+ mxsp_date;
            sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] :=
                  chr((hour DIV 10) + ord(csp_ascii_zero));
            sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len+1 ] :=
                  chr((hour MOD 10) + ord(csp_ascii_zero));
            g10mv ('VKB79 ',   8,
                  sizeof (operand_addr [2]^), sel.sfp_workbuf_size,
                  @operand_addr [2]^, 6,
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len+2, len [2] - 5,
                  e);
            sel.sfp_workbuf_len := sel.sfp_workbuf_len + mintimelength;
            SAPDB_PascalFill ('VKB79 ',   9,
                  sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len, MICROSEC_MXSP00, csp_ascii_zero, e);
            sel.sfp_workbuf_len := sel.sfp_workbuf_len + MICROSEC_MXSP00;
            sel.sfp_work_st_top^.elen_var := 1 + mxsp_timestamp
            END
        ELSE
            BEGIN
            sel.sfp_work_st_top^.elen_var :=
                  1 + mxsp_timestamp;
            g10mv ('VKB79 ',  10,
                  sizeof (operand_addr [1]^), sel.sfp_workbuf_size,
                  @operand_addr [1]^, 1,
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len, len[ 1 ], e);
            g10mv ('VKB79 ',  11,
                  sizeof (operand_addr [2]^), sel.sfp_workbuf_size,
                  @operand_addr [2]^, 4,
                  @sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + mxsp_date + 1,
                  len [2] - 3, e);
            SAPDB_PascalFill ('VKB79 ',  12,
                  sel.sfp_workbuf_size, @sel.sfp_workbuf_addr^,
                  sel.sfp_workbuf_len + mxsp_date + mintimelength + 1,
                  MICROSEC_MXSP00, csp_ascii_zero, e);
            sel.sfp_workbuf_len :=
                  sel.sfp_workbuf_len + mxsp_timestamp
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      kb79sec_get (
            hour        : tsp00_Int4;
            min         : tsp00_Int4;
            sec         : tsp00_Int4): tsp00_Int4;
 
BEGIN
kb79sec_get := hour * 3600 + min * 60 + sec
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79sec_put (
            seconds  : tsp00_Int4;
            VAR hour : integer;
            VAR min  : integer;
            VAR sec  : integer);
 
VAR
      secs : tsp00_Int4;
 
BEGIN
hour := seconds DIV 3600;
secs := seconds MOD 3600;
min  := secs    DIV   60;
sec  := secs    MOD   60
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79sub_date (
            VAR indat  : tsp00_MoveObj;
            inpos      : tsp00_Int4;
            VAR outdat : tsp00_MoveObj;
            outpos     : tsp00_Int4;
            sub_days   : tsp00_Int4;
            VAR e      : tsp6_date_error);
 
VAR
      day    : integer;
      year   : integer;
      diff   : tsp00_Int4;
 
BEGIN
e := sp6de_ok;
IF  sub_days > max_days
THEN
    e := sp6de_num_invalid
ELSE
    s78year_and_day (indat, inpos, year, day, e);
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    BEGIN
    diff := sub_days;
    REPEAT
        IF  diff < day
        THEN
            BEGIN
            day  := day - diff;
            diff := 0
            END
        ELSE
            BEGIN
            diff := diff - day;
            IF  year <= 0
            THEN
                e := sp6de_invalid_date
            ELSE
                year := year - 1;
            (*ENDIF*) 
            day := s78days_of_year (year);
            END
        (*ENDIF*) 
    UNTIL
        (diff <= 0) OR (e <> sp6de_ok);
    (*ENDREPEAT*) 
    kb79day_year_to_date (day, year, outdat, outpos)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79sub_month (
            VAR indat  : tsp00_MoveObj;
            inpos      : tsp00_Int4;
            VAR outdat : tsp00_MoveObj;
            outpos     : tsp00_Int4;
            add_months : tsp00_Int4;
            VAR e      : tsp6_date_error);
 
VAR
      day              : integer;
      month            : integer;
      year             : integer;
      max_day_of_month : integer;
      diff             : tsp00_Int4;
 
BEGIN
e := sp6de_ok;
IF  add_months > max_months
THEN
    e := sp6de_num_invalid
ELSE
    s78year_month_day (indat, inpos, year, month, day, e);
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    BEGIN
    year := year - add_months DIV 12;
    diff := add_months MOD 12;
    IF  month - diff <= 0
    THEN
        BEGIN
        year  := pred(year);
        month := 12 + month - diff;
        END
    ELSE
        month := month - diff;
    (*ENDIF*) 
    max_day_of_month := s78days_of_month (year, month);
    IF  max_day_of_month < day
    THEN
        day := max_day_of_month;
    (*ENDIF*) 
    s78val_to_buf (outdat, outpos, year, month, day);
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79sub_time (
            VAR timebuf1  : tsp00_MoveObj;
            timepos1      : tsp00_Int4;
            timelen1      : integer;
            VAR timebuf2  : tsp00_MoveObj;
            timepos2      : tsp00_Int4;
            timelen2      : integer;
            VAR resultbuf : tsp00_MoveObj;
            resultpos     : tsp00_Int4;
            VAR e         : tsp6_date_error);
 
VAR
      hour    : integer;
      min     : integer;
      sec     : integer;
      seconds : tsp00_Int4;
 
BEGIN
e := sp6de_ok;
s78time_from_buf (timebuf1, timepos1, timelen1, hour, min, sec, e);
IF  e = sp6de_ok
THEN
    BEGIN
    seconds := kb79sec_get (hour, min, sec);
    s78time_from_buf (timebuf2, timepos2, timelen2, hour, min, sec, e)
    END;
(*ENDIF*) 
IF  e = sp6de_ok
THEN
    BEGIN
    seconds := seconds - kb79sec_get (hour, min, sec);
    IF  (seconds < 0) OR (seconds > max_seconds)
    THEN
        e := sp6de_invalid_time
    ELSE
        BEGIN
        kb79sec_put (seconds, hour, min, sec);
        s78val_to_buf (resultbuf, resultpos, hour, min, sec)
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79time_add_sub (
            VAR intim     : tsp00_MoveObj;
            inpos         : tsp00_Int4;
            time_duration : tsp00_Int4;
            VAR outtim    : tsp00_MoveObj;
            outpos        : tsp00_Int4;
            add_wanted    : boolean;
            is_labeled    : boolean;
            duration_type : char;
            VAR e         : tsp6_date_error);
 
CONST
      hour_duration   = 10000;
      minute_duration = 100;
 
VAR
      is_add       : boolean;
      i            : integer;
      hour         : integer;
      minute       : integer;
      second       : integer;
      abs_duration : tsp00_Int4;
      duration     : ARRAY [ 1..3 ] OF integer;
 
BEGIN
e := sp6de_ok;
&ifdef TRACE
t01p2int4 (kb_qual, 'time_duratio', time_duration
      ,             'add_wanted  ', ord(add_wanted));
t01p2int4 (kb_qual, 'is_labeled  ', ord(is_labeled)
      ,             'durationtype', ord(duration_type));
&endif
IF  time_duration < 0
THEN
    BEGIN
    is_add       := NOT add_wanted;
    abs_duration := -time_duration
    END
ELSE
    BEGIN
    is_add       := add_wanted;
    abs_duration := time_duration
    END;
(*ENDIF*) 
&ifdef TRACE
t01p2int4 (kb_qual, 'abs_duratio ', abs_duration
      ,             'is_add      ', ord(is_add));
t01p2int4 (kb_qual, 'is_labeled  ', ord(is_labeled)
      ,             'durationtype', ord(duration_type));
&endif
FOR i := 1 TO 3 DO
    IF  is_labeled
    THEN
        IF  ord(duration_type) - 2 = i
        THEN
            duration[ i ] := abs_duration
        ELSE
            duration[ i ] := 0
        (*ENDIF*) 
    ELSE
        CASE i OF
            1 :
                duration[ i ] := abs_duration DIV hour_duration;
            2 :
                duration[ i ] := (abs_duration MOD hour_duration)
                      DIV minute_duration;
            3 :
                duration[ i ] := abs_duration MOD minute_duration
            END;
        (*ENDCASE*) 
    (*ENDIF*) 
(*ENDFOR*) 
s78val_from_buf (intim, inpos, hour, minute, second,
      sp6de_invalid_time, e);
&ifdef TRACE
t01p2int4(kb_qual, 'hour        ', hour
      ,            'hour_duratio', duration[ 1 ]);
t01p2int4(kb_qual, 'minute      ', minute
      ,            'minute_durat', duration[ 2 ]);
t01p2int4(kb_qual, 'second      ', second
      ,            'second_durat', duration[ 3 ]);
&endif
IF  e = sp6de_ok
THEN
    BEGIN
    IF  is_add
    THEN
        hour := hour + duration[ 1 ]
    ELSE
        hour := hour - duration[ 1 ];
    (*ENDIF*) 
    IF  is_add
    THEN
        minute := minute + duration[ 2 ]
    ELSE
        minute := minute - duration[ 2 ];
    (*ENDIF*) 
    WHILE minute > 59 DO
        BEGIN
        minute := minute - 60;
        hour   := hour   +  1
        END;
    (*ENDWHILE*) 
    WHILE minute < 0 DO
        BEGIN
        minute := minute + 60;
        hour   := hour   -  1
        END;
    (*ENDWHILE*) 
    IF  is_add
    THEN
        second := second + duration[ 3 ]
    ELSE
        second := second - duration[ 3 ];
    (*ENDIF*) 
    WHILE second > 59 DO
        BEGIN
        second := second - 60;
        minute := minute +  1;
        IF  minute > 59
        THEN
            BEGIN
            minute := minute - 60;
            hour   := hour   +  1
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    WHILE second < 0 DO
        BEGIN
        second := second + 60;
        minute := minute -  1;
        IF  minute < 0
        THEN
            BEGIN
            minute := minute + 60;
            hour   := hour   -  1
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    WHILE hour > 23 DO
        hour := hour - 24;
    (*ENDWHILE*) 
    WHILE  hour < 0 DO
        hour := hour + 24;
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
s78val_to_buf ( outtim, outpos, hour, minute, second);
&ifdef TRACE
IF  e = sp6de_ok
THEN
    BEGIN
    t01int4 (kb_qual, 'hour        ', hour  );
    t01int4 (kb_qual, 'minute      ', minute);
    t01int4 (kb_qual, 'second      ', second);
    END;
&endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79timestamp_add_sub (
            VAR intim       : tsp00_MoveObj;
            inpos           : tsp00_Int4;
            timest_duration : tsp00_Longreal;
            VAR outtim      : tsp00_MoveObj;
            outpos          : tsp00_Int4;
            add_wanted      : boolean;
            duration_type   : char;
            VAR e           : tsp6_date_error);
 
CONST
      max_duration = 7;
 
VAR
      is_add       : boolean;
      i            : integer;
      maxtype      : integer;
      maxvalue     : integer;
      minvalue     : integer;
      abs_duration : tsp00_Longreal;
      timestamp    : tsp6_timestamp_array;
      check_needed : boolean;
 
BEGIN
e := sp6de_ok;
IF  timest_duration < 0
THEN
    BEGIN
    is_add       := NOT add_wanted;
    abs_duration := - timest_duration
    END
ELSE
    BEGIN
    is_add       := add_wanted;
    abs_duration := timest_duration
    END;
(*ENDIF*) 
&ifdef trace
t01real (kb_qual, 'abs_duration', abs_duration, 3);
&endif
maxtype := ord(duration_type) + 1;
s78ints_from_buf (intim, inpos, timestamp, e);
&ifdef TRACE
FOR i := 1 TO max_duration DO
    t01int4 (kb_qual, 'timestamp i ', timestamp[ i ]);
(*ENDFOR*) 
&endif
IF  e = sp6de_ok
THEN
    WHILE abs_duration > 0.0 DO
        BEGIN
        IF  is_add
        THEN
            timestamp[ maxtype ] := timestamp[ maxtype ] + trunc (abs_duration)
        ELSE
            timestamp[ maxtype ] := timestamp[ maxtype ] - trunc (abs_duration);
        (*ENDIF*) 
        FOR i := maxtype DOWNTO 2 DO
            BEGIN
            IF  i = 2
            THEN
                BEGIN
                maxvalue := 12;
                minvalue :=  1
                END;
            (*ENDIF*) 
            IF  i = 3
            THEN
                BEGIN
                minvalue := 1;
                maxvalue := s78days_of_month(timestamp[ 1 ], timestamp[ 2 ])
                END;
            (*ENDIF*) 
            IF  i = 4
            THEN
                BEGIN
                maxvalue := 23;
                minvalue :=  0
                END;
            (*ENDIF*) 
            IF  i in [ 5, 6 ]
            THEN
                BEGIN
                maxvalue := 59;
                minvalue :=  0
                END;
            (*ENDIF*) 
            IF  i = 7
            THEN
                BEGIN
                maxvalue := 999999;
                minvalue :=      0
                END;
            (*ENDIF*) 
            check_needed := timestamp[ i ] > maxvalue;
            WHILE check_needed DO
                kb79check_stamp_values (timestamp, i, c_positive,
                      check_needed);
            (*ENDWHILE*) 
            check_needed := timestamp[ i ] < minvalue;
            WHILE check_needed DO
                kb79check_stamp_values (timestamp, i, NOT c_positive,
                      check_needed);
            (*ENDWHILE*) 
            END;
        (*ENDFOR*) 
        IF  maxtype >= 7
        THEN
            abs_duration := 0.0
        ELSE
            BEGIN
            maxtype      := succ (maxtype);
            abs_duration := abs_duration - trunc (abs_duration);
            CASE  maxtype OF
                4: (* hours *)
                    abs_duration := abs_duration * 24.0;
                7: (* microseconds *)
                    abs_duration := abs_duration * 1000000.0;
                OTHERWISE (* minutes or seconds *)
                    abs_duration := abs_duration * 60.0;
                END
            (*ENDCASE*) 
            END
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
(*ENDIF*) 
IF  timestamp[ 3 ] > s78days_of_month (timestamp[ 1 ], timestamp[ 2 ])
THEN
    BEGIN
    e := sp6de_end_of_month_adjustment;
    timestamp[ 3 ] := s78days_of_month (timestamp[ 1 ], timestamp[ 2 ])
    END;
(*ENDIF*) 
IF  (timestamp[ 1 ] > max_year) OR
    (timestamp[ 1 ] < 1 )
THEN
    e := sp6de_invalid_date;
&ifdef TRACE
(*ENDIF*) 
FOR i := 1 TO max_duration DO
    t01int4 (kb_qual, 'timestamp i ', timestamp[ i ]);
(*ENDFOR*) 
&endif
IF  (e = sp6de_ok) OR (e = sp6de_end_of_month_adjustment)
THEN
    s78ints_to_buf (outtim, outpos, timestamp);
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79tn_timestamp_add_sub_number (
            VAR intim       : tsp00_MoveObj;
            inpos           : tsp00_Int4;
            VAR in_number   : tsp00_MoveObj;
            slen            : integer;
            VAR outtim      : tsp00_MoveObj;
            outpos          : tsp00_Int4;
            add_wanted      : boolean;
            VAR e           : tsp6_date_error);
 
LABEL
      999;
 
CONST
      max_duration   = 7;
      c_million      = '\C7\10\00\00\00';
      c_hundred      = '\C3\10\00\00\00';
      c_one_exponent = '\C1';
 
VAR
      i             : integer;
      curr_type     : integer;
      timestamp     : tsp6_timestamp_array;
      number        : tsp00_Number;
      num_len       : integer;
      million       : tsp00_C5;
      hundred       : tsp00_C5;
      seconds       : tsp00_Number;
      sec_len       : integer;
      micro_seconds : tsp00_Number;
      mic_len       : integer;
      value         : tsp00_Number;
      val_len       : integer;
      increase      : integer;
      num_err       : tsp00_NumError;
      adjusted      : boolean;
      value_mptr    : tsp00_MoveObjPtr;
 
BEGIN
e := sp6de_ok;
IF  in_number[ 2 ] < csp_zero_exponent
THEN
    add_wanted := NOT add_wanted;
(*ENDIF*) 
s51abs (in_number, 2, slen-1, number, 1, 20, csp_float_frac,
      num_len, num_err);
IF  (num_err <> num_ok) AND (num_err <> num_trunc)
THEN
    BEGIN
    kb79num_err_to_date_err (num_err, e);
    goto 999;
    END;
&ifdef trace
(*ENDIF*) 
t01buf (kb_qual, number, 1, num_len);
&endif
s78ints_from_buf (intim, inpos, timestamp, e);
&ifdef TRACE
FOR i := 1 TO max_duration DO
    t01int4 (kb_qual, 'timestamp i ', timestamp[ i ]);
(*ENDFOR*) 
&endif
IF  e <> sp6de_ok
THEN
    goto 999;
(*ENDIF*) 
s51trunc (number, 1, num_len, 0, seconds, 1, csp_fixed, 0,
      sec_len, num_err);
IF  (num_err <> num_ok) AND (num_err <> num_trunc)
THEN
    BEGIN
    kb79num_err_to_date_err (num_err, e);
    goto 999;
    END;
(*ENDIF*) 
s51sub (number, 1, num_len, seconds, 1, sec_len,
      micro_seconds, 1, csp_fixed, csp_float_frac, mic_len, num_err);
IF  (num_err <> num_ok) AND (num_err <> num_trunc)
THEN
    BEGIN
    kb79num_err_to_date_err (num_err, e);
    goto 999;
    END;
(*ENDIF*) 
IF  micro_seconds[1] > csp_zero_exponent
THEN
    BEGIN
    million := c_million;
    s51mul (micro_seconds, 1, mic_len,
          million, 1, sizeof (million),
          micro_seconds, 1, csp_fixed, csp_float_frac,
          mic_len, num_err);
    value_mptr := @micro_seconds;
    IF  num_err in [ num_ok, num_trunc ]
    THEN
        s40glint (value_mptr^,
              1, csp_fixed, increase, num_err);
    (*ENDIF*) 
    IF  (num_err <> num_ok) AND (num_err <> num_trunc)
    THEN
        BEGIN
        kb79num_err_to_date_err (num_err, e);
        goto 999;
        END;
    (*ENDIF*) 
    IF  NOT add_wanted
    THEN
        increase := -increase;
&   ifdef trace
    (*ENDIF*) 
    t01p2int4 (kb_qual, 'curr_type   ', 7
          ,             'increase    ', increase);
&   endif
    timestamp[ 7 ] := timestamp [ 7 ] + increase;
    REPEAT
        kb79check_stamp_values (timestamp,
              7, add_wanted, adjusted)
    UNTIL
        NOT adjusted
    (*ENDREPEAT*) 
    END;
(*ENDIF*) 
hundred   := c_hundred;
curr_type := 6 (* seconds *);
WHILE (curr_type >= 1) AND (seconds[ 1 ] >= c_one_exponent) DO
    BEGIN
    IF  curr_type = 1
    THEN
        BEGIN
        value_mptr := @seconds;
        val_len    := sec_len
        END
    ELSE
        BEGIN
        s51div (seconds, 1, sec_len,
              hundred, 1, sizeof (hundred),
              value, 1, csp_fixed, csp_float_frac,
              val_len, num_err);
        IF  num_err in [ num_ok, num_trunc ]
        THEN
            s51trunc (value, 1, val_len, 0, value, 1, csp_fixed, 0,
                  val_len, num_err);
        (*ENDIF*) 
        IF  num_err in [ num_ok, num_trunc ]
        THEN
            s51mul (value, 1, val_len,
                  hundred, 1, sizeof (hundred),
                  value, 1, csp_fixed, csp_float_frac,
                  val_len, num_err);
        (*ENDIF*) 
        IF  num_err in [ num_ok, num_trunc ]
        THEN
            s51sub (seconds, 1, sec_len, value, 1, val_len,
                  value, 1, csp_fixed, csp_float_frac, val_len, num_err);
        (*ENDIF*) 
        value_mptr := @value;
        END;
    (*ENDIF*) 
    IF  num_err in [ num_ok, num_trunc ]
    THEN
        s40glint (value_mptr^,
              1, csp_fixed, increase, num_err);
    (*ENDIF*) 
    IF  (num_err <> num_ok) AND (num_err <> num_trunc)
    THEN
        BEGIN
        kb79num_err_to_date_err (num_err, e);
        goto 999;
        END;
    (*ENDIF*) 
    IF  NOT add_wanted
    THEN
        increase := -increase;
&   ifdef trace
    (*ENDIF*) 
    t01p2int4 (kb_qual, 'curr_type   ', curr_type
          ,             'increase    ', increase);
&   endif
    timestamp[ curr_type ] := timestamp [ curr_type ] + increase;
    REPEAT
        kb79check_stamp_values (timestamp,
              curr_type, add_wanted, adjusted)
    UNTIL
        NOT adjusted;
    (*ENDREPEAT*) 
    s51div (seconds, 1, sec_len,
          hundred, 1, sizeof (hundred),
          seconds, 1, csp_fixed, csp_float_frac,
          sec_len, num_err);
    IF  (num_err <> num_ok) AND (num_err <> num_trunc)
    THEN
        BEGIN
        kb79num_err_to_date_err (num_err, e);
        goto 999;
        END;
    (*ENDIF*) 
    curr_type := pred (curr_type)
    END;
(*ENDWHILE*) 
IF  timestamp[ 3 ] > s78days_of_month (timestamp[ 1 ], timestamp[ 2 ])
THEN
    BEGIN
    e := sp6de_end_of_month_adjustment;
    timestamp[ 3 ] := s78days_of_month (timestamp[ 1 ], timestamp[ 2 ])
    END;
(*ENDIF*) 
IF  (timestamp[ 1 ] > max_year) OR
    (timestamp[ 1 ] < 1 )
THEN
    e := sp6de_invalid_date;
&ifdef TRACE
(*ENDIF*) 
FOR i := 1 TO max_duration DO
    t01int4 (kb_qual, 'timestamp i ', timestamp[ i ]);
(*ENDFOR*) 
&endif
IF  (e = sp6de_ok) OR (e = sp6de_end_of_month_adjustment)
THEN
    s78ints_to_buf (outtim, outpos, timestamp);
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_new_time (
            VAR sel : tgg00_SelectFieldsParam;
            VAR e : tgg00_BasisError);
 
VAR
      i            : integer;
      len          : ARRAY [ 1..3 ] OF integer;
      undef        : ARRAY [ 1..3 ] OF boolean;
      operand_addr : ARRAY [ 1..3 ] OF tsp00_MoveObjPtr;
      tz           : ARRAY [ 2..3 ] OF tsp00_C3; (* Timezone abbreviation. *)
      offset       : ARRAY [ 2..3 ] OF tsp00_Longreal; (* offset to GMT.   *)
      date_e       : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e := e_ok;
i := 3;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
WHILE (i >= 1) DO
    BEGIN
    k71get_operand (sel, c_check_spec_null, operand_addr[ i ],
          len[ i ], e);
    IF  e <> e_ok
    THEN
        goto 999;
&   ifdef TRACE
    (*ENDIF*) 
    t01moveobj (kb_qual, operand_addr[ i ]^, 1, len[ i ]);
&   endif
    undef[ i ] := (operand_addr[ i ]^[ 1 ] = csp_undef_byte);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    i := i - 1
    END;
(*ENDWHILE*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  undef[ 1 ] OR undef[ 2 ] OR undef[ 3 ]
THEN
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    i := 3;
    WHILE i >= 2 DO
        BEGIN
        (* PTS 1121793 E.Z. *)
        len[i] := 1 + s30lnr_defbyte (@operand_addr[ i ]^,
              operand_addr[ i ]^[ 1 ], 2, len[ i ] - 1);
        IF  len[ i ] <> 4 (* three chars plus defined byte. *)
        THEN
            BEGIN
            e := e_invalid_timezone;
            goto 999
            END;
        (*ENDIF*) 
        kb79upper (operand_addr[ i ], tz[ i ]);
&       ifdef TRACE
        t01p2int4 (kb_qual, 'tz[i][1] =  ', ord (tz[ i ][ 1 ])
              ,             'tz[i][2] =  ', ord (tz[ i ][ 2 ]));
        t01int4   (kb_qual, 'tz[i][3] =  ', ord (tz[ i ][ 3 ]));
&       endif
        IF  NOT zone_offset (tz[ i ], offset[ i ])
        THEN
            BEGIN
            e := e_invalid_timezone;
            goto 999
            END;
        (*ENDIF*) 
        i := pred (i)
        END;
    (*ENDWHILE*) 
    kb79timestamp_add_sub (operand_addr [ 1 ]^, 2,
          offset[ 3 ] - offset[ 2 ],
          sel.sfp_workbuf_addr^, sel.sfp_workbuf_len + 1,
          c_add_wanted, chr (3), date_e);
    e := g03date_error_to_b_err (date_e);
    IF  e <> e_ok
    THEN
        goto 999;
    (*ENDIF*) 
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := csp_ascii_blank;
    sel.sfp_work_st_top^.elen_var := 1 + mxsp_timestamp;
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1 + mxsp_timestamp;
&   ifdef TRACE
    t01sname (kb_qual, '=== result: ');
    WITH sel.sfp_work_st_top^ DO
        t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
              epos, epos + elen_var - 1);
    (*ENDWITH*) 
&   endif
    END;
(*ENDIF*) 
999:;
END;
 
(*------------------------------*) 
 
FUNCTION
      zone_offset (
            zone       : tsp00_C3;
            VAR offset : tsp00_Longreal) : boolean;
 
VAR
      found : boolean;
 
BEGIN
found := zone[ 3 ] = 'T';
IF  found
THEN
    CASE zone[ 1 ] OF
        'A': (* Atlantic       Time. *)
            offset :=  -4;
        'B': (* Bering         Time. *)
            offset := -11;
        'C':(* Central        Time. *)
            offset :=  -6;
        'E':(* Eastern        Time. *)
            offset :=  -5;
        'G':(* Greenwich Mean Time. *)
            offset :=   0;
        'H':(* Alaska-Hawaii  Time. *)
            offset := -10;
        'M':(* Mountain       Time. *)
            offset :=  -7;
        'N':(* Newfoundland   Time. *)
            offset :=  -3;
        'P':(* Pacific        Time. *)
            offset :=  -8;
        'Y':(* Yukon          Time. *)
            offset :=  -9;
        OTHERWISE: (* Unknown. *)
            BEGIN
            offset := 0;
            found := false
            END;
        END;
    (*ENDCASE*) 
(*ENDIF*) 
IF  found
THEN
    IF  offset = 0
    THEN (* Greenwich Mean Time. *)
        found := zone[ 2 ] = 'M'
    ELSE (* Some american Timezone, that ends with ST or DT. *)
        CASE zone[ 2 ] OF
            'D': (* Daylight Saving Time, not for Newfoundland! *)
                BEGIN
                offset := offset + 1;
                found  := zone[ 1 ] <> 'N'
                END;
            'S': (* Standard Time. *)
                found := true;
            OTHERWISE (* Unknown Time Zone. *)
                found := false;
            END;
        (*ENDCASE*) 
    (*ENDIF*) 
(*ENDIF*) 
zone_offset := found
END;
 
(*------------------------------*) 
 
FUNCTION
      k79ora_number_format (
            VAR format : tsp00_MoveObj;
            len : tsp00_Int4;
            pos : tsp00_Int4) : tkb07_ora_number_fmt_elem;
 
VAR
      found : tkb07_ora_number_fmt_elem;
 
BEGIN
found := onf_no_correct_format;
IF  pos <= len
THEN
    CASE format[ pos ] OF
        '9': (* number of significant digits. *)
            found := onf_nine;
        '0': (* leading zero. *)
            found := onf_zero;
        '$': (* prefix value with dollar sign. *)
            found := onf_currency_dollar;
        'B', 'b': (* zero value as blank. *)
            found := onf_blank;
        'M', 'm':
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'I') OR (format[ pos+1 ] = 'i')
                THEN (* 'MI': A - after negative values. *)
                    found := onf_sign_at_end;
                (*ENDIF*) 
            (*ENDIF*) 
        'S', 's': (* + for positive and - for negative values. *)
            found := onf_sign_at_this_position;
        'P', 'p':
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'R') OR (format[ pos+1 ] = 'r')
                THEN (* 'PR': negative values in angle brackets. *)
                    found := onf_sign_brackets;
                (*ENDIF*) 
            (*ENDIF*) 
        'D', 'd': (* decimal character. *)
            found := onf_decimal_point;
        'G', 'g': (* group seperator. *)
            found := onf_seperator;
        'C', 'c': (* iso currency symbol. *)
            found := onf_currency_iso;
        'L', 'l': (* local currency symbol. *)
            found := onf_currency_local;
        ',': (* A comma at this position. *)
            found := onf_seperator_comma;
        '.': (* A dot as decimal point. *)
            found := onf_decimal_dot;
        'V', 'v': (* An implicit decimal point at this position. *)
            found := onf_decimal_implicit;
        'E', 'e':
            IF  pos+3 <= len
            THEN
                IF  ((format[ pos+1 ] = 'E') OR (format[ pos+1 ] = 'e')) AND
                    ((format[ pos+2 ] = 'E') OR (format[ pos+2 ] = 'e')) AND
                    ((format[ pos+3 ] = 'E') OR (format[ pos+3 ] = 'e'))
                THEN (* 'EEEE': value in scientific notation. *)
                    found := onf_exponent;
                (*ENDIF*) 
            (*ENDIF*) 
        'R':
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'N') OR (format[ pos+1 ] = 'n')
                THEN (* 'PR': negative values in angle brackets. *)
                    found := onf_roman_numeral_upper;
                (*ENDIF*) 
            (*ENDIF*) 
        'r':
            IF  pos+1 <= len
            THEN
                IF  (format[ pos+1 ] = 'N') OR (format[ pos+1 ] = 'n')
                THEN (* 'PR': negative values in angle brackets. *)
                    found := onf_roman_numeral_lower;
                (*ENDIF*) 
            (*ENDIF*) 
        OTHERWISE;
        END;
    (*ENDCASE*) 
(*ENDIF*) 
k79ora_number_format := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      k79new_pos_ora_number_format (
            last_fmt : tkb07_ora_number_fmt_elem;
            VAR pos  : tsp00_Int4);
 
BEGIN
CASE last_fmt OF
    onf_no_correct_format:
        ;
    onf_nine, onf_zero, onf_sign_at_this_position, onf_blank,
    onf_currency_dollar, onf_currency_iso, onf_currency_local,
    onf_decimal_implicit, onf_decimal_point, onf_decimal_dot,
    onf_seperator, onf_seperator_comma:
        pos := pos + 1;
    onf_sign_at_end, onf_sign_brackets,
    onf_roman_numeral_lower, onf_roman_numeral_upper:
        pos := pos + 2;
    onf_exponent:
        pos := pos + 4;
    END;
(*ENDCASE*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      k79n_dest_len_ora_number_format (
            VAR format : tsp00_MoveObj;
            fmt_pos : tsp00_Int4;
            fmt_len : tsp00_Int4) : tsp00_Int2;
 
VAR
      fmt_end       : tsp00_Int4;
      dest_len      : tsp00_Int2;
      curr_fmt      : tkb07_ora_number_fmt_elem;
      explicit_sign : boolean;
 
BEGIN
explicit_sign := false;
dest_len      := 0;
fmt_end       := fmt_pos+fmt_len-1;
WHILE (fmt_pos <= fmt_end) AND (dest_len < mxsp_c256) DO
    BEGIN
    curr_fmt := k79ora_number_format (format, fmt_end, fmt_pos);
    CASE curr_fmt OF
        onf_no_correct_format:
            dest_len := mxsp_c256;
        onf_nine, onf_zero, onf_blank,
        onf_currency_dollar, onf_currency_iso, onf_currency_local,
        onf_decimal_point, onf_decimal_dot,
        onf_seperator, onf_seperator_comma:
            dest_len := dest_len + 1;
        onf_sign_at_this_position, onf_sign_at_end:
            BEGIN
            explicit_sign := true;
            dest_len      := dest_len + 1
            END;
        onf_sign_brackets:
            BEGIN
            explicit_sign := true;
            dest_len      := dest_len + 2
            END;
        onf_decimal_implicit:
            ;
        onf_exponent:
            dest_len := dest_len + 4;
        onf_roman_numeral_lower, onf_roman_numeral_upper:
            dest_len := dest_len + 15;
        OTHERWISE;
        END;
    (*ENDCASE*) 
    k79new_pos_ora_number_format (curr_fmt, fmt_pos);
    END;
(*ENDWHILE*) 
IF  NOT explicit_sign
THEN
    dest_len := succ (dest_len);
(*ENDIF*) 
k79n_dest_len_ora_number_format := dest_len;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79round_adjustment (
            curr_fmt       : tsp6_date_fmt_elem;
            VAR add_amount : tsp00_Longreal;
            VAR add_unit   : integer;
            VAR sub_amount : tsp00_Longreal;
            VAR sub_unit   : integer);
 
BEGIN
add_amount := 0;
sub_amount := 0;
CASE curr_fmt OF
    sp6df_minute:
        BEGIN
        add_amount := 30;
        add_unit   := 5; (* seconds *)
        END;
    sp6df_hour, sp6df_hour_12, sp6df_hour_24:
        BEGIN
        add_amount := 30;
        add_unit   := 4; (* minutes *)
        END;
    sp6df_day_of_week_numeric, sp6df_day_of_week_long,
    sp6df_day_of_week_short, sp6df_week_of_month, sp6df_week_of_year:
        BEGIN
        add_amount := 84; (* these are 3.5 days. *)
        add_unit   := 3;  (* hours *)
        END;
    sp6df_day_of_month, sp6df_day_of_year, sp6df_julian_day:
        BEGIN
        add_amount := 12;
        add_unit   := 3; (* hours *)
        END;
    sp6df_month_numeric, sp6df_month_long, sp6df_month_short,
    sp6df_month_roman:
        BEGIN
        add_amount := 1;  (* this is a half month too much...  *)
        add_unit   := 1;  (* months *)
        sub_amount := 15; (* ... and here it will be corrected. *)
        sub_unit   := 2;  (* days *)
        END;
    sp6df_quarter:
        BEGIN
        add_amount := 2;  (* this is a half month too much...  *)
        add_unit   := 1;  (* months *)
        sub_amount := 15; (* ... and here it will be corrected. *)
        sub_unit   := 2;  (* days *)
        END;
    sp6df_year, sp6df_year_1, sp6df_year_10, sp6df_year_10_relative,
    sp6df_year_100, sp6df_year_short, sp6df_year_comma:
        BEGIN
        add_amount := 6;
        add_unit   := 1;  (* months *)
        END;
    sp6df_century:
        BEGIN
        add_amount := 50;
        add_unit   := 0;  (* years. *)
        END;
    OTHERWISE;
    END
(*ENDCASE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79op_trunc_ts (
            VAR op  : tgg00_StackEntry;
            VAR sel : tgg00_SelectFieldsParam;
            VAR e   : tgg00_BasisError);
 
VAR
      curr_fmt     : tsp6_date_fmt_elem;
      pos          : integer;
      this_week    : integer;
      this_year    : integer;
      day_in_week  : integer;
      day_in_year  : integer;
      add_amount   : tsp00_Longreal;
      add_unit     : integer;
      sub_amount   : tsp00_Longreal;
      sub_unit     : integer;
      undef        : ARRAY [ 1..2 ] OF boolean;
      len          : ARRAY [ 1..2 ] OF integer;
      operand_addr : ARRAY [ 1..2 ] OF tsp00_MoveObjPtr;
      timestamp    : tsp6_timestamp_array;
      date_e       : tsp6_date_error;
 
LABEL
      999;
 
BEGIN
e     := e_ok;
(* PTS 1116311 E.Z. *)
date_e := sp6de_ok;
IF  op.epos = 1
THEN
    BEGIN
    pos        := 1;
    undef[ 2 ] := false
    END
ELSE
    pos := 2;
(*ENDIF*) 
WHILE pos >= 1 DO
    BEGIN
    k71get_operand (sel, c_check_spec_null,
          operand_addr[ pos ], len[ pos ], e);
    sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, -1);
    IF  (e <> e_ok)
    THEN
        goto 999;
    (*ENDIF*) 
    undef[ pos ] := (operand_addr[ pos ]^[ 1 ] = csp_undef_byte);
&   ifdef TRACE
    t01moveobj   (kb_qual, operand_addr[ pos ]^, 1, len[ pos ]);
&   endif
    pos := pred (pos)
    END;
(*ENDWHILE*) 
sel.sfp_work_st_top := s35inc_st (sel.sfp_work_st_top, 1);
sel.sfp_workbuf_len := sel.sfp_workbuf_len + 1;
WITH sel.sfp_work_st_top^ DO
    BEGIN
    etype := st_result;
    eop   := op_none;
    epos  := sel.sfp_workbuf_len;
    ecol_tab[ 1 ] := chr(0);
    ecol_tab[ 2 ] := chr(0)
    END;
(*ENDWITH*) 
IF  undef[ 1 ] OR undef[ 2 ]
THEN
    BEGIN
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ]    := csp_undef_byte;
    sel.sfp_work_st_top^.elen_var := 1
    END
ELSE
    BEGIN
    IF  sel.sfp_workbuf_len + mxsp_timestamp > sel.sfp_workbuf_size
    THEN (* Is there enough place on the stack? *)
        BEGIN
        e := e_stack_overflow;
        goto 999;
        END;
    (* First of all we set the defined byte to blank. *)
    (*ENDIF*) 
    sel.sfp_workbuf_addr^[ sel.sfp_workbuf_len ] := operand_addr[ 1 ]^[ 1 ];
    IF  op.epos = 1
    THEN (* default of day. *)
        BEGIN
        IF  op.eop_build_in = op_b_ts_round
        THEN (* for rounding we add twelve hours. *)
            kb79timestamp_add_sub (operand_addr[ 1 ]^, 2,
                  12, operand_addr[ 1 ]^, 2, c_add_wanted,
                  chr (3), date_e);
        (*ENDIF*) 
        s78year_month_day (operand_addr[ 1 ]^, 1,
              timestamp[ 1 ], timestamp[ 2 ], timestamp[ 3 ], date_e);
        e := g03date_error_to_b_err (date_e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        timestamp[ 4 ] := 0;
        timestamp[ 5 ] := 0;
        timestamp[ 6 ] := 0;
        END
    ELSE
        BEGIN
        s78df_len1 (operand_addr[ 2 ], len[ 2 ], curr_fmt, date_e);
        IF  date_e <> sp6de_ok
        THEN
            BEGIN
            IF  date_e = sp6de_overflow
            THEN
                e := e_too_many_precision_specs
            ELSE
                e := g03date_error_to_b_err (date_e);
            (*ENDIF*) 
            goto 999
            END;
        (*ENDIF*) 
        IF  op.eop_build_in = op_b_ts_round
        THEN
            BEGIN
            kb79round_adjustment (curr_fmt, add_amount, add_unit,
                  sub_amount, sub_unit);
            IF  add_amount <> 0
            THEN
                BEGIN
                kb79timestamp_add_sub (operand_addr[ 1 ]^, 2,
                      add_amount, operand_addr[ 1 ]^, 2,
                      c_add_wanted, chr (add_unit), date_e);
                IF  (date_e = sp6de_end_of_month_adjustment)
                THEN
                    date_e    := sp6de_ok;
                (*ENDIF*) 
                e := g03date_error_to_b_err (date_e);
                IF  e <> e_ok
                THEN
                    goto 999;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  sub_amount <> 0
            THEN
                BEGIN
                kb79timestamp_add_sub (operand_addr[ 1 ]^, 2,
                      sub_amount, operand_addr[ 1 ]^, 2,
                      NOT c_add_wanted, chr (sub_unit), date_e);
                e := g03date_error_to_b_err (date_e);
                IF  e <> e_ok
                THEN
                    goto 999;
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        (* Not all of the formats are straight forward in the sense, *)
        (* that there are only some units to nullify. These formats  *)
        (* will get right now some special treatment.                *)
        (*ENDIF*) 
        CASE curr_fmt OF
            sp6df_day_of_week_numeric, sp6df_day_of_week_long,
            sp6df_day_of_week_short:
                BEGIN (* nearest sunday. *)
                s78week_and_day (operand_addr[ 1 ]^, 1,
                      this_week, day_in_week, date_e);
                IF  date_e = sp6de_ok
                THEN
                    kb79timestamp_add_sub (operand_addr[ 1 ]^, 2,
                          day_in_week, operand_addr[ 1 ]^, 2,
                          NOT c_add_wanted, chr (2), date_e);
                (*ENDIF*) 
                e := g03date_error_to_b_err (date_e);
                IF  e <> e_ok
                THEN
                    goto 999;
                (*ENDIF*) 
                END;
            sp6df_week_of_year:
                BEGIN (* start of week of year *)
                s78year_and_day (operand_addr[ 1 ]^, 1,
                      this_year, day_in_year, date_e);
                IF  date_e = sp6de_ok
                THEN
                    BEGIN
                    day_in_year := ((day_in_year-1) DIV 7)*7+1;
                    kb79day_year_to_date (day_in_year, this_year,
                          operand_addr[ 1 ]^, 1)
                    END;
                (*ENDIF*) 
                e := g03date_error_to_b_err (date_e);
                IF  e <> e_ok
                THEN
                    goto 999;
                (*ENDIF*) 
                END;
            OTHERWISE;
            END;
        (*ENDCASE*) 
        s78ints_from_buf (operand_addr[ 1 ]^, 2, timestamp, date_e);
        e := g03date_error_to_b_err (date_e);
        IF  e <> e_ok
        THEN
            goto 999;
        (*ENDIF*) 
        CASE curr_fmt OF
            sp6df_minute:
                BEGIN (* minute. *)
                timestamp[ 6 ] := 0;
                END;
            sp6df_hour_12, sp6df_hour_24, sp6df_hour:
                BEGIN (* hour. *)
                timestamp[ 5 ] := 0;
                timestamp[ 6 ] := 0;
                END;
            sp6df_day_of_month, sp6df_day_of_year, sp6df_julian_day,
            sp6df_week_of_year, sp6df_day_of_week_numeric,
            sp6df_day_of_week_long, sp6df_day_of_week_short:
                BEGIN (* day *)
                timestamp[ 4 ] := 0;
                timestamp[ 5 ] := 0;
                timestamp[ 6 ] := 0;
                END;
            sp6df_week_of_month:
                BEGIN (* start of week of month *)
                timestamp[ 3 ] := ((timestamp[ 3 ]-1) DIV 7)*7+1;
                timestamp[ 4 ] := 0;
                timestamp[ 5 ] := 0;
                timestamp[ 6 ] := 0;
                timestamp[ 7 ] := 0;
                END;
            sp6df_month_numeric, sp6df_month_long,
            sp6df_month_short, sp6df_month_roman:
                BEGIN (* month *)
                timestamp[ 3 ] := 1;
                timestamp[ 4 ] := 0;
                timestamp[ 5 ] := 0;
                timestamp[ 6 ] := 0;
                END;
            sp6df_quarter:
                BEGIN (* quarter *)
                timestamp[ 2 ] := ((timestamp[ 2 ]-1) DIV 3)*3 + 1;
                timestamp[ 3 ] := 1;
                timestamp[ 4 ] := 0;
                timestamp[ 5 ] := 0;
                timestamp[ 6 ] := 0;
                END;
            sp6df_year, sp6df_year_1, sp6df_year_10, sp6df_year_10_relative,
            sp6df_year_100, sp6df_year_short, sp6df_year_comma:
                BEGIN (* year *)
                timestamp[ 2 ] := 1;
                timestamp[ 3 ] := 1;
                timestamp[ 4 ] := 0;
                timestamp[ 5 ] := 0;
                timestamp[ 6 ] := 0;
                END;
            sp6df_century:
                BEGIN (* century *)
                timestamp[ 1 ] := (timestamp[ 1 ] DIV 100)*100;
                timestamp[ 2 ] := 1;
                timestamp[ 3 ] := 1;
                timestamp[ 4 ] := 0;
                timestamp[ 5 ] := 0;
                timestamp[ 6 ] := 0;
                END;
            OTHERWISE
                BEGIN
                e := e_bad_precision_spec;
                goto 999
                END;
            END;
        (*ENDCASE*) 
        END;
    (*ENDIF*) 
    timestamp[ 7 ] := 0; (* micro seconds are always set to zero. *)
    s78ints_to_buf (sel.sfp_workbuf_addr^,
          sel.sfp_workbuf_len+1, timestamp);
    sel.sfp_workbuf_len := sel.sfp_workbuf_len + mxsp_timestamp;
    END;
(*ENDIF*) 
&ifdef TRACE
t01sname (kb_qual, '=== result: ');
WITH sel.sfp_work_st_top^ DO
    t01moveobj (kb_qual, sel.sfp_workbuf_addr^,
          epos, epos + elen_var - 1);
(*ENDWITH*) 
&endif
999:;
END;
 
(*------------------------------*) 
 
PROCEDURE
      kb79num_err_to_date_err (
            num_err : tsp00_NumError;
            VAR e : tsp6_date_error);
 
BEGIN
CASE num_err OF
    num_overflow:
        e := sp6de_num_overflow;
    num_invalid:
        e := sp6de_num_invalid;
    OTHERWISE
        e := sp6de_ok
    END
(*ENDCASE*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
