Enunciado

Código:

PROGRAM tp_computacion;
 
USES  crt;
 
CONST
	NL = #13#10; {*  Nueva Linea (Para no escribir tantoss writeln;) *}
 
TYPE
    t_matriz=array[1..255,1..6, 1.. 4] of integer;
 
VAR  (* VARIABLES GOLBALES *)
    matriz: t_matriz;
 
 
{*---------PROCEDIMIENTOS Y FUNCIONES--------------*}
 
 
FUNCTION Validar (max_e:integer):integer;
 
{Función para validar cada numero que ingresa el usuario}
{Cada nro que ingresa pasa por este procedimiento}
{max_e es la cantidad maxima de enteros que puede ingresar.
Por ej, a:=validar(2) hace que el prog lea "a", pero que el usuario solo pueda
ingresar 2 enteros}
{VAMOS A PERMITIR SOLO EL INGRESO DE CARACTERES NUMERICOS}
 
var {* Variables locales *}
    c_e,codigo:integer;
    s:string;
    car:char;
    aux:integer;
 
begin
     s:='';
     c_e:=0;
     car:=readkey;
 
     repeat
           case car of
                      '0'..'9': if c_e<max_e then
                                      begin
                                           s:=s+car;
                                           write(car);
                                           c_e:=c_e+1;
                                      end;
           end;
 
     car:=readkey;
     until car=#13;
 
     VAL(s,aux,codigo);
     validar:=aux;
     writeln;
 
end;
 
{* Fin de Validar *}
 
 
PROCEDURE validar_fecha(var fecha:string; var idia: integer;var imes: integer;var ianio: integer);
 
{*  Procedimiento para validar las fechas ingresadas por el usuario *}
 
var {* Variables locales *}
   s_dia,s_mes,s_anio: string[4];
   a,error: integer;
 
begin
     repeat
     a:=0;
     write('Ingrese la fecha (dd/mm/aaaa) : ');
     readln(fecha);
     {Copy ----> Procedimiento propio del pascal. Hacemos un copy de dd, mm y aaaa}
     s_dia:= copy(fecha,1,2);
     s_mes:= copy(fecha,4,2);
     s_anio:= copy(fecha,7,4);
     {Val ----> Procedimiento propio del pascal. Pasamos los dd, mm y aaaa de string a integer}
     val(s_dia,idia,error);
     val(s_mes,imes,error);
     val(s_anio,ianio,error);
     {Aquí empieza la validación}
     if (imes<1) or (imes>12) or (idia<1) or (idia>31) then
        begin
          writeln;
          writeln('Mes o dia fuera de rango'); readkey
        end
     else
         begin
             if ((imes = 2) and (idia > 28))  then      {Validación para años biciestos}
                if ((ianio mod 4= 0) and not(ianio mod 100=0)) or ((ianio mod 4=0) and (ianio mod 400=0)) then
                   begin
                        if idia=30 then
                           begin
                           writeln('Dia fuera de rango'); readkey;
                           end
                   end
                else
                    begin
                    writeln('Dia fuera de rango'); readkey
                    end
             else
                 begin
                      if ((imes=4) or (imes=6) or (imes=9) or (imes=11)) and (idia=31) then
                         begin
                         writeln('Dia fuera de rango'); readkey
                         end
                      else
                          A:= 1
                 end
         end
	until a=1;
 
end;
 
{* Fin de validar_fecha *}
 
 
 
PROCEDURE cargar_matriz(var matriz:t_matriz; var tranf1:integer; var tranf2:integer;var tranf3:integer;var tranf4:integer);
 
{Procedimiento para cargar la matriz con datos}
{i representa las transfusiones. j es el nro de HC, nro de UT, LimdeUT, dia, mes, año. k representa los 4 sectores}
{tranf1,2,3 y 4 representan el nro de transfusiones en el sector 1,2,3 y 4 respectivamente}
 
var {* Variables locales *}
    i,j,k:integer;
    idia,imes,ianio:integer;
    opcionA:integer;
    fecha:string;
 
begin
     repeat
     clrscr;
     writeln('Marque alguna de las siguientes opciones:',NL);
     writeln('1. Ingresar una nueva transfusion');
     writeln('2. Volver al menu principal');
     opcionA:=validar(1);
     if (opcionA=1) then
        begin
             clrscr;
             repeat
             writeln('Ingrese en que sector se produjo la transfusion',NL);
             writeln('1. Internacion');
             writeln('2. Unidad de terapia intensiva');
             writeln('3. Unidad de terapia intermedia');
             writeln('4. Quirofanos');
             k:=validar(1);
             until (k=1)or(k=2)or(k=3)or(k=4);
             case k of
             1: begin
                     tranf1:= tranf1 + 1;
                     i:=tranf1
                end;
             2: begin
                     tranf2:= tranf2 + 1;
                     i:=tranf2
                end;
             3: begin
                     tranf3:= tranf3 + 1;
                     i:=tranf3
                end;
             4: begin
                     tranf4:= tranf4 + 1;
                     i:=tranf4
                end
        end;
        for j:=1 to 6 do
       	     begin
       	          case j of
        	     1: begin
                         Clrscr;
                         write('Ingrese numero de historia clinica:',NL);
                         matriz[i,j,k]:=validar(4)
                    end;
        	     2: begin
			             write('Ingrese la cantidad de UT: ',NL);
		   	             matriz[i,j,k]:=validar(4)
		            end;
        	     3: begin
			             write('Ingrese el limite de UT por contrato con la obra social: ',NL);
                         matriz[i,j,k]:=validar(4)
		            end;
        	     4: begin
   	                     validar_fecha(fecha,idia,imes,ianio);
                         matriz[i,j,k]:=idia
		            end;
		         5: matriz[i,j,k]:=imes;
		         6: matriz[i,j,k]:=ianio;
       	     end;
         end;
     end;
     until opcionA=2;
end;
 
{Fin de cargar_matriz}
 
PROCEDURE informe1(var matriz: t_matriz; tranf1,tranf2,tranf3,tranf4:integer);
 
{i, j y k son lo mismo que antes}
{ En la tabla (donde aparecen solo j= 1, 2 y 3) se agrega una cuarta columna: el importe}
{tranf1,2,3 y 4 son el nro de trnaf en cada sector}
 
var {* Variables locales *}
   dia1,mes1,anio1,dia2,mes2,anio2,cont: integer;
   periodo:integer;
   importe: longint;
   fecha1,fecha2:string;
   i,j,k: integer;
 
begin
     clrscr;
     writeln('INGRESO DEL PERIODO');
     writeln('-------------------');
     writeln;
     writeln('Fecha inicial: ');
     validar_fecha(fecha1,dia1,mes1,anio1);
     writeln;
     writeln('Fecha final: ');
     validar_fecha(fecha2,dia2,mes2,anio2);
     writeln;
     writeln('Periodo del ', fecha1, ' al ', fecha2);
     for k:=1 to 4 do
	 begin
          clrscr;
          writeln;
          writeln('SECTOR ',k,NL);
          writeln('(UT= Unidades Transfundidas)',NL);
          write('Nro. de historia clinica ');
          write(' Cantidad de UT ');
          write(' Limite de UT ');
          writeln(' Importe por excedente($) ');
	      case k of
	       1: cont:=tranf1;
           2: cont:=tranf2;
           3: cont:=tranf3;
           4: cont:=tranf4
          end;
          for i:=1 to cont do
          begin
 
               importe:=0;
               periodo:=0;
		begin {Compraración de fechas}
		if (anio1 < matriz[i,6,k]) and  (matriz[i,6,k] < anio2) then
                 periodo:=1
                else
                  if (anio1 = matriz[i,6,k]) or  (matriz[i,6,k] = anio2) then
                     begin
                     if (mes1 < matriz[i,5,k]) and  (matriz[i,5,k] < mes2) then
                     	periodo:=1
                     else
                         begin
                         if (mes1 = matriz[i,5,k]) or  (matriz[i,5,k] = mes2) then
                         if (dia1 <= matriz[i,4,k]) and  (matriz[i,4,k] <= dia2) then
                         periodo:=1
			 end
		     end
		end;
               {periodo=1 indica que se encuentra en el lapso dado por el usuario}
               if periodo=1 then
                 begin
                      for j:=1 to 3 do
                      write('       ',matriz[i,j,k],'          ');
                      if (matriz[i,2,k] > matriz[i,3,k]) then
                      importe:= 50*(matriz[i,2,k] - matriz[i,3,k]);
                      writeln('   ',importe);
                      readkey
                 end
          end
     end
end;
 
PROCEDURE informe2(var matriz: t_matriz; tranf1,tranf2,tranf3,tranf4:integer);
 
{tranf1,2,3 Y 4 representan lo mismo que antes}
 
var {* Variables locales *}
   totalUT,totalUTexc,totalimporte,cont,periodo : integer;
   i,k: integer;
   dia1,mes1,anio1,dia2,mes2,anio2: integer;
   fecha1,fecha2: string;
   promedio: real;
 
begin
     clrscr;
     writeln('INGRESO DEL PERIODO');
     writeln('-------------------',NL);
     writeln('Fecha inicial: ',NL);
     validar_fecha(fecha1,dia1,mes1,anio1);
     writeln('Fecha final: ',NL);
     validar_fecha(fecha2,dia2,mes2,anio2);
     writeln('Periodo del ', fecha1, ' al ', fecha2);
     for k:=1 to 4 do
	 begin
          totalUT:= 0;
          totalUTexc:=0;
	      case k of
	      1: cont:=tranf1;
          2: cont:=tranf2;
          3: cont:=tranf3;
          4: cont:=tranf4
     end;
     clrscr;
     writeln('SECTOR ',k,NL);
     writeln('(UT= Unidades Transfundidas)',NL);
	 write('Total UT    ');
	 write('Total UT excedentes   ');
	 write('Importe Total ($)   ');
	 writeln('Promedio de UT excedentes');
	 for i:=1 to cont do
	 begin
	       totalimporte:=0;
               periodo:=0;
		begin {Compraración de fechas}
		if (anio1 < matriz[i,6,k]) and  (matriz[i,6,k] < anio2) then
                 periodo:=1
                else
                  if (anio1 = matriz[i,6,k]) or  (matriz[i,6,k] = anio2) then
                     begin
                     if (mes1 < matriz[i,5,k]) and  (matriz[i,5,k] < mes2) then
                     	periodo:=1
                     else
                         begin
                         if (mes1 = matriz[i,5,k]) or  (matriz[i,5,k] = mes2) then
                         if (dia1 <= matriz[i,4,k]) and  (matriz[i,4,k] <= dia2) then
                         periodo:=1
			 end
		     end
		end;
     {periodo=1 indica que se encuentra en el lapso dado por el usuario}
          if periodo=1 then
             begin
                  totalUT:= totalUT + matriz[i,2,k];
                  if (matriz[i,2,k] > matriz[i,3,k]) then
                     totalUTexc:= totalUTexc + (matriz[i,2,k] - matriz[i,3,k]);
             end
     end;
	 totalimporte:= totalUTexc * 50;
	 if (cont <> 0) then
           promedio:= totalUTexc / cont
        else
            promedio:=0;
	 write('     ',totalUT,'          ');
	 write('     ',totalUTexc,'                  ');
	 write('',totalimporte,'         ');
	 writeln(promedio:6:0);
	 readkey;
        end;
end;
 
PROCEDURE menu(var m_matriz: t_matriz);
 
Var {* Variables locales *}
   tranf1,tranf2,tranf3,tranf4: integer;
   H : char;
 
begin
     tranf1:=0;
     tranf2:=0;
     tranf3:=0;
     tranf4:=0;
     repeat
           repeat
                   ClrScr;
                   Writeln;
                   Writeln('            M E N U  P R I N C I P A L');
                   Writeln('            ---------------------------',NL,NL,NL);
                   writeln ( '          1. Cargar nuevos datos ', NL);
                   writeln ( '          2. Informe 1 ', NL);
                   writeln ( '          3. Informe 2 ', NL);
                   writeln ( '          4. Cantidad de transfusiones por sector ', NL);
                   {esta opcion fue agregada para que el usuario pueda verificar la cant de datos ingresados}
                   writeln ( '          S. Salir del programa', NL, NL);
                   write ( '          Elija una opcion ');
                   h:=upcase(readkey);
 
 
              until h in ['1','2','3','4','S'];
                     case h of
                           '1': cargar_matriz(m_matriz,tranf1,tranf2,tranf3,tranf4);
                           '2': informe1(m_matriz,tranf1,tranf2,tranf3,tranf4);
                           '3': informe2(m_matriz,tranf1,tranf2,tranf3,tranf4);
                           '4': begin
                                   clrscr;
                                   writeln('Cantidad de transfusiones:');
                                   writeln;
                                   writeln('Sector 1 : ', tranf1);
                                   writeln('Sector 2 : ', tranf2);
                                   writeln('Sector 3 : ', tranf3);
                                   writeln('Sector 4 : ', tranf4);
                                   writeln;
                                   writeln('Presione una tecla para volver al menu');
                                   readkey
                                   end;
                     else clrscr;
                     end;
      until h='S';
end;
 
 
 
(*--------------PROGRAMA PRINCIPAL----------------------*)
 
 
BEGIN
     menu(matriz)
END.

Conjunto de datos de prueba y manual del usuario

Pseudocodigos y diagramas estructurados

Diagrama en bloques