home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / database / mail20.ark / MROOT2.INC < prev    next >
Encoding:
Text File  |  1986-09-25  |  12.8 KB  |  352 lines
  1. { File = MROOT2.INC -- Include file for Reliance Mailing List
  2.     Copyright (c) 1986 William Meacham, All Rights Reserved
  3.     Revised: 3/7/86 }
  4.  
  5. procedure clear_display ;
  6.   { write spaces over data input area on screen }
  7.     begin
  8.       write_str(blanks,14,3) ;         { First name }
  9.       write_str(blanks,14,4) ;         { Last name }
  10.       write_real(0.0,wid,frac,65,4) ;  { Last amount }
  11.       write_str(null_date_str,67,5) ;  { Last date }
  12.       write_str(blanks,14,6) ;         { Title }
  13.       write_real(0.0,wid,frac,65,6) ;   { Total amount }
  14.       write_str(blanks,14,7) ;         { Salutation }
  15.       write_str(blanks,14,9) ;         { Address 1 }
  16.       write_bool(false,74,9) ;         { Category 1 }
  17.       write_str(blanks,14,10) ;        { Address 2 }
  18.       write_bool(false,74,10) ;        { Category 2 }
  19.       write_str(blanks,14,11) ;        { City }
  20.       write_bool(false,74,11) ;        { Category 3 }
  21.       write_str('  ',14,12) ;          { State }
  22.       write_str('         ',28,12) ;   { Zip code }
  23.       write_bool(false,74,12) ;        { Category 4 }
  24.       write_bool(false,74,13) ;        { Category 5 }
  25.       write_str(copy(blanks,1,14),14,14) ; { Home phone }
  26.       write_str('   ',41,14) ;         { Precinct }
  27.       write_bool(false,74,14) ;        { Category 6 }
  28.       write_str(blanks,14,15) ;        { Work phone }
  29.       write_bool(false,74,15) ;        { Category 7 }
  30.       write_bool(false,74,16) ;        { Category 8 }
  31.       clrline (1,23) ;
  32.       clrline (1,24)
  33.     end ; { --- Procedure clear_display --- }
  34.  
  35. { ----------------------------------------------------------- }
  36.  
  37. procedure clear_master ;
  38.   { assign null values to all of master record }
  39. begin
  40.   with master do
  41.     begin
  42.       status     := 0 ;
  43.       last_name  := '' ;
  44.       frst_name  := '' ;
  45.       title      := '' ;
  46.       salutation := '' ;
  47.       addr1      := '' ;
  48.       addr2      := '' ;
  49.       city       := '' ;
  50.       state      := '' ;
  51.       zip        := '' ;
  52.       home_phon  := '' ;
  53.       work_phon  := '' ;
  54.       precinct   := '' ;
  55.       last_amt   := 0.0 ;
  56.       last_date  := null_date ;
  57.       tot_amt    := 0.0 ;
  58.       flags      := 0
  59.     end
  60. end ; { proc clear_master }
  61.  
  62. { ----------------------------------------------------------- }
  63.  
  64. procedure display_master ;
  65.   { write master record on screen }
  66. begin
  67.   with master do
  68.     begin
  69.       write_str(frst_name,14,3) ;
  70.       write_str(last_name,14,4) ;
  71.       write_real(last_amt,wid,frac,65,4) ;
  72.       write_date(last_date,67,5) ;
  73.       write_str(title,14,6) ;
  74.       write_real(tot_amt,wid,frac,65,6) ;
  75.       write_str(salutation,14,7) ;
  76.       write_str(addr1,14,9) ;
  77.       write_bool(tstbit(flags,0),74,9) ;   { category 1 }
  78.       write_str(addr2,14,10) ;
  79.       write_bool(tstbit(flags,1),74,10) ;  { category 2 }
  80.       write_str(city,14,11) ;
  81.       write_bool(tstbit(flags,2),74,11) ;  { category 3 }
  82.       write_str(state,14,12) ;
  83.       write_str(zip,28,12) ;
  84.       write_bool(tstbit(flags,3),74,12) ;  { category 4 }
  85.       write_bool(tstbit(flags,4),74,13) ;  { category 5 }
  86.       write_str(home_phon,14,14) ;
  87.       write_str(precinct,41,14) ;
  88.       write_bool(tstbit(flags,5),74,14) ;  { category 6 }
  89.       write_str(work_phon,14,15) ;
  90.       write_bool(tstbit(flags,6),74,15) ;  { category 7 }
  91.       write_bool(tstbit(flags,7),74,16)    { category 8 }
  92.     end { with }
  93. end ;  { proc display_master }
  94.  
  95. { ----------------------------------------------------------- }
  96.  
  97. procedure input_master ;
  98.   { Gets name and address information from console. }
  99. var
  100.     i : integer ;
  101.  
  102. procedure check_amounts ;
  103.   begin
  104.     if greater (master.last_amt,master.tot_amt) then
  105.       begin
  106.         show_msg ('LAST AMOUNT MAY NOT EXCEED TOTAL AMOUNT') ;
  107.         fld := 13
  108.       end
  109.   end ;  { proc greater_error }
  110.  
  111. begin { proc input_master }
  112.     display_master ;
  113.     fld := 1 ;
  114.     with master do
  115.       begin
  116.         for i := 1 to 8 do
  117.             cat[i] := tstbit(flags,i-1) ;  { determine values of flags }
  118.         repeat
  119.           case fld of
  120.             1:   read_str(frst_name,18,14,3) ;
  121.             2: begin
  122.                  read_str(last_name,30,14,4) ;
  123.                  if  (fld > 2)
  124.                  and not(fld = maxint)
  125.                  and (last_name = '') then
  126.                    begin
  127.                      beep ;
  128.                      fld := 2
  129.                    end
  130.                end ; { 1 }
  131.             3:   read_str(title,9,14,6) ;
  132.             4:   read_str(salutation,11,14,7) ;
  133.             5:   read_str(addr1,25,14,9) ;
  134.             6:   read_str(addr2,25,14,10) ;
  135.             7:   read_str(city,23,14,11) ;
  136.             8:   read_str(state,2,14,12) ;
  137.             9:   read_str(zip,9,28,12) ;
  138.             10:  read_str(home_phon,14,14,14) ;
  139.             11:  read_str(work_phon,14,14,15) ;
  140.             12:  read_str(precinct,3,41,14) ;
  141.             13:  read_real(last_amt,wid,frac,65,4) ;
  142.             14:  read_date(last_date,67,5) ;
  143.             15:  begin
  144.                    read_real(tot_amt,wid,frac,65,6) ;
  145.                    if (fld > 15) and (fld < maxint) then
  146.                        check_amounts
  147.                  end ;
  148.             16 .. 23:
  149.                begin
  150.                  i := fld-15 ;
  151.                  read_bool (cat[i],74,i+8) ;
  152.                  if cat[i] then                 { assign values to flags }
  153.                      setbit(flags,i-1)
  154.                  else
  155.                      clrbit(flags,i-1)
  156.                end ;
  157.             24: pause
  158.           end ; { case }
  159.  
  160.           if fld < 1 then
  161.               fld := 1
  162.           else if (fld > 99) and (fld < maxint) then  { page forward }
  163.             begin                                     { edit for valid data }
  164.               if last_name = '' then
  165.                 begin
  166.                   beep ;
  167.                   fld := 2
  168.                 end
  169.               else if not (valid_date(last_date)) then
  170.                 begin
  171.                   beep ;
  172.                   fld := 14
  173.                 end
  174.               else
  175.                 begin
  176.                   check_amounts ;
  177.                   if not (fld = 13) then
  178.                       fld := 24           { if edits OK, make page forward }
  179.                 end                       { stick on the Pause }
  180.             end
  181.         until (fld > 24)
  182.       end { with }
  183. end ; { --- Procedure input_master --- }
  184.  
  185. { ----------------------------------------------------------- }
  186.  
  187. procedure select (var which : prt_criterion ;
  188.                   var sort  : sort_criterion ;
  189.                       opt   : option) ;
  190.   { select which names to print or count and how to sort them }
  191.  
  192. var
  193.     i,
  194.     sort_choice,
  195.     prevfld,
  196.     savefld      : integer ;
  197.  
  198.   begin
  199.     clrscr ;
  200.     write_str ('SELECT FOR OUTPUT',32,1) ;
  201.     write_str ('1   All the names',6,3) ;
  202.     write_str ('5   Those who have contributed',38,3) ;
  203.     write_str ('2   Only certain categories',6,4) ;
  204.     write_str ('since a certain date',42,4) ;
  205.     write_str ('3   One precinct',6,5) ;
  206.     write_str ('6   Those whose total contribution',38,5) ;
  207.     write_str ('4   One zip code',6,6) ;
  208.     write_str ('is at least a certain amount',42,6) ;
  209.     write_str ('==>',38,8) ;
  210.     mask := 0 ;
  211.     pcinct := '' ;
  212.     zipcode := '' ;
  213.     lastdt := null_date ;
  214.     contrib := 0.0 ;
  215.     sort := name ;
  216.     sort_choice := 0 ;
  217.     choice := 0 ;
  218.     fld := 1 ;
  219.     repeat
  220.         case fld of
  221.           1 : begin
  222.                 for i := 10 to 24 do
  223.                     clrline (1,i) ;
  224.                 repeat
  225.                     read_int(choice,1,42,8) ;
  226.                     if not (choice in [1..6]) then
  227.                       begin
  228.                         choice := 0 ;
  229.                         if not (fld = maxint) then
  230.                             fld := 1
  231.                       end ;
  232.                     if (fld > 1) and (fld < maxint) then
  233.                         fld := 2
  234.                 until (choice in [1..6]) or (fld = maxint) ;
  235.                 case choice of
  236.                   1 : which := all ;
  237.                   2 : which := pcat ;
  238.                   3 : which := pct ;
  239.                   4 : which := pzip ;
  240.                   5 : which := dt ;
  241.                   6 : which := amt
  242.                 end ; { case }
  243.                 prevfld := 1
  244.               end ; { 1 }
  245.           2 : begin
  246.                 for i := 19 to 24 do
  247.                     clrline (1,i) ;
  248.                 case which of
  249.                   all  : if prevfld < 2 then
  250.                              fld := 3
  251.                          else
  252.                              fld := 1 ;
  253.                   pcat : begin
  254.                            write_str ('Selection categories',24,10) ;
  255.                            for i := 1 to 8 do
  256.                                begin
  257.                                   write_int (i,1,26,10+i) ;
  258.                                   write (concat(' ',scr.cat_name[i])) ;
  259.                                   cat[i] := tstbit(mask,i-1) ;
  260.                                   write_bool (cat[i],51,10+i)
  261.                                end ;
  262.                            savefld := fld ;
  263.                            fld := 1 ;
  264.                            repeat
  265.                                case fld of
  266.                                  1..8 : begin
  267.                                           i := fld ;
  268.                                           read_bool (cat[i],51,10+i) ;
  269.                                           if cat[i] then
  270.                                               setbit(mask,i-1)
  271.                                           else
  272.                                               clrbit(mask,i-1)
  273.                                         end ; { 1..8 }
  274.                                end ; { case fld of }
  275.                            until (fld < 1) or (fld > 8) ;
  276.                            if fld < 1 then
  277.                                fld := pred(savefld)
  278.                            else if not (fld = maxint) then
  279.                                fld := succ(savefld) ;
  280.                          end ; { pcat }
  281.                   pct  : begin
  282.                            write_str ('Precinct:',38,10) ;
  283.                            read_str (pcinct,3,48,10)
  284.                          end ; { pct }
  285.                   pzip : begin
  286.                            write_str ('Zip code:',38,10) ;
  287.                            read_str (zipcode,9,48,10)
  288.                          end ; { pzip }
  289.                   dt   : begin
  290.                            write_str ('Date:',38,10) ;
  291.                            read_date (lastdt,45,10)
  292.                          end ; { dt }
  293.                   amt  : begin
  294.                            write_str ('Amount:',38,10) ;
  295.                            read_real (contrib,wid,frac,47,10)
  296.                          end ; { amt }
  297.                 end ; { case }
  298.                 if (fld > 2) and (fld < maxint) then
  299.                     fld := 3 ;
  300.                 prevfld := 2
  301.               end ; { 2 }
  302.           3 : begin
  303.                 for i := 22 to 24 do
  304.                     clrline (1,i) ;
  305.                 if opt = count then
  306.                   begin
  307.                     if prevfld < 3 then
  308.                         fld := 4
  309.                     else
  310.                         fld := 2
  311.                   end
  312.                 else
  313.                   begin
  314.                     write_str ('SORT BY:  1 Last name',24,20) ;
  315.                     write_str ('2 Zip code     ==>',34,21) ;
  316.                     repeat
  317.                         read_int (sort_choice,1,53,21) ;
  318.                         if not (sort_choice in [1..2]) then
  319.                           begin
  320.                             sort_choice := 0 ;
  321.                             if (fld > prevfld) then
  322.                                 fld := 3
  323.                           end ;
  324.                         if (fld > 3) and (fld < maxint) then
  325.                             fld := 4 ;
  326.                     until (sort_choice in [1..2])
  327.                        or (fld < 3)
  328.                        or (fld = maxint) ;
  329.                     if sort_choice = 1 then
  330.                         sort := name
  331.                     else
  332.                         sort := szip ;
  333.                   end ; { else }
  334.                 prevfld := 3
  335.               end ; { 3 }
  336.           4 : begin
  337.                 if (opt = list) then
  338.                     write_str ('PUT PLAIN PAPER IN THE PRINTER . . .',23,23)
  339.                 else if (opt = labels) then
  340.                     write_str ('PUT LABELS IN THE PRINTER . . .',25,23) ;
  341.                 pause ;
  342.                 prevfld := 4
  343.               end ; { 4 }
  344.         end ; { case }
  345.         if fld < 1 then fld := 1 ;
  346.     until (fld > 4)
  347.   end ; { proc select }
  348.  
  349. { ---- EOF FILE MROOT2.INC ---------------------------------- }
  350.  3
  351.                           end ;
  352.                         if (fld > 3) and (fld < maxint