Здравствуйте, Кирилл Демидов.
В приложении код программы. Тут пример окна вывода, когда назначение вывода по специальностям - на экран (в исходном коде именно так)

Кое-что комментировал, но, ессно, не все - что непонятно будет, спрашивайте.
На всяк случай пристегнул исходный код в архиве 7z

Приложение:
uses CRT;
CONST
inFileName : String = 'student.dat';
nameLen = 20;
specLen = 6;
TYPE
PStudents = ^TStudents;
TStudents = record
Name : String[nameLen];
Number: Longint;
speciality: String[specLen];
group : Integer; {две последние цифры}
next : PStudents;
end;

PSpec = ^TSpec;
TSpec = record
spec: String[specLen];
next: PSpec;
end;

function UpRuss(src: String): String; {стандартная только для "их" букв.
А для сравнения не нужно учитывать регистр}
var i, len: Integer;
begin
len := length(src);
for i:=1 to len do
case src[i] of
'a'..'z': src[i] := UpCase(src[i]);
'а'..'п': src[i] := chr(ord(src[i]) - 32);
'р'..'я': src[i] := chr(ord(src[i]) - 80);
end;
UpRuss := src
end;

function Exists(s: PStudents; aName: String;
aNumber: Longint; aSpeciality: String;
aGroup : Integer): PStudents;
{если есть, то возвращает запись, если нет - то NIL}
var p: PStudents;
begin
Exists:= NIL;
if s = nil then Exit;
p := s;
while p <> nil do begin
{проверяем по трем полям}
if (UpRuss(copy(aName, 1, nameLen)) = UpRuss(p^.Name))
and (aNumber = p^.Number)
and (UpRuss(copy(aSpeciality, 1, specLen)) = p^.Speciality) then
begin Exists := p; Break end;
p:= p^.Next;
end;
end;

function Add(var s: PStudents; aName: String;
aNumber: Longint; aSpeciality: String;
aGroup : Integer): Integer;
{число добавленных: 0 или 1}
var p, q: pStudents;
begin
Add:=0;
if Exists(s, aName, aNumber, aSpeciality, aGroup) <> NIL then Exit;
New(p);
p^.Name := copy(aName, 1, nameLen);
p^.Number := aNumber;
p^.Speciality := copy(aSpeciality, 1, specLen);
p^.Group := aGroup;
p^.Next := nil;
if s = nil then s := p else
begin
{Ищем конец списка}
q:= s;
while q^.next <> nil do q:= q^.next;
q^.Next := p;
end;
Add := 1
end;

{Символы, которые являются разделителями полей}
CONST
Devs: Set of Char = ['-',',','.',' ',#9,#13,#10,#27];
{9 = знак табуляции, 13 - возврат в начало строки,
10 - переход на следующую. 27 - часто конец файла}
Numbers: Set of Char = ['0'..'9'];

function AddAsFullString(var s: PStudents; Line: String): Integer;
var aName, aSpec: String;
aNumber : LongInt;
aGroup : Integer;
i, len: Integer;
begin
AddAsFullString := 0;
aName := ''; aSpec := ''; aNumber := 0; aGroup:=0;
i:=1; len := length(Line);
while (Line[i] in Devs) and (i <= len) do inc(i); {пропуск в начале может что}
while (NOT (line[i] in Devs)) and (i <= len) do
begin aName := aName + Line[i]; inc(i) end;
while (Line[i] in Devs) and (i <= len) do inc(i);
while (Line[i] in Numbers) and (i <= len) do begin
aNumber := aNumber * 10 + ord(Line[i]) - ord('0');
inc(i) end;
while (Line[i] in Devs) and (i <= len) do inc(i);
while (NOT (Line[i] in Devs)) and (i <= len) do begin
aSpec := aSpec + Line[i]; inc(i);
end;
while (Line[i] in Devs) and (i <= len) do inc(i);
while (Line[i] in Numbers) and (i <= len) do begin
aGroup := aGroup * 10 + ord(Line[i]) - ord('0');
inc(i) end;
AddAsFullString := Add(s, aName, aNumber, aSpec, aGroup)
end;

procedure PrintOne(p: PStudents; var aFile: Text);
begin
if p = NIL then Exit;
WriteLn(aFile, p^.Name,' ', p^.Number:7,' ',
p^.speciality,'-',p^.group);
end;

procedure PrintOneSpec(p: PStudents; var aFile: Text);
begin
if p = NIL then Exit;
WriteLn(aFile, p^.Name,'-', p^.Number:7);
end;

{Таблица перевода русских букв в латинские для имен файлов}
const
RussL: String = 'АБВГДЕЖЗИКЛМНОПРСТУФХЦ'; {Не все предусмотрены!!}
LatL: String = 'ABVGDEJZIKLMNOPRSTUFXC';

{Для того, чтобы в файл - любой символ в DEST. Пустой = на экран}
procedure PrintSpeciality(s: PStudents; spec: String; dest: String);
var p: PStudents; i: Integer;
f: Text;
begin
if s = nil then Exit;
if dest <> '' then begin
dest := spec;
dest := UpRuss(copy(dest, 1, specLen));
for i:=1 to length(dest) do
begin
if POS(dest[i], RussL) <> 0 then
dest[i] := LatL[POS(dest[i], RussL)];
end;
dest := dest+'.txt';
end; {Если пустой, то на экран, по-прежнему}
Assign(f, dest); Rewrite(f);
p:= s;
WriteLn(f,'Специальность ',spec);
WriteLn(f,'Фамилия-номер');
WriteLn(f,'-------------------------');
while p <> nil do begin
if spec = p^.Speciality then PrintOneSpec(p, f);
p := p^.next
end;
Flush(f); Close(f);
end;


procedure printAllSpecs(s: PStudents; ToScreen: Boolean);
{Вывод все специальности в свои файлы}
var p: PStudents;
sp, qp: PSpec;
e: Boolean;
Destignation: String;
begin
if s = nil then Exit;

if ToScreen then Destignation := '' else Destignation := 'a';
{Определим, какие есть специальности}
sp:= nil;
p := s;
while p <> nil do begin
if sp = nil then begin
New(sp); sp^.Spec := p^.Speciality;
sp^.Next := nil;
end
else
begin
{Ищем, есть ли уже такая}
qp := sp;
e:=FALSE;
while qp <> nil do
begin
if qp^.spec = p^.Speciality then
begin
e:=TRUE; Break {немедл. выход из цикла этого}
end;
qp := qp^.next
end;
if NOT e then begin
{Ищем конец очереди}
qp := sp;
while qp^.Next <> nil do qp:= qp^.Next;
New(qp^.Next);
qp^.Next^.Next := nil;
qp^.Next^.Spec := p^.Speciality;
end;
end;
p:= p^.next
end;
{Создаем файлы и заполняем}
qp := sp; {Теперь здесь уникальные имена}
while qp <> nil do begin
PrintSpeciality(s, qp^.spec, Destignation);
qp := qp^.next;
if ToScreen then WriteLn
end;

{Удаление - очистка списка}
while sp <> nil do begin
qp := sp^.Next;
dispose(sp);
sp := qp
end
end;

procedure PrintAll(s: PStudents; dest: String);
{Выводит в файл с именем dest. Если на экран, то нужно dest := ''}
var p: PStudents;
f: Text;
begin
if s = nil then WriteLn('База данных пуста') else
begin
Assign(f, dest); Rewrite(f);
p := s;
while p <> nil do begin
PrintOne(p, f);
p := p^.next
end;
Flush(f); Close(f)
end;
end;

procedure Free(var s: PStudents);
var p: PStudents;
begin
if s = nil then Exit;
while s <> nil do begin
p:= s^.next;
dispose(s);
s := p;
end;
end;

function ReadFileToBase(aFileName: String; var s: PStudents): Integer;
var f: Text;
str: String; count : Integer;
begin
Count := 0;
Assign(f, aFileName);
{$I-} Reset(f); {$I+}
if IOResult <> 0 then begin
WriteLn('Не могу открыть файл ', aFileName);
WriteLn('Нажмите любую клавишу'); ReadKey;
ReadFileToBase := 0; Exit
end;
ReadLn(f, str); ReadLn(f, str); {пропускаем две строки}
while NOT SeekEOF(f) do begin
ReadLn(f, str);
count := count + AddAsFullString(s, str);
end;
ReadFileToBase := count;
end;

VAR
Students: PStudents;
BEGIN
ClrScr;
Students:= NIL;
ReadFileToBase('student.dat', Students);
PrintAll(Students, ''); {Если пустое имя файла = на экран}
WriteLn;
printAllSpecs(Students, True);
Free(Students);
END.

Здравствуйте, Кирилл Демидов.
В приложении код программы. Тут пример окна вывода, когда назначение вывода по специальностям - на экран (в исходном коде именно так)

Кое-что комментировал, но, ессно, не все - что непонятно будет, спрашивайте.
На всяк случай пристегнул исходный код в архиве 7z

Приложение:
uses CRT;
CONST
inFileName : String = 'student.dat';
nameLen = 20;
specLen = 6;
TYPE
PStudents = ^TStudents;
TStudents = record
Name : String[nameLen];
Number: Longint;
speciality: String[specLen];
group : Integer; {две последние цифры}
next : PStudents;
end;

PSpec = ^TSpec;
TSpec = record
spec: String[specLen];
next: PSpec;
end;

function UpRuss(src: String): String; {стандартная только для "их" букв.
А для сравнения не нужно учитывать регистр}
var i, len: Integer;
begin
len := length(src);
for i:=1 to len do
case src[i] of
'a'..'z': src[i] := UpCase(src[i]);
'а'..'п': src[i] := chr(ord(src[i]) - 32);
'р'..'я': src[i] := chr(ord(src[i]) - 80);
end;
UpRuss := src
end;

function Exists(s: PStudents; aName: String;
aNumber: Longint; aSpeciality: String;
aGroup : Integer): PStudents;
{если есть, то возвращает запись, если нет - то NIL}
var p: PStudents;
begin
Exists:= NIL;
if s = nil then Exit;
p := s;
while p <> nil do begin
{проверяем по трем полям}
if (UpRuss(copy(aName, 1, nameLen)) = UpRuss(p^.Name))
and (aNumber = p^.Number)
and (UpRuss(copy(aSpeciality, 1, specLen)) = p^.Speciality) then
begin Exists := p; Break end;
p:= p^.Next;
end;
end;

function Add(var s: PStudents; aName: String;
aNumber: Longint; aSpeciality: String;
aGroup : Integer): Integer;
{число добавленных: 0 или 1}
var p, q: pStudents;
begin
Add:=0;
if Exists(s, aName, aNumber, aSpeciality, aGroup) <> NIL then Exit;
New(p);
p^.Name := copy(aName, 1, nameLen);
p^.Number := aNumber;
p^.Speciality := copy(aSpeciality, 1, specLen);
p^.Group := aGroup;
p^.Next := nil;
if s = nil then s := p else
begin
{Ищем конец списка}
q:= s;
while q^.next <> nil do q:= q^.next;
q^.Next := p;
end;
Add := 1
end;

{Символы, которые являются разделителями полей}
CONST
Devs: Set of Char = ['-',',','.',' ',#9,#13,#10,#27];
{9 = знак табуляции, 13 - возврат в начало строки,
10 - переход на следующую. 27 - часто конец файла}
Numbers: Set of Char = ['0'..'9'];

function AddAsFullString(var s: PStudents; Line: String): Integer;
var aName, aSpec: String;
aNumber : LongInt;
aGroup : Integer;
i, len: Integer;
begin
AddAsFullString := 0;
aName := ''; aSpec := ''; aNumber := 0; aGroup:=0;
i:=1; len := length(Line);
while (Line[i] in Devs) and (i <= len) do inc(i); {пропуск в начале может что}
while (NOT (line[i] in Devs)) and (i <= len) do
begin aName := aName + Line[i]; inc(i) end;
while (Line[i] in Devs) and (i <= len) do inc(i);
while (Line[i] in Numbers) and (i <= len) do begin
aNumber := aNumber * 10 + ord(Line[i]) - ord('0');
inc(i) end;
while (Line[i] in Devs) and (i <= len) do inc(i);
while (NOT (Line[i] in Devs)) and (i <= len) do begin
aSpec := aSpec + Line[i]; inc(i);
end;
while (Line[i] in Devs) and (i <= len) do inc(i);
while (Line[i] in Numbers) and (i <= len) do begin
aGroup := aGroup * 10 + ord(Line[i]) - ord('0');
inc(i) end;
AddAsFullString := Add(s, aName, aNumber, aSpec, aGroup)
end;

procedure PrintOne(p: PStudents; var aFile: Text);
begin
if p = NIL then Exit;
WriteLn(aFile, p^.Name,' ', p^.Number:7,' ',
p^.speciality,'-',p^.group);
end;

procedure PrintOneSpec(p: PStudents; var aFile: Text);
begin
if p = NIL then Exit;
WriteLn(aFile, p^.Name,'-', p^.Number:7);
end;

{Таблица перевода русских букв в латинские для имен файлов}
const
RussL: String = 'АБВГДЕЖЗИКЛМНОПРСТУФХЦ'; {Не все предусмотрены!!}
LatL: String = 'ABVGDEJZIKLMNOPRSTUFXC';

{Для того, чтобы в файл - любой символ в DEST. Пустой = на экран}
procedure PrintSpeciality(s: PStudents; spec: String; dest: String);
var p: PStudents; i: Integer;
f: Text;
begin
if s = nil then Exit;
if dest <> '' then begin
dest := spec;
dest := UpRuss(copy(dest, 1, specLen));
for i:=1 to length(dest) do
begin
if POS(dest[i], RussL) <> 0 then
dest[i] := LatL[POS(dest[i], RussL)];
end;
dest := dest+'.txt';
end; {Если пустой, то на экран, по-прежнему}
Assign(f, dest); Rewrite(f);
p:= s;
WriteLn(f,'Специальность ',spec);
WriteLn(f,'Фамилия-номер');
WriteLn(f,'-------------------------');
while p <> nil do begin
if spec = p^.Speciality then PrintOneSpec(p, f);
p := p^.next
end;
Flush(f); Close(f);
end;


procedure printAllSpecs(s: PStudents; ToScreen: Boolean);
{Вывод все специальности в свои файлы}
var p: PStudents;
sp, qp: PSpec;
e: Boolean;
Destignation: String;
begin
if s = nil then Exit;

if ToScreen then Destignation := '' else Destignation := 'a';
{Определим, какие есть специальности}
sp:= nil;
p := s;
while p <> nil do begin
if sp = nil then begin
New(sp); sp^.Spec := p^.Speciality;
sp^.Next := nil;
end
else
begin
{Ищем, есть ли уже такая}
qp := sp;
e:=FALSE;
while qp <> nil do
begin
if qp^.spec = p^.Speciality then
begin
e:=TRUE; Break {немедл. выход из цикла этого}
end;
qp := qp^.next
end;
if NOT e then begin
{Ищем конец очереди}
qp := sp;
while qp^.Next <> nil do qp:= qp^.Next;
New(qp^.Next);
qp^.Next^.Next := nil;
qp^.Next^.Spec := p^.Speciality;
end;
end;
p:= p^.next
end;
{Создаем файлы и заполняем}
qp := sp; {Теперь здесь уникальные имена}
while qp <> nil do begin
PrintSpeciality(s, qp^.spec, Destignation);
qp := qp^.next;
if ToScreen then WriteLn
end;

{Удаление - очистка списка}
while sp <> nil do begin
qp := sp^.Next;
dispose(sp);
sp := qp
end
end;

procedure PrintAll(s: PStudents; dest: String);
{Выводит в файл с именем dest. Если на экран, то нужно dest := ''}
var p: PStudents;
f: Text;
begin
if s = nil then WriteLn('База данных пуста') else
begin
Assign(f, dest); Rewrite(f);
p := s;
while p <> nil do begin
PrintOne(p, f);
p := p^.next
end;
Flush(f); Close(f)
end;
end;

procedure Free(var s: PStudents);
var p: PStudents;
begin
if s = nil then Exit;
while s <> nil do begin
p:= s^.next;
dispose(s);
s := p;
end;
end;

function ReadFileToBase(aFileName: String; var s: PStudents): Integer;
var f: Text;
str: String; count : Integer;
begin
Count := 0;
Assign(f, aFileName);
{$I-} Reset(f); {$I+}
if IOResult <> 0 then begin
WriteLn('Не могу открыть файл ', aFileName);
WriteLn('Нажмите любую клавишу'); ReadKey;
ReadFileToBase := 0; Exit
end;
ReadLn(f, str); ReadLn(f, str); {пропускаем две строки}
while NOT SeekEOF(f) do begin
ReadLn(f, str);
count := count + AddAsFullString(s, str);
end;
ReadFileToBase := count;
end;

VAR
Students: PStudents;
BEGIN
ClrScr;
Students:= NIL;
ReadFileToBase('student.dat', Students);
PrintAll(Students, ''); {Если пустое имя файла = на экран}
WriteLn;
printAllSpecs(Students, True);
Free(Students);
END.