program spisok_patientov;
{$D+,L+}
uses crt;
type pat=record
     n:integer;
     c,d,fam:string[25];
     end;
     patptr=^patdin;
     patdin=record
	 dat:pat;
	 next:patptr;
     end;
var fpat:file of pat;
    first:patptr;
    st:pat;
Procedure Createfile; {создание файла}
var sym:char;
    i:integer;
begin
 clrscr;
 rewrite(fpat);
 repeat
   with st do
    begin
      write('Возраст - ');
      readln(n);
      write('Фамилия - ');
      readln(fam);
      write('Диагноз - ');
      readln(d);
       write('Город - ');
      readln(c);
      end;
  write(fpat,st);
  write('Продолжить ? [Д/Н]');
  readln(sym);
until sym in ['н','Н'];
close(fpat);
end;

Procedure List_Create(var first:patptr); {создание неотсортированного списка
с добавлением элементов в конец списка}
var tek,last:patptr;
begin
 reset(fpat);
 first:=nil;
 last:=nil;
 while not(eof(fpat)) do
 begin
  new(tek);         {выделение памяти}
  read(fpat,tek^.dat);
  {чтение информации из файла и размещение ее в поле dat эл-та списка}
  tek^.next:=nil;
  if first=nil
     then first:=tek
      else last^.next:=tek;
  last:=tek;
  end;
end;

Procedure Sort_List_Create(var first:patptr);
{создание осортир списка}
var tek,tek1,pred:patptr;
 begin
  reset(fpat);
  first:=nil;
  while not(eof(fpat)) do
   begin
     new(tek);           {выделение памяти}
     read(fpat,tek^.dat);
     tek^.next:=nil;
     if first=nil
       then first:=tek
	else
	 begin
	 tek1:=first; {поиск места для вставки}
	 pred:=nil;
	 while (tek1<>nil) and
	       (tek^.dat.fam>tek1^.dat.fam) do
	       begin
		pred:=tek1;
		tek1:=tek1^.next;
	       end;
	 if tek1=first then {вставка в начало}
	   begin
	    tek^.next:=first;
	    first:=tek;
	   end
	 else           {вставка после pred}
	  begin
	   tek^.next:=pred^.next;
	   pred^.next:=tek;
	  end;
       end;
     end;
  end;

 Procedure Print(first:patptr);   {процедура вывода списка на экран}
 var i:integer;
     tek:patptr;
 begin
  clrscr;
  tek:=first;
  while tek<>nil do
   begin
    with tek^.dat do
     begin
      write(n:3,'   ',fam,'   ':20-length(fam),'  ',d:15,'   ',c);
       writeln;
      end;
    tek:=tek^.next                 {переход к след элементу}
    end;
    writeln;
    writeln('Нажмите ENTER');
    readln;
  end;

Procedure DeleteList(var first:patptr);
{удаление списка}
var tek:patptr;
begin
 while first<>nil do
 begin
   tek:=first;
   first:=first^.next;
   dispose(tek);
 end;
end;
Procedure Del(var first:patptr);  {Удаление элемента}
var fam:string;
tek,pred:patptr;
begin
 writeln('Введите Фамилию для удаления');
 readln(fam);
 tek:=first;
 while tek<>nil do
  if tek^.dat.fam=fam then
   begin
    if tek=first
     then first:=tek^.next
      else pred^.next:=tek^.next;
      dispose(tek);
      exit
     end
   else begin
       pred:=tek;
       tek:=tek^.next
   end;
  writeln('Фамилия ',fam,' не найдена');
  end;
  begin
    assign(fpat,'pat.dat');
    {$I-}
    reset(fpat);
     {$I+}
    if IOresult<>0 then
	Createfile;
    List_Create(first);
    writeln('*************************************');
    writeln('       НЕОТСОРТИРОВАННЫЙ СПИСОК      ');
    print(first);
    writeln('*************************************');
    deletelist(first);
    Sort_List_Create(first);
    writeln('*************************************');
    writeln('       ОТСОРТИРОВАННЫЙ СПИСОК        ');
    print(first);
    writeln('*************************************');
    del(first);
    writeln('*************************************');
    writeln('       ОТКОРРЕКТИРОВАННЫЙ СПИСОК     ');
    print(first);
    writeln('*************************************');
    deletelist(first);
end.