home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol023 / makedate.lib < prev    next >
Text File  |  1984-04-29  |  2KB  |  75 lines
  1.  
  2. {    GETDATE with no range limits
  3.  
  4.     This inputs a date in the format number-char-number-char-number
  5.     (ie: 1-22-80 or 10/5/77) and returns an integer in the range
  6.     1..maxint. Yrbase sets the initial year which will be accepted,
  7.     and yrspan determines the last year. Yrspan cannot exceed 89,
  8.     in order to remain within range.
  9.  
  10.     Note that the prompt must be passed to MAKEDATE from the calling
  11.     program.
  12.  
  13.     This package requires global declarations
  14.         TYPE    string255 = string 255;
  15.             byte = 0..255;
  16.  
  17.     The following additional procedure must be declared;
  18.         PROCEDURE prompt;
  19. }
  20.  
  21. PROCEDURE getdate (msg : string255; VAR mo, da, yr : byte);
  22.  
  23. CONST    yrspan = 89;
  24.     yrbase = 10;
  25.  
  26. VAR    ch : char;
  27.     good : boolean;
  28.     temp : integer;
  29.  
  30. begin
  31.       repeat
  32.         good := true;
  33.         prompt (msg);
  34.         readln (mo,ch,da,ch,temp);
  35.         temp := temp mod 100 - yrbase;
  36.         if (da < 1) or (da > 31) or (mo < 1) or (mo >12)
  37.             or (temp < 0) or (temp > yrspan) then
  38.             begin
  39.                 good := false;
  40.                 writeln (' *** Bad date ***')
  41.             end
  42.     until good;
  43.     yr := temp
  44. end;
  45.  
  46. FUNCTION makedate (msg : string255) : integer;
  47.  
  48. CONST    yrbase = 10;
  49.  
  50. VAR    days : integer;
  51.     da, mo, yr : byte;
  52.     str : string255;
  53.  
  54. begin
  55.     getdate (msg,mo,da,yr);
  56.     case mo of
  57.         1 : days := 0;
  58.         2 : days := 31;
  59.         3 : days := 59;
  60.         4 : days := 90;
  61.         5 : days := 120;
  62.         6 : days := 151;
  63.         7 : days := 181;
  64.         8 : days := 212;
  65.         9 : days := 243;
  66.         10 : days := 273;
  67.         11 : days := 304;
  68.         12 : days := 334;
  69.         end;
  70.     days := days + (yr*365) + (yr div 4) + da;
  71.     if ((yr + yrbase) mod 4 = 0) and (mo > 2) then days := days + 1;
  72.     makedate := days
  73. end;
  74.  
  75.