{ RGETDATE with range This is similar to getdate, except that a year range is specified, with dates outside that range being rejected. This routine uses the same base year as standard GETDATE, so that compatibility of the derived integer is maintained. The following global type declarations are required: TYPE string255 = string 255; byte = 0..255; The following additional procedure must be declared: PROCEDURE prompt; } PROCEDURE rgetdate (msg : string255; minyr, maxyr : byte; VAR mo, da, yr : byte); CONST yrspan = 89; yrbase = 10; VAR ch : char; good : boolean; temp : integer; begin repeat good := true; prompt (msg); readln (mo,ch,da,ch,temp); temp := temp mod 100; if (da < 1) or (da > 31) or (mo < 1) or (mo >12) or (temp < minyr) or (temp > maxyr) then begin good := false; writeln (' *** Bad date ***') end until good; yr := temp - yrbase end; FUNCTION rmakedate (msg : string255; minyr, maxyr : byte) : integer; CONST yrbase = 10; VAR days : integer; da, mo, yr : byte; str : string255; begin rgetdate (msg,minyr,maxyr,mo,da,yr); case mo of 1 : days := 0; 2 : days := 31; 3 : days := 59; 4 : days := 90; 5 : days := 120; 6 : days := 151; 7 : days := 181; 8 : days := 212; 9 : days := 243; 10 : days := 273; 11 : days := 304; 12 : days := 334; end; days := days + (yr*365) + (yr div 4) + da; if ((yr + yrbase) mod 4 = 0) and (mo > 2) then days := days + 1; rmakedate := days end;