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 / TTUPDATE.INC < prev    next >
Text File  |  1979-12-31  |  5KB  |  172 lines
  1. PROCEDURE find;
  2. LABEL
  3.   escape;
  4. VAR
  5.   k,l   : INTEGER;
  6.   dummy : str20;
  7.   tc    : CHAR;
  8.   ok2   : integer;
  9. BEGIN
  10.   line(1);
  11.   dis(1,2,'                            F I N D         M E N U        ');
  12.   DisDate;
  13.     Display_Recs_Used;
  14.   line(16);
  15.   dis(1,17,'      Type in Ear Number          | ^Z = ABORT      |');
  16.   ClrEOL;
  17.   dummy := '';
  18.   inputstr(dummy,5,22,3,[^M,^Z],TC);
  19.   IF tc = ^Z
  20.     THEN GOTO escape;
  21.   IF dummy <> ''
  22.     THEN
  23.       BEGIN
  24.         dummy := UpcaseStr(dummy);
  25.         fillup(dummy);
  26.         FindKey(EarIndexFile,Ptr,Dummy);
  27.         if ok then
  28.           begin
  29.             GetRec(DatF,Ptr,Animal);
  30.           end;
  31.       END
  32.     ELSE
  33.       BEGIN
  34.         dis(1,17,'      Type in Full Name           | ^Z = ABORT      |');
  35.         ClrEOL;
  36.         dummy := '';
  37.         inputstr(dummy,20,46,3,[^M,^Z],TC);
  38.         IF tc = ^Z
  39.           THEN GOTO escape;
  40.         IF dummy <> '' THEN
  41.             BEGIN
  42.               SearchKey(NameIndexFile,Ptr,Dummy);
  43.               if not ok then
  44.               PrevKey(NameIndexFile,Ptr,Dummy);
  45.               repeat
  46.                 GetRec(DatF,Ptr,Animal);
  47.                 DisplayForm;
  48.                 Display_Animal(Animal);
  49.                 dis(1,17,'   |   |   |   |   |   | N = Next | P = Previous    | <ESC> = UPDATE MENU |');
  50.                 select(74,17,' ',['N','P',#27],ch);
  51.                 case ch of
  52.                    'N' : repeat NextKey(NameIndexFile,Ptr,Dummy) until ok;
  53.                    'P' : repeat PrevKey(NameIndexFile,Ptr,Dummy) until ok;
  54.                  end; {case}
  55.               until ch = #27;
  56.             END;
  57.       END;
  58.     line(1);
  59.     dis(1,2,'                            E D I T         M E N U      ');
  60.     DisDate;
  61.     display_Animal(Animal);
  62.     line(16);
  63.     dis(1,17,'   |   |   |   |   |   | E = Edit | D = Delete      | <ESC> = UPDATE MENU |');
  64.     f_table;
  65.     LowVideo;
  66.     dis(1,15,'P/table No, E, D or <ESC>');
  67.     NormVideo;
  68.     repeat
  69.       k := 0;
  70.       select(74,17,' ',['1','2','3','4','5','6','E','D',#27],ch);
  71.       val(ch,k,ok2);
  72.       IF k IN [1..6] THEN Animals_table(k,Animal);
  73.     until (ch = #27) or (ch = 'E') or (ch = 'D');
  74.     dis(1,15,'                         ');
  75.     CASE ch OF
  76.       'E' : BEGIN
  77.               edit(Animal);
  78.             END;
  79.       'D' : BEGIN
  80.               with Animal do
  81.               begin
  82.                 DeleteKey(EarIndexFile,Ptr,Ear_No);
  83.                 DeleteKey(NameIndexFile,Ptr,Name);
  84.                 DeleteRec(DatF,Ptr);
  85.               end;
  86.             END;
  87.        ELSE ch := ^M;
  88.     END;{case fo ch}
  89.     escape:
  90. END;
  91.  
  92.  
  93. PROCEDURE Add;
  94. (*  Add is used to add a Animal *)
  95. var
  96.   ear   : str5;
  97.   k,ok2 : integer;
  98.   DataF : integer;
  99. BEGIN
  100.   dis(1,17,'   |   |   |   |   |   |          | ^Z = ABORT      | <ESC> = FINISHED    |');
  101.   ClrEOL;
  102.   F_TABLE;
  103.   ear := '';
  104.   Initialize(Animal);
  105.   FillChar(Animal,SizeOf(Animal),0);
  106.   repeat
  107.     InputAnimal(Animal,CH);
  108.     FindKey(EarIndexFile,DataF,Animal.Ear_No);
  109.     if ok then
  110.       begin
  111.         GotoXY(10,9);
  112.         LowVideo;
  113.         Write(' D U P L I C A T E    Ear number ');
  114.         NormVideo;
  115.       end;
  116.   until not ok;
  117.   IF ch = #27 THEN
  118.       BEGIN
  119.         Animal.Rec_No := UsedRecs(DatF) + 1;
  120.         AddRec(DatF,DataF,Animal);
  121.         AddKey(EarIndexFile,DataF,Animal.Ear_No);
  122.         AddKey(NameIndexFile,DataF,Animal.Name);
  123.         ch := ' ';
  124.       END;
  125.     repeat
  126.       LowVideo;
  127.       dis(1,15,'P/table No or <ESC>');
  128.       NormVideo;
  129.       k := 0;
  130.       select(74,17,' ',['1','2','3','4','5','6','E','D',#27],ch);
  131.       val(ch,k,ok2);
  132.       IF k IN [1..6] THEN Animals_table(k,Animal);
  133.       f_table;
  134.     until (ch = #27) or (k in [1..6]);
  135.     ch := ^M;
  136. END;
  137.  
  138. BEGIN(* Update*)
  139.   line(1);
  140.   dis(1,2,'                          U P D A T E       M E N U        ');
  141.   disdate;
  142.   REPEAT
  143.     gotoxy(1,2);
  144.     Display_Recs_Used;
  145.     DisplayForm;
  146.     k := 0;
  147.     line(16);
  148.     dis(1,17,'   |   |   |   |   |   | A = Add  | F = Find        | <ESC> = MAIN   MENU |');
  149.     f_table;
  150.     select(74,17,' ',['1','2','3','4','5','6','A','F',#27],Ch);
  151.     val(ch,k,ok2);
  152.     IF k IN [1..6]
  153.       THEN BEGIN
  154.              IF Animal_table[k].rec_no <> -1
  155.                THEN BEGIN
  156.                       FindKey(EarIndexFile,Ptr,Animal_Table[k].Ear_No);
  157.                       GetRec(DatF,Ptr,Animal);
  158.                       display_Animal(Animal);
  159.                       edit(Animal);
  160.                  END;
  161.         END
  162.       ELSE
  163.         CASE Ch OF
  164.           'A' : Add;
  165.           'F' : Find;
  166.         END;
  167.   Update_Animal_Table(Animal);
  168.   UNTIL Ch = #27;
  169.   clrscr;
  170. END;
  171.  
  172.