Лица после оптикореконструктивных операций на роговице и склере временно не годны к военной службе: - В течение 3 месяцев.

Правильные ответы к тесту выделены
Тест  прошел проверку

Var
  T : array [1..3] of string;
  V : string;
  s : integer;
  Bad : array [1..3] of record
                          num : integer;
                          max : 1..2;
                          pos : 1..3
                        end;
    n : integer;
    i, j, k : integer;
 Procedure Vost (i,bad:Integer);
begin
  if bad=1 then V[i]:=T[2][i]
  else V[i]:=T[1][i]
end;
begin
   assign(input,'input.txt'); reset(input);
   assign(output,'output.txt'); rewrite(output);
   readln(T[1]);
   readln(T[2]);
   readln(T[3]);
   s:=length(T[1]);
   n:=0;
   for i := 1 to s do
     if (T[1][i]<>T[2][i]) or (T[2][i]<>T[3][i] ) Then
     with Bad [n+1] do
     begin
        n:=n+1;
        num:=i;
        max:=1;
        for j:=1 to 2 do
           for k:=j+1 to 3 do
             if T[j][i]=T[k][i] then
             begin
                max:=2;
                pos:=6-j-k;
             end;
     end;
   if (n=0) or (n=1) then write ('NO')
   else if n=3 then
        begin
           V:=T[1];
           for i:=1 to 3 do
             Vost (Bad[i].num,Bad[i].pos);
        write(V)
        end
   else
        if (Bad[1].max=2) and (Bad[2].max=2) then
           write ('NO')
        else begin
               V:=T[1];
               if Bad[1].max=2 then
               begin
                  Vost (Bad[1].num,Bad[1].pos);
                  V[Bad[2].num]:=T[Bad[1].pos,Bad[2].num];
               end else begin
                  Vost (Bad[2].num,Bad[2].pos);
                  V[Bad[1].num]:=T[Bad[2].pos,Bad[1].num];
               end;
               write(V)
             end;
end.

var
  s, t : string;
  a : array [1..2,0..200] of integer;
  i, j, k : integer;
begin
  assign(input,'input.txt'); reset(input);
  assign(output,'output.txt'); rewrite(output);
  readln(s); t:='';
  k:=0; a[1,k]:=0; a[2,k]:=0;
  for i:=1 to length(s) do
  begin
    k:=k+1;
    if s[i]='N' then begin a[1,k]:=a[1,k-1]; a[2,k]:=a[2,k-1]+1; t:=t+'S' end;
    if s[i]='E' then begin a[1,k]:=a[1,k-1]+1; a[2,k]:=a[2,k-1]; t:=t+'W' end;
    if s[i]='S' then begin a[1,k]:=a[1,k-1]; a[2,k]:=a[2,k-1]-1; t:=t+'N' end;
    if s[i]='W' then begin a[1,k]:=a[1,k-1]-1; a[2,k]:=a[2,k-1]; t:=t+'E' end;
    j:=0;
    while (a[1,j]<>a[1,k]) or (a[2,j]<>a[2,k]) do j:=j+1;
    if j<k then
    begin
      delete(t,j+1,k-j);
      k:=j
    end
  end;
  for i:=length(t) downto 1 do write(t[i])
end.