Programa sobre Ficheiros Definidos pelo Programador

Program Hospital;

type hosp=record

        ndoente:integer;

        nome:string;

morada:string;

estado:string;

nss:string;

        tconsulta:string;

        data:string;

        reforma:string;

end;

var fich: file of hosp;

a,op:integer;

dat:string;

        paciente:hosp;

        custo:real;

procedure criar_ficheiro;

begin

assign(fich,'Hospital.dat');

rewrite(fich);

        close(fich);

end;

procedure dados;

begin

reset(fich);

seek(fich, filesize(fich));

write('N. do paciente (4 digitos) -->');

Readln(paciente.ndoente);

        write('Nome do paciente   -->');

Readln(paciente.nome);

Write('Morada             -->');

readln(paciente.morada);

        Repeat

                writeln('Qual o estado civil?');

                writeln('1-Casado');

                writeln('2-Solteiro');

                writeln('3-Vi£vo');

                writeln('4-Divorciado');

                Readln(a);

                If a=1 Then paciente.estado:='Casado';

                If a=2 Then paciente.estado:='Solteiro';

                If a=3 Then paciente.estado:='Vi£vo';

                If a=4 Then paciente.estado:='Divorciado';

        until ((a=1) or (a=2) or (a=3) or (a=4));

        write('Numero da Seguran‡a Social (4 digitos) -->');

Readln(paciente.nss);

        Repeat

                writeln('Qual o tipo de consulta?');

                writeln('1-Urgencia');

                writeln('2-Marcada');

                Readln(a);

                If a=1 Then paciente.tconsulta:='Urgencia';

                If a=2 Then paciente.tconsulta:='Marcada';

        until ((a=1) or (a=2));

        write('Data da consulta -->');

Readln(paciente.data);

        Repeat

                writeln('Reformado?');

                writeln('1-Sim');

                writeln('2-NÆo');

                Readln(a);

                If a=1 Then paciente.reforma:='Sim';

                If a=2 Then paciente.reforma:='NÆo';

        until ((a=1) or (a=2));

write(fich,paciente);

close(fich);

end;

procedure listar;

begin

reset(fich);

        If filesize(fich)=0 then

        Write('NÆo h  consultas marcadas')

        Else

        Begin

        Writeln('N§ de SS', '====','Nome','====','Morada','====','Estado','====','Tipo de Consulta','====','Data');

        Writeln('==================================================');

        while not eof (fich) do

begin

read(fich,paciente);

       Writeln(paciente.nss,'          ',paciente.nome,'     ',paciente.morada,'        ',paciente.estado, '       ',paciente.tconsulta,'       ',paciente.data);

                 end;

close(fich);

        end;

end;

Procedure consultar;

begin

write('Introduza a data -->');

read(dat);

        reset(fich);

        Writeln('N§ de SS', '====','Nome','====','Morada','====','Estado','====','Tipo de Consulta','====','Data');

        Writeln('==================================================');

        while not eof (fich) do

begin

read(fich,paciente);

                        if paciente.data=dat then

       Writeln(paciente.nss,'   ',paciente.nome,'   ',paciente.morada,'    ',paciente.estado, '    ',paciente.tconsulta,'    ',paciente.data);

                 end;

end;

procedure relatorio;

begin

reset(fich);

        Writeln('N§ de SS','--------','Nome','--------','Total a Pagar');

        While not eof (fich) do

        begin

        read(fich, paciente);

        custo:=0;

if paciente.estado='Casado' then custo:=custo+10;

        if paciente.estado='Solteiro' then custo:=custo+12;

        if paciente.estado='Vi£vo' then custo:=custo+5;

        if paciente.estado='Divorciado' then custo:=custo+5;

        if paciente.tconsulta='Urgencia' then custo:=custo+2;

        if paciente.reforma='Sim' then custo:=custo*0.8;

        Writeln(paciente.nss,'                     ',paciente.nome,'                  ',custo:4:2,'euros');

end;

        close(fich);

end;

procedure apagar;

begin

rewrite(fich);

end;

//Programa principal

repeat

                Writeln;

                Writeln;

                

writeln('# Escolha uma das opcoes:#');

    Writeln('#      1-Criar ficheiro');

    Writeln('#      2-Introduzir dados das consultas');

    writeln('#      3-Apresentar todas as consultas marcadas');

    writeln('#      4-Apresentar as consultas marcadas para um determinado dia');

    writeln('#      5-Relat¢rio de custos das consultas');

          Writeln('#      6-Apagar os pacientes da lista de consultas');

    writeln('#      7-Sair');

                readln(op);

    case op of

    1:criar_ficheiro;

    2:dados;

    3:listar;

    4:consultar;

    5:relatorio;

    6:apagar;

    end;

until(op=7);

 End.