{ File = MAILMERG.INC -- Include file for Reliance Mailing List
    Copyright (c) 1986 William Meacham, All Rights Reserved
    Revised: 3/9/86 }

overlay procedure make_mailmerge_file  ;

label  99 ;  { to exit prematurely }

var
    which_ones  : prt_criterion ;
    how_to_sort : sort_criterion ;
    stop        : boolean ;        { whether to stop before done }
    prt_num     : num_str_typ ;    { for printing dollar amounts }
    prt_date    : datestring ;
    prt_zip     : string[10] ;
    field       : array [1..15] of boolean ; { which field to include in output }
    out_file    : text ;
    out_fname   : str14 ;
    num_out,
    num_bad     : integer ;
    overwrite   : boolean ;
    i           : integer ;

{ ==================== }

procedure get_a_rec ;
  { get the next record to print }
  begin
    if how_to_sort = name then
      begin
        nextkey (ix1_file,rec_num,key1) ;
        if OK then
            getrec (mf_file,rec_num,master)
      end
    else { how_to_sort := szip }
      begin
        nextkey (ix2_file,rec_num,key2) ;
        if OK then
            getrec (mf_file,rec_num,master)
      end
  end ; { proc get_a_rec }

{ ==================== }

procedure pick_fields ;
  const
    file_msg = 'OUTPUT FILE ALREADY EXISTS -- DO YOU WISH TO WRITE OVER IT? (Y/N)' ;
  var
    i           : integer ;
    some_chosen : boolean ;

{ ~~~~~~~~~~~~~~~~~~~~ }

  procedure check_file ;
    label 50 ;
    var
      bad,
      overwrite : boolean ;
      i,                       { loop counter }
      l,                       { length }
      c,                       { position of colon }
      p         : integer ;    { position of period }
    begin
      bad := false ;
      if out_fname = '' then                   { no entry }
          begin bad := true ; goto 50 end ;

      l := length(out_fname) ;
      c := pos(':',out_fname) ;
      p := pos('.',out_fname) ;
      if (c <> 0) and (c <> 2) then            { colon not in right place }
          begin bad := true ; goto 50 end ;
      if (c = 2) and not (out_fname[1] in ['A'..'P']) then
          begin bad := true ; goto 50 end ;    { drive designation no good }
      if p <> 0 then
        begin
          if (p - c) > 9 then                  { more than 8 chars in name }
              begin bad := true ; goto 50 end ;
          for i := c+1 to p-1 do               { bad char in name }
              if not(out_fname[i] in ['A'..'Z','0'..'9']) then
                  begin bad := true ; goto 50 end ;
          if (l - p) > 3 then                  { more than 3 chars in ext }
              begin bad := true ; goto 50 end ;
          for i := p+1 to l do                 { bad char in ext }
              if not(out_fname[i] in ['A'..'Z','0'..'9']) then
                  begin bad := true ; goto 50 end ;
        end
      else  { p = 0 }
        begin
          if (l - c) > 8 then                  { more than 8 chars in name }
              begin bad := true ; goto 50 end ;
          for i := c+1 to l do                 { bad char in name }
              if not(out_fname[i] in ['A'..'Z','0'..'9']) then
                  begin bad := true ; goto 50 end ;
        end ;
50:
      if bad then
        begin
          show_msg ('INVALID FILENAME') ;
          fld := 16
        end
      else if exists (out_fname) then
        begin
          write_str (file_msg,1,21) ;
          beep ;
          read_yn (overwrite,67,21) ;
          if overwrite then
              fld := 17
          else
              fld := 16 ;
          clrline(1,21)
        end
    end ; { proc check_file }

{ ~~~~~~~~~~~~~~~~~~~~ }

  begin
    clrscr ;
    write_str ('CHOOSE FIELDS FOR MAILMERGE FILE',24,1) ;
    paint_screen(1) ;
    write_str ('Output file:',1,18) ;
    write_str ('(Note -- you must make sure there is enough space for the file!)',1,19) ;
    for i := 1 to 15 do
        field[i] := false ;
    out_fname := '' ;
    write_bool(field[1],14,3) ;    { frst_name }
    write_bool(field[2],14,4) ;    { last_name }
    write_bool(field[3],14,6) ;    { title }
    write_bool(field[4],14,7) ;    { salutation }
    write_bool(field[5],14,9) ;    { addr1 }
    write_bool(field[6],14,10) ;   { addr2 }
    write_bool(field[7],14,11) ;   { city }
    write_bool(field[8],14,12) ;   { state }
    write_bool(field[9],28,12) ;   { zip }
    write_bool(field[10],14,14) ;  { home_phon }
    write_bool(field[11],14,15) ;  { work_phon }
    write_bool(field[12],41,14) ;  { precinct }
    write_bool(field[13],65,4) ;   { last_amt }
    write_bool(field[14],65,5) ;   { last_date }
    write_bool(field[15],65,6) ;   { tot_amt }
    fld := 1 ;
    repeat
        case fld of
          1  : read_bool(field[1],14,3) ;    { frst_name }
          2  : read_bool(field[2],14,4) ;    { last_name }
          3  : read_bool(field[3],14,6) ;    { title }
          4  : read_bool(field[4],14,7) ;    { salutation }
          5  : read_bool(field[5],14,9) ;    { addr1 }
          6  : read_bool(field[6],14,10) ;   { addr2 }
          7  : read_bool(field[7],14,11) ;   { city }
          8  : read_bool(field[8],14,12) ;   { state }
          9  : read_bool(field[9],28,12) ;   { zip }
          10 : read_bool(field[10],14,14) ;  { home_phon }
          11 : read_bool(field[11],14,15) ;  { work_phon }
          12 : read_bool(field[12],41,14) ;  { precinct }
          13 : read_bool(field[13],65,4) ;   { last_amt }
          14 : read_bool(field[14],65,5) ;   { last_date }
          15 : read_bool(field[15],65,6) ;   { tot_amt }
          16 : begin                         { output file name }
                 read_str (out_fname,14,14,18) ;
                 out_fname := purgech (out_fname,' ') ;
                 for i := 1 to length (out_fname) do
                     out_fname[i] := upcase(out_fname[i]) ;
                 write_str (out_fname,14,18) ;
                 for i := length(out_fname) + 1 to 14 do
                     write(' ') ;
                 if (fld > 16) and (fld < maxint) then
                     check_file
               end ; { 16 }
          17 : pause
        end ; { case }

        if fld < 1 then
            fld := 1
        else if (fld > 99) and (fld < maxint) then          { page forward }
          begin
            check_file ;                                  { do edit checks }
            if fld > 17 then                   { if OK, stick on the Pause }
                fld := 17
          end ;

    until fld > 17 ;

    some_chosen := false ;
    for i := 1 to 15 do
        some_chosen := some_chosen or field[i] ;
    if not some_chosen then
        fld := maxint ;
  end ; { proc pick_fields }

{ ==================== }

procedure write_a_record ;
  label  99 ;
  var
    st : string[255] ;
    i  : integer ;
    ch : char ;
  begin
    if keypressed then
      begin
        keyin (ch) ;
        if ch = #$1B then
          begin
            write_str ('STOP NOW? (Y/N)',9,7) ;
            beep ;
            read_yn (stop,25,7) ;
            OK := not stop ;
            if OK then clrline(9,7) ;
          end
      end ;
    if OK then
      begin
        st := '' ;
        with master do
          begin
            if field[1] then
                if pos(',',frst_name) <> 0 then
                    st := concat(st,'"',frst_name,'"',',')
                else
                    st := concat(st,frst_name,',') ;
            if field[2] then
                if pos(',',last_name) <> 0 then
                    st := concat(st,'"',last_name,'"',',')
                else
                    st := concat(st,last_name,',') ;
            if field[3] then
                if pos(',',title) <> 0 then
                    st := concat(st,'"',title,'"',',')
                else
                    st := concat(st,title,',') ;
            if field[4] then
                if pos(',',salutation) <> 0 then
                    st := concat(st,'"',salutation,'"',',')
                else
                    st := concat(st,salutation,',') ;
            if field[5] then
                if pos(',',addr1) <> 0 then
                    st := concat(st,'"',addr1,'"',',')
                else
                    st := concat(st,addr1,',') ;
            if field[6] then
                if pos(',',addr2) <> 0 then
                    st := concat(st,'"',addr2,'"',',')
                else
                    st := concat(st,addr2,',') ;
            if field[7] then
                if pos(',',city) <> 0 then
                    st := concat(st,'"',city,'"',',')
                else
                    st := concat(st,city,',') ;
            if field[8] then
                if pos(',',state) <> 0 then
                    st := concat(st,'"',state,'"',',')
                else
                    st := concat(st,state,',') ;
            if field[9] then
              begin
                prt_zip := zip ;
                if length(prt_zip) > 5 then
                    insert('-',prt_zip,6) ;
                if pos(',',prt_zip) <> 0 then
                    st := concat(st,'"',prt_zip,'"',',')
                else
                    st := concat(st,prt_zip,',')
              end ;
            if field[10] then
                if pos(',',home_phon) <> 0 then
                    st := concat(st,'"',home_phon,'"',',')
                else
                    st := concat(st,home_phon,',') ;
            if field[11] then
                if pos(',',work_phon) <> 0 then
                    st := concat(st,'"',work_phon,'"',',')
                else
                    st := concat(st,work_phon,',') ;
            if field[12] then
                if pos(',',precinct) <> 0 then
                    st := concat(st,'"',precinct,'"',',')
                else
                    st := concat(st,precinct,',') ;
            if field[13] then
              begin
                editnum(last_amt,wid,frac,prt_num) ;
                prt_num := stripch(prt_num,' ') ;
                if pos(',',prt_num) <> 0 then
                    st := concat(st,'"',prt_num,'"',',')
                else
                    st := concat(st,prt_num,',') ;
                if length(st) > 240 then goto 99
              end ;
            if field[14] then
              begin
                prt_date := mk_dt_st(last_date) ;
                prt_date := purgech(prt_date,' ') ;
                st := concat(st,prt_date,',') ;
                if length(st) > 240 then goto 99
              end ;
            if field[15] then
              begin
                editnum(tot_amt,wid,frac,prt_num) ;
                prt_num := stripch(prt_num,' ') ;
                if pos(',',prt_num) <> 0 then
                  begin
                    if length(st) + length(prt_num) + 3 < 256 then
                        st := concat(st,'"',prt_num,'"',',')
                    else
                        st[0] := #242  { make it too long }
                  end
                else   { no comma }
                  begin
                    if length(st) + length(prt_num) + 1 < 256 then
                        st := concat(st,prt_num,',')
                    else
                        st[0] := #242  { make it too long }
                  end  { else, no comma }
              end { if field[15] }
          end ; { with }
        delete(st,length(st),1) ; { delete trailing comma }
99:
        if length(st) > 240 then
            num_bad := succ(num_bad)
        else
          begin
            writeln (out_file,st) ;
            num_out := succ(num_out)
          end
      end  { if OK }
  end ; { procedure write_a_record }

{ ==================== }

procedure create_file ;
  begin
    clrscr ;
    write_str ('Creating ',9,3) ;
    write (out_fname,' . . .') ;
    write_str ('Press ESC to stop ',9,5) ;
    num_out := 0 ;
    num_bad := 0 ;
    assign(out_file,out_fname) ;
    rewrite(out_file) ;
    open_database ;
    if how_to_sort = name then
        clearkey (ix1_file)
    else  { how_to_sort = szip }
        clearkey (ix2_file) ;
    repeat
        get_a_rec ;
        if OK then
            case which_ones of
              all  : write_a_record ;
              pcat : if (master.flags and mask) > 0 then
                        write_a_record ;
              pct  : if master.precinct = pcinct then
                        write_a_record ;
              pzip : if copy(master.zip,1,5) = copy(zipcode,1,5) then
                        write_a_record ;
              dt   : if not (greater_date(lastdt,master.last_date) = 1) then
                        write_a_record ;
              amt  : if not (greater(contrib,master.tot_amt)) then
                        write_a_record ;
            end { case }
    until not OK ;
    close_database ;
    close(out_file) ;
    gotoxy(9,9) ;
    write(num_out,' records written') ;
    if num_bad > 0 then
        write ('.   ',num_bad,' not written -- too long.') ;
    beep ;
    hard_pause ;
    if num_out = 0 then
        erase(out_file) ;
    fld := 1 ;
  end ; { proc create_file }

{ ==================== }

begin { ---- procedure make_mailmerge_file ---- }
    select (which_ones, how_to_sort, mailmerge) ;
    if not (fld = maxint) then
        pick_fields ;
    if not (fld = maxint) then
        create_file ;
    fld := 1
end ; { proc make_mailmerge_file }

{ ---- EOF FILE MAILMERG.INC -------------------------------- }