I think my programm is right.
This my programm:

CONST
 fin='';
 fout='';
 MaxN=60;
VAR
 i,j,k,n:LongInt;
 st,A:String[MaxN];
 B:String[240];
 p:BooLean;
PROCEDURE Open_Files;
Begin
 Assign(input,fin);
 ReSet(input);
 Assign(output,fout);
 ReWrite(output);
End;
PROCEDURE Date;
Begin
 if pos('one',B)=1 then
  begin
   delete(B,1,3);
   p:=true;
   Exit;
  end;
 if pos('puton',B)=1 then
  begin
   delete(B,1,5);
   p:=true;
   Exit;
  end;
 if pos('inputone',B)=1 then
  begin
   delete(B,1,8);
   p:=true;
   Exit;
  end;
 if pos('inputon',B)=1 then
  begin
   delete(B,1,7);
   p:=true;
   Exit;
  end;
 if pos('input',B)=1 then
  begin
   delete(B,1,5);
   p:=true;
   Exit;
  end;
 if pos('in',B)=1 then
  begin
   delete(B,1,2);
   p:=true;
   Exit;
  end;
 if pos('outputone',B)=1 then
  begin
   delete(B,1,9);
   p:=true;
   Exit;
  end;
 if pos('outputon',B)=1 then
  begin
   delete(B,1,8);
   p:=true;
   Exit;
  end;
 if pos('output',B)=1 then
  begin
   delete(B,1,6);
   p:=true;
   Exit;
  end;
 if pos('out',B)=1 then
  begin
   delete(B,1,3);
   p:=true;
   Exit;
  end;
End;
PROCEDURE UpDate;
Begin
 while p do
  begin
   p:=false;
   Date;
   if length(B)<16 then Exit;
   if not(p) then st:='NO';
  end;
End;
PROCEDURE Solve;
Begin
 Read(A);
 while length(A)>0 do
  begin
   B:=B+A;
   p:=true;
   UpDate;
   if st='NO' then
    begin
     while length(A)>0 do Read(A);
     Exit;
    end;
   Read(A);
  end;
 p:=true;
 while p do
  begin
   p:=false;
   Date;
   if length(B)=0 then Exit;
  end;
 if length(B)<>0 then st:='NO';
End;
PROCEDURE Run;
Begin
 ReadLn(n);
 for i:=1 to n do
  begin
   st:='YES';
   B:='';
   Solve;
   if i<>n then ReadLn;
   WriteLn(st);
  end;
End;
PROCEDURE Close_Files;
Begin
 Close(input);
 Close(output);
End;
BEGIN
 Open_Files;
 Run;
 Close_Files;
END.

Help me please.