home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB139 / mail20r.lzh / MAILMERG.INC < prev    next >
Text File  |  1988-10-11  |  14KB  |  393 lines
  1. { File = MAILMERG.INC -- Include file for Reliance Mailing List
  2.     Copyright (c) 1986 William Meacham, All Rights Reserved
  3.     Revised: 3/9/86 }
  4.  
  5. {Modified for the DEC Rainbow by David P. Maroun on 11-Oct-1988.}
  6.  
  7. overlay procedure make_mailmerge_file  ;
  8.  
  9. label  99 ;  { to exit prematurely }
  10.  
  11. var
  12.     which_ones  : prt_criterion ;
  13.     how_to_sort : sort_criterion ;
  14.     stop        : boolean ;        { whether to stop before done }
  15.     prt_num     : num_str_typ ;    { for printing dollar amounts }
  16.     prt_date    : datestring ;
  17.     prt_zip     : string[10] ;
  18.     field       : array [1..15] of boolean ; { which field to include in output }
  19.     out_file    : text ;
  20.     out_fname   : str14 ;
  21.     num_out,
  22.     num_bad     : integer ;
  23.     overwrite   : boolean ;
  24.     i           : integer ;
  25.  
  26. { ==================== }
  27.  
  28. procedure get_a_rec ;
  29.   { get the next record to print }
  30.   begin
  31.     if how_to_sort = name then
  32.       begin
  33.         nextkey (ix1_file,rec_num,key1) ;
  34.         if OK then
  35.             getrec (mf_file,rec_num,master)
  36.       end
  37.     else { how_to_sort := szip }
  38.       begin
  39.         nextkey (ix2_file,rec_num,key2) ;
  40.         if OK then
  41.             getrec (mf_file,rec_num,master)
  42.       end
  43.   end ; { proc get_a_rec }
  44.  
  45. { ==================== }
  46.  
  47. procedure pick_fields ;
  48.   const
  49.     file_msg = 'OUTPUT FILE ALREADY EXISTS -- DO YOU WISH TO WRITE OVER IT? (Y/N)' ;
  50.   var
  51.     i           : integer ;
  52.     some_chosen : boolean ;
  53.  
  54. { ~~~~~~~~~~~~~~~~~~~~ }
  55.  
  56.   procedure check_file ;
  57.     label 50 ;
  58.     var
  59.       bad,
  60.       overwrite : boolean ;
  61.       i,                       { loop counter }
  62.       l,                       { length }
  63.       c,                       { position of colon }
  64.       p         : integer ;    { position of period }
  65.     begin
  66.       bad := false ;
  67.       if out_fname = '' then                   { no entry }
  68.           begin bad := true ; goto 50 end ;
  69.  
  70.       l := length(out_fname) ;
  71.       c := pos(':',out_fname) ;
  72.       p := pos('.',out_fname) ;
  73.       if (c <> 0) and (c <> 2) then            { colon not in right place }
  74.           begin bad := true ; goto 50 end ;
  75.       if (c = 2) and not (out_fname[1] in ['A'..'P']) then
  76.           begin bad := true ; goto 50 end ;    { drive designation no good }
  77.       if p <> 0 then
  78.         begin
  79.           if (p - c) > 9 then                  { more than 8 chars in name }
  80.               begin bad := true ; goto 50 end ;
  81.           for i := c+1 to p-1 do               { bad char in name }
  82.               if not(out_fname[i] in ['A'..'Z','0'..'9']) then
  83.                   begin bad := true ; goto 50 end ;
  84.           if (l - p) > 3 then                  { more than 3 chars in ext }
  85.               begin bad := true ; goto 50 end ;
  86.           for i := p+1 to l do                 { bad char in ext }
  87.               if not(out_fname[i] in ['A'..'Z','0'..'9']) then
  88.                   begin bad := true ; goto 50 end ;
  89.         end
  90.       else  { p = 0 }
  91.         begin
  92.           if (l - c) > 8 then                  { more than 8 chars in name }
  93.               begin bad := true ; goto 50 end ;
  94.           for i := c+1 to l do                 { bad char in name }
  95.               if not(out_fname[i] in ['A'..'Z','0'..'9']) then
  96.                   begin bad := true ; goto 50 end ;
  97.         end ;
  98. 50:
  99.       if bad then
  100.         begin
  101.           show_msg ('INVALID FILENAME') ;
  102.           fld := 16
  103.         end
  104.       else if exists (out_fname) then
  105.         begin
  106.           write_str (file_msg,1,21) ;
  107.           beep ;
  108.           read_yn (overwrite,67,21) ;
  109.           if overwrite then
  110.               fld := 17
  111.           else
  112.               fld := 16 ;
  113.           clrline(1,21)
  114.         end
  115.     end ; { proc check_file }
  116.  
  117. { ~~~~~~~~~~~~~~~~~~~~ }
  118.  
  119.   begin
  120.     clrscr ;
  121.     write_str ('CHOOSE FIELDS FOR MAILMERGE FILE',24,1) ;
  122.     paint_screen(1) ;
  123.     write_str ('Output file:',1,18) ;
  124.     write_str ('(Note -- you must make sure there is enough space for the file!)',1,19) ;
  125.     for i := 1 to 15 do
  126.         field[i] := false ;
  127.     out_fname := '' ;
  128.     write_bool(field[1],14,3) ;    { frst_name }
  129.     write_bool(field[2],14,4) ;    { last_name }
  130.     write_bool(field[3],14,6) ;    { title }
  131.     write_bool(field[4],14,7) ;    { salutation }
  132.     write_bool(field[5],14,9) ;    { addr1 }
  133.     write_bool(field[6],14,10) ;   { addr2 }
  134.     write_bool(field[7],14,11) ;   { city }
  135.     write_bool(field[8],14,12) ;   { state }
  136.     write_bool(field[9],29,12) ;   { zip }
  137.     write_bool(field[10],14,14) ;  { home_phon }
  138.     write_bool(field[11],14,15) ;  { work_phon }
  139.     write_bool(field[12],41,14) ;  { precinct }
  140.     write_bool(field[13],65,4) ;   { last_amt }
  141.     write_bool(field[14],65,5) ;   { last_date }
  142.     write_bool(field[15],65,6) ;   { tot_amt }
  143.     fld := 1 ;
  144.     repeat
  145.         case fld of
  146.           1  : read_bool(field[1],14,3) ;    { frst_name }
  147.           2  : read_bool(field[2],14,4) ;    { last_name }
  148.           3  : read_bool(field[3],14,6) ;    { title }
  149.           4  : read_bool(field[4],14,7) ;    { salutation }
  150.           5  : read_bool(field[5],14,9) ;    { addr1 }
  151.           6  : read_bool(field[6],14,10) ;   { addr2 }
  152.           7  : read_bool(field[7],14,11) ;   { city }
  153.           8  : read_bool(field[8],14,12) ;   { state }
  154.           9  : read_bool(field[9],29,12) ;   { zip }
  155.           10 : read_bool(field[10],14,14) ;  { home_phon }
  156.           11 : read_bool(field[11],14,15) ;  { work_phon }
  157.           12 : read_bool(field[12],41,14) ;  { precinct }
  158.           13 : read_bool(field[13],65,4) ;   { last_amt }
  159.           14 : read_bool(field[14],65,5) ;   { last_date }
  160.           15 : read_bool(field[15],65,6) ;   { tot_amt }
  161.           16 : begin                         { output file name }
  162.                  read_str (out_fname,14,14,18) ;
  163.                  out_fname := purgech (out_fname,' ') ;
  164.                  for i := 1 to length (out_fname) do
  165.                      out_fname[i] := upcase(out_fname[i]) ;
  166.                  write_str (out_fname,14,18) ;
  167.                  for i := length(out_fname) + 1 to 14 do
  168.                      write(' ') ;
  169.                  if (fld > 16) and (fld < maxint) then
  170.                      check_file
  171.                end ; { 16 }
  172.           17 : pause
  173.         end ; { case }
  174.  
  175.         if fld < 1 then
  176.             fld := 1
  177.         else if (fld > 99) and (fld < maxint) then          { page forward }
  178.           begin
  179.             check_file ;                                  { do edit checks }
  180.             if fld > 17 then                   { if OK, stick on the Pause }
  181.                 fld := 17
  182.           end ;
  183.  
  184.     until fld > 17 ;
  185.  
  186.     some_chosen := false ;
  187.     for i := 1 to 15 do
  188.         some_chosen := some_chosen or field[i] ;
  189.     if not some_chosen then
  190.         fld := maxint ;
  191.   end ; { proc pick_fields }
  192.  
  193. { ==================== }
  194.  
  195. procedure write_a_record ;
  196.   label  99 ;
  197.   var
  198.     st : string[255] ;
  199.     i  : integer ;
  200.     ch : char ;
  201.   begin
  202.     if keypressed then
  203.       begin
  204.         keyin (ch) ;
  205.         if ch = #$1B then
  206.           begin
  207.             write_str ('STOP NOW? (Y/N)',9,7) ;
  208.             beep ;
  209.             read_yn (stop,25,7) ;
  210.             OK := not stop ;
  211.             if OK then clrline(9,7) ;
  212.           end
  213.       end ;
  214.     if OK then
  215.       begin
  216.         st := '' ;
  217.         with master do
  218.           begin
  219.             if field[1] then
  220.                 if pos(',',frst_name) <> 0 then
  221.                     st := concat(st,'"',frst_name,'"',',')
  222.                 else
  223.                     st := concat(st,frst_name,',') ;
  224.             if field[2] then
  225.                 if pos(',',last_name) <> 0 then
  226.                     st := concat(st,'"',last_name,'"',',')
  227.                 else
  228.                     st := concat(st,last_name,',') ;
  229.             if field[3] then
  230.                 if pos(',',title) <> 0 then
  231.                     st := concat(st,'"',title,'"',',')
  232.                 else
  233.                     st := concat(st,title,',') ;
  234.             if field[4] then
  235.                 if pos(',',salutation) <> 0 then
  236.                     st := concat(st,'"',salutation,'"',',')
  237.                 else
  238.                     st := concat(st,salutation,',') ;
  239.             if field[5] then
  240.                 if pos(',',addr1) <> 0 then
  241.                     st := concat(st,'"',addr1,'"',',')
  242.                 else
  243.                     st := concat(st,addr1,',') ;
  244.             if field[6] then
  245.                 if pos(',',addr2) <> 0 then
  246.                     st := concat(st,'"',addr2,'"',',')
  247.                 else
  248.                     st := concat(st,addr2,',') ;
  249.             if field[7] then
  250.                 if pos(',',city) <> 0 then
  251.                     st := concat(st,'"',city,'"',',')
  252.                 else
  253.                     st := concat(st,city,',') ;
  254.             if field[8] then
  255.                 if pos(',',state) <> 0 then
  256.                     st := concat(st,'"',state,'"',',')
  257.                 else
  258.                     st := concat(st,state,',') ;
  259.             if field[9] then
  260.               begin
  261.                 prt_zip := zip ;
  262. (*              if length(prt_zip) > 5 then
  263.                     insert('-',prt_zip,6) ;
  264. *)
  265.                 if pos(',',prt_zip) <> 0 then
  266.                     st := concat(st,'"',prt_zip,'"',',')
  267.                 else
  268.                     st := concat(st,prt_zip,',')
  269.               end ;
  270.             if field[10] then
  271.                 if pos(',',home_phon) <> 0 then
  272.                     st := concat(st,'"',home_phon,'"',',')
  273.                 else
  274.                     st := concat(st,home_phon,',') ;
  275.             if field[11] then
  276.                 if pos(',',work_phon) <> 0 then
  277.                     st := concat(st,'"',work_phon,'"',',')
  278.                 else
  279.                     st := concat(st,work_phon,',') ;
  280.             if field[12] then
  281.                 if pos(',',precinct) <> 0 then
  282.                     st := concat(st,'"',precinct,'"',',')
  283.                 else
  284.                     st := concat(st,precinct,',') ;
  285.             if field[13] then
  286.               begin
  287.                 editnum(last_amt,wid,frac,prt_num) ;
  288.                 prt_num := stripch(prt_num,' ') ;
  289.                 if pos(',',prt_num) <> 0 then
  290.                     st := concat(st,'"',prt_num,'"',',')
  291.                 else
  292.                     st := concat(st,prt_num,',') ;
  293.                 if length(st) > 240 then goto 99
  294.               end ;
  295.             if field[14] then
  296.               begin
  297.                 prt_date := mk_dt_st(last_date) ;
  298.                 prt_date := purgech(prt_date,' ') ;
  299.                 st := concat(st,prt_date,',') ;
  300.                 if length(st) > 240 then goto 99
  301.               end ;
  302.             if field[15] then
  303.               begin
  304.                 editnum(tot_amt,wid,frac,prt_num) ;
  305.                 prt_num := stripch(prt_num,' ') ;
  306.                 if pos(',',prt_num) <> 0 then
  307.                   begin
  308.                     if length(st) + length(prt_num) + 3 < 256 then
  309.                         st := concat(st,'"',prt_num,'"',',')
  310.                     else
  311.                         st[0] := #242  { make it too long }
  312.                   end
  313.                 else   { no comma }
  314.                   begin
  315.                     if length(st) + length(prt_num) + 1 < 256 then
  316.                         st := concat(st,prt_num,',')
  317.                     else
  318.                         st[0] := #242  { make it too long }
  319.                   end  { else, no comma }
  320.               end { if field[15] }
  321.           end ; { with }
  322.         delete(st,length(st),1) ; { delete trailing comma }
  323. 99:
  324.         if length(st) > 240 then
  325.             num_bad := succ(num_bad)
  326.         else
  327.           begin
  328.             writeln (out_file,st) ;
  329.             num_out := succ(num_out)
  330.           end
  331.       end  { if OK }
  332.   end ; { procedure write_a_record }
  333.  
  334. { ==================== }
  335.  
  336. procedure create_file ;
  337.   begin
  338.     clrscr ;
  339.     write_str ('Creating ',9,3) ;
  340.     write (out_fname,' . . .') ;
  341.     write_str ('Press ESC to stop ',9,5) ;
  342.     num_out := 0 ;
  343.     num_bad := 0 ;
  344.     assign(out_file,out_fname) ;
  345.     rewrite(out_file) ;
  346.     open_database ;
  347.     if how_to_sort = name then
  348.         clearkey (ix1_file)
  349.     else  { how_to_sort = szip }
  350.         clearkey (ix2_file) ;
  351.     repeat
  352.         get_a_rec ;
  353.         if OK then
  354.             case which_ones of
  355.               all  : write_a_record ;
  356.               pcat : if (master.flags and mask) > 0 then
  357.                         write_a_record ;
  358.               pct  : if master.precinct = pcinct then
  359.                         write_a_record ;
  360.               pzip : if copy(master.zip,1,5) = copy(zipcode,1,5) then
  361.                         write_a_record ;
  362.               dt   : if not (greater_date(lastdt,master.last_date) = 1) then
  363.                         write_a_record ;
  364.               amt  : if not (greater(contrib,master.tot_amt)) then
  365.                         write_a_record ;
  366.             end { case }
  367.     until not OK ;
  368.     close_database ;
  369.     close(out_file) ;
  370.     gotoxy(9,9) ;
  371.     write(num_out,' records written') ;
  372.     if num_bad > 0 then
  373.         write ('.   ',num_bad,' not written -- too long.') ;
  374.     beep ;
  375.     hard_pause ;
  376.     if num_out = 0 then
  377.         erase(out_file) ;
  378.     fld := 1 ;
  379.   end ; { proc create_file }
  380.  
  381. { ==================== }
  382.  
  383. begin { ---- procedure make_mailmerge_file ---- }
  384.     select (which_ones, how_to_sort, mailmerge) ;
  385.     if not (fld = maxint) then
  386.         pick_fields ;
  387.     if not (fld = maxint) then
  388.         create_file ;
  389.     fld := 1
  390. end ; { proc make_mailmerge_file }
  391.  
  392. { ---- EOF FILE MAILMERG.INC -------------------------------- }
  393.