!***********************************************************************
!                                                                      *
!               Confidentiality Information:                           *
!                                                                      *
! This module is the confidential and proprietary information of       *
! PeopleSoft, Inc.; it is not to be copied, reproduced, or transmitted *
! in any form, by any means, in whole or in part, nor is it to be used *
! for any purpose other than that for which it is expressly provided   *
! without the written permission of PeopleSoft.                        *
!                                                                      *
! Copyright (c) 1988-2005 PeopleSoft, Inc. All Rights Reserved         *
!                                                                      *
!***********************************************************************
!                                                                      *
! SourceSafe Information:                                              *
!                                                                      *
! $Header:: /pt843/SQR/DATETIME.SQC 7     2/19/03 11:48p Ptadm        $*
!                                                                      *
!***********************************************************************
!
!DATETIME.SQC
!
!This file contains generalized routines to format dates and times.  The
!types of legal output formats are derived from the date and time formats
!present in MSC Windows.  MSC Window datetime formats can be set in the
!the Windows Control Panel and are stored in win.ini.  The different date
!formats are mdy, dmy, ymd and hhmiss.  Date and time delimiter along with
!printing leading zeroes are parameters specified by the user.  To set
!these parameters for SQR, edit the environment file, setenv.sqc.
!Datetime symbols in setenv.sqc are grouped together under a database
!environment.  A list of the symbols and their definitions/values follows:
!
!                                                             MSC
!                                                             Windows
!Symbol          Definition                Value              Counterpart
!------          ----------                -----              -----------
!Native-Datetime native datetime format    any                none
!                of a database
!DateType        date format               0 = mdy, 1 = dmy   idate
!                                          2 = ymd
!DDelimiter      date separator            any                sdate
!MMLZero         month leading zero        0 = no, 1 = yes    sShortDate
!DDLZero         day leading zero          0 = no, 1 = yes    sShortDate
!Year4           4 digit year (1991 vs 91) 0 = no  1 = yes    sShortDate
!Time24          24 hour time (military)   0 = no  1 = yes    iTime
!TDelimiter      time separator            any                sTime
!TLZero          time leading zero         0 = no  1 = yes    iTLZero
!TZ1159          time zone (0:00 - 11:59)  any (i.e. AM)      s1159
!TZ2359          time zone(12:00 - 23:59)  any (i.e. PM)      s2359
!
!These global datetime symbols are string symbols and can be changed by
!referencing them either without the underscore if the procedure does
!not have parameters or with the underscore (i.e. $_DateType).
!When "Report" is appended to these symbols, the change will last for
!the duration of the report.  So when a report expects all printed dates
!to have the same characteristics (i.e. 'mm/dd/yy'), change the
!"Report..." symbol (i.e. $_ReportDateType).
!Native-DateTime, these symbols can be modified while running a SQR
!program because their default values are restored before returning to
!the calling program.  This feature allows a program to format a date in
!multiple formats without editing setenv.sqc.  The program assumes that
!native time is always 24 hour time except for Oracle and Sybase.
!
!To use the generalized datetime routine, do the following:
!   1. Set the datetime values in setenv.sqc
!   2. At the top of the SQR program, include files "setenv.sqc".
!      Also include "datetime.sqc".
!   3. Before using the generalized datetime routine, a program must
!      call "Init-DateTime"
!
!The generalized datetime routine is called "Format-DateTime".
!
!   Format-DateTime($in, $out, $date, $time, $native)
!
!     $in - input string or literal value either in native or $date format.
!     $out - output date format (will be null if fails)
!     $date - date format: DEFMDY, DEFDMY, DEFYMD,
!             DEFDATE (based on DateType), DEFCMP (for date comparison)
!             DEFROM (Japanese romaji format)
!             DEFKAN (Japanese Kanji format)
!       (see Note2 below for more info on Japanese Date conversions)
!
!     $time - format time with date.  If $time is a null string (''),
!             time is not formatted.  Any value in $time will format time.
!     $native - format from program to native format. If $native is a
!             null string (''), the direction of the format is native to
!             program.  Any value in $native will change the direction
!             from program to native.  In this case, the input format of
!             the date is described in $date.
!   Examples:
!     Format-DateTime('17-Sep-91 01:02 PM', $out, {DEFDATE},'','')
!     Format-DateTime('17-Sep-91 01:02 PM', $out, {DEFMDY},'time','')
!     Format-DateTime('17-Sep-91 01:02 PM', $out, {DEFCMP},'time','')
!     Format-DateTime('09/17/91 01:02', $out, {DEFMDY},'','native')
!     Format-DateTime('17/09/91 01:02:00 AM', $out, {DEFDMY},'time','native')
!     Format-DateTime('19910917', $out, {DEFCMP},'','native')
!************************************************************************
!  Note1:
!   Passing a two-digit year to be formatted in native format may cause
!   problems because we currently assume the century that the date is in.
!   For example, the following code flow could cause problems:
!     let $Year4 = '0'
!     do Format-DateTime ('17-Sep-2001 01:02 PM', $out, {DEFYMD}, '', '')
!         This will return 01/09/17 in $out
!     do Format-DateTime ($out, $out1, {DEFYMD}, '', 'native')
!         This will return 17-Sep-1901 in $out1
!   The workaround for this would be to retain the native value to avoid
!   having to convert back.
!
!  Note2:
!    In order to convert from native to romaji or native to Kanji, you
!    will first need to convert the date into native format.   What that
!    mean is you have to call `do format-datetime` twice.   First to
!    convert to native format and second to convert to either romaji
!    or Kanji ... for example:
!       if you want to convert 09/01/91 to Kanji, you would
!       do format-datetime ('09/01/91', $out, {DEFMDY}, '', 'native')
!       do format-datetime ($out, $kanji_date, {DEFKAN}, '', '')
!
!    Please note: the Japanese {DEFKAN} format is not currently supported
!                 on DB2/MVS host-side SQR, due to character set
!                 considerations.
!    NOTE:  IF you want to use the Japanese Date formatting described
!           above you must include #DEFINE JapaneseDates in the Report
!           header.
!************************************************************************
!Native Formats Currently Supported
!  (Note: SQR 4 now supports the Native Format of the Database)
!------------------------------------------------------------------------
! YYYY-MM-DD-HH.MI.SS           DB2, DB2/400, DB2/UNIX
! YYYY-MM-DD_HH:MI:SS           Informix
! DD-MON-YYYY_HH:MI:SS_AM       Oracle
! MON_DD_YYYY_HH:MI:SS:NNNAM    MSSQLServer, Sybase
!************************************************************************

!This guards against the SQC being #included twice...
#ifndef DATETIME-INCLUDED

#define DATETIME-INCLUDED

!****************************************
!Init-DateTime - init datetime varibles *
!****************************************
begin-procedure Init-Datetime
!
!
#ifdef debugx
! The following is only printed once to provide useful debug information
  #ifndef SHOW-PLATFORM-INFO
    #define SHOW-PLATFORM-INFO
    show 'SQR Program:    ' $sqr-program
    show 'Platform:       ' $sqr-platform
    let $Database = 'UNKNOWN'
    #ifdef DB2ALL
      #ifdef DB2400
        #ifdef NT
          let $Database = 'ODBC to DB2/400'
        #else
          let $Database = 'DB2/400'
        #endif
      #else
        #ifdef DB2UNIX
          #ifdef NT
            let $Database = 'ODBC to DB2/UNIX'
          #else
            let $Database = 'DB2/UNIX'
          #endif
        #else
          #ifdef NT
            let $Database = 'ODBC to DB2/390'
          #else
            let $Database = 'DB2/390'
          #endif
        #endif
      #endif
    #endif

    #ifdef INFORMIX
      let $Database = 'Informix'
    #endif
    #ifdef ORACLE
      let $Database = 'Oracle'
    #endif
    #ifdef MICROSOFT
      let $Database = 'Microsoft SQL Server'
    #endif
    #ifdef SQLBASE
      let $Database = 'SQLBase'
    #endif
    #ifdef SYBASE
      let $Database = 'Sybase'
    #endif

    show 'Database:       ' $Database
    show 'Locale:         ' $sqr-locale

    show 'SQR Version:    ' $sqr-ver
    show 'Report Output:  ' $sqr-report
    show 'HostName:       ' $sqr-hostname
  #endif

  Show 'Entering DATETIME.SQC: Init-Datetime'
  #ifdef debugy
    Show ' Native-DateTime: {Native-DateTime}'
  #end-if
#end-if

if $ReportDateType = ''
  move {DateType}   to $ReportDateType
end-if
if $ReportDDelimiter = ''
  move {DDelimiter} to $ReportDDelimiter
end-if
if $ReportMMLZero = ''
  move {MMLZero}    to $ReportMMLZero
end-if
if $ReportDDLZero = ''
  move {DDLZero}    to $ReportDDLZero
end-if
if $ReportYear4 = ''
  move {Year4}      to $ReportYear4
end-if
if $ReportTime24 = ''
  move {Time24}     to $ReportTime24
end-if
if $ReportTLZero = ''
  move {TLZero}     to $ReportTLZero
end-if
if $ReportTDelimiter = ''
  move {TDelimiter} to $ReportTDelimiter
end-if
if $ReportTZ1159 = ''
  move {TZ1159}     to $ReportTZ1159
end-if
if $ReportTZ2359 = ''
  move {TZ2359}     to $ReportTZ2359
end-if
if $ReportNativeTimeFmt = ''
  move {NativeTimeFmt} to $ReportNativeTimeFmt
end-if

move $ReportDateType       to $DateType
move $ReportDDelimiter     to $DDelimiter
move $ReportMMLZero        to $MMLZero
move $ReportDDLZero        to $DDLZero
move $ReportYear4          to $Year4
move $ReportTime24         to $Time24
move $ReportTLZero         to $TLZero
move $ReportTDelimiter     to $TDelimiter
move $ReportTZ1159         to $TZ1159
move $ReportTZ2359         to $TZ2359
move $ReportNativeTimeFmt  to $NativeTimeFmt
move '00:00:00'            to $PSTime24

!
!init month array
!
create-array name=month size=13 field=mm:char:3
put '00' 'BUG' 'Bug' into month(0)  mm(0) mm(1) mm(2)
put '01' 'JAN' 'Jan' into month(1)  mm(0) mm(1) mm(2)
put '02' 'FEB' 'Feb' into month(2)  mm(0) mm(1) mm(2)
put '03' 'MAR' 'Mar' into month(3)  mm(0) mm(1) mm(2)
put '04' 'APR' 'Apr' into month(4)  mm(0) mm(1) mm(2)
put '05' 'MAY' 'May' into month(5)  mm(0) mm(1) mm(2)
put '06' 'JUN' 'Jun' into month(6)  mm(0) mm(1) mm(2)
put '07' 'JUL' 'Jul' into month(7)  mm(0) mm(1) mm(2)
put '08' 'AUG' 'Aug' into month(8)  mm(0) mm(1) mm(2)
put '09' 'SEP' 'Sep' into month(9)  mm(0) mm(1) mm(2)
put '10' 'OCT' 'Oct' into month(10) mm(0) mm(1) mm(2)
put '11' 'NOV' 'Nov' into month(11) mm(0) mm(1) mm(2)
put '12' 'DEC' 'Dec' into month(12) mm(0) mm(1) mm(2)

!
!init month-char array
!
create-array name=month-char size=13 field=len:number field=remain:number
                     field=past:number
put 0  365  0       into month-char(0)  len remain past
put 31 334  31      into month-char(1)  len remain past
put 28 306  59      into month-char(2)  len remain past
put 31 275  90      into month-char(3)  len remain past
put 30 245  120     into month-char(4)  len remain past
put 31 214  151     into month-char(5)  len remain past
put 30 184  181     into month-char(6)  len remain past
put 31 153  212     into month-char(7)  len remain past
put 31 122  243     into month-char(8)  len remain past
put 30 92   273     into month-char(9)  len remain past
put 31 61   304     into month-char(10) len remain past
put 30 31   334     into month-char(11) len remain past
put 31  0   365     into month-char(12) len remain past
!
!init DaysInMonth array
!
create-array name=DaysInMonth size=13 field=dim:number:2
put 0  0    into DaysInMonth(0)  dim(0) dim(1)
put 31 31   into DaysInMonth(1)  dim(0) dim(1)
put 28 29   into DaysInMonth(2)  dim(0) dim(1)
put 31 31   into DaysInMonth(3)  dim(0) dim(1)
put 30 30   into DaysInMonth(4)  dim(0) dim(1)
put 31 31   into DaysInMonth(5)  dim(0) dim(1)
put 30 30   into DaysInMonth(6)  dim(0) dim(1)
put 31 31   into DaysInMonth(7)  dim(0) dim(1)
put 31 31   into DaysInMonth(8)  dim(0) dim(1)
put 30 30   into DaysInMonth(9)  dim(0) dim(1)
put 31 31   into DaysInMonth(10) dim(0) dim(1)
put 30 30   into DaysInMonth(11) dim(0) dim(1)
put 31 31   into DaysInMonth(12) dim(0) dim(1)
!
! Initialize Global TimeZone
!
! Build TimeZone Array.  This is loaded by AddTimeZoneRecord
let #TZMaxSize = 200  !This Current Max Size of the TimeZone Array.
let #TZCurSize = 0    !This Counter contains the current number of Elements in TimeZone Array.

create-array name=timezone size = 200
    field=arTZ:char
    field=arTZStdLbl:char
    field=arTZDSTLbl:char
    field=arUTCOffset:integer
    field=arObserveDST:char
    field=arDSTOffset:integer
    field=arDSTStart:char
    field=arDSTend:char

! Build DSTTime Array.  This is loaded by AddDSTTimeRecord
let #DSTMaxSize = 100  !This Current Max Size of the DSTTime Array.
let #DSTCurSize = 0    !This Counter contains the current number of Elements in DSTTime Array.

create-array name=DSTtime size = 100
    field=arDSTId:char
    field=arDSTAbsolute:char
    field=arDSTMonth:integer
    field=arDSTDay:integer
    field=arDSTDOW:integer
    field=arDSTHour:integer
    field=arDSTMinute:integer

#ifdef debugx
  #ifdef debugy
    Show ' $DateType  : ' $DateType
    Show ' $DDelimiter: ' $DDelimiter
    Show ' $MMLZero   : ' $MMLZero
    Show ' $DDLZero   : ' $DDLZero
    Show ' $Year4     : ' $Year4
    Show ' $Time24    : ' $Time24
    Show ' $TLZero    : ' $TLZero
    Show ' $TDelimiter: ' $TDelimiter
    Show ' $TZ1159    : ' $TZ1159
    Show ' $TZ2359    : ' $TZ2359
    Show ' $PSTime24  : ' $PSTime24
  #end-if
  Show 'Exiting DATETIME.SQC: Init-Datetime'
#end-if

end-procedure                           ! Init-Datetime


!**********************
!  Format-Datetime    *
!**********************
begin-procedure Format-DateTime($in, :$out, $date, $time, $native)

declare-variable
    date    $tempDate
end-declare

#ifdef debugx
    Show 'Entering DATETIME.SQC: Format-DateTime'
    Show ' Input $in    : ' $in
    Show ' Input $date  : ' $date
    Show ' Input $time  : ' $time
    Show ' Input $native: ' $native
    #ifdef debugy
        Show ' Global variables:'
        if $_date != {DEFCMP}
            Show '  $DateType  : ' $_DateType
            Show '  $DDelimiter: ' $_DDelimiter
            Show '  $Year4     : ' $_Year4
            Show '  $TDelimiter: ' $_TDelimiter
        end-if
    #end-if
#end-if

let $DDel = $_DDelimiter
let $TDel = $_TDelimiter
move {No} to $error
move {No} to $done

! Format some variables, based on Global settings
if $_Year4 = '1'                                               !Default
    let $PTYear = 'YYYY'
else
    let $PTYear = 'RR'                                         !If this is used a warning will be sent to the Log File
end-if



if IsBlank($in) = {True}                                       !Test if $in is valid
    move '' to $date
end-if


if $native != ''    ! $in is in Non-Native format
    evaluate $date
        when = {DEFDATE}
            if $_DateType = '0'
                move {DEFMDY} to $date
            else
                if $_DateType = '1'
                    move {DEFDMY} to $date
                else
                    move {DEFYMD} to $date
                end-if
            end-if
        when = {DEFCMP}
            if $time != ''
                let $DateFormatIn  =  {PTCMPT}                 !See begining of this SQC for the #DEFINE for this Variable
                let $DateFormatOut =  {Native-DateTimeMask}
            else
                let $DateFormatIn  =  {PTCMP}                  !See begining of this SQC for the #DEFINE for this Variable
                let $DateFormatOut =  {Native-DateMask}
                let #length        =  length($DateFormatIn)
                let $in            =  substr($in,1,#length)
            end-if
            break
        when = {DEFMDY}
            if $time != ''
                let $DateFormatIn  = '{PTMon}' || $DDel || '{PTDay}' || $DDel || $PTYear || ' ' || '{PTHour}' || $TDel || '{PTMin}' || $TDel || '{PTSec}'
                let $DateFormatOut =  {Native-DateTimeMask}
            else
                let $DateFormatIn  = '{PTMon}' || $DDel || '{PTDay}' || $DDel || $PTYear
                let $DateFormatOut =  {Native-DateMask}
                let #length        =  length($DateFormatIn)
                let $in            =  substr($in,1,#length)
            end-if
            break
        when = {DEFDMY}
            if $time != ''
                let $DateFormatIn  = '{PTDay}'|| $DDel ||'{PTMon}'|| $DDel || $PTYear || ' ' ||'{PTHour}'|| $TDel ||'{PTMin}'|| $TDel || '{PTSec}'
                let $DateFormatOut =  {Native-DateTimeMask}
            else
                let $DateFormatIn  = '{PTDay}'|| $DDel ||'{PTMon}'|| $DDel || $PTYear
                let $DateFormatOut =  {Native-DateMask}
                let #length        =  length($DateFormatIn)
                let $in            =  substr($in,1,#length)
            end-if
            break
        when = {DEFYMD}
            if $time != ''
                let $DateFormatIn  =  $PTYear || $DDel ||'{PTMon}'|| $DDel ||'{PTDay}'|| ' ' ||'{PTHour}'|| $TDel ||'{PTMin}'|| $TDel || '{PTSec}'
                let $DateFormatOut =  {Native-DateTimeMask}
            else
                let $DateFormatIn  =  $PTYear || $DDel ||'{PTMon}'|| $DDel ||'{PTDay}'
                let $DateFormatOut =  {Native-DateMask}
                let #length        =  length($DateFormatIn)
                let $in            =  substr($in,1,#length)
            end-if
            break

#ifdef JapaneseDates
        when = {DEFROM}
            do romaji-to-native($in, $out, $time)
            move {Yes} to $done
            break
        when = {DEFKAN}
            do kanji-to-native($in, $out, $time)
            move {Yes} to $done
            break
#end-if

        when-other
            move {Yes} to $error
            break
    end-evaluate

else                ! $in is in Native Format

    evaluate $date
        when = {DEFDATE}
            if $_DateType = '0'
                move {DEFMDY} to $date
            else
                if $_DateType = '1'
                    move {DEFDMY} to $date
                else
                    move {DEFYMD} to $date
                end-if
            end-if
        when = {DEFCMP}
            if $time != ''
                let $DateFormatIn  =  {Native-DateTimeMask}
                let $DateFormatOut =  {PTCMPT}                 !See begining of this SQC for the #DEFINE for this Variable
            else
                let $DateFormatIn  =  {Native-DateMask}
                let $DateFormatOut =  {PTCMP}                  !See begining of this SQC for the #DEFINE for this Variable
                let #length        =  length($DateFormatIn)
                let $in            =  substr($in,1,#length)
            end-if
            break
        when = {DEFMDY}
            if $time != ''
                let $DateFormatIn  =  {Native-DateTimeMask}
                let $DateFormatOut = '{PTMon}' || $DDel || '{PTDay}' || $DDel ||  $PTYear  || ' ' || '{PTHour}' || $TDel || '{PTMin}' || $TDel || '{PTSec}'
            else
                let $DateFormatIn  =  {Native-DateMask}
                let $DateFormatOut = '{PTMon}' || $DDel || '{PTDay}' || $DDel ||  $PTYear
                let #length        =  length($DateFormatIn)
                let $in            =  substr($in,1,#length)
            end-if
            break
        when = {DEFDMY}
            if $time != ''
                let $DateFormatIn  =  {Native-DateTimeMask}
                let $DateFormatOut = '{PTDay}'|| $DDel ||'{PTMon}'|| $DDel || $PTYear || ' ' ||'{PTHour}'|| $TDel ||'{PTMin}'|| $TDel || '{PTSec}'
            else
                let $DateFormatIn  =  {Native-DateMask}
                let $DateFormatOut = '{PTDay}'|| $DDel ||'{PTMon}'|| $DDel || $PTYear
                let #length        =  length($DateFormatIn)
                let $in            =  substr($in,1,#length)
            end-if
            break
        when = {DEFYMD}
            if $time != ''
                let $DateFormatIn  =  {Native-DateTimeMask}
                let $DateFormatOut =  $PTYear || $DDel ||'{PTMon}'|| $DDel ||'{PTDay}'|| ' ' ||'{PTHour}'|| $TDel ||'{PTMin}'|| $TDel || '{PTSec}'
            else
                let $DateFormatIn  =  {Native-DateMask}
                let $DateFormatOut =  $PTYear || $DDel ||'{PTMon}'|| $DDel ||'{PTDay}'
                let #length        =  length($DateFormatIn)
                let $in            =  substr($in,1,#length)
            end-if
            break

#ifdef JapaneseDates
        when = {DEFROM}
            do native-to-romaji($in, $out, $time)
            move {Yes} to $done
            break
        when = {DEFKAN}
            do native-to-kanji($in, $out, $time)
            move {Yes} to $done
            break
#end-if

        when-other
            move {Yes} to $error
            break
    end-evaluate

end-if

if $done = {No}
    if $error = {No}
        let $tempDate = strtodate($in,$DateFormatIn)
        let $out      = datetostr($tempDate,$DateFormatOut)
        if $time != ''
            let $_PSTime24 = datetostr($tempDate,{PTHMS})
        end-if
    else
        let $out = ''
        if $time != ''
            let $_PSTime24 = '00:00:00'
        end-if
    end-if
end-if
    
move $_ReportDateType to $_DateType
move $_ReportDDelimiter to $_DDelimiter
move $_ReportYear4 to $_Year4
move $_ReportTDelimiter to $_TDelimiter

#ifdef debugx
  Show 'Exiting DATETIME.SQC: Format-DateTime'
  Show ' Output $out: ' $out
#end-if

end-procedure

!***********************************************************************
!Diff-Date                                                             *
!                                                                      *
! Accepts two date in native format, and returns the algebraic         *
! difference in years, months and days                                 *
!                                                                      *
! Note that the values returned represent the date difference in       *
! different units, and that the difference is not expressed in terms   *
! of all three returned values.  In other words, the difference        *
! between 19950101 and 19960202 will not be expressed as one year,     *
! one month, and one day, but rather one year, thirteen months, and    *
! 397 days.  That is, each of the returned values will express the     *
! date difference independent of the other values                      *
!***********************************************************************
! Parameter descriptions:                                              *
!  $indate1    The starting date                                       *
!  $indate2    The ending date                                         *
!              Note: if $indate2 is earlier than $indate1, the result  *
!                    will be returned as negative durations            *
!  #wkYears    The number of years between the dates                   *
!  #wkMonths   The number of months between the dates                  *
!  #wkDays     The number of days between the dates                    *
!***********************************************************************
begin-procedure Diff-Date($indate1,$indate2,:#wkYears,:#wkMonths,:#wkDays)

    declare-variable
        date    $wkDate1
        date    $wkDate2
        integer #wkDays
        integer #wkMonths
        integer #wkYears

    end-declare

    #ifdef debugx
        Show 'Entering DATETIME.SQC: Diff-Date'
        Show ' Input $indate1: ' $indate1
        Show ' Input $indate2: ' $indate2
    #end-if

!
! convert the dates to yyyymmdd (CMP) format
!
    do Format-DateTime($indate1, $date1, {DEFCMP}, '', '')
    do Format-DateTime($indate2, $date2, {DEFCMP}, '', '')
!
! Convert Dates to internal SQR Dateformat
!
    let $wkDate1 = strtodate($date1,{PTCMP})
    let $wkDate2 = strtodate($date2,{PTCMP})
!
! special case of one date empty, return no difference
!
    if (($date1 = '') or ($date2 = ''))
        let #wkYears  = 0
        let #wkMonths = 0
        let #wkDays   = 0
    else

! Calculate Years
    let  #wkYears  = trunc(datediff($wkDate1, $wkDate2,'Year'),0)

! Calculate Months
    let  #wkMonths = trunc(datediff($wkDate1, $wkDate2,'Month'),0)

! Calculate Days
    let  #wkDays   = trunc(datediff($wkDate1, $wkDate2,'Day'),0)

  end-if

  #ifdef debugx
    Show 'Exiting DATETIME.SQC: Diff-Date'
    Show ' Output #wkYears : ' #wkYears
    Show ' Output #wkMonths: ' #wkMonths
    Show ' Output #wkDays  : ' #wkDays
  #end-if

end-procedure                           ! Diff-Date

!***********************************************************************
!Diff-DateElapsed                                                      *
!                                                                      *
! Accepts two date in native format, and returns the algebraic         *
! difference in years, months and days. unlike Diff-Date, the total of *
! the Years + Months + Days will be the elapsed time.                  *
!                                                                      *
! Taking the example in Diff-Date, this would be the result using this *
! procedure: Difference between 19950101 and 19960202 will be          *
! expressed as one year, one month, and one day.                       *
!***********************************************************************
! Parameter descriptions:                                              *
!  $indate1    The starting date                                       *
!  $indate2    The ending date                                         *
!              Note: if $indate2 is earlier than $indate1, the result  *
!                    will be returned as negative durations            *
!  #wkYears    The number of years between the dates                   *
!  #wkMonths   The number of months between the dates - Years          *
!  #wkDays     The number of days between the dates - Years - Months   *
!***********************************************************************
begin-procedure Diff-DateElapsed($indate1,$indate2,:#wkYears,:#wkMonths,:#wkDays)

    declare-variable
        date    $wkDate1
        date    $wkDate2
        date    $wkDate3
        integer #wkDays
        integer #wkMonths
        integer #wkYears

    end-declare

    #ifdef debugx
        Show 'Entering DATETIME.SQC: Diff-DateElapsed'
        Show ' Input $indate1: ' $indate1
        Show ' Input $indate2: ' $indate2
    #end-if

!
! convert the dates to yyyymmdd (CMP) format
!
    do Format-DateTime($indate1, $date1, {DEFCMP}, '', '')
    do Format-DateTime($indate2, $date2, {DEFCMP}, '', '')
!
! Convert Dates to internal SQR Dateformat
!
    let $wkDate1 = strtodate($date1,{PTCMP})
    let $wkDate2 = strtodate($date2,{PTCMP})
!
! special case of one date empty, return no difference
!
    if (($date1 = '') or ($date2 = ''))
        let #wkYears  = 0
        let #wkMonths = 0
        let #wkDays   = 0
    else

! Calculate Years
    let  #wkYears  = trunc(datediff($wkDate1, $wkDate2,'year'),0)

! Subtract Years from $Date2 to Build $Date3
    let  $wkDate3  = dateadd($wkDate1,'year',(#wkYears * -1))

! Calculate Months
    let  #wkMonths = trunc(datediff($wkDate3, $wkDate2,'Month'),0)

! Subtract Months from $Date3 to build new $Date3
    let  $wkDate3  = dateadd($wkDate3,'month',(#wkMonths * -1))

! Calculate Days
    let  #wkDays   = trunc(datediff($wkDate3, $wkDate2,'Day'),0)
  end-if

  #ifdef debugx
    Show 'Exiting DATETIME.SQC: Diff-DateElapsed'
    Show ' Output #wkYears : ' #wkYears
    Show ' Output #wkMonths: ' #wkMonths
    Show ' Output #wkDays  : ' #wkDays
  #end-if

end-procedure                           ! Diff-DateElapsed


!***********************************************************************
!Get-DateComponents                                                    *
!                                                                      *
! Given a date in yyyymmdd string format, break it up into year,       *
! month, and day as numerics                                           *
!***********************************************************************
! Parameter descriptions:                                              *
!  $indate     The yyyymmdd string date                                *
!  #wkYears    The numeric representation of the year                  *
!  #wkMonths   The numeric representation of the month                 *
!  #wkDays     The numeric representation of the day                   *
!***********************************************************************
begin-procedure Get-DateComponents ($indate,:#wkYears,:#wkMonths,:#wkDays)

    declare-variable
        date    $wkDate
        integer #wkDays
        integer #wkMonths
        integer #wkYears
    end-declare

  #ifdef debugx
    Show 'Entering DATETIME.SQC: Get-DateComponents'
    Show ' Input $indate: ' $indate
  #end-if
!
! Convert Date to internal SQR Dateformat
!
    let $wkDate  = strtodate(substr($indate,1,8),{PTCMP})

    let #wkDays   = to_number(datetostr($wkDate,'DD'))
    let #wkMonths = to_number(datetostr($wkDate,'MM'))
    let #wkYears  = to_number(datetostr($wkDate,'YYYY'))

  #ifdef debugx
    Show 'Exiting DATETIME.SQC: Get-DateComponents'
    Show ' Output #wkYears : ' #wkYears
    Show ' Output #wkMonths: ' #wkMonths
    Show ' Output #wkDays  : ' #wkDays
  #end-if

end-procedure                           ! Get-DateComponents


!***********************************************************************
!Count-Leapdays                                                        *
!                                                                      *
! Given two dates in yyyymmdd (CMP) string format, count the number    *
! of leap days that fall between the two dates (not inclusive)         *
!                                                                      *
! A leap day is defined as February 29th, which occurs every four      *
! years, with the exception of centuries, in which case a leap day     *
! only occurs in those years divisible by 400.                         *
!***********************************************************************
! Parameter descriptions:                                              *
!  $indate1    The ending date in yyyymmdd string format               *
!  $indate2    The starting date in yyyymmdd string format             *
!  #nLeapdays  The number of leap days between the dates               *
!***********************************************************************
begin-procedure Count-LeapDays ($indate1,$indate2,:#nLeapdays)

  #ifdef debugx
    Show 'Entering DATETIME.SQC: Count-LeapDays'
    Show ' Input $indate1: ' $indate1
    Show ' Input $indate2: ' $indate2
  #end-if

  let #nLeapdays = 0
!
! make sure that the start date is prior to the end date
!
  let $date1 = $indate1
  let $date2 = $indate2
  if ($date2 > $date1)
    let $datebuffer = $date1
    let $date1 = $date2
    let $date2 = $datebuffer
  end-if
!
! break the dates up into their numeric components
!
  do Get-DateComponents ($date1, #year1, #month1, #day1)
  do Get-DateComponents ($date2, #year2, #month2, #day2)
!
! set working year to the 1st possible leap year after the start date
!
  let #workingYear = #year2
  if (mod(#workingYear,4) != 0)         ! starting year not leap year
    let #workingYear = #workingYear + 4 - mod(#workingYear,4)
  else                                  ! starting year is leap year
    if (#month2 >= 3)                   ! check to see if past March
      add 4 to #workingYear
    end-if
  end-if
!
! count the leap years
!
  while (#workingYear <= #year1)
!
!   check if the working year is a leap year
!
    if (((mod(#workingYear,4) = 0) and (mod(#workingYear,100) != 0)) or
     (mod(#workingYear,400) = 0))
!
!     count the day unless we're in the end year, and it's before March
!
      if not ((#workingYear = #year1) and (#month1 < 3))
    add 1 to #nLeapdays
      end-if
    end-if
!
!   get to the next potential leap year
!
    add 4 to #workingYear
  end-while

  #ifdef debugx
    Show 'Exiting DATETIME.SQC: Count-LeapDays'
    Show ' Output #nLeapDays: ' #nLeapDays
  #end-if

end-procedure                           ! Count-LeapDays


!***********************************************************************
!MakeYear4Digits                                                       *
!                                                                      *
! Given a two digit year (yy), The following Century will be appended  *
!   to the input year.                                                 *
! to avoid hard-coding of Century values, this routine takes advantage *
! of SQR's built in Date Functionality.  The 'RR' is a special format  *
! that allows SQR to calculate the century.                            *
!***********************************************************************
! Parameter descriptions:                                              *
!  $inYear     On input, the two-digit year                            *
!              On output, the four-digit year                          *
!***********************************************************************
begin-procedure MakeYear4Digits (:$inYear)
    declare-variable
        date    $wkDate
    end-declare

    #ifdef debugx
        Show 'Entering DATETIME.SQC: MakeYear4Digits'
        Show ' Input $inYear : ' $inYear
    #end-if

    let $wkdate = strtodate($inYear,'RR')
    let $inYear = datetostr($wkDate,'YYYY')

    #ifdef debugx
        Show 'Exiting DATETIME.SQC: MakeYear4Digits'
        Show ' Output $inYear: ' $inYear
    #end-if
end-procedure                           ! MakeYear4Digits

!***********************************************************************
!FormatNativeTime                                                      *
! Return the time in the Native Format                                 *
!***********************************************************************
begin-procedure FormatNativeTime ($in, :$tt, :#start, :#delimiter, :$tzone)

    declare-variable
        date    $wktime
    end-declare

#ifdef debugx
    Show 'Entering DATETIME.SQC: FormatNativeTime'
    Show ' Input $in       : ' $in
    Show ' Input #start    : ' #start
    Show ' Input #delimiter: ' #delimiter
    #ifdef debugy
        Show ' Global variables: '
        Show '  $DDelimiter: ' $_DDelimiter
    #end-if
#end-if

if #start <> 1             ! This is for DB2 only.  If Time only, Milliseconds cannot be appended.
    let $Time_Only = {No}
else
    let $Time_Only = {Yes}
end-if

if IsBlank($in) = {True}
    let $in = ''
end-if

if $_DDelimiter = ''
    if $Time_Only = {No}
        let $wktime  = strtodate(substr($in,9,6),'HHMISS')
    else
        let $wktime  = strtodate(substr($in,1,6),'HHMISS')
    end-if
else
    let $timemask    = 'HH' || $_TDelimiter || 'MI' || $_TDelimiter || 'SS'
    let #timemasklen = length($timemask)
    let $wktime      = strtodate(substr($in,#start,#timemasklen),$timemask)
end-if

let $tt = datetostr($wktime,{Native-TimeMask})

#ifdef DB2ALL
    if $Time_Only = {No}
        let $tt = datetostr($wktime,{Native-TimeMaskMS})     !DB2 needs microseconds when part of full DateTime
    end-if
#end-if

!Set $TZone
if $_Time24 = '0' or {NativeTimeFmt} = '1'                   !12 hour day - set timezone
    let $tzone = datetostr($wktime,'PM')
else
    let $tzone = ''
end-if


#ifdef debugx
  Show 'Exiting DATETIME.SQC: FormatNativeTime'
  Show ' Output $tt          : ' $tt
  Show ' Output $tzone       : ' $tzone
#end-if

end-procedure                           ! FormatNativeTime


!***********************************************************************
!  Convert-To-MM                                                       *
!***********************************************************************
begin-procedure Convert-To-MM(:$mm)

#ifdef debugx
  Show 'Entering DATETIME.SQC: Convert-To-MM'
  Show ' Input $mm: ' $mm
  #ifdef debugy
    Show ' Global variables: '
    Show '  $MMLZero: ' $_MMLZero
  #end-if
#end-if

move 0 to #n
while #n < 13
  get $m $mmm from month(#n) mm(0) mm(1)
  if upper($mm) = upper($mmm)
    break
  end-if
  add 1 to #n
end-while
let $mm = cond($_MMLZero = '0', to_char(to_number($m)), $m)

#ifdef debugx
  Show 'Exiting DATETIME.SQC: Convert-To-MM'
  Show ' Output $mm: ' $mm
#end-if

end-procedure


!***********************************************************************
!  Convert-To-MMM                                                      *
!***********************************************************************
begin-procedure Convert-To-MMM(:$mm)

#ifdef debugx
  Show 'Entering DATETIME.SQC: Convert-To-MMM'
  Show ' Input $mm: ' $mm
#end-if

let #mm = to_number($mm)
get $mm from month(#mm) mm(2)

let $mm = upper($mm)

#ifdef debugx
  Show 'Exiting DATETIME.SQC: Convert-To-MMM'
  Show ' Output $mm: ' $mm
#end-if

end-procedure


#ifdef JapaneseDates

!***********************************************************************
! Native-to-romaji                                                    *
!***********************************************************************

begin-procedure native-to-romaji($in, :$out, $time)

  let $japan_date_in = $in

      let $meiji_begin = '18680909'
      let $meiji_end = '19120730'
      let $taisho_begin = '19120731'
      let $taisho_end = '19261225'
      let $showa_begin = '19261226'
      let $showa_end = '19890107'
      let $heisei_begin = '19890108'
      let $heisei_end = 'current'

  do format-datetime($japan_date_in, $japan_compare, {DEFCMP}, '', '')

  if $japan_compare >= $meiji_begin and $japan_compare <= $meiji_end
     move 'M' to $gengou_romaji
     let #year = substr($japan_compare,1,4)
     let #final_yr = #year - 1867
     let $yr = edit(#final_yr,'999')
  else
     if $japan_compare >= $taisho_begin and $japan_compare <= $taisho_end
        move 'T'  to $gengou_romaji
        let #year = substr($japan_compare,1,4)
        let #final_yr = #year - 1911
        let $yr = edit(#final_yr, '999')

     else
        if $japan_compare >= $showa_begin and $japan_compare <= $showa_end
           move 'S'  to $gengou_romaji
           let #year = substr($japan_compare,1,4)
           let #final_yr = #year - 1925
           let $yr = edit(#final_yr, '999')
        else
           move 'H' to $gengou_romaji
           let #year = substr($japan_compare,1,4)
           let #final_yr = #year - 1988
           let $yr = edit(#final_yr, '999')
        end-if
     end-if
  end-if

  let $month_portion = substr($japan_compare,5,2)
  let $day_portion = substr($japan_compare,7,2)

  let $imperial_date = $gengou_romaji  || '.' || ltrim($yr,' ') || '.' ||
                           $month_portion || '.' || $day_portion

  let $out = $imperial_date

end-procedure

!***********************************************************************
! Native-to-Kanji                                                      *
!***********************************************************************

begin-procedure native-to-kanji($in, :$out, $time)

  let $japan_date_in = $in

      let $meiji_begin = '18680909'
      let $meiji_end = '19120730'
      let $taisho_begin = '19120731'
      let $taisho_end = '19261225'
      let $showa_begin = '19261226'
      let $showa_end = '19890107'
      let $heisei_begin = '19890108'
      let $heisei_end = 'current'

  let $heisei_kanji = unicode('U+5e73') || unicode('U+6210')
  let $showa_kanji  = unicode('U+662d') || unicode('U+548c')
  let $taisho_kanji = unicode('U+5927') || unicode('U+6b63')
  let $meiji_kanji  = unicode('U+660e') || unicode('U+6cbb')

  let $year_kanji  = unicode('U+5e74')
  let $month_kanji = unicode('U+6708')
  let $day_kanji   = unicode('U+65e5')

  do format-datetime($japan_date_in, $japan_compare, {DEFCMP}, '', '')

  if $japan_compare >= $meiji_begin and $japan_compare <= $meiji_end
     move $meiji_kanji to $gengou_kanji
     let #year = substr($japan_compare,1,4)
     let #final_yr = #year - 1867
     let $yr = edit(#final_yr,'999')
  else
     if $japan_compare >= $taisho_begin and $japan_compare <= $taisho_end
        move $taisho_kanji to $gengou_kanji
        let #year = substr($japan_compare,1,4)
        let #final_yr = #year - 1911
        let $yr = edit(#final_yr, '999')

     else
        if $japan_compare >= $showa_begin and $japan_compare <= $showa_end
           move $showa_kanji to $gengou_kanji
           let #year = substr($japan_compare,1,4)
           let #final_yr = #year - 1925
           let $yr = edit(#final_yr, '999')
        else
           let #year = substr($japan_compare,1,4)
           move $heisei_kanji to $gengou_kanji
           let #final_yr = #year - 1988
           let $yr = edit(#final_yr, '999')
        end-if
     end-if
  end-if

  let $month_portion = substr($japan_compare,5,2)
  let $day_portion = substr($japan_compare,7,2)

  let $imperial_date = $gengou_kanji || ltrim($yr,' ') || $year_kanji ||
                           $month_portion || $month_kanji || $day_portion || $day_kanji

  let $out = $imperial_date

end-procedure

!***********************************************************************
! Kanji-to-Native                                                      *
!***********************************************************************

begin-procedure kanji-to-native($in, :$out, $time)

  let $kanji = $in

  let $achar   = substr($kanji, 1, 2)

  let $heisei_kanji = unicode('U+5e73') || unicode('U+6210')
  let $showa_kanji  = unicode('U+662d') || unicode('U+548c')
  let $taisho_kanji = unicode('U+5927') || unicode('U+6b63')
  let $meiji_kanji  = unicode('U+660e') || unicode('U+6cbb')

  let $year_kanji  = unicode('U+5e74')
  let $month_kanji = unicode('U+6708')
  let $day_kanji   = unicode('U+65e5')

  let #ct = 1
  let $yy = ''
  let $mm = ''
  let $dd = ''
  let $continue = 'Y'
  let $yy_cont = 'Y'
  let $mm_cont = 'Y'
  let $dd_cont = 'Y'

  while $continue = 'Y'
     if range(substr($in, #ct,1), '0','9')
        if $yy_cont = 'Y'
           let $yy = $yy || substr($in,#ct,1)
        else
           if $mm_cont = 'Y'
              let $mm = $mm || substr($in,#ct,1)
           else
              if $dd_cont = 'Y'
                 let $dd = $dd || substr($in,#ct,1)
              end-if
           end-if
        end-if
    else
        if rtrim($yy, ' ')  != '' and $yy_cont != 'N'
           let $yy_cont = 'N'
        else
           if rtrim ($mm, ' ') != '' and $mm_cont != 'N'
              let $mm_cont = 'N'
           else
              if rtrim ($dd, ' ') != '' and $dd_cont != 'N'
                 let $dd_cont = 'N'
              end-if
           end-if
        end-if
    end-if

    if substr($in, #ct, 1) = $day_kanji
       let $continue = 'N'
    else
       let #ct = #ct + 1
    end-if
 end-while

 let #tmp_yy = $yy

 if $achar = $heisei_kanji
     let #tmp_yy2 = #tmp_yy + 1988
 else
    if $achar = $showa_kanji
       let #tmp_yy2 = #tmp_yy + 1925
    else
       if $achar = $taisho_kanji
          let #tmp_yy2 = #tmp_yy + 1911
       else
          let #tmp_yy2 = #tmp_yy + 1867
       end-if
    end-if
 end-if

 let $tmp_yy2 = edit(#tmp_yy2,'9999')

  if length($mm) = 1
     let $mm = '0' || $mm
  end-if
  if length ($dd) = 1
     let $dd = '0' || $dd
  end-if
 let $tmp_dte = $tmp_yy2 || $mm || $dd

 do format-datetime($tmp_dte, $out, {DEFCMP}, '', 'native')

end-procedure

!***********************************************************************
! romaji-to-Native                                                    *
!***********************************************************************

begin-procedure romaji-to-native($in, :$out, $time)

  let $romaji = $in

  let $gengou_romaji = substr($romaji,1,1)
  let #len = length($romaji)
  let #ct = 3
  let #f_per = 0
  let #s_per = 0

  while  #ct < #len + 1
     if substr($romaji,#ct,1) = '.'
        if #f_per = 0
           let #f_per = #ct
        else
           let #s_per = #ct
        end-if
     end-if
     let #ct = #ct + 1
  end-while

  let #tmp_yy = substr($romaji,3, #f_per - 3)
  let $mm = substr($romaji,#f_per + 1, #s_per - #f_per - 1)
  let $dd = substr($romaji,#s_per + 1, #len - #s_per)

  if $gengou_romaji = 'M'
     let #tmp_yy2 = #tmp_yy + 1867
  else
     if $gengou_romaji = 'T'
        let #tmp_yy2 = #tmp_yy + 1911
     else
        if $gengou_romaji = 'S'
           let #tmp_yy2 = #tmp_yy + 1925
        else
           let #tmp_yy2 = #tmp_yy + 1988
        end-if
     end-if
  end-if

  let $tmp_yy2 = edit(#tmp_yy2,'9999')
  if length($mm) = 1
     let $mm = '0' || $mm
  end-if
  if length ($dd) = 1
     let $dd = '0' || $dd
  end-if
  let $tmp_dte = $tmp_yy2 || $mm || $dd

  do format-datetime($tmp_dte, $out, {DEFCMP}, '', 'native')

end-procedure

#end-if       ! JapaneseDates

#endif                                  ! DATETIME-INCLUDED