'**** HEADER ************************************************************
'DATELIB.PF3

'This program is the CONFIDENTIAL and PROPRIETARY property of Applied
'Resource Technologies, Inc.  Any unauthorized use, reproduction or
'transfer of this program is strictly prohibited.  This is an unpublished
'work, and is subject to limited distribution and restricted disclosure
'only.  ALL RIGHTS RESERVED.

'Copyright (c) 1990-1991 Applied Resource Technologies, Inc.
'2305 Cedar Springs Road, Suite 150, Dallas, Texas 75201 U.S.A.
'Voice: (214) 855-0449  FAX: (214) 969-7506  BBS: (214) 855-1347

'Description: Date handling functionss

'**** FUNCTION DECLARATIONS *********************************************
'core
public   chkdate()        '  verifies date valid and not <= 0 (optional)
public   datediff1()      '  yrs,mo
public   datediff2()      '  yrs.yr fraction  (from yr_elapsed)
public   to_mildate()     '  converts date to military style i.e. "9253"
public   fm_mildate()     '  converts date to military style i.e. "9253"
public   to_busdate()     '  converts date to "julian" style i.e. "90253"
public   fm_busdate()     '  converts date to "jualin" style i.e. "90253"
public   date2num()       '  converts date to numeric order of day in yr.
public   num2date()       '  converts yr,num back to date2 format
'**** VARIABLE DECLARATIONS *********************************************
'library
public ptstr ptval currlib
'core
'**** CODE **************************************************************

MAIN
local ptpsl
ptpsl = "datelib"
'screen clear box scrheight-3 1 scrheight-3 scrwidth 0 0 no-border
'screen print scrheight-3 1 bginvpleasing bgstandard \
'             "Pop-Tools(tm)"&upper(ptpsl)& \
'             "(Copyright 1990-1991 Applied Resource Technologies, Inc.)"
if currlib = 0
     currlib = ptpsl
     lock module currlib
else
     if chr(32)|lower(currlib)|chr(32) !! chr(32)|ptpsl|chr(32)
          currlib = currlib & ptpsl
     end if
end if
if ptstr = 0
     ptstr = NULL
     lock module ptstr
end if
if ptval = 0
     ptval = BLANK
     lock module ptval
end if
END MAIN


function chkdate(d,z)
local r
r = 0
if iserr(date2(d))>=isdate(d)
     r = -1
elseif z = 1
     if days(d) <= 0
          r = -2
     end if
end if
return (r)
end function   'chkdate(d)


function datediff1(ed,bd)
local y1 y2 m1 m2 d1 d2 r
r = 0
ptstr = NULL
if chkdate(ed,0) < 0 or chkdate(bd,0) < 0
     r = -1
else
     y1 = value(year(bd))
     y2 = value(year(ed))
     m1 = value(month(bd))
     m2 = value(month(ed))
     d1 = value(day(bd))
     d2 = value(day(ed))
     if d2-d1 < 0
          m1 = m1+1
     end if
     if m1 > m2
          m2 = m2+12
          y2 = y2-1
     end if
     ptstr = (str(y2-y1)|","|str(m2-m1))
end if
return (r)
end function   'datediff1()


function datediff2(ed,bd)
local yrs y1 y2 eldoy etdoy andate andiff poy r lp1 lp2
r = 0
ptval = blank
if chkdate(ed,0) < 0 or chkdate(bd,0) < 0
     r = -1
else
     y1 = year(bd)
     y2 = year(ed)
     yrs = value(y2)-value(y1)
     eldoy  = "12/31/"|str(y2)
     etdoy  = days(eldoy)-days("12/31/"|str(y2-1))
     if (month(bd)=2 and day(bd)=29)
          lp1 = true
     end if
     if (month(ed)=2 and day(ed)=29)
          lp2 = true
     end if
     if (lp1=true and lp2=true)
          andiff = 0
     elseif (lp1=true and lp2=false)
          andate =  "02/28/"|str(y2)
          andiff = days(ed)-days(andate)+1
     else
          andate = str(month(bd))|"/"|str(day(bd))|"/"|str(y2)
          andiff = days(ed)-days(andate)
     end if
     poy    = andiff/etdoy
     ptval = (yrs+poy)
end if
return (r)
end function   'datediff2()


function to_mildate(d,z)
local r
r = 0
if chkdate(d,z) = 0
     ptstr = (right(str(@year(d)),1)| \
             right("00"|str((days(d)-days("01/01/"|str(@year(d)))+1)),3))
else
     r = -1
end if
return (r)
end function   'to_mildate()


function fm_mildate(jd,y)
local r m
r = 0
if mod(y,4)=0
     m = 9366
else
     m = 9365
end if
if value(jd) < 1 or value(jd) > m
     r = -2
elseif chkdate("01/01/"|str(y),1) < 0
     r = -1
else
     ptstr = str(adddays("01/01/"|str(y),(value(right(jd,3))-1)))
end if
return (r)
end function   'fm_mildate()


function to_busdate(d,z)
local r
r = 0
if chkdate(d,z) = 0
     ptstr = (right(str(@year(d)),2)| \
             right("00"|str((days(d)-days("01/01/"|str(@year(d)))+1)),3))
else
     r = -1
end if
return (r)
end function   'to_busdate()


function fm_busdate(jd)
local r m y
jd = str(jd)
r = 0
y = value(left(jd,2))
if mod(y,4)=0
     m = (y*1000)+366
else
     m = (y*1000)+365
end if
if value(jd) < 1 or value(jd) > m
     r = -2
elseif chkdate("01/01/"|str(y),1) < 0
     r = -1
else
     ptstr = str(adddays("01/01/"|str(y),(value(right(jd,3))-1)))
end if
return (r)
end function   'fm_busdate()


function date2num(d,z)
local r
r = 0
if chkdate(d,z) = 0
     ptstr = right("00"|str((days(d)-days("01/01/"|str(@year(d)))+1)),3)
else
     r = -1
end if
return (r)
end function   'date2num()


function num2date(d,y)
local r m
r = 0
if mod(y,4)=0
     m = 366
else
     m = 365
end if
if d < 1 or d > m
     r = -2
elseif chkdate("01/01/"|str(y),1) = -1
     r = -1
else
     ptstr = str(adddays("01/01/"|str(y),d-1))
end if
return (r)
end function   'num2date()