Program Beadando; {Tarcsi Adam}
Uses newdelay,crt;

Const Nmax=200;
      mezohossz=30;
Type rekord=record
      nev:string[mezohossz];
      laz:real;
      kor:integer;
      sorszam:integer;
      megjegyzes:string;
     End;
     tomb=array [1..Nmax] of rekord;

Var i,j,k:integer;
    beteg:tomb;
    n,e,db,ok,egesz:integer;
    valos:real;
    jo,megf:boolean;

Procedure beolvasas;
Var
   be:string;
   megj:char;
  Function Ellenorzes1 (szam:integer; int1:integer; int2:integer):boolean;
     Begin
          jo:=(ok=0) and ((szam>=int1) and (szam<=int2));
          if not jo then
                        begin
                        textcolor(red);
                        gotoxy(20,15);
                        if (ok<>0) then writeln ('Nem eg�szet vagy nem sz�mot irt')
                        else
                        if szam>int2 then writeln(int2,'-n�l/n�l nagyobbat �rt')
                                     else writeln(int1,'-nal/nel kissebbet �rt');
                        Writeln('Nyomjon meg egy billenty�t es pr�b�lja �jra!');
                        Readkey;
                        textcolor(white);
                        end;
          Ellenorzes1:=jo;
     End;
    Function Ellenorzes2 (szam:real; int1:real; int2:real):boolean;
     Begin
          jo:=(ok=0) and ((szam>=int1) and (szam<=int2));
          if not jo then
                        begin
                        gotoxy(20,13);
                        textcolor(red);
                        if (ok<>0) then writeln ('Nem sz�mot �rt')
                        else
                        if szam>int2 then writeln(int2:2:0,'-n�l/n�l nagyobbat �rt')
                                     else writeln(int1:2:0,'-n�l/n�l kissebbet �rt');
                        Writeln('Nyomjon meg egy billenty�t �s pr�balja �jra!');
                        Readkey;
                        textcolor(white);
                        end;
          Ellenorzes2:=jo;
     End;
  Function joS:boolean;
     Var j:integer;
     Begin
        j:=1; jo:=true;
        While (j<=i-1) and jo do
          Begin
            if beteg[j].sorszam=egesz then
                                       Begin
                                         textcolor(red);
                                         gotoxy(20,13);
                                         writeln('A sorsz�m m�r l�tezik!');
                                         Writeln('Nyomjon meg egy billenty�t �s pr�balja �jra');
                                         Readkey;
                                         textcolor(white);
                                         jo:=false;
                                       End;
            j:=j+1;
          End;
     joS:=jo
     End;

  Function Hosszell (szoveg:string; int1:integer):boolean;
     Begin
        jo:=true;
        If (length(szoveg)>int1) or (szoveg='') then
                                begin
                                  textcolor(red);
                                  gotoxy(20,13);
                                  if length(szoveg)>int1 then Writeln('A szoveg t�l hossz�!');
                                  if szoveg='' then writeln('Nem �rt be semmit');
                                  Writeln('Nyomjon meg egy billenty�t es pr�balja �jra!');
                                  Readkey;
                                  textcolor(white);
                                  jo:=false;
                                end;
        Hosszell:=jo;
     End;
  Procedure torles(x:integer;y:integer);
     Begin
       GotoXY(20,13);
       Writeln('                                                          ');
       Writeln('                                                          ');
       Writeln('                                                          ');
       Writeln('                                                          ');
       GotoXY(x,y);
       Writeln('                                                          ');
     End;

Begin
Clrscr;
   repeat
     torles(28,13);
     gotoxy(28,13);
     write ('A betegek sz�ma (1-200): '); readln(be);
     val(be,n,ok);
     until ellenorzes1(n,1,nmax);
 megf:=true; i:=1;
 For i:=1 to n do
 Begin
 repeat
   clrscr;
   writeln('���������������������������������   ',i,'. beteg   ���������������������������������� ');
   gotoxy(1,2); Writeln('      ');
   repeat
      torles(1,3);
      gotoxy(1,3);
      write('Neve (max ',mezohossz,' karakter): ');
      readln(be);
   until hosszell(be,mezohossz);
   beteg[i].nev:=be;
   repeat
      torles(1,4);
      Gotoxy(1,4);
      write('H�mr�s�klete (35-43 C�): ');
      readln(be);
      val(be,valos,ok)
   until ellenorzes2(valos,35,43);
   beteg[i].laz:=valos;
   repeat
      torles(1,5);
      Gotoxy(1,5);
      write('�letkora (0-150): ');
      readln(be);
      val(be,valos,ok);
   until ellenorzes2(valos,0,150);
   beteg[i].kor:=round(valos);
   repeat
      torles(1,6);
      gotoxy(1,6);
      write('Sorsz�ma (1-',Nmax,'): ');
      readln(be);
      val(be,egesz,ok);
   until (joS) and (ellenorzes1(egesz,1,Nmax));
   beteg[i].sorszam:=egesz;
   gotoxy(1,7);
   writeln('Kiv�n a beteghez megjegyz�st f�zni? (I/N) ');
   repeat
         megj:=readkey;
   until megj in['I','i','N','n'];
   if (megj='i') or (megj='I') then
            Begin
              repeat
                torles(1,8);
                gotoxy(1,8);
                write('Megjegyz�s: ');
                readln(be);
              until hosszell(be,255);
              beteg[i].megjegyzes:=be;
            End;
   Writeln('Megfelelnek az adatok val�s�gnak? (I/N) ');
   Repeat
     megj:=readkey;
   Until megj in['I','i','N','n'];
   If (megj='i') or (megj='I') then megf:=true
                               else megf:=false;
 Until megf;
 End;
End;

Procedure szetval;
var sv:rekord;
    e,u:integer;
Procedure felvesz (var a,b:rekord);
Begin
  a.nev:=b.nev;
  a.laz:=b.laz;
  a.kor:=b.kor;
  a.sorszam:=b.sorszam;
  a.megjegyzes:=b.megjegyzes;
End;
Begin
  felvesz(sv,beteg[1]);
  e:=1;u:=n;
  while e<u do
        begin
          while (e<u) and ((beteg[u].laz>=37.5) and (beteg[u].laz<=38.5)) do
            u:=u-1;
          If e<u then
            Begin
              felvesz(beteg[e],beteg[u]);
              e:=e+1;
            End;
          while (e<u) and ((beteg[e].laz>38.5) or (beteg[e].laz<37.5)) do
           e:=e+1;
          If e<u then
            Begin
              felvesz(beteg[u],beteg[e]);
              u:=u-1;
            End;
        End;
  felvesz(beteg[e],sv);
  If (beteg[e].laz>38.5) or (beteg[e].laz<37.5) then db:=e
                                                else db:=e-1;
End;

Procedure rendezes(hatar1:integer; hatar2:integer);
 Procedure csere (var a,b:rekord);
    var sv:rekord;
    Begin
         sv.nev:=a.nev;
         sv.laz:=a.laz;
         sv.kor:=a.kor;
         sv.sorszam:=a.sorszam;
         sv.megjegyzes:=a.megjegyzes;

         a.nev:=b.nev;
         a.laz:=b.laz;
         a.kor:=b.kor;
         a.sorszam:=b.sorszam;
         a.megjegyzes:=b.megjegyzes;

         b.nev:=sv.nev;
         b.laz:=sv.laz;
         b.kor:=sv.kor;
         b.sorszam:=sv.sorszam;
         b.megjegyzes:=sv.megjegyzes;
    End;
 Begin
  for i:=hatar1 to hatar2 do
   begin
     for j:=i+1 to hatar2 do
       begin
         if beteg[i].sorszam>beteg[j].sorszam then csere(beteg[i],beteg[j]);
       end;
   end;
   for k:=1 to n do
   writeln(beteg[k].nev,' ',beteg[k].sorszam);
  end;

Procedure Ujsorsz(hatar1:integer; hatar2:integer);
Begin
  j:=1;
  for i:=hatar1 to hatar2 do
   Begin
     beteg[i].sorszam:=j;
     j:=j+1;
   End;
End;

Procedure kiiras(hatar1:integer; hatar2:integer;orvos:integer);
   var betegszam,lap,intw:integer;
   Begin
     lap:=1;i:=hatar1;j:=1;
     intw:=hatar2-hatar1+1;
     if ((intw) mod 20)=0 then betegszam:=(intw) div 20
                                   else betegszam:=((intw) div 20) +1;
     While lap<=betegszam  do
          Begin
            clrscr;
            Writeln('��������������������������� A(z) ',orvos,'. orvos betegei  ������������������������������ ');
            GotoXY(1,2);  Write('NEV');
            GotoXY(40,2); Write('SORSZAM');
            GotoXY(60,2); Writeln('LAZ');
            While (j<=20) and (i<=hatar2) do
                  begin
                    GotoXY(1,j+3); Write(beteg[i].nev);
                    GotoXY(40,j+3);Write(beteg[i].sorszam);
                    GotoXY(60,j+3);Write(beteg[i].laz:2:2);
                    j:=j+1; i:=i+1;
                  End;
             GotoXY(1,24); Writeln('Nyomjon meg egy billenty�t a folytat�shoz!');
             readkey;
            lap:=lap+1; j:=1;
          End;

   ok:=ok+1;
   End;


BEGIN
TextBackground(LightBlue);
Textcolor(white);
Beolvasas;
Szetval;
Rendezes(1,db);
Rendezes(db+1,n);
Ujsorsz(1,db);
Ujsorsz(db+1,n);
Clrscr;
Kiiras(1,db,1);
Kiiras(db+1,n,2);
END.