home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol071 / age.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  2.6 KB  |  118 lines
  1.  
  2. program xage; {$c-,f-,m-}
  3. type
  4. byte=0..255;
  5.  
  6. date=record
  7.     month:byte;
  8.     day:byte;
  9.     year:byte;
  10.     end;
  11.  
  12. var
  13. reference_date,current_date,birthday:date;
  14. cont:char;
  15. continue:boolean;
  16.  
  17. function age (current_date,birthday:date):real;
  18. var
  19. days_elapse_from_birth_to_current_date,years,days,months:integer;
  20. years_of_age:byte;
  21. months_of_age:real;
  22. days_from_reference_to_current_date,days_birthday_to_reference:integer;
  23.  
  24.  
  25.  
  26.  
  27. function elapse_time(date_to_use:date):integer;  {internal function}
  28. var
  29. pastdays:byte;
  30.  
  31. begin
  32. years:=0;
  33. days:=0;
  34. years:= (date_to_use.year - reference_date.year); 
  35.  
  36. case date_to_use.month of 
  37. 1:    days:= 0;
  38. 2:    days:= 31;
  39. 3:    days:= 59;
  40. 4:    days:= 90;
  41. 5:    days:= 120;
  42. 6:    days:= 151;
  43. 7:    days:= 181;
  44. 8:    days:= 212;
  45. 9:    days:= 243;
  46. 10:    days:= 273;
  47. 11:    days:= 304;
  48. 12:    days:= 334;
  49. end;
  50.  
  51. days:= days + date_to_use.day + (years div 4); {+ days so far in month
  52.                           and correct for leap years}
  53. days:= days + (years*365); {now add in days of years gone by}
  54. {days should now = total days from date of test to reference year }
  55. elapse_time:=days;
  56. end; {of internal procedure elapse time}
  57.  
  58.  
  59.  
  60. begin { of function age}
  61. years_of_age:=0;
  62. months_of_age:=0;
  63.  
  64. days_from_reference_to_current_date:= elapse_time(current_date);
  65. days_birthday_to_reference:= elapse_time(birthday);
  66.  
  67. days_elapse_from_birth_to_current_date:=
  68.  (days_from_reference_to_current_date - days_birthday_to_reference); 
  69.  
  70. years_of_age:= days_elapse_from_birth_to_current_date div 365;
  71. months_of_age:=
  72.     (days_elapse_from_birth_to_current_date mod 365) div 30;
  73.  
  74. writeln('years and months of age are= ',years_of_age:3,months_of_age:5:3);
  75. {debug}
  76.  
  77.  
  78. if months_of_age > 9 then months_of_age:= months_of_age/100 else 
  79.                   months_of_age:= months_of_age/10;
  80.  
  81. {convert months of age to decimal representing number of months, not
  82.  fraction of year, eg. age = 12.5 means 12 years and 5 months}
  83.  
  84.  
  85. age:= years_of_age + months_of_age;
  86.  
  87. end; {of procedure}
  88.  
  89.  
  90. begin {of main program}
  91. continue:= true;
  92.  
  93. reference_date.month:=1;
  94. reference_date.day:=1;
  95. reference_date.year:=40;
  96.  
  97. while continue do
  98.     begin
  99.     writeln(chr(27),'[2J',chr(27),'[1;1H'); {clear screen}
  100.    writeln('Calculate the age of a patient given birth and current date.');
  101.  
  102. write('Enter current date as  mm, dd,  yy   ');
  103. readln(current_date.month, current_date.day, current_date.year);
  104.  
  105. writeln;
  106. write('Enter date of birth as mm, dd, yy  ');
  107. readln(birthday.month, birthday.day, birthday.year);
  108.  
  109.  
  110.  
  111. writeln;
  112. writeln;
  113. writeln('Age is : ',age(current_date,birthday):2:2, ' years');
  114.  
  115. readln(cont);
  116. if cont = chr(27) then continue:= false;
  117. end; {of while}
  118. end.