Удалить из последовательности числа, все цифры которых различны

const nmax=10000;
function razn(x:integer):boolean;
var y,c,k,p:integer;
    m:set of byte;
begin
y:=x;
m:=[];
k:=0;
p:=0;
while y>0 do
 begin
  c:=y mod 10;
  p:=p+1;{всего цифр}
  if not(c in m)then{разные}
   begin
    k:=k+1;
    m:=m+[c];
   end;
  y:=y div 10;
 end;
razn:=k=p;
end;
function prz(x:integer):boolean;
var y,p:integer;
begin
y:=x;
p:=1;
while y>0 do
 begin
  p:=p*(y mod 10);
  y:=y div 10;
 end;
prz:=p mod 14=0;
end;
var a:array[1..nmax] of integer;
    n,i,j,x:integer;
begin
repeat
write('Размер массива А от 2 до ',nmax,' n=');
readln(n);
until (n>2)and(n<=nmax);
writeln('Массив A');
for i:=1 to n do
 begin
  a[i]:=i;
  write(a[i],' ');
 end;
writeln;
{удаление с разными цифрами}
i:=1;
while i<=n do
if razn(a[i]) then
 begin
  if i<n then
  for j:=i to n-1 do
  a[j]:=a[j+1];
  n:=n-1;
 end
else i:=i+1;
writeln('Удаление чисел с разными цифрами');
for i:=1 to n do
write(a[i],' ');
writeln;
{дублирование с произведением кратным 14}
i:=1;
while i<=n do
if prz(a[i]) then
 begin
  n:=n+1;
  for j:=n downto i+1 do
  a[j]:=a[j-1];
  a[i]:=a[i+1];
  i:=i+2;
 end
else i:=i+1;
writeln('Дублирование чисел с произведением цифр кратным 14');
for i:=1 to n do
write(a[i],' ');
end.