Файлы. Оставить в слове только первые вхождения каждой буквы

uses crt; 
const nmax=100; 
var a:array[1..nmax] of string;     
n,i,j,k:byte; begin clrscr; 
repeat 
write($$Количество слов до $$,nmax,$$ n=$$); 
readln(n); 
until n in [1..nmax]; 
writeln($$Введите последовательность слов:$$); 
for i:=1 to n do readln(a[i]); 
for i:=1 to n do  begin   j:=1;   
while j(a[i]) do    begin     
for k:=length(a[i]) downto j+1 do     
if a[i][k]=a[i][j] then delete(a[i],k,1);     
j:=j+1;    
end;  
end; 
writeln($$Слова после удаления лишних символов:$$); 
for i:=1 to n do write(a[i],$$ $$); 
readln 
end.

program laba5;
uses crt;
const
  nmax = 50;
type arr = array[1..nmax] of string;
procedure input (var name1, name2: string);
var f1: text; buf: integer;
begin
  clrscr;
  writeln ('Данная программа предназначена для работы с текстовыми файлами');
  writeln ('Программа оставляет в слове только первые вхождения каждой буквы.');
  repeat
    writeln ('Введите имя исходного файла');
    readln (name1);
    assign (f1, name1);
    {$I-}
    reset (f1);
    {$I+}
    buf:= ioresult;
    if buf <> 0 then
      writeln ('Запрашиваемый файл не существует. Повторите ввод.');
  until buf = 0;
  close (f1);
  writeln ('Введите имя файла для результата');
  readln (name2);
end;
 
procedure select (var a:arr; i: byte; var n:byte; var f1: text; name1: string);
var
  j, k: byte;
  st: string;
  c: char;
begin
  assign(f1, name1);
  reset(f1);
  n := 1;
  while not eof(f1) do
  begin
    readln(f1, st);
    a[n] := st;
    n := n + 1;
  end;
  for i := 1 to n - 1 do
  begin
    j := 1;
    while j < length(a[i]) do
    begin
      for k := length(a[i]) downto j + 1 do
        if a[i][k] = a[i][j] then delete(a[i], k, 1);
      j := j + 1;
    end;
  end;
  close (f1);
end;
 
procedure output (a: arr; i,n: byte; name2: string; var f1: text);
var f2: text;
begin
  assign (f2, name2);
  rewrite (f2);
  writeln('Слова после удаления лишних символов:');
  for i := 1 to n do
    begin
      writeln(a[i]);
      write (f2, a[i]);
    end;
  readln;
  close(f2);
end;
 
var
  name1, name2: string;
  a: arr;
  n, i: byte;
  f1: text;
begin
  input (name1, name2);
  select(a,i,n,f1, name1);
  output (a,i,n,name2,f1);
end.