home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG027.ARC / TTEDIT.INC < prev    next >
Text File  |  1979-12-31  |  1KB  |  54 lines
  1.  
  2. PROCEDURE edit( Animal : Animal_rec);
  3. Label
  4.   Escape;
  5. VAR
  6.   ch     : CHAR;
  7.   ear    : str5;
  8.   name   : str20;
  9. BEGIN
  10.   dis(1,2,'                            E D I T         M E N U      ');
  11.   DisDate;
  12.   dis(1,17,foot3);
  13.   ClrEOL;
  14.   ear := Animal.ear_no;
  15.   name := Animal.Name;
  16.   repeat
  17.     inputAnimal(Animal,ch);
  18.     dis(1,2,' ');
  19.     if ch = ^Z then goto escape;
  20.     if Animal.ear_no = ear then
  21.       begin
  22.         ok := false;
  23.       end
  24.     else
  25.       begin
  26.         FindKey(EarIndexFile,I,Animal.Ear_No);
  27.         if OK then
  28.         begin
  29.           GotoXY(10,9);
  30.           LowVideo;
  31.           Write(' D U P L I C A T E    Ear number ');
  32.           NormVideo;
  33.           BEEP;
  34.         end;
  35.       end;
  36.   until Not OK;
  37.   GotoXY(10,9);
  38.   Write('                                   ');
  39.   PutRec(DatF,Ptr,Animal);
  40.   UpDate_Animal_Table(Animal);
  41.   if Animal.Ear_No <> Ear then
  42.   begin
  43.     DeleteKey(EarIndexFile,Ptr,Ear);
  44.     AddKey   (EarIndexFile,Ptr,Animal.Ear_No);
  45.   end;
  46.   if Animal.Name <> Name then
  47.   begin
  48.     DeleteKey(NameIndexFile,Ptr,Name);
  49.     AddKey   (NameIndexFile,Ptr,Animal.Name);
  50.   end;
  51.   escape:
  52. END;
  53.  
  54.