home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug027.arc / START.INC < prev    next >
Text File  |  1979-12-31  |  4KB  |  139 lines
  1. FUNCTION Exist(Filename: str14): BOOLEAN;
  2. VAR
  3.   fil: FILE;
  4. BEGIN
  5.   assign(fil,filename);
  6.   {$I-}
  7.   reset(fil) {$I+};
  8.   IF IOresult <>0
  9.     THEN exist := FALSE
  10.     ELSE exist := TRUE;
  11. END;
  12.  
  13. overlay PROCEDURE start(Var Todays_date : str11);
  14. const
  15.   Term : CharSet = [#27,^M];
  16.  
  17. var
  18.   ok          : boolean;
  19.  
  20. procedure Load_PCG;
  21. begin
  22.     {#128}
  23.     mem[-2048]:=255;mem[-2047]:=0;mem[-2046]:=0;mem[-2045]:=0;
  24.     mem[-2044]:=0;mem[-2043]:=0;mem[-2042]:=0;mem[-2041]:=0;
  25.     mem[-2040]:=0;mem[-2039]:=0;mem[-2038]:=0;
  26.     {#129}
  27.     mem[-2032]:=0;mem[-2031]:=0;mem[-2030]:=0;mem[-2029]:=0;
  28.     mem[-2028]:=0;mem[-2027]:=0;mem[-2026]:=0;mem[-2025]:=0;
  29.     mem[-2024]:=0;mem[-2023]:=0;mem[-2022]:=255;
  30. end;
  31.  
  32. PROCEDURE getfilenames;
  33. VAR
  34.   i : integer;
  35.  
  36. BEGIN { getfilenames }
  37.   infilename := ParamSTR(1);
  38.   IF (not exist(infilename + '.DAT'))
  39.     THEN
  40.       REPEAT
  41.         infilename := 'A:ANIMAL1';
  42.         gotoxy(1,8);
  43.         write('Name of Input file >  __________.DAT');
  44.         InputStr(InfileName,10,22,7,term,ch);
  45.         if infilename = '' then infilename := 'Animal';
  46.         infilename := UpCaseStr(infilename);
  47.         assign(infile,infilename + '.DAT');
  48.         IF NOT (exist(infilename + '.DAT'))  THEN
  49.           BEGIN
  50.             gotoxy(1,9);
  51.             write('File ',infilename,'.DAT does not  exist on current drive.');
  52.             select(1,22,'                     Create new file | Y | N |',['Y','N'],ch);
  53.             IF ch ='Y' THEN
  54.             begin
  55.               REWRITE(infile);
  56.               gotoxy(1,9);
  57.               clreol;
  58.             end;
  59.           end
  60.           else
  61.           reset(infile);
  62.       UNTIL exist(infilename + '.DAT') or (ch = 'N');
  63.       gotoxy(1,8);
  64.       clreol;
  65. END; { getfilenames }
  66.  
  67. BEGIN
  68.   Load_PCG;
  69.   Load_Months;
  70.   ClrScr ;
  71.   assign(Q,'CON:');
  72.   rewrite(Q);
  73.   FOR i := 1 TO 6 DO
  74.     Initialize(Animal_table[i]);
  75.   For i := 1 to 12 do
  76.     Initialize(List_Table[i]);
  77.   Line(1);
  78.   Line(21);
  79.   getfilenames;
  80.   IF ch <> 'N' THEN
  81.     BEGIN
  82.       if filesize(infile) = 0 then
  83.       begin
  84.         Initialize(Animal);
  85.         with Animal do
  86.         begin
  87.           Rec_No := 0;
  88.           Name := 'Last Update ->';
  89.           Ear_No := '!!!!!'; {This will always sort to the first record in the file}
  90.           Date_Died := '15 SEP 1986'; {The date this was written};
  91.           write(infile,Animal);
  92.         end;
  93.         Initialize(Animal);
  94.         with Animal do
  95.         begin
  96.           Rec_No := 1;
  97.           Name := 'Un Known Female';
  98.           Ear_No := '!000F';
  99.           sex    := 'F';
  100.           sire   := '!000M';
  101.           Dam    := '!000F';
  102.           write(infile,Animal);
  103.         end;
  104.         Initialize(Animal);
  105.         with Animal do
  106.         begin
  107.           Rec_No := 2;
  108.           Name := 'Un Known Male';
  109.           Ear_No := '!000M';
  110.           sex    := 'F';
  111.           sire   := '!000M';
  112.           Dam    := '!000F';
  113.           write(infile,Animal);
  114.         end;
  115.       end;
  116.       seek(infile,0);
  117.       read(infile,Animal);
  118.     dis(1,2,'           Database.                                          ');
  119.     dis(1,2,infilename);
  120.     GotoXY(60,2);
  121.     Display_Recs_Used;
  122.       Animal.Date_Born := Animal.Date_Died;
  123.       Todays_Date := Animal.Date_Born;
  124.         ok := false;
  125.         dis(1,22,'                                  | ^Z = ABORT      | <ESC> = FINISHED    |');
  126.         repeat
  127.           gotoxy(9,12);
  128.           write('Todays Date : ',Todays_Date);
  129.           getdate(todays_date,11);
  130.           verify_date(Todays_date,ok);
  131.           gotoxy(1,12);
  132.           clreol;
  133.         until ok;
  134.         Animal.Date_Died := Todays_Date;
  135.         seek(infile,0);
  136.         write(infile,Animal);
  137.     end;
  138. END;
  139.