home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / mailit.zip / MADDETC.INC < prev    next >
Text File  |  1986-03-07  |  15KB  |  501 lines

  1.   { File = MADDETC.INC -- Include file for Reliance Mailing List
  2.     Copyright (c) 1986 William Meacham, All Rights Reserved
  3.     Revised : 3/2/86 }
  4.  
  5. { ----------------------------------------------------------- }
  6.  
  7. overlay procedure do_name (opt : option) ;
  8.   { Add, display/change, delete and record contribution for a name }
  9.  
  10. { ==================== }
  11.  
  12. procedure add_name ;
  13.   { add a name and address record -- get input from screen and
  14.     insert into database }
  15.  
  16.   label 99 ;
  17.  
  18.   const
  19.     full_msg : string[30] = 'CANNOT ADD -- THE FILE IS FULL' ;
  20.  
  21.   var
  22.     save_it,
  23.     some_added,
  24.     do_another : boolean ;
  25.  
  26.   begin
  27.     clrscr ;
  28.     write_str ('ADD A NAME',34,1) ;
  29.     paint_screen(1) ;
  30.  
  31.     if scr.num_recs >= scr.max_rec then
  32.       begin
  33.         show_msg(full_msg) ;
  34.         goto 99
  35.       end ;
  36.  
  37.     open_database ;
  38.     some_added := false ;
  39.     repeat
  40.         clear_display ;
  41.         clear_master ;
  42.         input_master ;
  43.         if fld = maxint then
  44.             save_it := false
  45.         else
  46.           begin
  47.             write_str ('Do you wish to save this information? (Y/N)',16,23) ;
  48.             read_yn (save_it,60,23) ;
  49.             clrline(16,23)
  50.           end ;
  51.         if save_it then
  52.           begin
  53.             key1 := build_key1 (master.last_name) ;
  54.             key2 := build_key2 (master.last_name,master.zip) ;
  55.             addrec (mf_file,rec_num,master) ;
  56.             addkey (ix1_file,rec_num,key1) ;
  57.             addkey (ix2_file,rec_num,key2) ;
  58.             write_str ('SAVED',16,23) ;
  59.             some_added := true
  60.           end  { if save_it }
  61.         else
  62.             write_str ('NOT SAVED',16,23) ;
  63.  
  64.         write_str ('Do you wish to add another name? (Y/N)',16,24) ;
  65.         read_yn (do_another,55,24) ;
  66.         if  do_another
  67.         and (usedrecs(mf_file) >= scr.max_rec) then
  68.           begin
  69.             show_msg (full_msg) ;
  70.             do_another := false
  71.           end
  72.     until not do_another ;
  73.  
  74.     if some_added then
  75.       begin
  76.         scr.num_recs := usedrecs (mf_file) ;
  77.         write_scr
  78.       end ;
  79.     close_database ;
  80. 99:
  81.     fld := 1
  82.   end ; { proc add_name }
  83.  
  84. { ==================== }
  85.  
  86. procedure get_index (code : char) ;
  87.   { Input name to display/change or delete, construct key,
  88.     search index, return global variables Key1 and Rec_num }
  89. label  99 ;
  90. var
  91.     name        : str30 ;
  92.     get_closest : boolean ;
  93. begin
  94.     clrscr ;
  95.     if code = 'C' then
  96.         write_str ('DISPLAY OR CHANGE A NAME',28,2)
  97.     else if code = 'D' then
  98.         write_str ('DELETE A NAME',33,2)
  99.     else { code = 'R' }
  100.         write_str ('RECORD A CONTRIBUTION',30,2) ;
  101.     write_str ('Press ESC to cancel',31,3) ;
  102.  
  103.     if scr.num_recs = 0 then
  104.       begin
  105.         show_msg ('THE FILE IS EMPTY') ;
  106.         fld := maxint ;
  107.         goto 99
  108.       end ;
  109.  
  110.     write_str ('Last name:',19,6) ;
  111.     name := '' ;
  112.     fld := 1 ;
  113.     repeat
  114.         case fld of
  115.           1: begin
  116.               read_str (name,30,30,6) ;
  117.               if (name = '') and not (fld = maxint) then
  118.                 begin
  119.                   beep ;
  120.                   fld := 1
  121.                 end
  122.               else if (fld > 1) and (fld < maxint) then
  123.                   fld := 2
  124.              end ; { 1 }
  125.           2: begin
  126.               key1 := build_key1(name) ;
  127.               findkey (ix1_file,rec_num,key1) ;
  128.               if OK then
  129.                   fld := 3
  130.               else
  131.                 begin
  132.                   write_str ('NAME NOT FOUND',19,10) ;
  133.                   write_str ('Do you wish to view the closest one found?',19,12) ;
  134.                   write_str ('(Y/N)',33,14) ;
  135.                   get_closest := true ;
  136.                   read_bool (get_closest,39,14) ;
  137.                   if fld < 2 then
  138.                     begin
  139.                       clrline (19,10) ;
  140.                       clrline (19,12) ;
  141.                       clrline (33,14)
  142.                     end
  143.                   else if (fld > 2) and (fld < maxint) then
  144.                     begin
  145.                       if get_closest then
  146.                         begin
  147.                           prevkey (ix1_file,rec_num,key1) ;
  148.                           if not OK then
  149.                               searchkey (ix1_file,rec_num,key1)
  150.                         end
  151.                       else { not get_closest }
  152.                         begin
  153.                           clrline (19,10) ;
  154.                           clrline (19,12) ;
  155.                           clrline (33,14) ;
  156.                           fld := 1
  157.                         end
  158.                     end { if (fld > 2) ... }
  159.                 end  { else, not OK }
  160.              end { 2 }
  161.         end ; { case }
  162.         if fld < 1 then fld := 1
  163.     until fld > 2 ;
  164. 99:
  165.       { the calling proc must check for fld = maxint }
  166. end ; { function get_index }
  167.  
  168. { ==================== }
  169.  
  170. procedure prev_next_menu (code : char) ;
  171.   begin
  172.     write_str('SELECT:  1    Display previous name',20,18) ;
  173.     write_str('2    Display next name',29,19) ;
  174.     write_str('3    ',29,20) ;
  175.     if code = 'C' then
  176.         write ('CHANGE')
  177.     else if code = 'D' then
  178.         write ('DELETE')
  179.     else
  180.         write ('RECORD CONTRIBUTION for') ;
  181.     write (' this name') ;
  182.     write_str('ESC  Cancel            ==>',29,21) ;
  183.   end ; { proc prev_next_menu }
  184.  
  185. { ==================== }
  186.  
  187. procedure choose_name (var code : char) ;
  188. { Select record to update, delete or record a contribution for.
  189.   Returns: valid rec_num and key1 if a name is selected;
  190.            fld = maxint if user cancelled while displaying names;
  191.            ch = 'Q' if user cancelled while entering name to search for. }
  192.  
  193.   begin
  194.     get_index (code) ;  { this updates globals rec_num and key1 }
  195.     if fld = maxint then
  196.         code := 'Q'
  197.     else
  198.       begin
  199.         clrscr ;
  200.         if code = 'C' then
  201.             write_str ('DISPLAY OR CHANGE A NAME',28,1)
  202.         else if code = 'D' then
  203.             write_str ('DELETE A NAME',33,1)
  204.         else { code = 'R' }
  205.             write_str ('RECORD A CONTRIBUTION',30,1) ;
  206.         paint_screen(1) ;
  207.         prev_next_menu (code) ;
  208.         getrec (mf_file,rec_num,master) ;
  209.         repeat
  210.             clear_display ;
  211.             display_master ;
  212. (*            write_str ('record ',2,18) ; write (rec_num,'     ') ;   *)
  213. (*            write_str ('key    ',2,19) ; write (key1,'     ') ;      *)
  214.             choice := 0 ;
  215.             repeat
  216.                 fld := 1 ;
  217.                 read_int(choice,1,56,21)
  218.             until ((choice in [1..3]) and (fld > 1)) or (fld = maxint) ;
  219.             case choice of
  220.              1: get_prev_rec ;
  221.              2: get_next_rec
  222.             end ; { case }
  223.         until (choice = 3) or (fld = maxint)
  224.       end  { else }
  225.         { the calling proc must check for fld = maxint and code = 'Q' }
  226.   end ; { proc choose_name }
  227.  
  228. { ==================== }
  229.  
  230. procedure change_name ;
  231. { display / change name & address information }
  232.  
  233.   label 99 ;
  234.  
  235.   var
  236.     save_it,
  237.     do_another : boolean ;
  238.     i          : integer ;
  239.     entryname  : str30 ;
  240.     entryzip   : str9 ;
  241.     code       : char ;
  242.  
  243.   begin
  244.     open_database ;
  245.     repeat
  246.         code := 'C' ;
  247.         choose_name (code) ;
  248.         if code = 'Q' then
  249.           begin
  250.             do_another := false ;
  251.             goto 99
  252.           end ;
  253.  
  254.         for i := 18 to 21 do
  255.             clrline (1,i) ;
  256.         if not (fld = maxint) then
  257.           begin
  258.             entryname := master.last_name ;
  259.             entryzip := master.zip ;
  260.             input_master
  261.           end ;
  262.  
  263.         if fld = maxint then
  264.             save_it := false
  265.         else
  266.           begin
  267.             write_str ('Do you wish to save this information? (Y/N)',16,23) ;
  268.             read_yn (save_it,60,23) ;
  269.             clrline (16,23)
  270.           end ;
  271.         if save_it then           { save the record }
  272.           begin                   { change the keys if needed }
  273.               if not (entryzip = master.zip)
  274.               or not (entryname = master.last_name) then
  275.                 begin
  276.                   key2 := build_key2 (entryname,entryzip) ;
  277.                   deletekey (ix2_file,rec_num,key2) ;
  278.                   key2 := build_key2 (master.last_name,master.zip) ;
  279.                   addkey (ix2_file,rec_num,key2) ;
  280.                 end ;
  281.               if not (entryname = master.last_name) then
  282.                 begin
  283.                   key1 := build_key1 (entryname) ;
  284.                   deletekey (ix1_file,rec_num,key1) ;
  285.                   key1 := build_key1 (master.last_name) ;
  286.                   addkey (ix1_file,rec_num,key1) ;
  287.                 end ;
  288.               putrec (mf_file,rec_num,master) ;
  289.               write_str ('SAVED',16,23)
  290.           end  { if save_it }
  291.         else
  292.             write_str ('NOT SAVED',16,23) ;
  293.  
  294.         write_str ('Do you wish to change another name? (Y/N)',16,24) ;
  295.         read_yn (do_another,58,24) ;
  296. 99:
  297.     until not do_another ;
  298.     close_database ;
  299.     fld := 1
  300.   end ; { proc change_name }
  301.  
  302. { ==================== }
  303.  
  304. procedure delete_name ;
  305. { delete a name and address record }
  306.  
  307.   label 99 ;
  308.  
  309.   var
  310.     i             : integer ;
  311.     some_deleted,
  312.     do_another    : boolean ;
  313.     code          : char ;
  314.  
  315.   procedure bad_delete ;
  316.     begin
  317.       show_msg ('ERROR DELETING -- REBUILD DATABASE') ;
  318.       scr.num_recs := usedrecs(mf_file) ;
  319.       write_scr ;
  320.       close_database ;
  321.       halt
  322.     end ;
  323.  
  324.   begin
  325.     open_database ;
  326.     some_deleted := false ;
  327.     repeat
  328.         code := 'D' ;
  329.         choose_name (code) ;
  330.         if code = 'Q' then
  331.           begin
  332.             do_another := false ;
  333.             goto 99
  334.           end ;
  335.  
  336.         for i := 18 to 21 do
  337.             clrline (1,i) ;
  338.         if fld = maxint then
  339.             write_str ('NOT DELETED',16,23)
  340.         else                                  { delete the record }
  341.           begin
  342.             deletekey (ix1_file,rec_num,key1) ;
  343.             if OK then
  344.               begin
  345.                 key2 := build_key2 (master.last_name,master.zip) ;
  346.                 deletekey (ix2_file,rec_num,key2) ;
  347.                 if OK then
  348.                   begin
  349.                     deleterec (mf_file,rec_num) ;
  350.                     if OK then
  351.                       begin
  352.                         write_str ('DELETED',16,23) ;
  353.                         some_deleted := true
  354.                       end
  355.                     else
  356.                         bad_delete
  357.                   end
  358.                 else
  359.                     bad_delete
  360.               end
  361.             else
  362.                 bad_delete
  363.           end ;  { else, delete the record }
  364.  
  365.         write_str ('Do you wish to delete another name? (Y/N)',16,24) ;
  366.         read_yn (do_another,58,24) ;
  367. 99:
  368.     until not do_another ;
  369.     if some_deleted then
  370.       begin
  371.         scr.num_recs := usedrecs(mf_file) ;
  372.         write_scr
  373.       end ;
  374.     close_database ;
  375.     fld := 1
  376.   end ; { proc delete_name }
  377.  
  378. { ------------------------------ }
  379.  
  380. procedure record_contribution ;
  381.  
  382.   label 99 ;
  383.  
  384.   var
  385.     save_it,
  386.     do_another : boolean ;
  387.     i          : integer ;
  388.     new_amt,
  389.     new_tot    : real ;
  390.     new_date   : date ;
  391.     code       : char ;
  392.  
  393.   begin
  394.     open_database ;
  395.     repeat
  396.         code := 'R' ;
  397.         choose_name (code) ;
  398.         if code = 'Q' then
  399.           begin
  400.             do_another := false ;
  401.             goto 99
  402.           end ;
  403.  
  404.         for i := 18 to 21 do
  405.             clrline (1,i) ;
  406.         if not (fld = maxint) then
  407.           begin
  408.             new_amt := 0.0 ;
  409.             new_tot := master.tot_amt ;
  410.             new_date := null_date ;
  411.             write_str ('Previous total: $',24,18) ;
  412.             write_real (master.tot_amt,wid,frac,42,18) ;
  413.             write_str ('Contribution:',26,19) ;
  414.             write_str ('New total:',29,20) ;
  415.             write_real (master.tot_amt,wid,frac,42,20) ;
  416.             write_str ('Date:',34,21) ;
  417.             write_date (new_date,44,21) ;
  418.             fld := 1 ;
  419.  
  420.             repeat
  421.                 case fld of
  422.                   1 : begin
  423.                         read_real (new_amt,wid,frac,42,19) ;
  424.                         if (fld > 1) and (fld < maxint) then
  425.                           begin
  426.                             if not(greater(new_amt,0.0)) then
  427.                               begin
  428.                                 beep ;
  429.                                 fld := 1
  430.                               end
  431.                             else
  432.                               begin
  433.                                 new_tot := master.tot_amt + new_amt ;
  434.                                 write_real (new_tot,wid,frac,42,20)
  435.                               end
  436.                           end
  437.                       end ; { 1 }
  438.                   2 : read_date (new_date,44,21) ;
  439.                   3 : pause
  440.                 end ; { case }
  441.                 if fld < 1 then
  442.                     fld := 1
  443.                 else if (fld > 2) and (fld < maxint) then
  444.                   begin
  445.                     if (not (valid_date(new_date)))
  446.                     or (equal_date(new_date,null_date))
  447.                     or (greater_date(master.last_date,new_date) = 1) then
  448.                       begin
  449.                         show_msg ('NEW DATE MAY NOT BE EARLIER THAN CURRENT LAST DATE') ;
  450.                         fld := 2
  451.                       end
  452.                   end ;
  453.                 if (fld > 99) and (fld < maxint) then
  454.                     fld := 3
  455.             until (fld > 3)
  456.           end ; { if not fld = maxint }
  457.  
  458.         if fld = maxint then
  459.             save_it := false
  460.         else
  461.           begin
  462.             write_str ('Do you wish to save this information? (Y/N)',16,23) ;
  463.             read_yn (save_it,60,23) ;
  464.             clrline (16,23)
  465.           end ;
  466.         if save_it then           { save the record }
  467.             with master do
  468.               begin
  469.                 last_amt := new_amt ;
  470.                 last_date := new_date ;
  471.                 tot_amt := tot_amt + new_amt ;
  472.                 write_real (last_amt,wid,frac,65,4) ;
  473.                 write_date (last_date,67,5) ;
  474.                 write_real (tot_amt,wid,frac,65,6) ;
  475.                 putrec (mf_file,rec_num,master)
  476.               end  { with }
  477.         else
  478.             write_str ('NOT SAVED',16,23) ;
  479.  
  480.         write_str ('Do you wish to record another contribution? (Y/N)',16,24) ;
  481.         read_yn (do_another,66,24) ;
  482. 99:
  483.     until not do_another ;
  484.     close_database ;
  485.     fld := 1
  486.   end ; { record_contribution }
  487.  
  488. { ------------------------------ }
  489.  
  490. begin { proc do_name }
  491.   case opt of
  492.     add          : add_name ;
  493.     change       : change_name ;
  494.     del_rec      : delete_name ;
  495.     contribution : record_contribution
  496.   end
  497. end ; { proc do_name }
  498.  
  499. { ---------- EOF MADDETC.INC -------------------------------- }
  500. 
  501.