Pascal/Turbo Pascal - Problame con el codigo registro de control clinica

 
Vista:
sin imagen de perfil

Problame con el codigo registro de control clinica

Publicado por Danny (9 intervenciones) el 07/07/2014 19:01:45
Saludos a toda la comunidad, tengo el siguiente codigo para realizar el registro de pacientes de un clinica, pero mi detalle es que estoy usando el IDE lazarus y me manda un error en VAR, donde dice F : File of paciente; y no encuentro el error en la compilacion, asi, que si pueden ayudarme con este codigo y hacerme las correcciones se los agradeceria mucho.

program clinica;
uses
crt, dos;

const
patoA = 550;
patoB = 430;
patoC = 620;
ingres = 500;
archi = 'Datospac.dat';

type
string12 = string[12];
paciente = record
activo : boolean;
nombre : string[80];
apells : string;
numpac : longint;
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;
ayo, mes, dia, sem : word;

function guardardatos(dd : paciente) : boolean;
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;
var
comm, comd : string[2];
coma : string[4];
begin
getdate(ayo,mes,dia,sem);
str(ayo,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;
var
tec : char;
begin
clrscr;
writeln('***** Ingreso Paciente *****');
writeln;
with datos do
begin
activo := true;
write(' Entre Nombre : ');
readln(nombre);
write(' Entre Apellidos : ');
readln(apells);
write(' Entre Num. Pacit. : ');
readln(numpac);
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(' >>> Acectar 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);
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(' Nombre = ',nombre);
writeln(' Apellidos = ',apells);
writeln(' Numero Paciente = ',numpac);
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);
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(' N = Nombre');
writeln(' A = Apellidos');
writeln(' P = Num. Paciente');
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
'N' : begin
write(' Nombre : ');
readln(mo.nombre);
end;
'A' : begin
write(' Apellidos : ');
readln(mo.apells);
end;
'P' : begin
write(' Num. Paciente : ');
readln(mo.numpac);
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);
var
bn, hh : longint;
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
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 reportefinal(num : longint);
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 Actovo ');
writeln(' <<< Pulse Una Tecla >>>');
readkey;
close(f);
end;
end;
end;
end;

procedure menu;
var
tecla : char;
sal : boolean;
nnm : longint;
begin
sal := false;
repeat
clrscr;
writeln(' ***** Menu Jeneral *****');
writeln;
writeln(' I = Incluir');
writeln(' C = Consultar');
writeln(' M = Modificar');
writeln(' E = Eliminar');
writeln(' R = Reporte Alta');
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. Paciente : ');
readln(nnm);
consultar(nnm);
end;
'M' : begin
write(' Entre Num. Paciente : ');
readln(nnm);
modificadatos(nnm);
end;
'E' : begin
write(' Entre Num. Paciente : ');
readln(nnm);
eliminapaciente(nnm);
end;
'R' : begin
write(' Entre Num. Paciente : ');
readln(nnm);
reportefinal(nnm);
end;
'S' : sal := true;
end;
until sal = true;
end;

begin
clrscr;
menu;
end.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Problame con el codigo registro de control clinica

Publicado por ramon (39 intervenciones) el 10/07/2014 01:20:29
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
{Mira Aquí Tienes el fallo }
 
procedure consultar(num : longint);
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(' Nombre = ',nombre);
writeln(' Apellidos = ',apells);
writeln(' Numero Paciente = ',numpac);
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');
close(f);   {Te falta esto <----------}
readkey;
end;
end;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

Problame con el codigo registro de control clinica

Publicado por Danny (9 intervenciones) el 10/07/2014 03:50:35
Oye muchas gracias me ha servido mucho, no lo veia..
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Problame con el codigo registro de control clinica

Publicado por Vanessa (16 intervenciones) el 10/07/2014 22:44:14
HOLA AMIGOS!! ESTOY APRENDIENDO PASCAL POR OCIO, Y CORRI ESTE PROGRAMA DISCULPEN EL ABUSO, PERO A MI ME DA ERROR DE Q VARIAS VARIABLEA NO ESTAN SIENDO USADAS. COMO tt , dt, err, bn, totl, an3. HACE TIEMPO CUANDO EMPECE A ESTUDIAR PASCAL AL HACER PEOGRAMITAS ME DABA ESE ERROR A PESAR DE Q SI USABA LAS VARIABLES. A LA FINAL ME RENDI Y NO DI CON EL PROBLEMA
USO FREE PASCAL. QUE PUEDE ESTAR SUCEDIENDO?
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

Problame con el codigo registro de control clinica

Publicado por Danny (9 intervenciones) el 10/07/2014 22:49:23
Intenta hacer lo siguiente : copias y pegas el código en un bloc de notas, cuando lo vayas a guardar, hazlo con la extensión .Pas osea el nombre seria clínica.Pas luego eso que has guardado ejecútalo con el fpc y ta listo. Cuéntanos cómo te fue.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Problame con el codigo registro de control clinica

Publicado por Vanessa (16 intervenciones) el 10/07/2014 23:08:49
Eso es lo q pasaba???? Si corre.. menos mal no borew mis programas. Voy a buscarlos a ver si corren. Jajajaja graciiiiaz
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

Problame con el codigo registro de control clinica

Publicado por Danny (9 intervenciones) el 10/07/2014 23:13:50
Si el codigo me corre perfecto y sin problemas, yo me descargue el pascal desde esta pagina, http://www.freepascal.org/download.var , pues te cuento que yo hago el procedimiento que te conte y cuando lo abro con el pascal, me corre bien. ;).
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Problame con el codigo registro de control clinica

Publicado por Vanessa (16 intervenciones) el 10/07/2014 23:15:55
Lo habia guardado mal.. corre bien q horror. Yo no sabia eso jajajaja gracias de verdad
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

Problame con el codigo registro de control clinica

Publicado por Danny (9 intervenciones) el 10/07/2014 23:18:50
Hahahahaha, Que bueno que te corra, alli solo te queda modificarlo para que hagas lo que tu quieres y estudies el codigo. ;) estamos para ayudar.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar