Tp computacion

program Clinica_Cardiovascular;

{$I-,S-}

uses
crt;
const
LIM_TRANF=255;
LIM_AREA=4;
LIM_PAC=6; (*6 porque ingreso dia, mes y a¤o en columnas diferentes para facilitar calculos*)
{Declaro entre que a¤os se pueden cargar datos, o sea, el periodo}
MIN_ANIO=1950;
MAX_ANIO=2008;
MIN_MES=01;
MAX_MES=12;
{Limite de valores para historiaclinica}
MIN_HC=10000;
MAX_HC=99999;
{Declaracion de la matriz}
type
T_paciente=array[1..LIM_PAC] of longint;
T_datos=array[1..LIM_TRANF] of T_paciente;
T_area=array[1..LIM_AREA] of T_datos;

FUNCTION validarEnteros:LONGINT;
VAR
VALIDADOS: SET OF CHAR;
car:char;
CODIGO,pos,i: INTEGER;
S,S2: STRING;
AUX:LONGINT;
BEGINVALIDADOS:=['0'..'9'];
S:='';
S2:='';
car:=readkey;
REPEAT
IF car IN VALIDADOS THEN
begin
WRITE(car);
S:=S+car;
end
else
CASE car OF
'.',',': begin
writeln;
WRITELN('ERROR.INGRESE UN NéMERO ENTERO');
S:='';
end;'A'..'Z','a'..'z': begin
writeln;
WRITELN('ERROR.INGRESE UN NéMERO ENTERO');
S:='';
end
else
begin
if car#8 then
begin
writeln;WRITELN('ERROR.INGRESE UN NéMERO ENTERO');
S:='';
end
else
begin
writeln;
S:='';
end;
end;
end;
car:=readkey;
UNTIL (car=#13);
writeln;
VAL(S,AUX,CODIGO);validarEnteros:=AUX;
END;

procedure validarOpcion(var op:integer);
begin
op:=validarEnteros;
while (op4) do
begin
writeln('Area inexistente. Ingresela nuevamente');
op:=validarEnteros;
end;
end;

procedure validarOpcionOS(var op:integer);
begin
op:=validarEnteros;
while (op4) do
begin
writeln('Obra Socialinexistente. Ingresela nuevamente');
op:=validarEnteros;
end;
end;

procedure validarHC(var hc:longint);
begin
hc:=validarEnteros;
while (hcMAX_HC) do
begin
writeln('Error. El numero de historia clinica debe ser de 5 digitos');
hc:=validarEnteros;
end;
end;

procedure validarAnio(var anio:longint);
begin
anio:=validarEnteros;
while (anioMAX_ANIO) dobegin
writeln('Error. Ingrese nuevamente el a¤o');
anio:=validarEnteros;
end;
end;

procedure validarMes(var mes:longint);
begin
mes:=validarEnteros;
while (mesMAX_MES) do
begin
writeln('Error. Ingrese nuevamente el mes');
mes:=validarEnteros;
end;
end;

procedure validarDia(var dia:longint;mes,anio:longint);
var
resto:longint;begin
resto:=0;
dia:=validarEnteros;
if (mes=1) or (mes=3) or (mes=5) or (mes=7) or (mes=8) or (mes=10) or (mes=12) then
while (dia31) do
begin
writeln('Error.El mes tiene 31 dias. Ingreselo nuevamente');
dia:=validarEnteros;
end
else
if (mes=4) or (mes=6) or (mes=9) or (mes=11) then
begin
while (dia30) dobegin
writeln('Error. El mes tiene 30 dias. Ingreselo nuevamente');
dia:=validarEnteros;
end;
end
else
begin
resto:=anio mod 4;
if resto=0 then
begin
while (dia29) do
begin
writeln('Error.El mes tiene 29 dias. Ingreselo...