Создать односвязный линейный список из слов строки, расположив их в алфавитном порядке

]uses crt;
 
type
  ptr = ^item;
  item = record
    words:  string;
    next:   ptr;
  end;
  
var
  head, 
  current,
  newptr,         // Показчик на елемент що вводиться.
  last,           // Показчик на останній елемент.
  prev:   ptr; 
  i:      integer;
  key:    char;   // Код дії над елементом списку.
  str:    string; // Елемент що вводиться.
  search: boolean;// Результат пошуку.
  
procedure Create; // Створення одноелементного списку.
  begin
    head := newptr;
    head^.next := nil;
  end;
  
procedure InsBeg;
  begin
    newptr^.next := head;
    head := newptr;
  end;
  
procedure SearchIns;
  begin
    current := head;
    repeat
      prev := current;
      current := current^.next;
      if current = nil then
        search := true
      else
        search := current^.words >= str;
    until search;
  end;
  
procedure InsMid;
  begin
    prev^.next := newptr;
    newptr^.next := current;
  end;
  
procedure Insert;
  begin
    write('input element: ');
    readln(str);
    New(newptr);
    newptr^.words := str;
    if head = nil then
      Create
    else
      if str <= head^.words then
        InsBeg
      else begin
        SearchIns;
        InsMid;
      end;
  end;
  
procedure DelFirst;
  begin
    head := current^.next;
    Dispose(current);
  end;
  
function SearchPlaceDel: boolean;
  begin
    repeat
      prev := current;
      current := current^.next;
    until(current^.words = str) or (current^.next = nil);
    SearchPlaceDel := current^.words = str;
  end;
  
procedure DelMid;
  begin
    prev^.next := current^.next;
    Dispose(current);
  end;
  
procedure Del;
  begin
   if head = nil then begin
      writeln('List empty. Press enter.');
      readln;
    end else begin
      writeln('input value');
      readln(str);
      current := head;
      if current^.words = str then DelFirst
      else
        if SearchPlaceDel then DelMid
        else begin
          write(str, ' not found in list');
          readln;
        end;
    end;
  end;
  
procedure OutList;
  begin
    current := head;
    if current = nil then
      writeln('List is empty.')
    else begin
      writeln('output list:');
      repeat
        write(current^.words, ' ');
        current := current^.next;
      until current = nil;
    end;
    writeln;
  end;  
  
begin
  head := nil;
  ClrScr;
  repeat
    outlist;
    writeln;
    writeln;
    writeln('1-input, d-delete, q-quit');
    key := readkey;
    case key of
      'i': insert;
      'd': del;
    end;
  until key = 'q';
end.