uSES crt;
var a:array[0..1000] of longint;
   n,i,k,j:longint;
function nt(n:longint):boolean;
var i:longint;
begin
  if n<2 then exit(false) else
   begin
     i:=2;
      while n mod i<>0 do inc(i);
      nt:=i=n;
   end;
end;
begin
 clrscr;
 readln(n);
 for i:=1 to n do readln(a[i]);
    For i:=1 to n-1 do
    For j:=i+1 to n do
    If a[i]<a[j] then
    Begin k:=a[i];a[i]:=a[j];a[j]:=k;End;
    k:=1; if n<=2 then k:=0; 
    For i:=1 to n do begin
     if a[i]<>a[i+1] then inc(k); 
     if k=3 then begin writeln(a[i+1],' ',i+1);
     for j:=1 to a[i+1]-1 do if nt(j) then write(j,' '); break; end;
     end;

if k<3 then writeln('No');

readln
end.
 

Nếu có lỗi hoặc đáp án sai thì bạn nói mình nhé.

program Hello;
uses crt;
var n,i,j,t,sl1,sl2,sl3:integer;
    a:array[1..100] of integer;
begin
    readln(n);
    sl1:=low(integer); sl2:=sl1; sl3:=sl2;
    for i:=1 to n do
        read(a[i]);
    for i:=2 to n do 
        if sl1<a[i] then 
            sl1:= a[i];
    for i:= 1 to n do 
        if ( sl2<a[i]) and (a[i] < sl1) then 
            sl2:= a[i];
    for i:= 1 to n do 
        if ( sl3<a[i]) and (a[i] < sl2) then 
            begin
                sl3:= a[i];
                t:=1;
            end;
    if (n>2) and (t=1) then
        begin
            writeln('So lon thu 3: ', sl3);
            write('Vi tri: ');
            for i:= 1 to n do
                if a[i]= sl3 then
                    write(i,' ');
            writeln;
            write('Cac so nguyen to nho hon: ');
            for i:=2 to sl3 do
                begin
                    t:=0;
                    for j:= 2 to sl3 do
                        if (i mod j = 0) and (i<>j) then
                            t:=1;
                    if t=1 then continue;
                    write(i,' ');
                end;
        end
    else
        write('None!');
end.