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