.ad 8
.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$VGG03$
.tt 2 $$$
.tt 3 $ElkeZ$Check-Date-Time$$2000-01-20$
***********************************************************
.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  : Check-Date-Time
=========
.sp
Purpose : Routinen zum ?Uberpr?ufen von Datum- und Timeformat
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        VAR
              g03short_daynames : tgg04_ShortDaynames;
              g03dictionary     : tsp6_dictionaries;
 
        PROCEDURE
              g03init;
 
        PROCEDURE
              g03daynames_init (
                    VAR buf   : tsp00_MoveObj;
                    i         : integer;
                    VAR is_ok : boolean);
 
        PROCEDURE
              g03fdcheck_date (
                    VAR sbuf   : tsp00_MoveObj;
                    VAR dbuf   : tsp00_MoveObj;
                    spos       : tsp00_Int4;
                    dpos       : tsp00_Int4;
                    actlen     : integer;
                    format     : tgg00_DateTimeFormat;
                    VAR b_err  : tgg00_BasisError);
 
        PROCEDURE
              g03fdc_date (
                    sptr       : tsp00_MoveObjPtr;
                    dptr       : tsp00_MoveObjPtr;
                    spos       : tsp00_Int4;
                    dpos       : tsp00_Int4;
                    actlen     : integer;
                    format     : tgg00_DateTimeFormat;
                    VAR b_err  : tgg00_BasisError);
 
        PROCEDURE
              g03ftcheck_time (
                    VAR sbuf   : tsp00_MoveObj;
                    VAR dbuf   : tsp00_MoveObj;
                    spos       : tsp00_Int4;
                    dpos       : tsp00_Int4;
                    actlen     : integer;
                    format     : tgg00_DateTimeFormat;
                    VAR b_err  : tgg00_BasisError);
 
        PROCEDURE
              g03ftc_time (
                    sptr       : tsp00_MoveObjPtr;
                    dptr       : tsp00_MoveObjPtr;
                    spos       : tsp00_Int4;
                    dpos       : tsp00_Int4;
                    actlen     : integer;
                    format     : tgg00_DateTimeFormat;
                    VAR b_err  : tgg00_BasisError);
 
        PROCEDURE
              g03ftscheck_timestamp (
                    VAR sbuf   : tsp00_MoveObj;
                    VAR dbuf   : tsp00_MoveObj;
                    spos       : tsp00_Int4;
                    dpos       : tsp00_Int4;
                    actlen     : integer;
                    format     : tgg00_DateTimeFormat;
                    language   : tsp00_C3;
                    VAR b_err  : tgg00_BasisError);
 
        PROCEDURE
              g03ftsc_timestamp (
                    sptr       : tsp00_MoveObjPtr;
                    dptr       : tsp00_MoveObjPtr;
                    spos       : tsp00_Int4;
                    dpos       : tsp00_Int4;
                    actlen     : integer;
                    format     : tgg00_DateTimeFormat;
                    language   : tsp00_C3;
                    VAR b_err  : tgg00_BasisError);
 
        PROCEDURE
              g03dchange_format_date (
                    VAR sbuf : tsp00_MoveObj;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    format    : tgg00_DateTimeFormat;
                    VAR b_err : tgg00_BasisError);
 
        PROCEDURE
              g03tchange_format_time (
                    VAR sbuf : tsp00_MoveObj;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    format    : tgg00_DateTimeFormat;
                    VAR b_err : 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 b_err : tgg00_BasisError);
 
        PROCEDURE
              g03dfchange_format_date (
                    VAR sbuf : tsp00_MoveObj;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    format    : tgg00_DateTimeFormat;
                    VAR b_err : tgg00_BasisError);
 
        PROCEDURE
              g03tfchange_format_time (
                    VAR sbuf : tsp00_MoveObj;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    format    : tgg00_DateTimeFormat;
                    VAR b_err : tgg00_BasisError);
 
        PROCEDURE
              g03tsfchange_format_timestamp (
                    VAR sbuf : tsp00_MoveObj;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : tsp00_Int4;
                    dpos      : tsp00_Int4;
                    format    : tgg00_DateTimeFormat;
                    language  : tsp00_C3;
                    VAR b_err : tgg00_BasisError);
 
        PROCEDURE
              g03part2_decrypt (
                    VAR part_buf  : tsp00_MoveObj;
                    mess_code     : tsp00_CodeType;
                    pos           : tsp00_Int4;
                    sourceswap    : tsp00_SwapKind;
                    destswap      : tsp00_SwapKind;
                    VAR clearname : tsp00_Name);
 
        PROCEDURE
              g03monthnames_init (
                    VAR buf   : tsp00_MoveObj;
                    i         : integer;
                    VAR is_ok : boolean);
 
        FUNCTION
              g03date_error_to_b_err (date_e : tsp6_date_error)
                    : tgg00_BasisError;
 
.CM *-END-* define --------------------------------------
.sp
.cp 3
Use     :
 
&       ifdef TRACE
        FROM
              Test_Procedures : VTA01;
 
        PROCEDURE
              t01buf (
                    debug    : tgg00_Debug;
                    VAR buf  : tsp00_C3;
                    startpos : integer;
                    endpos   : integer);
 
        PROCEDURE
              t01int4 (
                    debug    : tgg00_Debug;
                    nam      : tsp00_Sname;
                    int4     : tsp00_Int4);
&       endif
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01code : tgg04_CodeGlobals;
 
      ------------------------------ 
 
        FROM
              Codetransformation_and_Coding : VGG02;
 
        PROCEDURE
              g02datechange (
                    VAR sbuf : tsp00_Timestamp;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : integer;
                    dpos      : tsp00_Int4;
                    format    : tgg00_DateTimeFormat;
                    VAR b_err : tgg00_BasisError);
 
        PROCEDURE
              g02timechange (
                    VAR sbuf : tsp00_Timestamp;
                    VAR dbuf  : tsp00_MoveObj;
                    spos      : integer;
                    dpos      : tsp00_Int4;
                    format    : tgg00_DateTimeFormat;
                    VAR b_err : tgg00_BasisError);
 
        PROCEDURE
              g02upstring (
                    VAR source : tsp00_C28;
                    srcind   : tsp00_Int4;
                    VAR dest : tsp00_C28;
                    destind  : tsp00_Int4;
                    length   : tsp00_Int4;
                    code_type : tsp00_CodeType );
              (* vsp10 should be here      *)
              (* vgg03 is used in audit !! *)
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalOverlappingMove (
                    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
              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
              SAPDB_PascalFill (
                    mod_id      : tsp00_C6;
                    mod_num     : tsp00_Int4;
                    obj_upb     : tsp00_Int4;
                    obj         : tsp00_MoveObjPtr;
                    obj_pos     : tsp00_Int4;
                    length      : tsp00_Int4;
                    fillchar    : char;
                    VAR e       : tgg00_BasisError);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-20 : VSP20;
 
        FUNCTION
              s20buf_to_int4_swap (
                    VAR source : tsp00_MoveObj;
                    si         : tsp00_Int4;
                    sourceswap : tsp00_SwapKind;
                    destswap   : tsp00_SwapKind) : tsp00_Int4;
 
.CM *-END-* use -----------------------------------------
.sp
.cp 3
Synonym :
 
        PROCEDURE
              g02upstring;
 
              tsp00_MoveObj tsp00_C28
 
        PROCEDURE
              t01buf;
 
              tsp00_Buf tsp00_C3
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : ElkeZ
.sp
.cp 3
Created : 1987-01-13
.sp
.cp 3
.sp
.cp 3
Release :      Date : 2000-01-20
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.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
      mintimelength       =  6;
      mintimestamplength  = 14;
 
TYPE
 
      one_glob_rec = RECORD
            zero           : integer;
            nine           : integer;
            dt_blank       : char;
            iso_date_limit : char;
            usa_date_limit : char;
            eur_date_limit : char;
            (* PTS 1112472 E.Z. *)
            eur_time_limit : char;
            iso_time_limit : char;
            usa_time_limit : char;
            usa_t_am_upper_key : tsp00_C2;
            usa_t_am_lower_key : tsp00_C2;
            usa_t_pm_upper_key : tsp00_C2;
            usa_t_pm_lower_key : tsp00_C2
      END;
 
 
      one_language_short_monthnames = RECORD
            language   : tsp00_C3;
            monthnames : ARRAY [ 1..12 ] OF tsp00_C3;
            fill       : tsp00_C1;
      END;
 
 
VAR
      g03global : one_glob_rec;
      g03short_monthnames : ARRAY [ 1..4 ] OF
            one_language_short_monthnames;
 
 
(*------------------------------*) 
 
PROCEDURE
      gg03change_usa_time (
            VAR sbuf  : tsp00_C8;
            VAR dbuf  : tsp00_MoveObj;
            spos      : integer;
            dpos      : tsp00_Int4;
            VAR b_err : tgg00_BasisError);
 
VAR
      hour      : integer;
      minute    : integer;
 
BEGIN
WITH g03global DO
    BEGIN
    hour   := (ord (sbuf[ spos+2 ]) - zero) * 10 +
          (ord (sbuf[ spos+3 ]) - zero);
    minute := (ord (sbuf[ spos+4 ]) - zero) * 10 +
          (ord (sbuf[ spos+5 ]) - zero);
    IF  hour = 0
    THEN
        IF  minute = 0
        THEN (* 00:00 AM *)
            BEGIN
            SAPDB_PascalMove ('VGG03 ',   1,    
                  sizeof (sbuf), sizeof (dbuf), @sbuf, spos+2,
                  @dbuf, dpos, 2, b_err);
            dbuf[ dpos+2 ] := usa_time_limit;
            SAPDB_PascalMove ('VGG03 ',   2,    
                  sizeof (sbuf), sizeof (dbuf), @sbuf, spos+4,
                  @dbuf, dpos+3, 2, b_err);
            dbuf[ dpos+5 ] := dt_blank;
            dbuf[ dpos+6 ] := usa_t_am_upper_key[ 1 ];
            dbuf[ dpos+7 ] := usa_t_am_upper_key[ 2 ];
            END
        ELSE (* 12:01 - 12:59 AM *)
            BEGIN
            dbuf[ dpos ] := chr (zero+1);
            dbuf[ dpos+1 ] := chr (zero+2);
            dbuf[ dpos+2 ] := usa_time_limit;
            SAPDB_PascalMove ('VGG03 ',   3,    
                  sizeof (sbuf), sizeof (dbuf), @sbuf, spos+4,
                  @dbuf, dpos+3, 2, b_err);
            dbuf[ dpos+5 ] := dt_blank;
            dbuf[ dpos+6 ] := usa_t_am_upper_key[ 1 ];
            dbuf[ dpos+7 ] := usa_t_am_upper_key[ 2 ];
            END
        (*ENDIF*) 
    ELSE
        IF  hour < 12
        THEN (* 01:00 - 11:59 AM *)
            BEGIN
            SAPDB_PascalMove ('VGG03 ',   4,    
                  sizeof (sbuf), sizeof (dbuf), @sbuf, spos+2,
                  @dbuf, dpos, 2, b_err);
            dbuf[ dpos+2 ] := usa_time_limit;
            SAPDB_PascalMove ('VGG03 ',   5,    
                  sizeof (sbuf), sizeof (dbuf), @sbuf, spos+4,
                  @dbuf, dpos+3, 2, b_err);
            dbuf[ dpos+5 ] := dt_blank;
            dbuf[ dpos+6 ] := usa_t_am_upper_key[ 1 ];
            dbuf[ dpos+7 ] := usa_t_am_upper_key[ 2 ];
            END
        ELSE
            IF  hour = 12
            THEN (* 12:00 - 12:59 PM *)
                BEGIN
                SAPDB_PascalMove ('VGG03 ',   6,    
                      sizeof (sbuf), sizeof (dbuf), @sbuf, spos+2,
                      @dbuf, dpos, 2, b_err);
                dbuf[ dpos+2 ] := usa_time_limit;
                SAPDB_PascalMove ('VGG03 ',   7,    
                      sizeof (sbuf), sizeof (dbuf), @sbuf, spos+4,
                      @dbuf, dpos+3, 2, b_err);
                dbuf[ dpos+5 ] := dt_blank;
                dbuf[ dpos+6 ] := usa_t_pm_upper_key[ 1 ];
                dbuf[ dpos+7 ] := usa_t_pm_upper_key[ 2 ];
                END
            ELSE
                IF  hour < 24
                THEN (* 01:00 - 11:59 PM *)
                    BEGIN
                    hour := hour - 12;
                    dbuf[ dpos ]   := chr ( ( hour DIV 10 ) + zero);
                    dbuf[ dpos+1 ] := chr ( ( hour MOD 10 ) + zero);
                    dbuf[ dpos+2 ] := usa_time_limit;
                    SAPDB_PascalMove ('VGG03 ',   8,    
                          sizeof (sbuf), sizeof (dbuf), @sbuf, spos+4,
                          @dbuf, dpos+3, 2, b_err);
                    dbuf[ dpos+5 ] := dt_blank;
                    dbuf[ dpos+6 ] := usa_t_pm_upper_key[ 1 ];
                    dbuf[ dpos+7 ] := usa_t_pm_upper_key[ 2 ];
                    END
                ELSE (* 12:00 AM *)
                    BEGIN
                    dbuf[ dpos ] := chr (zero+1);
                    dbuf[ dpos+1 ] := chr (zero+2);
                    dbuf[ dpos+2 ] := usa_time_limit;
                    SAPDB_PascalMove ('VGG03 ',   9,    
                          sizeof (sbuf), sizeof (dbuf), @sbuf, spos+4,
                          @dbuf, dpos+3, 2, b_err);
                    dbuf[ dpos+5 ] := dt_blank;
                    dbuf[ dpos+6 ] := usa_t_am_upper_key[ 1 ];
                    dbuf[ dpos+7 ] := usa_t_am_upper_key[ 2 ];
                    END
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      gg03check_usa_time (
            VAR sbuf     : tsp00_MoveObj;
            VAR dbuf     : tsp00_C8;
            spos         : tsp00_Int4;
            dpos         : integer;
            actlen       : integer;
            VAR b_err    : tgg00_BasisError);
 
VAR
      hour      : integer;
      hourpos   : integer;
      hourlen   : integer;
      minute    : integer;
      minutepos : integer;
      minutelen : integer;
      ident     : tsp00_C2;
 
BEGIN
WITH g03global DO
    BEGIN
    hourpos := gg03chrpos (sbuf, spos, spos+actlen, usa_time_limit);
    IF  ( ( hourpos - spos ) = actlen )
    THEN
        hourpos := gg03chrpos (sbuf, spos, spos+actlen, dt_blank);
    (*ENDIF*) 
    hourlen := hourpos - spos;
    minutepos := gg03chrpos (sbuf, hourpos+1, spos+actlen, dt_blank);
    IF  ( ( minutepos - spos ) = actlen )
    THEN
        BEGIN
        minutepos := hourpos;
        minutelen := 0
        END
    ELSE
        minutelen := minutepos - hourpos - 1;
    (*ENDIF*) 
    ident[ 1 ] := sbuf[ minutepos+1 ];
    ident[ 2 ] := sbuf[ minutepos+2 ];
    IF  (   ( ident <> usa_t_am_upper_key )
        AND ( ident <> usa_t_am_lower_key )
        AND ( ident <> usa_t_pm_upper_key )
        AND ( ident <> usa_t_pm_lower_key ) )
    THEN
        b_err := e_invalid_time;
&   ifdef trace
    (*ENDIF*) 
    t01int4 (gg, 'hourpos     ', hourpos);
    t01int4 (gg, 'hourlen     ', hourlen);
    t01int4 (gg, 'minutepos   ', minutepos);
    t01int4 (gg, 'minutelen   ', minutelen);
    t01int4 (gg, 'e1          ', ord (b_err));
&   endif
    IF  ( hourlen < 1 ) OR ( hourlen > 2 )
    THEN
        b_err := e_invalid_time;
    (*ENDIF*) 
    IF  ( minutelen < 0 ) OR ( minutelen > 2 )
    THEN
        b_err := e_invalid_time;
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        BEGIN
        IF  hourlen = 1
        THEN
            hour := ord (sbuf[ hourpos-1 ]) - zero
        ELSE
            hour := ((ord (sbuf[ hourpos-2 ]) - zero) * 10) +
                  (ord (sbuf[ hourpos-1 ]) - zero);
        (*ENDIF*) 
        IF  minutelen > 0
        THEN
            IF  minutelen = 1
            THEN
                minute := ord (sbuf[ minutepos-1 ]) - zero
            ELSE
                minute := (ord (sbuf[ minutepos-2 ]) - zero) * 10 +
                      (ord (sbuf[ minutepos-1 ]) - zero)
            (*ENDIF*) 
        ELSE
            minute := 0;
        (*ENDIF*) 
&       ifdef trace
        t01int4 (gg, 'hour        ', hour);
        t01int4 (gg, 'minute      ', minute);
&       endif
        IF  (   ( ident = usa_t_am_upper_key )
            OR  ( ident = usa_t_am_lower_key ) )
        THEN
            BEGIN
            IF  ( hour = 0 ) AND ( minute <> 0 )
            THEN
                b_err := e_invalid_time;
            (*ENDIF*) 
            IF  hour > 12
            THEN
                b_err := e_invalid_time;
&           ifdef trace
            (*ENDIF*) 
            t01int4 (gg, 'am          ', 1);
            t01int4 (gg, 'e2          ', ord (b_err));
&           endif
            IF  b_err = e_ok
            THEN
                IF  ( hour = 12 ) AND ( minute = 0 )
                THEN
                    BEGIN
                    dbuf[ dpos+2 ] := chr (zero+2);
                    dbuf[ dpos+3 ] := chr (zero+4)
                    END
                ELSE
                    BEGIN
                    IF  hour <> 12
                    THEN
                        SAPDB_PascalMove ('VGG03 ',  10,    
                              sizeof (sbuf), sizeof (dbuf),
                              @sbuf, hourpos - hourlen,
                              @dbuf, dpos + 4 - hourlen, hourlen, b_err);
                    (*ENDIF*) 
                    SAPDB_PascalMove ('VGG03 ',  11,    
                          sizeof (sbuf), sizeof (dbuf),
                          @sbuf, minutepos - minutelen,
                          @dbuf, dpos + 6 - minutelen, minutelen, b_err)
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  (   ( ident = usa_t_pm_upper_key )
            OR  ( ident = usa_t_pm_lower_key ) )
        THEN
            BEGIN
            IF  ( hour <= 0 ) OR ( hour > 12 )
            THEN
                b_err := e_invalid_time;
            (*ENDIF*) 
            IF  b_err = e_ok
            THEN
                BEGIN
                IF  hour = 12
                THEN
                    BEGIN
                    dbuf[ dpos+2 ] := sbuf[ hourpos-2 ];
                    dbuf[ dpos+3 ] := sbuf[ hourpos-1 ]
                    END
                ELSE
                    BEGIN
                    hour := hour + 12;
                    dbuf[ dpos+2 ] := chr ( (hour DIV 10) + zero);
                    dbuf[ dpos+3 ] := chr ( (hour MOD 10) + zero)
                    END;
                (*ENDIF*) 
                SAPDB_PascalMove ('VGG03 ',  12,    
                      sizeof (sbuf), sizeof (dbuf),
                      @sbuf, minutepos - minutelen,
                      @dbuf, dpos + 6 - minutelen, minutelen, b_err)
                END
            (*ENDIF*) 
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      gg03chrpos (
            VAR sbuf  : tsp00_MoveObj;
            startpos  : tsp00_Int4;
            maxpos    : tsp00_Int4;
            pattern   : char) : tsp00_Int4;
 
VAR
      found : boolean;
      pos   : integer;
 
BEGIN
found := false;
pos := startpos;
WHILE ( pos < maxpos ) AND NOT found DO
    IF  sbuf[ pos ] = pattern
    THEN
        found := true
    ELSE
        pos := succ (pos);
    (*ENDIF*) 
(*ENDWHILE*) 
IF  found
THEN
    gg03chrpos := pos
ELSE
    gg03chrpos := maxpos;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      gg03dcheck_date (
            VAR date   : tsp00_C8;
            actlen     : integer;
            VAR b_err  : tgg00_BasisError);
 
VAR
      i         : integer;
      year      : integer;
      month     : integer;
      day       : integer;
      nul       : integer;
      asczero   : char;
      ascnine   : char;
 
BEGIN
asczero := chr (48);
ascnine := chr (57);
nul     := ord (asczero);
b_err   := e_ok;
IF  actlen < mxsp_date
THEN
    b_err := e_invalid_date
ELSE
    BEGIN
    FOR i := 1 TO mxsp_date DO
        IF  ((date[ i ] < asczero) OR
            ( date[ i ] > ascnine))
        THEN
            b_err := e_invalid_date
        (*ENDIF*) 
    (*ENDFOR*) 
    END;
(*ENDIF*) 
IF  b_err = e_ok
THEN
    BEGIN
    year := (ord (date[ 1 ]) - nul) * 1000 +
          (ord (date[ 2 ]) - nul) * 100 +
          (ord (date[ 3 ]) - nul) * 10 +
          ord (date[ 4 ]) - nul;
    month := (ord (date[ 5 ]) - nul) * 10 +
          ord (date[ 6 ]) - nul;
    IF  (year = 0)
    THEN
        (*   there was no year 0 between year -1 and year 1   *)
        b_err := e_invalid_date;
    (*ENDIF*) 
    IF  ((month = 0) OR (month > 12))
    THEN
        b_err := e_invalid_date
    ELSE
        BEGIN
        day := (ord (date[ 7 ]) - nul) * 10 +
              ord (date[ 8 ]) - nul;
        IF  day = 0
        THEN
            b_err := e_invalid_date
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        BEGIN
        CASE month OF
            1,3,5,7,8,10,12 :
                IF  day > 31
                THEN
                    b_err := e_invalid_date;
                (*ENDIF*) 
            4,6,9,11 :
                IF  day > 30
                THEN
                    b_err := e_invalid_date;
                (*ENDIF*) 
            2 :
                IF  (year MOD 4 = 0)
                THEN
                    IF  year MOD 100 = 0
                    THEN
                        IF  year MOD 400 = 0
                        THEN
                            BEGIN
                            IF  day > 29
                            THEN
                                b_err := e_invalid_date
                            (*ENDIF*) 
                            END
                        ELSE
                            BEGIN
                            IF  day > 28
                            THEN
                                b_err := e_invalid_date
                            (*ENDIF*) 
                            END
                        (*ENDIF*) 
                    ELSE
                        BEGIN
                        IF  day > 29
                        THEN
                            b_err := e_invalid_date
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                ELSE
                    IF  day > 28
                    THEN
                        b_err := e_invalid_date
                    (*ENDIF*) 
                (*ENDIF*) 
            END
        (*ENDCASE*) 
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      gg03tcheck_time (
            VAR time   : tsp00_C8;
            actlen    : integer;
            format    : tgg00_DateTimeFormat;
            VAR b_err : tgg00_BasisError);
 
VAR
      i         : integer;
      hours     : integer;
      minutes   : integer;
      seconds   : integer;
      nul       : integer;
      asczero   : char;
      ascnine   : char;
 
BEGIN
asczero := chr (48);
ascnine := chr (57);
nul     := ord (asczero);
b_err   := e_ok;
IF  actlen < mxsp_time
THEN
    b_err := e_invalid_time
ELSE
    BEGIN
    FOR i:= 1 TO mxsp_time DO
        IF  ((time[ i ] < asczero) OR
            ( time[ i ] > ascnine))
        THEN
            b_err := e_invalid_time;
        (*ENDIF*) 
    (*ENDFOR*) 
    END;
(*ENDIF*) 
IF  b_err = e_ok
THEN
    BEGIN
    (* PTS 1112742 E.Z. *)
    IF  format = dtf_iso
    THEN
        BEGIN
        hours :=
              (ord (time[ 1 ]) - nul) * 1000 +
              (ord (time[ 2 ]) - nul) *  100 +
              (ord (time[ 3 ]) - nul) *   10 +
              (ord (time[ 4 ]) - nul);
        IF  hours > 23
        THEN
            b_err := e_invalid_time
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    minutes := (ord (time[ 5 ]) - nul) * 10 +
          ord (time[ 6 ]) - nul;
    IF  minutes > 59
    THEN
        b_err := e_invalid_time
    ELSE
        BEGIN
        seconds := (ord (time[ 7 ]) - nul) * 10 +
              ord (time[ 8 ]) - nul;
        IF  seconds > 59
        THEN
            b_err := e_invalid_time
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03daynames_init (
            VAR buf   : tsp00_MoveObj;
            i         : integer;
            VAR is_ok : boolean);
 
VAR
      j        : integer;
      l        : integer;
 
BEGIN
&ifndef AUDIT
IF  i <= cgg04_languages
THEN
    WITH g03short_daynames[ i ] DO
        BEGIN
        language := 'ENG';
        FOR l := cgg04_monday TO cgg04_sunday DO
            WITH days[ l ] DO
                BEGIN
                daynumber := ord(buf[ (4*l - 3) ]) - ord ('0');
                FOR j := 1 TO 3 DO
                    dayname[ j ] := buf[ (4*l - 3 + j) ];
                (*ENDFOR*) 
                END;
            (*ENDWITH*) 
        (*ENDFOR*) 
        END
    (*ENDWITH*) 
ELSE
    is_ok := false;
(*ENDIF*) 
&endif
END;
 
(* PTS 1000018 Start*)
(*------------------------------*) 
 
PROCEDURE
      g03dchange_format_date (
            VAR sbuf : tsp00_MoveObj;
            VAR dbuf  : tsp00_MoveObj;
            spos      : tsp00_Int4;
            dpos      : tsp00_Int4;
            format    : tgg00_DateTimeFormat;
            VAR b_err : tgg00_BasisError);
 
VAR
      source_pos : integer;
      dest_pos   : integer;
 
BEGIN
WITH g03global DO
    IF  sbuf[ spos ] <> csp_undef_byte
    THEN
        BEGIN
        IF  sbuf[ spos ] = csp_ascii_blank
        THEN
            BEGIN
            dbuf[ dpos ] := csp_ascii_blank;
            source_pos := succ (spos);
            dest_pos   := succ (dpos)
            END
        ELSE
            BEGIN
            source_pos := spos;
            dest_pos   := dpos
            END;
        (*ENDIF*) 
        g03dfchange_format_date (sbuf, dbuf,
              source_pos, dest_pos, format, b_err)
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03dfchange_format_date (
            VAR sbuf : tsp00_MoveObj;
            VAR dbuf  : tsp00_MoveObj;
            spos      : tsp00_Int4;
            dpos      : tsp00_Int4;
            format    : tgg00_DateTimeFormat;
            VAR b_err : tgg00_BasisError);
 
VAR
      yearpos    : integer;
      monthpos   : integer;
      daypos     : integer;
      first_pos  : integer;
      second_pos : integer;
      fill_char  : char;
      date       : tsp00_C8;
 
BEGIN
WITH g03global DO
    BEGIN
    (* PTS 1000018 Ende*)
    SAPDB_PascalMove ('VGG03 ',  13,    
          sizeof (sbuf), sizeof (date), @sbuf, spos,
          @date, 1, sizeof (date), b_err);
    CASE format OF
        (* PTS 1112742 E.Z. *)
        dtf_iso, dtf_jis :
            BEGIN
            yearpos    := dpos;
            first_pos  := yearpos + 4;
            monthpos   := first_pos + 1;
            second_pos := monthpos + 2;
            daypos     := second_pos + 1;
            fill_char  := iso_date_limit
            END;
        dtf_usa :
            BEGIN
            monthpos   := dpos;
            first_pos  := monthpos + 2;
            daypos     := first_pos + 1;
            second_pos := daypos + 2;
            yearpos    := second_pos + 1;
            fill_char  := usa_date_limit
            END;
        dtf_eur, dtf_ts_eur :
            BEGIN
            daypos     := dpos;
            first_pos  := daypos + 2;
            monthpos   := first_pos + 1;
            second_pos := monthpos + 2;
            yearpos    := second_pos + 1;
            fill_char  := eur_date_limit
            END;
        dtf_normal :
            SAPDB_PascalMove ('VGG03 ',  14,    
                  sizeof (date), sizeof (dbuf), @date, 1,
                  @dbuf, dpos, sizeof (date), b_err);
        dtf_oracle_date :
            BEGIN
            SAPDB_PascalMove ('VGG03 ',  15,    
                  sizeof (date), sizeof (dbuf), @date, 1,
                  @dbuf, dpos, sizeof (date), b_err);
            SAPDB_PascalFill ('VGG03 ',  16,    
                  sizeof (dbuf), @dbuf, dpos + mxsp_date,
                  (* PTS 1124467 E.Z. *)
                  mxsp_extdate - mxsp_date, dt_blank, b_err);
            END;
        OTHERWISE
            b_err := e_invalid_date;
        END;
    (*ENDCASE*) 
    IF  (b_err = e_ok) AND
        (format <> dtf_normal) AND (format <> dtf_oracle_date)
    THEN
        BEGIN
        SAPDB_PascalMove ('VGG03 ',  17,    
              sizeof (date), sizeof (dbuf), @date, 1,
              @dbuf, yearpos, 4, b_err);
        SAPDB_PascalMove ('VGG03 ',  18,    
              sizeof (date), sizeof (dbuf), @date, 5,
              @dbuf, monthpos, 2, b_err);
        SAPDB_PascalMove ('VGG03 ',  19,    
              sizeof (date), sizeof (dbuf), @date, 7,
              @dbuf, daypos, 2, b_err);
        dbuf[ first_pos ]  := fill_char;
        dbuf[ second_pos ] := fill_char;
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03fdc_date (
            sptr       : tsp00_MoveObjPtr;
            dptr       : tsp00_MoveObjPtr;
            spos       : tsp00_Int4;
            dpos       : tsp00_Int4;
            actlen     : integer;
            format     : tgg00_DateTimeFormat;
            VAR b_err  : tgg00_BasisError);
 
BEGIN
(* h.b. this is only a dummy procedure to deal with TYPECHECK *)
g03fdcheck_date (sptr^, dptr^, spos, dpos,
      actlen, format, b_err);
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03fdcheck_date (
            VAR sbuf   : tsp00_MoveObj;
            VAR dbuf   : tsp00_MoveObj;
            spos       : tsp00_Int4;
            dpos       : tsp00_Int4;
            actlen     : integer;
            format     : tgg00_DateTimeFormat;
            VAR b_err  : tgg00_BasisError);
 
VAR
      yearpos      : integer;
      yearlen      : integer;
      monthpos     : integer;
      monthlen     : integer;
      daypos       : integer;
      daylen       : integer;
      i            : integer;
      date         : tsp00_C8;
 
BEGIN
WITH g03global DO
    BEGIN
    b_err := e_ok;
    FOR i := 1 TO mxsp_date DO
        date[ i ] := chr (zero);
    (*ENDFOR*) 
    CASE format OF
        (* PTS 1112742 E.Z. *)
        dtf_iso, dtf_jis :
            BEGIN
            yearpos  := gg03chrpos (sbuf, spos, spos + actlen,
                  iso_date_limit);
            yearlen  := yearpos - spos;
            monthpos := gg03chrpos (sbuf, yearpos + 1, spos + actlen,
                  iso_date_limit);
            monthlen := monthpos - yearpos - 1;
            daypos   := gg03chrpos (sbuf, monthpos + 1, spos + actlen,
                  iso_date_limit);
            daylen   := daypos - monthpos - 1
            END;
        dtf_usa :
            BEGIN
            monthpos := gg03chrpos (sbuf, spos, spos + actlen,
                  usa_date_limit);
            monthlen := monthpos - spos;
            daypos   := gg03chrpos (sbuf, monthpos + 1, spos + actlen,
                  usa_date_limit);
            daylen   := daypos - monthpos - 1;
            yearpos  := gg03chrpos (sbuf, daypos + 1, spos + actlen,
                  usa_date_limit);
            yearlen  := yearpos - daypos - 1
            END;
        dtf_eur, dtf_ts_eur :
            BEGIN
            daypos   := gg03chrpos (sbuf, spos, spos + actlen,
                  eur_date_limit);
            daylen   := daypos - spos;
            monthpos := gg03chrpos (sbuf, daypos + 1, spos + actlen,
                  eur_date_limit);
            monthlen := monthpos - daypos - 1;
            yearpos  := gg03chrpos (sbuf, monthpos + 1, spos + actlen,
                  iso_date_limit);
            yearlen  := yearpos - monthpos - 1
            END;
        dtf_normal, dtf_oracle_date :
            BEGIN
            yearpos  := spos + 4 - ( mxsp_date - actlen );
            yearlen  := 4 - ( mxsp_date - actlen );
            monthpos := yearpos + 2;
            monthlen := 2;
            daypos   := monthpos + 2;
            daylen   := 2;
            END;
        OTHERWISE
            BEGIN
            (* needed for b37table_modify and loop (dt_format := succ (dt_format)) *)
            b_err := e_invalid_date;
            yearpos  := 1;
            yearlen  := 0;
            monthpos := 1;
            monthlen := 0;
            daypos   := 1;
            daylen   := 0;
            END;
        END;
    (*ENDCASE*) 
    IF  yearlen <> 4
    THEN
        b_err := e_invalid_date;
    (*ENDIF*) 
    IF  (monthlen < 1) OR (monthlen > 2)
    THEN
        b_err := e_invalid_date;
    (*ENDIF*) 
    IF  (daylen < 1) OR (daylen > 2)
    THEN
        b_err := e_invalid_date;
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        BEGIN
        SAPDB_PascalMove ('VGG03 ',  20,    
              sizeof (sbuf), sizeof (date), @sbuf, yearpos - yearlen,
              @date, 1, yearlen, b_err);
        SAPDB_PascalMove ('VGG03 ',  21,    
              sizeof (sbuf), sizeof (date), @sbuf, monthpos - monthlen,
              @date, 7-monthlen, monthlen, b_err);
        SAPDB_PascalMove ('VGG03 ',  22,    
              sizeof (sbuf), sizeof (date), @sbuf, daypos - daylen,
              @date, 9-daylen, daylen, b_err)
        END;
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        BEGIN
        gg03dcheck_date (date, mxsp_date, b_err);
        IF  b_err = e_ok
        THEN
            SAPDB_PascalMove ('VGG03 ',  23,    
                  sizeof (date), sizeof (dbuf), @date, 1,
                  @dbuf, dpos, sizeof (date), b_err);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03ftc_time (
            sptr       : tsp00_MoveObjPtr;
            dptr       : tsp00_MoveObjPtr;
            spos       : tsp00_Int4;
            dpos       : tsp00_Int4;
            actlen     : integer;
            format     : tgg00_DateTimeFormat;
            VAR b_err  : tgg00_BasisError);
 
BEGIN
(* h.b. this is only a dummy procedure to deal with TYPECHECK *)
g03ftcheck_time (sptr^, dptr^, spos, dpos,
      actlen, format, b_err);
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03ftcheck_time (
            VAR sbuf   : tsp00_MoveObj;
            VAR dbuf   : tsp00_MoveObj;
            spos       : tsp00_Int4;
            dpos       : tsp00_Int4;
            actlen     : integer;
            format     : tgg00_DateTimeFormat;
            VAR b_err  : tgg00_BasisError);
 
VAR
      hourpos      : integer;
      hourlen      : integer;
      minutepos    : integer;
      minutelen    : integer;
      secondpos    : integer;
      secondlen    : integer;
      i            : integer;
      time         : tsp00_C8;
 
BEGIN
WITH g03global DO
    BEGIN
    b_err := e_ok;
    FOR i := 1 TO mxsp_time DO
        time[ i ] := chr (zero);
    (*ENDFOR*) 
    CASE format OF
        (* PTS 1112472 E.Z. *)
        dtf_eur, dtf_ts_eur :
            BEGIN
            hourpos   := gg03chrpos (sbuf, spos, spos + actlen,
                  eur_time_limit);
            hourlen   := hourpos - spos;
            minutepos := gg03chrpos (sbuf, hourpos + 1, spos + actlen,
                  eur_time_limit);
            minutelen := minutepos - hourpos - 1;
            secondpos := gg03chrpos (sbuf, minutepos + 1, spos + actlen,
                  eur_time_limit);
            IF  secondpos > minutepos
            THEN
                secondlen := secondpos - minutepos - 1
            ELSE
                secondlen := 0
            (*ENDIF*) 
            END;
        (* PTS 1112472 E.Z. *)
        dtf_iso, dtf_jis :
            BEGIN
            hourpos   := gg03chrpos (sbuf, spos, spos + actlen,
                  iso_time_limit);
            hourlen   := hourpos - spos;
            minutepos := gg03chrpos (sbuf, hourpos + 1, spos + actlen,
                  iso_time_limit);
            minutelen := minutepos - hourpos - 1;
            secondpos := gg03chrpos (sbuf, minutepos + 1, spos + actlen,
                  eur_time_limit);
            IF  secondpos > minutepos
            THEN
                secondlen := secondpos - minutepos - 1
            ELSE
                secondlen := 0
            (*ENDIF*) 
            END;
        dtf_usa :
            BEGIN
            gg03check_usa_time (sbuf, time, spos, 1, actlen, b_err);
            END;
        dtf_normal, dtf_oracle_date :
            BEGIN
            hourpos   := spos + 4 - ( mxsp_time - actlen );
            hourlen   := 4 - ( mxsp_time - actlen );
            minutepos := hourpos + 2;
            minutelen := 2;
            secondpos := minutepos + 2;
            secondlen := 2;
            END;
        OTHERWISE
            BEGIN
            (* needed for b37table_modify and loop (dt_format := succ (dt_format)) *)
            b_err := e_invalid_time;
            hourpos   := 1;
            hourlen   := 0;
            minutepos := 1;
            minutelen := 0;
            secondpos := 1;
            secondlen := 0;
            END;
        END;
    (*ENDCASE*) 
    IF  format <> dtf_usa
    THEN
        BEGIN
        IF  (hourlen < 1) OR (hourlen > 4)
        THEN
            b_err := e_invalid_time;
        (*ENDIF*) 
        IF  (minutelen < 1) OR (minutelen > 2)
        THEN
            b_err := e_invalid_time;
        (*ENDIF*) 
        IF  (secondlen < 0) OR (secondlen > 2)
        THEN
            b_err := e_invalid_time;
        (*ENDIF*) 
        IF  b_err = e_ok
        THEN
            BEGIN
            SAPDB_PascalMove ('VGG03 ',  24,    
                  sizeof (sbuf), sizeof (time), @sbuf, hourpos - hourlen,
                  @time, 5-hourlen, hourlen, b_err);
            SAPDB_PascalMove ('VGG03 ',  25,    
                  sizeof (sbuf), sizeof (time), @sbuf, minutepos - minutelen,
                  @time, 7-minutelen, minutelen, b_err);
            SAPDB_PascalMove ('VGG03 ',  26,    
                  sizeof (sbuf), sizeof (time), @sbuf, secondpos - secondlen,
                  @time, 9-secondlen, secondlen, b_err)
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  b_err = e_ok
    THEN
        BEGIN
        gg03tcheck_time (time, mxsp_time, format, b_err);
        IF  b_err = e_ok
        THEN
            SAPDB_PascalMove ('VGG03 ',  27,    
                  sizeof (time), sizeof (dbuf), @time, 1,
                  @dbuf, dpos, sizeof (time), b_err);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03ftsc_timestamp (
            sptr       : tsp00_MoveObjPtr;
            dptr       : tsp00_MoveObjPtr;
            spos       : tsp00_Int4;
            dpos       : tsp00_Int4;
            actlen     : integer;
            format     : tgg00_DateTimeFormat;
            language   : tsp00_C3;
            VAR b_err  : tgg00_BasisError);
 
BEGIN
(* h.b. this is only a dummy procedure to deal with TYPECHECK *)
g03ftscheck_timestamp (sptr^, dptr^, spos, dpos,
      actlen, format, language, b_err);
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03ftscheck_timestamp (
            VAR sbuf   : tsp00_MoveObj;
            VAR dbuf   : tsp00_MoveObj;
            spos       : tsp00_Int4;
            dpos       : tsp00_Int4;
            actlen     : integer;
            format     : tgg00_DateTimeFormat;
            language   : tsp00_C3;
            VAR b_err  : tgg00_BasisError);
 
CONST
      min_ora_datelen = 5;
      monthnamelen    = 3;
 
VAR
      found        : boolean;
      datepos      : integer;
      datelen      : integer;
      timepos      : integer;
      timelen      : integer;
      time_sep     : char;
      micropos     : integer;
      microlen     : integer;
      i            : integer;
      l            : integer;
      micro        : tsp00_C8;
      date         : tsp00_C8;
      c3           : tsp00_C3;
      ts           : tsp00_C28;
      charset      : SET OF char;
      digits       : SET OF char;
      yearpos      : integer;
      yearlen      : integer;
      monthpos     : integer;
      monthlen     : integer;
      daypos       : integer;
      daylen       : integer;
 
BEGIN
WITH g03global DO
    BEGIN
    b_err := e_ok;
    CASE format OF
        (* PTS 1112472 E.Z. *)
        dtf_iso, dtf_eur, dtf_jis, dtf_usa :
            BEGIN
            datepos := gg03chrpos ( sbuf, spos, spos + mxsp_extdate,
                  iso_date_limit);
            datepos := gg03chrpos ( sbuf, datepos + 1, spos + mxsp_extdate,
                  iso_date_limit);
            IF  format = dtf_iso
            THEN
                datepos := gg03chrpos ( sbuf, datepos + 1, spos + actlen,
                      dt_blank)
            ELSE
                datepos := gg03chrpos ( sbuf, datepos + 1, spos + actlen,
                      iso_date_limit);
            (*ENDIF*) 
            datelen := datepos - spos;
            (* PTS 1112472 E.Z. *)
            IF  format = dtf_iso
            THEN
                time_sep := iso_time_limit
            ELSE
                time_sep := eur_time_limit;
            (*ENDIF*) 
            timepos := gg03chrpos ( sbuf, datepos + 1,
                  spos + actlen, time_sep);
            i       := timepos;
            timepos := gg03chrpos ( sbuf, timepos + 1,
                  spos + actlen, time_sep);
            IF  i+3 <> timepos
            THEN (* DB2 : minutes with 2 digits *)
                (* something to get an error *)
                timelen := 0
            ELSE
                BEGIN
                i       := timepos;
                (* PTS 1112472 E.Z. *)
                timepos := gg03chrpos ( sbuf, timepos + 1,
                      spos + actlen, eur_time_limit);
                IF  i + 3 <> timepos
                THEN (* DB2 : seconds with 2 digits *)
                    (* something to get an error *)
                    timelen := 0
                ELSE
                    IF  timepos <= spos + actlen
                    THEN
                        timelen := timepos - datepos - 1
                    ELSE
                        timelen := actlen - datelen - 1;
                    (*ENDIF*) 
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            g03fdcheck_date (sbuf, dbuf, spos, dpos, datelen, dtf_iso, b_err);
            IF  b_err = e_ok
            THEN
                IF  format = dtf_iso
                THEN
                    g03ftcheck_time (sbuf, dbuf, datepos + 1,
                          dpos+mxsp_date, timelen, dtf_iso, b_err)
                ELSE
                    g03ftcheck_time (sbuf, dbuf, datepos + 1,
                          dpos+mxsp_date, timelen, dtf_eur, b_err);
                (*ENDIF*) 
            (*ENDIF*) 
            IF  b_err = e_ok
            THEN
                BEGIN
                (* PTS 1127104 E.Z. *)
                IF  (ord(dbuf[dpos+mxsp_date+2]) - ord('0')) * 10 +
                    (ord(dbuf[dpos+mxsp_date+3]) - ord('0')) > 23
                THEN
                    b_err := e_invalid_timestamp
                ELSE
                    SAPDB_PascalOverlappingMove ('VGG03 ',  28,    
                          sizeof (dbuf), sizeof (dbuf),
                          @dbuf, dpos+mxsp_date+2,
                          @dbuf, dpos+mxsp_date, mintimelength, b_err);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  b_err = e_ok
            THEN
                BEGIN
                IF  timelen + datelen + 1 = actlen
                THEN (* no microseconds found *)
                    FOR i := 0 TO MICROSEC_MXSP00-1 DO
                        dbuf[ dpos+mxsp_date+mintimelength+i ]
                              := chr (zero)
                    (*ENDFOR*) 
                ELSE (* microseconds found *)
                    BEGIN
                    micropos := timepos + 1;
                    WHILE ( micropos < spos + actlen ) AND
                          ( b_err = e_ok ) DO
                        IF  (ord (sbuf[ micropos ]) < zero) OR
                            (ord (sbuf[ micropos ]) > nine)
                        THEN
                            b_err := e_invalid_time
                        ELSE
                            micropos := succ (micropos);
                        (*ENDIF*) 
                    (*ENDWHILE*) 
                    IF  b_err = e_ok
                    THEN
                        BEGIN
                        microlen := micropos - timepos - 1;
                        IF  microlen > MICROSEC_MXSP00
                        THEN
                            b_err := e_invalid_time
                        ELSE
                            BEGIN
                            (* PTS 1109156 E.Z. *)
                            SAPDB_PascalMove ('VGG03 ',  29,    
                                  sizeof (sbuf), sizeof (dbuf),
                                  @sbuf, timepos + 1,
                                  @dbuf, dpos+mxsp_date+mintimelength,
                                  microlen, b_err);
                            FOR i := microlen TO MICROSEC_MXSP00-1 DO
                                dbuf[ dpos+mxsp_date+mintimelength+i ]:= chr (zero)
                            (*ENDFOR*) 
                            END
                        (*ENDIF*) 
                        END
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        dtf_ts_eur :
            BEGIN
            daypos   := gg03chrpos (sbuf, spos, spos + actlen,
                  eur_date_limit);
            daylen   := daypos - spos;
            monthpos := gg03chrpos (sbuf, daypos + 1, spos + actlen,
                  eur_date_limit);
            monthlen := monthpos - daypos - 1;
            yearpos  := gg03chrpos (sbuf, monthpos + 1, spos + actlen,
                  dt_blank);
            yearlen  := yearpos - monthpos - 1;
            datepos := spos + actlen - 1;
            WHILE ((sbuf[ datepos ] = dt_blank) AND
                  (datepos >= yearpos)) DO
                datepos := pred (datepos);
            (*ENDWHILE*) 
            IF  ((datepos <> yearpos-1) OR
                (daylen   <> 2) OR
                (monthlen <> 2) OR
                (yearlen  <> 4))
            THEN
                b_err := e_invalid_date
            ELSE
                BEGIN
                SAPDB_PascalMove ('VGG03 ',  30,    
                      sizeof (sbuf), sizeof (date), @sbuf, yearpos - yearlen,
                      @date, 1, yearlen, b_err);
                SAPDB_PascalMove ('VGG03 ',  31,    
                      sizeof (sbuf), sizeof (date), @sbuf, monthpos - monthlen,
                      @date, 7-monthlen, monthlen, b_err);
                SAPDB_PascalMove ('VGG03 ',  32,    
                      sizeof (sbuf), sizeof (date), @sbuf, daypos - daylen,
                      @date, 9-daylen, daylen, b_err)
                END;
            (*ENDIF*) 
            IF  b_err = e_ok
            THEN
                BEGIN
                gg03dcheck_date (date, mxsp_date, b_err);
                IF  b_err = e_ok
                THEN
                    BEGIN
                    SAPDB_PascalMove ('VGG03 ',  33,    
                          sizeof (date), sizeof (dbuf), @date, 1,
                          @dbuf, dpos, sizeof (date), b_err);
                    FOR timepos := sizeof(date)+1 TO mxsp_timestamp DO
                        dbuf[ dpos-1+timepos ] := '0'
                    (*ENDFOR*) 
                    END;
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        dtf_oracle_date :
            BEGIN
            IF  ((actlen < min_ora_datelen) OR
                (actlen > mxsp_exttimestamp))
            THEN
                b_err := e_invalid_date
            ELSE
                BEGIN
                SAPDB_PascalMove ('VGG03 ',  34,    
                      sizeof (sbuf), sizeof (ts),
                      @sbuf, spos, @ts, 1, actlen, b_err);
                g02upstring (ts, 1, ts, 1, actlen, g01code.ctype);
                datepos := 1;
                WHILE ((ts[ datepos ] = bsp_c1) AND
                      (datepos < actlen - min_ora_datelen)) DO
                    datepos := succ (datepos);
                (*ENDWHILE*) 
                digits := [ '0'..'9' ];
                IF  NOT (ts[ datepos ] in digits)
                THEN
                    b_err := e_invalid_date;
                (*ENDIF*) 
                IF  b_err = e_ok
                THEN
                    BEGIN
                    datelen := 1;
                    IF  ts[ datepos+1 ] in digits
                    THEN
                        datelen := succ (datelen);
                    (*ENDIF*) 
                    FOR i := 1 TO mxsp_date DO
                        date[ i ] := chr (zero);
                    (*ENDFOR*) 
                    (* PTS 1105409 E.Z. *)
                    date[ 1 ] := chr (zero+2);
                    date[ 2 ] := chr (zero+0);
                    SAPDB_PascalMove ('VGG03 ',  35,    
                          sizeof (sbuf), sizeof (date), @sbuf, spos+datepos-1,
                          @date, 9-datelen, datelen, b_err);
                    datepos := datepos + datelen + 1;
                    charset := [ 'A'..'I', 'J'..'R', 'S'..'Z' ];
                    IF  datepos > actlen + 1 - monthnamelen
                    THEN
                        b_err := e_invalid_date
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                IF  b_err = e_ok
                THEN
                    BEGIN
                    FOR i:= 1 TO 3 DO
                        c3[ i ] := ts[ datepos+i-1 ];
                    (*ENDFOR*) 
&                   ifdef TRACE
                    t01buf (gg, language, 1, 3);
&                   endif
                    found := false;
                    l := 1;
                    WHILE ((l <= cgg04_languages) AND NOT found) DO
                        BEGIN
&                       ifdef TRACE
                        t01buf (gg, g03short_monthnames[ l ].language, 1, 3);
&                       endif
                        IF  g03short_monthnames[ l ].language = language
                        THEN
                            found := true
                        ELSE
                            l := succ (l);
                        (*ENDIF*) 
                        END;
                    (*ENDWHILE*) 
                    IF  found
                    THEN
                        BEGIN
                        found := false;
                        i := 1;
                        WHILE (i <= 12) AND NOT found DO
                            BEGIN
&                           ifdef TRACE
                            t01buf (gg, g03short_monthnames[ l ].monthnames[ i ], 1, 3);
&                           endif
                            IF  c3 = g03short_monthnames[ l ].monthnames[ i ]
                            THEN
                                BEGIN
                                found := true;
                                IF  i <= 9
                                THEN
                                    date[ 6 ] := chr (zero+i)
                                ELSE
                                    BEGIN
                                    date[ 5 ] := chr (zero+1);
                                    date[ 6 ] := chr (zero+i-10)
                                    END
                                (*ENDIF*) 
                                END
                            ELSE
                                i := succ (i);
                            (*ENDIF*) 
                            END
                        (*ENDWHILE*) 
                        END;
                    (*ENDIF*) 
                    IF  NOT found
                    THEN
                        b_err := e_invalid_date;
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  b_err = e_ok
            THEN
                BEGIN
                datepos := datepos + monthnamelen;
                WHILE ((datepos < actlen) AND
                      (NOT (ts[ datepos ] in digits + charset))) DO
                    datepos := succ (datepos);
                (*ENDWHILE*) 
                datelen := 1;
                IF  datepos < actlen
                THEN
                    IF  ts[ datepos+1 ] in digits
                    THEN
                        datelen := succ (datelen);
                    (*ENDIF*) 
                (*ENDIF*) 
                SAPDB_PascalMove ('VGG03 ',  36,    
                      sizeof (sbuf), sizeof (date), @sbuf, spos+datepos-1,
                      @date, 5-datelen, datelen, b_err);
                datepos := datepos + datelen;
                WHILE datepos <= actlen DO
                    BEGIN
                    IF  ts[ datepos ] <> bsp_c1
                    THEN
                        b_err := e_invalid_date;
                    (*ENDIF*) 
                    datepos := succ (datepos)
                    END;
                (*ENDWHILE*) 
                IF  b_err = e_ok
                THEN
                    gg03dcheck_date (date, mxsp_date, b_err);
                (*ENDIF*) 
                IF  b_err = e_ok
                THEN
                    BEGIN
                    SAPDB_PascalMove ('VGG03 ',  37,    
                          sizeof (date), sizeof (dbuf), @date, 1,
                          @dbuf, dpos, sizeof (date), b_err);
                    SAPDB_PascalFill ('VGG03 ',  38,    
                          sizeof (dbuf), @dbuf, dpos+mxsp_date,
                          mintimelength+MICROSEC_MXSP00, csp_ascii_zero,
                          b_err)
                    END
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        dtf_normal :
            IF  ((actlen >= mintimestamplength) AND
                (actlen <= mxsp_timestamp))
            THEN
                BEGIN
                microlen := actlen - mxsp_date - mintimelength;
                SAPDB_PascalMove ('VGG03 ',  39,    
                      sizeof (sbuf), sizeof (micro),
                      @sbuf, spos+mxsp_date+mintimelength,
                      @micro, 1, microlen, b_err);
                FOR i := microlen+1 TO MICROSEC_MXSP00 DO
                    micro[ i ]:= chr (zero);
                (*ENDFOR*) 
                g03fdcheck_date (sbuf, dbuf, spos, dpos,
                      mxsp_date, dtf_normal, b_err);
                IF  b_err = e_ok
                THEN
                    g03ftcheck_time (sbuf, dbuf, spos+mxsp_date,
                          dpos+mxsp_date, mintimelength, dtf_normal,
                          b_err);
                (*ENDIF*) 
                IF  b_err = e_ok
                THEN
                    BEGIN
                    (* PTS 1127104 E.Z. *)
                    IF  (ord(dbuf[dpos+mxsp_date+2]) - ord('0')) * 10 +
                        (ord(dbuf[dpos+mxsp_date+3]) - ord('0')) > 23
                    THEN
                        b_err := e_invalid_timestamp
                    ELSE
                        SAPDB_PascalOverlappingMove ('VGG03 ',  40,    
                              sizeof (dbuf), sizeof (dbuf),
                              @dbuf, dpos+mxsp_date+2,
                              @dbuf, dpos+mxsp_date, mintimelength, b_err);
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                IF  b_err = e_ok
                THEN
                    BEGIN
                    micropos := dpos + mxsp_date + mintimelength;
                    FOR i := 1 TO MICROSEC_MXSP00 DO
                        IF  (ord (micro[ i ]) > nine ) OR
                            (ord (micro[ i ]) < zero )
                        THEN
                            b_err := e_invalid_time
                        ELSE
                            dbuf[ micropos+i-1 ] :=
                                  micro[ i ];
                        (*ENDIF*) 
                    (*ENDFOR*) 
                    END
                (*ENDIF*) 
                END
            ELSE
                b_err := e_invalid_timestamp
            (*ENDIF*) 
        OTHERWISE
            b_err := e_invalid_timestamp
        END;
    (*ENDCASE*) 
    IF  ((b_err = e_invalid_time) OR (b_err = e_invalid_date))
        AND (format <> dtf_oracle_date)
        AND (format <> dtf_ts_eur)
    THEN
        b_err := e_invalid_timestamp;
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03init;
 
VAR
      i : integer;
      language_no : tsp6_language;
 
BEGIN
&ifdef TRACE
(* just to make usecheck happy *)
g03short_monthnames[ 1 ].fill := ' ';
&endif
WITH g03global DO
    BEGIN
    zero           := ord ('0');
    nine           := ord ('9');
    dt_blank       := bsp_c1;
    iso_date_limit := '-';
    usa_date_limit := '/';
    eur_date_limit := '.';
    (* PTS 1112472 E.Z. *)
    eur_time_limit := '.';
    iso_time_limit := ':';
    usa_time_limit := ':';
    usa_t_am_upper_key := 'AM';
    usa_t_am_lower_key := 'am';
    usa_t_pm_upper_key := 'PM';
    usa_t_pm_lower_key := 'pm'
    END;
(*ENDWITH*) 
FOR i := 1 TO cgg04_languages DO
    g03short_daynames[ i ].language := '   ';
(*ENDFOR*) 
FOR i := 1 TO cgg04_languages DO
    g03short_monthnames[ i ].language := '   ';
(*ENDFOR*) 
g03dictionary.count := 0;
FOR language_no := 1 TO csp6_languages DO
    WITH g03dictionary.dict[ language_no ] DO
        BEGIN
        dict_upp_table       := NIL;
        dict_low_table       := NIL;
        dict_mon[ 1 ].length := 0
        END
    (*ENDWITH*) 
(*ENDFOR*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03monthnames_init (
            VAR buf   : tsp00_MoveObj;
            i         : integer;
            VAR is_ok : boolean);
 
VAR
      j        : integer;
      l        : integer;
      language : tsp00_C3;
 
BEGIN
&ifndef AUDIT
IF  i <= cgg04_languages
THEN
    BEGIN
    g03short_monthnames[i].language := 'ENG';
    FOR l := 1 TO 12 DO
        FOR j := 1 TO 3 DO
            g03short_monthnames[ i ].monthnames[ l, j ] :=
                  buf[ (l-1)*3+j ];
        (*ENDFOR*) 
    (*ENDFOR*) 
    END
ELSE
    is_ok := false
&         endif
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03part2_decrypt (
            VAR part_buf  : tsp00_MoveObj;
            mess_code     : tsp00_CodeType;
            pos           : tsp00_Int4;
            sourceswap    : tsp00_SwapKind;
            destswap      : tsp00_SwapKind;
            VAR clearname : tsp00_Name);
 
CONST
      p1 = 2;
      p2 = 521;
      p3 = 133379;
 
VAR
      i        : integer;
      vp1, vp2, vp3, left, right, exp1, exp2, exp3 : tsp00_Int4;
      help     : tsp00_CryptName;
      part_pos : tsp00_Int4;
 
BEGIN
vp1 := p1;
vp2 := p2;
vp3 := p3;
part_pos := pos;
FOR i := 1 TO 6 DO
    BEGIN
    help[ i ] := s20buf_to_int4_swap (part_buf,
          part_pos, sourceswap, destswap);
    part_pos := part_pos + 4;
    END;
(*ENDFOR*) 
FOR i := 1 TO 6 DO
    IF  odd (help[ i ])
    THEN
        help[ i ] := - help[ i ];
    (*ENDIF*) 
(*ENDFOR*) 
FOR i := 1 TO 6 DO
    BEGIN
    IF  i < 5
    THEN
        right := help[ i + 1 ]
    ELSE
        right := vp2;
    (*ENDIF*) 
    help[ i ] := help[ i ] - ((right MOD 61) * (vp3 * 128 - 1));
    END;
(*ENDFOR*) 
FOR i := 6 DOWNTO 1 DO
    BEGIN
    IF  i > 1
    THEN
        left := help[ i - 1 ]
    ELSE
        left := vp3;
    (*ENDIF*) 
    help[ i ] := help[ i ] - ((left MOD 61) * (vp3 * 126 - 1));
    END;
(*ENDFOR*) 
FOR i := 1 TO 6 DO
    BEGIN
    exp3 := help[ i ];
    exp1 := exp3 DIV vp3;
    exp2 := exp3 MOD vp3;
    IF  ((exp1 < 0) OR (exp1 > 255))
    THEN
        clearname[ 3*i - 2 ] := chr (0)
    ELSE
        clearname[ 3*i - 2 ] := chr (exp1);
    (*ENDIF*) 
    exp3 := exp2;
    exp1 := exp3 DIV vp2;
    exp2 := exp3 MOD vp2;
    IF  ((exp1 < 0) OR (exp1 > 255))
    THEN
        clearname[ 3*i - 2 ] := chr (0)
    ELSE
        clearname[ 3*i - 1 ] := chr (exp1);
    (*ENDIF*) 
    exp3 := exp2;
    exp1 := exp3 DIV vp1;
    exp2 := exp3 MOD vp1;
    IF  ((exp1 < 0) OR (exp1 > 255))
    THEN
        clearname[ 3*i - 2 ] := chr (0)
    ELSE
        clearname[ 3*i ] := chr (exp1);
    (*ENDIF*) 
    END;
(*ENDFOR*) 
END;
 
(* PTS 1000018 Start *)
(*------------------------------*) 
 
PROCEDURE
      g03tchange_format_time (
            VAR sbuf : tsp00_MoveObj;
            VAR dbuf  : tsp00_MoveObj;
            spos      : tsp00_Int4;
            dpos      : tsp00_Int4;
            format    : tgg00_DateTimeFormat;
            VAR b_err : tgg00_BasisError);
 
VAR
      source_pos : integer;
      dest_pos   : integer;
 
BEGIN
WITH g03global DO
    IF  sbuf[ spos ] <> csp_undef_byte
    THEN
        BEGIN
        IF  sbuf[ spos ] = csp_ascii_blank
        THEN
            BEGIN
            dbuf[ dpos ] := csp_ascii_blank;
            source_pos := succ (spos);
            dest_pos   := succ (dpos)
            END
        ELSE
            BEGIN
            source_pos := spos;
            dest_pos   := dpos
            END;
        (*ENDIF*) 
        g03tfchange_format_time (sbuf, dbuf,
              source_pos, dest_pos, format, b_err)
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03tfchange_format_time (
            VAR sbuf : tsp00_MoveObj;
            VAR dbuf  : tsp00_MoveObj;
            spos      : tsp00_Int4;
            dpos      : tsp00_Int4;
            format    : tgg00_DateTimeFormat;
            VAR b_err : tgg00_BasisError);
 
VAR
      hourpos    : integer;
      minutepos  : integer;
      secondpos  : integer;
      first_pos  : integer;
      second_pos : integer;
      hour       : integer;
      fill_char  : char;
      time       : tsp00_C8;
 
BEGIN
WITH g03global DO
    IF  sbuf[ spos ] <> csp_undef_byte
    THEN
        BEGIN
        (* PTS 1000018 Ende*)
&       ifdef TRACE
        t01int4 (ak_sem, 'spos        ', spos);
        FOR hour := 1 TO mxsp_time DO
            t01int4 (ak_sem, 'sbuf[ i ]   ', ord (sbuf[ spos+hour-1 ]));
        (*ENDFOR*) 
&       endif
        SAPDB_PascalMove ('VGG03 ',  41,    
              sizeof (sbuf), sizeof (time), @sbuf, spos,
              @time, 1, sizeof (time), b_err);
        hour := (ord (time[ 1 ]) - zero) * 1000 +
              (ord (time[ 2 ]) - zero) * 100 +
              (ord (time[ 3 ]) - zero) * 10 +
              (ord (time[ 4 ]) - zero);
        CASE format OF
            (* PTS 1112472 E.Z. *)
            dtf_iso, dtf_eur, dtf_ts_eur, dtf_jis :
                BEGIN
                (* PTS 1113976 E.Z. *)
                IF  (format = dtf_iso) AND (hour > 23)
                THEN
                    BEGIN
                    b_err     := e_time_value_too_long;
                    hour      := hour MOD 24;
                    time[ 1 ] := chr (zero);
                    time[ 2 ] := chr (zero);
                    time[ 3 ] := chr ((hour DIV 10) + zero);
                    time[ 4 ] := chr ((hour MOD 10) + zero)
                    END
                ELSE
                    IF  hour > 99
                    THEN
                        b_err := e_time_value_too_long;
                    (*ENDIF*) 
                (*ENDIF*) 
                hourpos    := dpos;
                first_pos  := hourpos + 2;
                minutepos  := first_pos + 1;
                second_pos := minutepos + 2;
                secondpos  := second_pos + 1;
                (* PTS 1112742 E.Z. *)
                IF  format in [dtf_iso, dtf_jis]
                THEN
                    fill_char := iso_time_limit
                ELSE
                    fill_char := eur_time_limit;
                (*ENDIF*) 
                END;
            dtf_usa :
                BEGIN
                IF  hour > 24
                THEN
                    BEGIN
                    b_err     := e_time_value_too_long;
                    hour      := hour MOD 24;
                    time[ 1 ] := chr (zero);
                    time[ 2 ] := chr (zero);
                    time[ 3 ] := chr ((hour DIV 10) + zero);
                    time[ 4 ] := chr ((hour MOD 10) + zero)
                    END;
                (*ENDIF*) 
                gg03change_usa_time (time, dbuf, 1, dpos, b_err)
                END;
            dtf_normal, dtf_oracle_date :
                SAPDB_PascalMove ('VGG03 ',  42,    
                      sizeof (time), sizeof (dbuf), @time, 1,
                      @dbuf, dpos, sizeof (time), b_err);
            OTHERWISE
                b_err := e_invalid_time;
            END;
        (*ENDCASE*) 
&       ifdef trace
        t01int4 (ak_sem, 'b_err       ', b_err);
&       endif
        IF  (b_err in [ e_ok, e_time_value_too_long]) AND
            ( format <> dtf_normal ) AND
            ( format <> dtf_usa ) AND
            ( format <> dtf_oracle_date)
        THEN
            BEGIN
            SAPDB_PascalMove ('VGG03 ',  43,    
                  sizeof (time), sizeof (dbuf), @time, 3,
                  @dbuf, hourpos, 2, b_err);
            SAPDB_PascalMove ('VGG03 ',  44,    
                  sizeof (time), sizeof (dbuf), @time, 5,
                  @dbuf, minutepos, 2, b_err);
            SAPDB_PascalMove ('VGG03 ',  45,    
                  sizeof (time), sizeof (dbuf), @time, 7,
                  @dbuf, secondpos, 2, b_err);
            dbuf[ first_pos ]  := fill_char;
            dbuf[ second_pos ] := fill_char
            END
        (*ENDIF*) 
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(* PTS 1000018 Start*)
(*------------------------------*) 
 
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 b_err : tgg00_BasisError);
 
VAR
      source_pos : integer;
      dest_pos   : integer;
 
BEGIN
WITH g03global DO
    IF  sbuf[ spos ] <> csp_undef_byte
    THEN
        BEGIN
        IF  sbuf[ spos ] = csp_ascii_blank
        THEN
            BEGIN
            dbuf[ dpos ] := csp_ascii_blank;
            source_pos := succ (spos);
            dest_pos   := succ (dpos)
            END
        ELSE
            BEGIN
            source_pos := spos;
            dest_pos   := dpos
            END;
        (*ENDIF*) 
        g03tsfchange_format_timestamp (sbuf, dbuf,
              source_pos, dest_pos, format, language, b_err)
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      g03tsfchange_format_timestamp (
            VAR sbuf : tsp00_MoveObj;
            VAR dbuf  : tsp00_MoveObj;
            spos      : tsp00_Int4;
            dpos      : tsp00_Int4;
            format    : tgg00_DateTimeFormat;
            language  : tsp00_C3;
            VAR b_err : tgg00_BasisError);
 
VAR
      found     : boolean;
      i         : integer;
      j         : integer;
      l         : integer;
      micropos  : integer;
      timepos   : integer;
      timestamp : tsp00_Timestamp;
 
BEGIN
WITH g03global DO
    IF  sbuf[ spos ] <> csp_undef_byte
    THEN
        BEGIN
        (* PTS 1000018 Ende*)
        SAPDB_PascalMove ('VGG03 ',  46,    
              sizeof (sbuf), sizeof (timestamp), @sbuf, spos, @timestamp, 1,
              sizeof (timestamp), b_err);
        IF  b_err = e_ok
        THEN
            CASE format OF
                (* PTS 1112472 E.Z. *)
                dtf_eur, dtf_jis, dtf_usa :
                    BEGIN
                    timepos := mxsp_date - 1;
                    g02datechange (timestamp, dbuf, 1, dpos,
                          dtf_iso, b_err);
                    micropos := timepos + mintimelength + 2;
                    (* last two bytes of date have to be zero for *)
                    (* time check (4 bytes of hour inspected)     *)
                    (* because only two bytes are in a timestamp  *)
                    timestamp[ timepos ]      := chr (zero);
                    timestamp[ timepos+1 ]    := chr (zero);
                    dbuf[ dpos+mxsp_extdate ] := iso_date_limit;
                    (* PTS 1112472 E.Z. *)
                    g02timechange (timestamp, dbuf, timepos,
                          dpos+mxsp_extdate+1, dtf_eur, b_err);
                    (* PTS 1112472 E.Z. *)
                    dbuf[ dpos+mxsp_extdate+mxsp_exttime+1 ] := eur_time_limit;
                    SAPDB_PascalMove ('VGG03 ',  47,    
                          sizeof (timestamp), sizeof (dbuf),
                          @timestamp, micropos,
                          @dbuf, dpos+mxsp_extdate+mxsp_exttime+2,
                          MICROSEC_MXSP00, b_err);
                    END;
                dtf_ts_eur :
                    BEGIN
                    g02datechange (timestamp, dbuf, 1, dpos,
                          dtf_ts_eur, b_err);
                    FOR timepos := mxsp_extdate TO mxsp_exttimestamp-1 DO
                        dbuf[ dpos+timepos ] := dt_blank
                    (*ENDFOR*) 
                    END;
                (* PTS 1112472 E.Z. *)
                dtf_iso :
                    BEGIN
                    timepos := mxsp_date - 1;
                    g02datechange (timestamp, dbuf, 1, dpos,
                          dtf_iso, b_err);
                    micropos := timepos + mintimelength + 2;
                    (* last two bytes of date have to be zero for *)
                    (* time check (4 bytes of hour inspected)     *)
                    (* because only two bytes are in a timestamp  *)
                    timestamp[ timepos ]      := chr (zero);
                    timestamp[ timepos+1 ]    := chr (zero);
                    dbuf[ dpos+mxsp_extdate ] := dt_blank;
                    (* PTS 1112472 E.Z. *)
                    g02timechange (timestamp, dbuf, timepos,
                          dpos+mxsp_extdate+1, dtf_iso, b_err);
                    (* PTS 1112472 E.Z. *)
                    dbuf[ dpos+mxsp_extdate+mxsp_exttime+1 ] := eur_time_limit;
                    SAPDB_PascalMove ('VGG03 ',  48,    
                          sizeof (timestamp), sizeof (dbuf),
                          @timestamp, micropos,
                          @dbuf, dpos+mxsp_extdate+mxsp_exttime+2,
                          MICROSEC_MXSP00, b_err);
                    END;
                dtf_oracle_date :
                    BEGIN
                    SAPDB_PascalMove ('VGG03 ',  49,    
                          sizeof (timestamp), sizeof (dbuf), @timestamp, 7,
                          @dbuf, dpos, 2, b_err);
                    dbuf[ dpos+2 ] := iso_date_limit;
                    i := (ord (timestamp[ 5 ]) - zero) * 10 +
                          ord (timestamp[ 6 ]) - zero;
                    found := false;
                    l := 1;
                    WHILE ((l <= cgg04_languages) AND NOT found) DO
                        IF  g03short_monthnames[ l ].language = language
                        THEN
                            found := true
                        ELSE
                            l := succ (l);
                        (*ENDIF*) 
                    (*ENDWHILE*) 
                    IF  found
                    THEN
                        FOR j := 1 TO 3 DO
                            dbuf[ dpos+2+j ] :=
                                  g03short_monthnames[ l ].monthnames[ i, j ]
                        (*ENDFOR*) 
                    ELSE
                        FOR j := 1 TO 3 DO
                            dbuf[ dpos+2+j ] := iso_date_limit;
                        (*ENDFOR*) 
                    (*ENDIF*) 
                    dbuf[ dpos+6 ] := iso_date_limit;
                    SAPDB_PascalMove ('VGG03 ',  50,    
                          sizeof (timestamp), sizeof (dbuf), @timestamp, 3,
                          @dbuf, dpos+7, 2, b_err);
                    SAPDB_PascalFill ('VGG03 ',  51,    
                          sizeof (dbuf), @dbuf, dpos+9,
                          mxsp_exttimestamp-9, dt_blank, b_err)
                    END;
                dtf_normal :
                    SAPDB_PascalMove ('VGG03 ',  52,    
                          sizeof (sbuf), sizeof (dbuf), @sbuf, spos,
                          @dbuf, dpos, mxsp_timestamp, b_err);
                OTHERWISE
                    b_err := e_invalid_date;
                END
            (*ENDCASE*) 
        (*ENDIF*) 
        END
    (*ENDIF*) 
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      g03date_error_to_b_err (date_e : tsp6_date_error) : tgg00_BasisError;
 
VAR
      e : tgg00_BasisError;
 
BEGIN
CASE date_e OF
    sp6de_ok:
        e := e_ok;
    sp6de_format_not_recognized:
        e := e_date_format_not_recognized;
    sp6de_invalid_date:
        e := e_invalid_date;
    sp6de_invalid_time:
        e := e_invalid_time;
    sp6de_invalid_timestamp:
        e := e_invalid_timestamp;
    sp6de_invalid_day:
        e := e_to_date_invalid_day;
    sp6de_invalid_timezone:
        e := e_invalid_timezone;
    sp6de_unknown_day:
        e := e_unknown_day;
    sp6de_unknown_month:
        e := e_unknown_month;
    sp6de_no_letter:
        e := e_to_date_no_letter;
    sp6de_no_number:
        e := e_to_date_no_number;
    sp6de_no_to_date_format:
        e := e_no_to_date_format;
    sp6de_unknown_meridian:
        e := e_unknown_meridian;
    sp6de_too_short_input:
        e := e_to_date_too_short_input;
    sp6de_too_long_input:
        e := e_to_date_too_long_input;
    sp6de_inconsistent:
        e := e_to_date_inconsistent;
    sp6de_duplicate_format:
        e := e_to_date_duplicate_format;
    sp6de_out_of_range:
        e := e_to_date_out_of_range;
    sp6de_overflow:
        e := e_stack_overflow;
    sp6de_num_overflow:
        e := e_num_overflow;
    sp6de_end_of_month_adjustment:
        e := e_end_of_month_adjustment;
    sp6de_num_invalid:
        e := e_num_invalid;
    END;
(*ENDCASE*) 
g03date_error_to_b_err := e;
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
