Определить виды тех культур, которые возделывают на каждом из участков

uses crt;
type kultura=(kr,uk,mr,gr,kp,rd);
     mnz=set of kultura;
const n=3;
      sp:array[0..5] of string=('картофель','укроп','морковь',
                                'горох','капуста','редис');
var m:array[1..n] of mnz;
    res:mnz;
    j:kultura;
    i,k:byte;
begin
writeln('Перечислите какие культуры возделывают на каждом из 3х участков:');
for i:=1 to n do
 begin
  writeln('Участок ',i);
  m[i]:=[];
  writeln('0-картофель 1-укроп 2-морковь 3-горох 4-капуста 5-редис 6-выход');
  repeat
   readln(k);
   if k in [0..5] then m[i]:=m[i]+[kultura(k)];
  until k=6;
 end;
clrscr;
writeln('Возделываются на всех участках');
res:=[];
for j:=kr to rd do
 begin
  k:=0;
  for i:=1 to n do
  if j in m[i] then k:=k+1;
  if k=n then res:=res+[j];
 end;
if res=[] then writeln('Таких культур нет')
else
 for j:=kr to rd do
 if j in res then write(sp[ord(j)],' ');
writeln;
writeln('Возделываются хотя бы на 1 участке:');
res:=[];
for j:=kr to rd do
 begin
  for i:=1 to n do
  if j in m[i] then res:=res+[j];
 end;
for j:=kr to rd do
if j in res then write(sp[ord(j)],' ');
writeln;
writeln;
writeln('Не возделываются ни на 1 участке:');
res:=[];
for j:=kr to rd do
 begin
  k:=0;
  for i:=1 to n do
  if not(j in m[i]) then k:=k+1;
  if k=n then res:=res+[j];
 end;
if res=[] then writeln('Таких культур нет')
else
 for j:=kr to rd do
 if j in res then write(sp[ord(j)],' ');
end.