program gestion ;
uses crt,dos,wincrt;
{============================================================================}
 type
     paye=(payer,non_payer) ;

     diagnostique = (bon,pas_bon);

     heure=record
       h:0..23;
       m:0..59;
       end;

     date=record
      j:1..31;
      m:1..12;
      a:1900..3000;
          end;

      fmal= record
            num: integer;
            nom , prenom , adresse,lieu : string [40] ;
            dln:date;
            tel: string [14];
            diagno :diagnostique;
            end;

    rdv= record
               numrdv,nummalade:integer;
               heur :heure ;
               dt:date;
               prix:real;
               etat:paye;
         end;

{----------------------------------------------------------------------------}
var
f : file of fmal ;
frdv : file of rdv;
malade : fmal;
rd : rdv;
pos,nouvnum:integer;
rep:integer;
q:char;


{****************************************************************************}
function pnummalade:integer;{permet de donner le num‚ro du  dernier malade}
begin
pnummalade:=0;
assign(f,'c:\tp\malade.pas');
reset(f);
 while not eof(f) do
   begin
   read(f,malade);
   pnummalade:=malade.num;
   end;
end;{fin de la fonction}

function numrendezvous:integer;{permet de donner le num‚ro du dernier rendz-vous}
begin
numrendezvous:=0;
assign(frdv,'c:\tp\rdv.pas');
reset(frdv);
while not eof(frdv) do
   begin
   read(frdv,rd);
   numrendezvous:=rd.numrdv;
   end;
end;{fin fonction}

procedure afficherdv (var rdv1:file of rdv; rdve:rdv);   {affiche les informations sur un rendez-vous}
begin
with rdve do
 begin
 writeln ('Num‚ro malade : ',nummalade);
 writeln ('Heure : ',heur.h,':',heur.m);
 writeln ('Date : ',dt.j,'/',dt.m,'/',dt.a);
 writeln ('Prix : ',prix);
{ writeln ('Etat : ',etat);}
 end;

end;


procedure affichermalade(var f1:file of fmal; ma:fmal);{affiche les information du malade}
begin
writeln ('  ÌÍ͹³ Informations sur le malade³ÌÍ͹ ');
writeln;
writeln;
with ma do
  begin
  writeln ('Num‚ro du malade : ',num);
  writeln ('Nom : ',nom);
  writeln ('Pr‚nom : ',prenom);
  writeln ('Date et Lieu de Naissance : ',dln.j,'/',dln.m,'/',dln.a,' … : ',lieu);
  writeln ('T‚l : ',tel);
 { writeln ('Diagnostique : ',diagno);}
  end;
end;


function recherchemalade:boolean ;    {Proc‚dure qui permet de chercher un malade par son num‚ro et son nom}
var  trouve : boolean;
n:integer;
nom1:string[40];
begin
trouve:=false;
writeln('**** Recherche du Malade ****');
writeln;
write('Num‚ro Du Malade : '); readln (n);
write('Nom malade: '); readln(nom1);
assign(f,'malade');
reset (f) ;
while (not eof(f)) and (not trouve) do
begin
if (malade.num=n) and (malade.nom=nom1) then
    begin
        affichermalade(f,malade);
        trouve:=true;
    end
    else
    read (f,malade);
end;{fin de la bopucle while}
recherchemalade:=trouve;
if trouve = false then
writeln (' ce malade n''est pas enregistrer ');
end;



Function rechercherdv(v1:integer):boolean;{fonction qui chereche le num‚ro du rendez-vous}
var trouve:boolean;
begin
trouve:=false;
assign(frdv,'c:\tp\rdv.pas');
reset(frdv);
read(frdv,rd);
while not eof(frdv) and (trouve=false) do
 begin
 if rd.numrdv=v1 then
   begin
     afficherdv (frdv,rd);
     trouve:=true;
   end
   else
   read(frdv,rd);
 end;
rechercherdv:=trouve;
end;




procedure pause;     {Temporisation de fin du nprogramme}
begin
gotoxy(25,24);
write('Taper sur la touche <entrer> pour finir');
readln;
end;

procedure ajouterrdv (var r: file of rdv; r1: rdv);{ajouter un nouveau Rendez-vous}
begin
assign(r,'c:\tp\rdv.pas');
reset(r);
seek(r,filesize(r));
write(r,r1);
close(r);
end;

procedure ajoutermalade(var t:file of fmal; m:fmal); {ajoute le nouveau malade … la derniŠre position}
begin
assign(t,'c:\tp\malade.pas');
reset(t);
seek(t, Filesize(t));
write(t,m);
close(t);
end;


procedure lecturemalade;
var z:1..2;
begin
 with malade do
      begin
      num:=pnummalade+1;          {pnummalade est une fonction qui donne le num‚ro du dernier malade}
      nouvnum:=num;
      write ('Nom : '); readln  (nom);
      write ('Pr‚nom : '); readln (prenom);
      write ('date et lieu de naissance : ');read (dln.j );
      write ('/');read (dln.m );
      write ('/');read (dln.a);
      write ('   … : '); readln (lieu);
      write ('Adresse : '); readln (adresse);
      write ('T‚l : '); readln (tel);
      write ('diagnostique (1/2) :   1-Bon    2-pas bon'); readln(z);
      case z of
        1:diagno:=bon;
        2:diagno:=pas_bon;
        end;
     end;
end;

procedure saisiemalade;
var choix:char;
begin
choix:='o';
repeat
     writeln ('saisie des informations du malade : ');
     lecturemalade;
     ajoutermalade(f,malade);   {appel de la proc‚dure ajoutermalade}
     write(' voulez ajouter un autre malade (O/N) : '); readln(choix);
until upcase(choix)='N';
end;


procedure saisierdv;  {saisir les rendez-vous}

var a:integer;       {num‚ro du malade}
    b:string[40];    {nom du malade}
   z,ch:1..2;         {ch nouveau/ancien malade }
begin
clrscr;
writeln ('le rendez-vous est pour un : ');
writeln ('1- Nouveau malade');
writeln ('2- Malade d‚j… enregistrer');
writeln;
write ('Entrez votre choix (1/2) : '); readln (ch);
    case ch of
    1:begin
      saisiemalade;
      end;
    2:begin
      if recherchemalade then
      begin
      nouvnum:=a;
      writeln;
      writeln;
      assign(frdv,'c:\tp\rdv.pas');
      reset(frdv);
      read(frdv,rd);
      with rd do
         begin
         numrdv:=numrendezvous+1;                {incr‚mentation du num‚ro rendez-vous}
         nummalade:=nouvnum;
         writeln (' Saisissez Un Rrendez-Vous ');
         write('Heure du rendez-vous : '); read(heur.h);
         write(':'); readln(heur.m);
         write('Date du rendez-vous : '); read(dt.j);
         write('/'); read(dt.m);
         write('/'); readln(dt.a);
         write('Prix : '); readln(prix);
         write('Payer   (1/2)     :     1-Oui     2-Non'); readln(z);
         case z of
            1:etat:=payer;
            2:etat:=non_payer;
            end;
         end;
      ajouterrdv(frdv,rd);
      end
    else
    writeln('ce malade n''est pas enregistrer');
    end;
  end;
end;

procedure decalage(var x:integer);
var rd1:rdv;                             {enregistrement interm‚diaire pour la permutation}
begin
if x<>filesize(frdv) then  {l'enregistrement … supprimer n'est pas le dernier enregistrement}
begin
seek(frdv,x+1);
read(frdv,rd);
while (x<>filesize(frdv)) do
  begin
  rd1.numrdv:=rd.numrdv;
  rd1.nummalade:=rd.nummalade;
  rd1.heur:=rd.heur;
  rd1.dt:=rd.dt;
  rd1.prix:=rd.prix;
  rd1.etat:=rd.etat;
  seek(frdv,x);
  rd.numrdv := rd1.numrdv;
  rd.nummalade:=rd1.nummalade;
  rd.heur:=rd1.heur;
  rd.dt:=rd1.dt;
  rd.prix:=rd1.prix;
  rd.etat:=rd1.etat;
  seek(frdv,x+1);
  read(frdv,rd);
  x:=x+1;
  end;
end;
seek(frdv,x-1);
truncate(frdv);       {force la fin de fichier … la position courante }
close(frdv);
writeln ('rendez-vous annuler');
end;


procedure annuler;
var tr:boolean;    {annule le rendez-vous, elle utilise le procedure decalage}
nrdv:integer;
begin
clrscr;
write (' entrez le num‚ro du rendez-vous … supprimer : '); readln (nrdv);
tr:=false;
assign(frdv,'c:\tp\rdv.pas');
reset(frdv);
read(frdv,rd);
while not eof(frdv) and not (tr) do
   begin
   if rd.numrdv=nrdv then
      begin
      pos:=filepos(frdv);
      decalage(pos);
      tr:=true;
      end
      else
      read(frdv,rd);
   end;
if tr=false then
begin
   close(frdv);
   writeln('le num‚ro que vous avez entrer n''existe pas');
end;
end;

procedure recette;{proc‚dure qui calcule le montant total de la recette }
var rec:real;
begin
clrscr;
rec:=0;
assign(frdv,'c:\tp\rdv.pas');
reset (frdv);
read(frdv,rd);
while not eof(frdv) do
begin
if rd.etat=payer then
rec:=rec+rd.prix;

read(frdv,rd);
end;
writeln('le Montant de la Recette est de : ',rec);
end;

procedure encaissement;
var numr:integer;
begin
clrscr;
writeln('**** E N C A I S S E M E N T ****');
writeln;
write('Entrez le num‚ro du rendez-vous : '); readln(numr);
if rechercherdv(numr)=true then
begin
rd.etat:=payer;
writeln('argent encaisser');
end
else
writeln('ce num‚ro n''existe pas');
end;

{===========================================================================}
{            P R O G R A M M E  P R I N C I P A L E                         }
{===========================================================================}

begin
assign (f,'c:\tp\malade.pas');
rewrite (f);
assign(frdv,'c:\tp\rdv.pas');
rewrite(frdv);
q:='o';
repeat
 clrscr;
writeln('²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²');
writeln('²                                                         ²');
writeln('²  G E S T I O N  D''U N  C A B I N E T   M E D I C A L E  ²');
writeln('²                                                         ²');
writeln('²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²');
writeln;
writeln;
writeln ('             1-Nouveau Malade');
writeln ('             2-Nouveau Rendez-Vous');
writeln ('             3-Annuler Rendez-Vous');
writeln ('             4-calculer la recette');
writeln ('             5-Encaissement');
writeln ('             6-Quitter');
writeln;
writeln;
write('Entrez votre choix : ');
readln (rep);

case rep of
   1:saisiemalade;
   2:saisierdv;
   3:annuler;
   4:recette;
   5:encaissement;
   6:q:='N';
   end;

until upcase(q)='N';
pause;
end.