procedure prn_q(G: PtrNode);
var
t: PtrNode;
begin
t: =G;{мне все таки кажется "=" долно быть,мож я и ошибаюсь}
while t<>Nil do{до тех пор пока ты не наткнешся на отсутствие кусочка ты делаеш следующее}
begin
write(t^.Info:5);{выводиш на экран текущий кусочек}
t:=t^.Next;{передвигается к следующему кусочку}
end;
writeln;
end;

type
 TElem = Integer; 
 TList = ^Telement;
 TElement = record{Volvo говорит что после рекорда ничего стоять не должно, и это действительно так,так что видно,что программа сдается скорее на листочке,чем компьютере}
             INFO:TElem;
             NEXT : TList
            end;
 TQueue = record
           head:TList;
           tail:TList;
          end;
var
 Q,P:Tlist;

Function QueueEmpty(Q:TQueue):boolean;{проверяет пуста ли наша очередь}
 begin
  QueueEmpty:=(Q.HEAD=nil)
 end;

Procedure OueuePush(var q:TQueue;E:TElem);{добавляет элемент  в очередь}
var temp:Tlist;
 begin
  new(temp);
  temp^.info:=random(100);
  temp^.next:=nil;
  If QueueEmpty(q) then 
     q.head:=z 
  else 
    q.tail^.next:=z;
  
q.tail:=z
 end;

Procedure CreateOueue(var q:TQueue;n:integer);{содаем всю очередь}
 var i,e:integer;
   begin
    i:=0;
    while i<=n do begin
      e:=random(100);
      OueuePush(q,e);
      i:=i+1;
    end;
   end;
{тогда код твоей главное программы будет выглядеть так}

clrscr;
 repeat
    write('vvedite kol-vo elementov v ocheredi Q: ');
    readln(n1);
  until n1>0; 
  CreateOueue(Q,n1);
  writeln('sozdana ochered Q: ');
  prn_q(Q);
  repeat
    write('vvedite kol-vo elementov v ocheredi P(ne menshe 4): ');
    readln(n2);
  until n2>=4;
  CreateOueue(P,n2);
.................
.................

for i:=1 to 3 do{тут цикл,ты же передать 3 элемента хочеш}
begin
Tek:=P;{записываеш эkемент второй очереди во временную переменную}
HQ^.Next:=Tek;
HQ:=Tek;
P:=P^.Next;{сдвигаешся к следующему элементу в очереди}
HQ^.Next:=Nil;{показываеш,что следующего элемента не существует,чтобы на следующем витке цикла написать в эту "ячейку"}
end;