STATISTICA Basic Program: JulianDates.stb

Products Services Solutions Support Downloads Customers Partners Company

Home I Electronic Statistics Textbook I Contact Us I Request Quote I Search

STATISTICA BASIC Program JulianDates.stb

{ This program will allow a user to enter any date (after 1900) and will return the Julian value for that date. The month may be entered as text or number, the first character will determine which type has been used. The Julian value is the numeric representation of a calendar date which is used internally by STATISTICA and other spreadsheet style programs.
Please note that this program is only intended for use in association with STATISTICA and in most cases it does not give the true number of days beyond 1/1/1900. This is due to a historical inaccuracy in software where the year 1900 was incorrectly assigned to include a leap year day. This is described as follows in Microsoft's technical support Web pages, "When the date system in Microsoft Excel was originally created, it was designed to be fully compatible with date systems used by other spreadsheet programs. However, in this date system, the year 1900 is incorrectly interpreted as a leap year." Unfortunately, the same inaccuracy must be included in STATISTICA for compatibility reasons.

Program written, modified, or edited at StatSoft, Inc.}

RandomAccess;
NoDataFileVariableNames;

REDO:

month := 0;
day := 0;
year := 0;

{obtain the user input}

monthlist$ := 'Jan|Feb|Mar|Apr|May|June|July|Aug|Sep|Oct|Nov|Dec';

if 0 = DisplayInputBox ('Enter Date:',
	'Month (Text/Number)|Day|Year (In Full)', date$)
	then STOP;

GetDelimitedString (date$, 1, month$);
GetDelimitedString (date$, 2, day$);
GetDelimitedString (date$, 3, year$);

if (Len (month$) > 10) or (Len (day$) > 10) or (Len (year$) > 10) then begin
	DisplayMessageBox (MB_OK, 'Error', 'Your entry was invalid, please re-enter.');
	GOTO redo;
end;


{deal with year}

year := Val (year$);

if (year < 1900) then begin
	DisplayMessageBox (MB_OK, 'Error', 'Julian Dates begin in 1900, please re-enter.');
	GOTO redo;
end;

if (year > 9999) then begin
	DisplayMessageBox (MB_OK, 'Error', 'The last available year is 9999, please re-enter.');
	GOTO redo;
end;

if (year - trunc(year) > 0) then begin
	DisplayMessageBox (MB_OK, 'Error', 'The year must be an integer, please re-enter.');
	GOTO redo;
end;

{deal with month}

month$ := UpCase (month$);
if Mid (month$, 1, 2) = 'JA' then month := 1;
if Mid (month$, 1, 1) = 'F' then month := 2;
if Mid (month$, 1, 3) = 'MAR' then month := 3;
if Mid (month$, 1, 2) = 'AP' then month := 4;
if Mid (month$, 1, 3) = 'MAY' then month := 5;
if Mid (month$, 1, 3) = 'JUN' then month := 6;
if Mid (month$, 1, 3) = 'JUL' then month := 7;
if Mid (month$, 1, 2) = 'AU' then month := 8;
if Mid (month$, 1, 1) = 'S' then month := 9;
if Mid (month$, 1, 1) = 'O' then month := 10;
if Mid (month$, 1, 1) = 'N' then month := 11;
if Mid (month$, 1, 1) = 'D' then month := 12;

if (month = 0) and (Val (Mid (month$, 1, 1)) > 0) then month := Val (month$);

if (month < 1) or (month > 12) or (month - Trunc (month) > 0) then begin
	DisplayMessageBox (MB_OK, 'Error', 'The month is invalid, please re-enter.');
	GOTO redo;
end;

{deal with day}

day := Val (day$);

if (day < 1) or (day > 31) or (day - trunc (day) > 0) then begin
	DisplayMessageBox (MB_OK, 'Error', 'The day is invalid, please re-enter.');
	GOTO redo;
end;

if ((month = 4) or (month = 6) or (month = 9) or (month = 11)) and (day > 30) then begin
	DisplayMessageBox (MB_OK, 'Error', 'The day is invalid, please re-enter.');
	GOTO redo;
end;

parts := 4*((year/4)-trunc(year/4));
	if (parts = 0) and (((year/100) - trunc(year/100)) > 0) then lastleap := 1 else lastleap := 0;
	if ((year/400) - trunc(year/400)) = 0 then lastleap := 1;
	if year = 1900 then lastleap := 1;

if (month = 2) and (day > 28+lastleap) then begin
	DisplayMessageBox (MB_OK, 'Error', 'The day is invalid, please re-enter.');
	GOTO redo;
end;



{start counting the number of days}

n_days := 0;

{loop through every year and add either 365/366}

if year > 1900 then for i := 1900 to (year-1) do begin
	parts := 4*((i/4)-trunc(i/4));
	if (parts = 0) and (((i/100) - trunc(i/100)) > 0) then leap := 1 else leap := 0;
	if ((i/400) - trunc(i/400)) = 0 then leap := 1;
	if i = 1900 then leap := 1;
	n_days := n_days + 365 + leap;
end;

{add days for the completed months}

if month > 1 then n_days := n_days + 31;
if month > 2 then n_days := n_days + 28 + lastleap;
if month > 3 then n_days := n_days + 31;
if month > 4 then n_days := n_days + 30;
if month > 5 then n_days := n_days + 31;
if month > 6 then n_days := n_days + 30;
if month > 7 then n_days := n_days + 31;
if month > 8 then n_days := n_days + 31;
if month > 9 then n_days := n_days + 30;
if month > 10 then n_days := n_days + 31;
if month > 11 then n_days := n_days + 30;

{add the number of days in the final month}

n_days := n_days + day;


{now make a Scrollsheet display}

GetDelimitedString (monthlist$, month, month$);

dateout := NewScrollsheet (1, 1, n_days, 'This is the Equivalent Julian Value',
	month$ + ' ' + Mid (day$, 1, (1+(day > 9))) + ' ' + Mid (year$, 1, 4), 'Julian Value');
ScrollsheetSetColumnFormat (dateout, 1, SCF_Integer, 8);
ScrollsheetSetRowNameWidth (dateout, 12);
ScrollsheetSetColumnWidth (dateout, 20, 2);

GOTO redo;

Back to List of Programs

[StatSoft]
2300 East 14th Street, Tulsa, OK 74104
Phone: (918) 749-1119; Fax: (918) 749-2217
e-mail: info@statsoft.com