Buenas tardes estimados amigos de aprender a programar tengo un problema con una materia de la universidad, estudio ingeniería industrial y me toca ver programación en pascal; me mandaron un trabajo y no soy experto en esto, de por sí es la única materia que veo y veré en mi carrera sobre el tema. Desearía su ayuda pues el programa no me corre y desearía ver que problema tengo y si alguien me puede ayudar a resolverlo, cosa que agradecería mucho.
El ejercicio es el siguiente:
La Clínica “La Mejor requiere un sistema automatizado para registrar a los pacientes que son atendidos, de tal modo, que se puedan obtener datos específicos tales como: las estadísticas en atención a menores de edad, adultos mayores, tanto femenino como masculino, los ingresos recaudados mensualmente según los tipos de patologías atendidas, entre otros. Es importante destacar, que se han clasificado estas patologías en tres categorías: las tipo A, las B y las tipo C; y se deberán tomar en cuenta las siguientes especificaciones, al momento de ser atendidas en la Clínica:
1. Los pacientes deberán cancelar Bs. 500 por ingreso a la clínica.
2. Deberán pagar diariamente Bs. 550 si son atendidos por patologías tipo A.
3. Bs. 430 si se trata de las tipos B.
4. Bs. 620 si es por las tipos C.
El sistema debe cumplir con las siguientes pautas:
Presentar un menú de mantenimiento con las opciones:
• Incluir
• Consultar
• Modificar
• Eliminar
• Reporte
• Salida
Debe registrar, con la opción Incluir, los siguientes datos:
• Cédula de Identidad.
• Apellidos y Nombres.
• Edad.
• Sexo.
• Días de hospitalización.
• Tipo de patologías (A/B/C).
• Debe ordenar el registro de pacientes por el número de la cédula de identidad.
• Mostrar por pantalla, cuando se consulte a un paciente por su número de cédula de identidad, toda la información referente al mismo.
• Mostrar por pantalla, en la opción Modificar y en la opción Eliminar, un mensaje de confirmación, donde el usuario ratifica la acción de modificar
• eliminar datos en el sistema.
• Las opciones Consultar, Modificar y Eliminar, harán uso de los mismos datos registrados en la opción Incluir.
• La opción Reporte, debe generar un listado impreso que presente la siguiente información:
• Ingresos recaudados por patologías tipo A.
• Ingresos recaudados por patologías tipo B.
• Ingresos recaudados por patologías tipo C.
• Número de pacientes atendidos menores de 18 años.
• Número de pacientes atendidos mayores de 65 años sexo femenino.
• Número de pacientes atendidos mayores de 65 años sexo masculino.
El programa como tal es el que se ve a continuación:
{PROGRAMA DE PASCAL CLINICA LA MEJOR}
{Rafael Perez}
program clinica;
uses
crt, dos;
const
patoA = 550;
patoB = 430;
patoC = 620;
ingres = 500;
archi = 'Datospac.dat';
type
string12 = string[12]; {variable que se van a utilizar en la programación}
paciente = record
activo : boolean;
numpac : longint;
nombre : string[80];
apells : string;
edad : integer;
sexo : char;
patolg : char;
ingreso : real;
tiempo : integer;
fechent : string[12];
fechalt : string[12];
total : real;
end;
var
f : file of paciente;
datos : paciente;
ano, mes, dia, sem : word;
function guardardatos(dd : paciente) : boolean; {función para guardar los datos}
var
tt : longint;
dt : paciente;
err : boolean;
begin
guardardatos := false;
assign(f,archi);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,dd);
close(f);
guardardatos := true;
end
else
begin
seek(f,filesize(f));
write(f,dd);
close(f);
guardardatos := true;
end;
end;
function diaingreso : string12; {función día de ingreso del paciente}
var
comm, comd : string[2];
coma : string[4];
begin
getdate(ano,mes,dia,sem);
str(ano,coma);
str(mes,comm);
str(dia,comd);
if length(comd) = 1 then
insert('0',comd,1);
if length(comm) = 1 then
insert('0',comm,1);
diaingreso := comd + '/' + comm + '/' + coma;
end;
procedure entradapaciente; {procedimiento incluir paciente}
var
tec : char;
begin
clrscr;
writeln('***** Ingreso Paciente *****');
writeln;
with datos do
begin
activo := true;
write(' Entre Num. Pacit. : ');
readln(numpac);
write(' Entre Nombre : ');
readln(nombre);
write(' Entre Apellidos : ');
readln(apells);
write(' Entre Edad : ');
readln(edad);
write(' Entre Sexo [F/M] : ');
readln(sexo);
write(' Entre Patol. [A/B/C] : ');
readln(patolg);
ingreso := ingres;
fechent := diaingreso;
writeln;
writeln(' >>> Aceptar Datos [S/N] <<<');
repeat
tec := upcase(readkey);
until tec in['S','N'];
if tec = 'S' then
begin
if guardardatos(datos) = true then
writeln(' Datos De Paciente Guardados ')
else
writeln(' Error El Numero Paciente Existe No Guardado ');
writeln(' Pulse Una Tecla ');
end;
end;
end;
procedure consultar(num : longint); {procedimiento para consultar paciente}
var
tt : longint;
dto : paciente;
si : boolean;
begin
si := false;
tt := 0;
assign(f,archi);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln(' Error Archivo No Encontrado Pulse Una Tecla');
readkey;
end
else
begin
for tt := 0 to filesize(f) - 1 do
begin
seek(f,tt);
read(f,dto);
if dto.numpac = num then
begin
si := true;
break;
end;
end;
if si = true then
begin
if dto.activo = true then
begin
with dto do
begin
writeln(' Numero Paciente = ',numpac);
writeln(' Nombre = ',nombre);
writeln(' Apellidos = ',apells);
case edad of
0..18 : writeln(' Categoria = Menor De Edad');
19..64 : writeln(' Categoria = Adulto');
65..107 : writeln(' Categoria = Mayor');
end;
writeln(' Patologia = ',patolg);
writeln(' Importe Ingreso = ',ingreso:0:2);
writeln(' Fecha Ingreso = ',fechent);
if fechalt <> ' ' then
writeln(' Fecha Actual = ',fechalt)
else
writeln(' Fecha Actual = ',diaingreso);
writeln(' Total Importe = ',total:0:2);
writeln;
end;
end
else
writeln(' El Paciente No Esta En Lista ');
end
else
writeln(' Numero Paciente No Encontrado ');
writeln(' Pulse Una Tecla');
readkey;
end;
end;
procedure modificadatos(num : longint); {procedimiento para modificar datos}
var
mo, mdi : paciente;
kk, jh : longint;
term : boolean;
deci : char;
begin
term := false;
assign(f,archi);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln(' Error Archivo No Encontrado Pulse Una Tecla');
readkey;
end
else
begin
for jh := 0 to filesize(f) - 1 do
begin
seek(f,jh);
read(f,mdi);
if mdi.numpac = num then
begin
term := true;
kk := jh;
mo := mdi;
break;
end;
end;
if term = true then
begin
if mdi.activo = true then
begin
term := false;
repeat
clrscr;
writeln(' ***** Menu Modificaciones *****');
writeln;
writeln(' P = Num. Paciente');
writeln(' N = Nombre');
writeln(' A = Apellidos');
writeln(' E = Edad');
writeln(' G = Patologia');
writeln(' F = Fecha Ingreso');
writeln(' S = Salir Y Guardar Cambios');
writeln;
writeln(' <<< Elija Opcion >>>');
repeat
deci := upcase(readkey);
until deci in['N','A','P','E','G','F','S'];
clrscr;
case deci of
'P' : begin
write(' Num. Paciente : ');
readln(mo.numpac);
end;
'N' : begin
write(' Nombre : ');
readln(mo.nombre);
end;
'A' : begin
write(' Apellidos : ');
readln(mo.apells);
end;
'E' : begin
write(' Edad : ');
readln(mo.edad);
end;
'G' : begin
write(' Patologia: ');
readln(mo.patolg);
end;
'F' : begin
write(' Fecha Ingreso : ');
readln(mo.fechent);
end;
'S' : begin
term := true;
end;
end;
until term = true;
mdi := mo;
seek(f,kk);
write(f,mdi);
end;
end;
close(f);
end;
end;
procedure eliminapaciente(num : longint); {procedimiento eliminar paciente}
var
bn, hh : longint;
begin
assign(f,archi);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln(' Esta seguro de eliminar Paciente S/N');
readkey;
end
else
begin
bn := 0;
for hh := 0 to filesize(f) - 1 do
begin
seek(f,hh);
read(f,datos);
if datos.numpac <> num then
begin
end
else
begin
datos.activo := false;
seek(f,hh);
write(f,datos);
end;
end;
close(f);
end;
end;
procedure reporte(num : longint); (procedimiento para reporte)
var
totl : real;
pul : char;
pos, tt : longint;
sil : boolean;
d, m, an : word;
d1, m1, an1 : word;
d3, m3, an3 : word;
dar : string[2];
ay : string[4];
totaldias, error : integer;
begin
assign(f,archi);
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
writeln(' Error Archivo No Encontrado Pulse Una Tecla');
readkey;
end
else
begin
sil := false;
for tt := 0 to filesize(f) - 1 do
begin
seek(f,tt);
read(f,datos);
if datos.numpac = num then
begin
sil := true;
pos := tt;
break;
end;
end;
if sil = true then
begin
if datos.activo = true then
begin
writeln(' Entrada Fecha Alta Como [A]=Automatico O [M]=Manual');
repeat
pul := upcase(readkey);
until pul in['A','M'];
if pul = 'A' then
datos.fechalt := diaingreso;
if pul = 'M' then
begin
writeln(' Entre Fecha De Alta d/m/a¤o ');
writeln;
write(' Fecha : ');
readln(datos.fechalt);
if datos.fechalt[2] = '/' then
insert('0',datos.fechalt,1);
if datos.fechalt[5] = '/' then
insert('0',datos.fechalt,4);
end;
dar := copy(datos.fechent,1,2);
val(dar,d,error);
dar := copy(datos.fechent,4,2);
val(dar,m,error);
ay := copy(datos.fechent,7,4);
val(ay,an,error);
dar := copy(datos.fechalt,1,2);
val(dar,d1,error);
dar := copy(datos.fechalt,4,2);
val(dar,m1,error);
ay := copy(datos.fechalt,7,4);
val(ay,an1,error);
d3 := 0;
m3 := 0;
an3 := 0;
d3 := d1 - d;
m3 := m1 - m;
an3 := an1 - an;
totaldias := (m3 * 30) + d3;
if (datos.patolg = 'A') or (datos.patolg = 'a') then
begin
datos.total := (patoA * totaldias);
end;
if (datos.patolg = 'B') or (datos.patolg = 'b') then
begin
datos.total := (patoB * totaldias);
end;
if (datos.patolg = 'C') or (datos.patolg = 'c') then
begin
datos.total := (patoC * totaldias);
end;
datos.activo := false;
clrscr;
writeln(' ***** Reporte De Alta *****');
writeln;
writeln(' Fecha De Ingreso = ',datos.fechent);
writeln(' Fecha De Alta = ',datos.fechalt);
writeln(' Dias De Ingreso = ',totaldias);
writeln(' Patologia = ',datos.patolg);
writeln(' Total Importe = ',datos.total:0:2);
writeln;
writeln(' <<< Pulse Una Tecla >>>');
readkey;
seek(f,pos);
write(f,datos);
close(f);
end
else
begin
writeln(' El Paciente No Esta Activo ');
writeln(' <<< Pulse Una Tecla >>>');
readkey;
close(f);
end;
end;
end;
end;
procedure menu; (procedimiento del menú principal)
var
tecla : char;
sal : boolean;
nnm : longint;
begin
sal := false;
repeat
clrscr;
writeln(' ***** Menu *****');
writeln;
writeln(' I = Incluir');
writeln(' C = Consultar');
writeln(' M = Modificar');
writeln(' E = Eliminar');
writeln(' R = Reporte ');
writeln(' S = Salir');
writeln;
writeln(' <<< Elija Opcion >>>');
repeat
tecla := upcase(readkey);
until tecla in['I','C','M','E','R','S'];
clrscr;
case tecla of
'I' : entradapaciente;
'C' : begin
write(' Entre Num. consultar : ');
readln(nnm);
consultar(nnm);
end;
'M' : begin
write(' Entre Num. modificar: ');
readln(nnm);
modificadatos(nnm);
end;
'E' : begin
write(' Entre Num. eliminar : ');
readln(nnm);
eliminapaciente(nnm);
end;
'R' : begin
write(' Entre Num. reporte : ');
readln(nnm);
reporte(nnm);
end;
'S' : sal := true;
end;
until sal = true;
end;
begin
clrscr;
menu;
end.
Tema: Pascal Ejemplo programa con menú, procedure, function, bucle for, repeat clinica (Leído 16142 veces)
RSS -
WAP2