home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol023 / rmakeda.lib < prev    next >
Text File  |  1984-04-29  |  2KB  |  73 lines
  1.  
  2. {    RGETDATE    with range
  3.  
  4.     This is similar to getdate, except that a year range is specified,
  5.     with dates outside that range being rejected.
  6.  
  7.     This routine uses the same base year as standard GETDATE, so that
  8.     compatibility of the derived integer is maintained.
  9.  
  10.     The following global type declarations are required:
  11.         TYPE    string255 = string 255;
  12.             byte = 0..255;
  13.  
  14.     The following additional procedure must be declared:
  15.         PROCEDURE prompt;
  16. }
  17.  
  18. PROCEDURE rgetdate (msg : string255; minyr, maxyr : byte;
  19.             VAR mo, da, yr : byte);
  20.  
  21. CONST    yrspan = 89;
  22.     yrbase = 10;
  23.  
  24. VAR    ch : char;
  25.     good : boolean;
  26.     temp : integer;
  27.  
  28. begin
  29.       repeat
  30.         good := true;
  31.         prompt (msg);
  32.         readln (mo,ch,da,ch,temp);
  33.         temp := temp mod 100;
  34.         if (da < 1) or (da > 31) or (mo < 1) or (mo >12)
  35.             or (temp < minyr) or (temp > maxyr) then
  36.             begin
  37.                 good := false;
  38.                 writeln (' *** Bad date ***')
  39.             end
  40.     until good;
  41.     yr := temp - yrbase
  42. end;
  43.  
  44. FUNCTION rmakedate (msg : string255; minyr, maxyr : byte) : integer;
  45.  
  46. CONST    yrbase = 10;
  47.  
  48. VAR    days : integer;
  49.     da, mo, yr : byte;
  50.     str : string255;
  51.  
  52. begin
  53.     rgetdate (msg,minyr,maxyr,mo,da,yr);
  54.     case mo of
  55.         1 : days := 0;
  56.         2 : days := 31;
  57.         3 : days := 59;
  58.         4 : days := 90;
  59.         5 : days := 120;
  60.         6 : days := 151;
  61.         7 : days := 181;
  62.         8 : days := 212;
  63.         9 : days := 243;
  64.         10 : days := 273;
  65.         11 : days := 304;
  66.         12 : days := 334;
  67.         end;
  68.     days := days + (yr*365) + (yr div 4) + da;
  69.     if ((yr + yrbase) mod 4 = 0) and (mo > 2) then days := days + 1;
  70.     rmakedate := days
  71. end;
  72.  
  73.