Вычисление суммы ряда p/q. Сумма должна быть = обычная несократимая дробь - Pascal ABC

Формулировка задачи:

Нужна помощь в написании программы, в основном процедуры. Программа вычисления суммы ряда p/q = 1 + 1/2 + 1/3 + ... + 1/n для заданного n. Сумма ряда в итоге, должна быть несократимая дробь(p,q - натуральные). Во есть такой код, считает, но дробь выходит такая, которую можно сократить.

var p, q, n, i: integer;
procedure fact(F: integer);
begin
var t, y: integer;
y:=1;
for t:=1 to F do
begin
y:=y*t;
end;
write(y);
end;
begin
write('n=');
readln(n);
p:=1;
q:=1;
for i:=2 to n do
begin
p:=p*i+q;
q:=i*q;
end;
write('Summa=',p,'/');
fact(n);
readln
end.

Нужно встроить процедуру, которая будет делать так, что бы выходила несократимая дробь. Есть такой вариант процедуры, но что-то не пойму что и как.

p:=0;
   q:=1;
   for k := 1 to n do begin
      if (k+1) mod 2 = 0 then {Определеям степени и знак числителя}
         pNew := 1
      else
         pNew := -1;
      qNew := k;
      p := p*qNew + pNew*q;
      q := qNew*q;
      for i := 2 to 7 do {Сокращение дроби}
         while ((p mod i) = 0) and ((q mod i) =0) do begin
            p := p div i;
            q := q div i;
         end;
   end

Дробь выходит несократимой, но в процедуре прописано другое условие. Я не знаю, как мне заменить на свое. Помогите кто-то.

Решение задачи: «Вычисление суммы ряда p/q. Сумма должна быть = обычная несократимая дробь»

Листинг программы

procedure summa(n:integer;var p,q:integer);
var i:integer;
begin
p:=1;
q:=1;
for i:=2 to n do
 begin
  p:=p*i+q;
  q:=q*i;
 end;
writeln('Сумма до сокращения= ',p,'/',q);
end;
procedure sokr(var p,q:integer);
var x,y,nd:integer;
begin
{нахождение НОД по алгоритму Эвклида}
x:=p;
y:=q;
repeat
if x>y then x:=x mod y
else y:=y mod x;
until (x=0) or (y=0);
nd:=x+y;
{Сокращение}
p:=p div nd;
q:=q div nd;
writeln('Сумма после сокращения= ',p,'/',q);
end;
var p,q,n:integer;
begin
repeat
write('Введите n от 1 до 12 n=');
readln(n);
until n in [1..12];
summa(n,p,q);
sokr(p,q)
end.

Объяснение кода листинга программы

В процедуре summa переменной n присваивается значение, введенное пользователем. Переменным p и q присваиваются начальные значения 1.
Затем происходит цикл for, который выполняется от 2 до n. Внутри цикла переменные p и q пересчитываются согласно формуле p=p*i+q и q=q*i.
По завершении цикла выводится сообщение с суммой до сокращения, которая представляет собой обычную несократимую дробь.
В процедуре sokr переменным x, y и nd присваиваются начальные значения 1.
Затем следует повторный цикл repeat, который выполняется до тех пор, пока x или y не станут равными нулю.
В конце цикла переменным p и q присваиваются результаты деления x и y на их наибольший общий делитель nd.
Выводится сообщение с суммой после сокращения, которая также представляет собой обычную несократимую дробь.
В основной программе сначала запрашивается значение n от пользователя. Затем вызываются процедуры summa и sokr с соответствующими значениями p и q.