#!/usr/bin/perl

#
# This script is copyright 2004, DOMINGO RAMOS CORPAS.
#
#########################################################################
##### USTED NO ESTA AUTORIZADO A COPIAR NI MODIFICAR ESTE SOFTWARE.
#####                                                                   
#####                                                                   
#########################################################################
#

$scripturl = "http://www.fetaltest.com/cgi-bin/dopplerfetoplacentario.cgi";

#Recogemos la cadena de datos

%rec = &get_data();

&hallazgos();
@valores=();
@buscador=();
@buscador=();
@introducidos2=();
$introducidos2[0].="<TD>SINDROMES MALFORMATIVOS / HALLAZGOS ECOGRAFICOS</TD>";
#getc;
for ($i=1;$i<=50;$i++){
if ($rec{$i}==1){
$buscador[$i]=1;
$introducidos.="<li>";
$introducidos.=$hallazgos[$i];
$introducidos2[0].="<TD>";
$introducidos2[0].=$hallazgos[$i];
$introducidos2[0].="</TD>";
}
}



%Frecuentes=();
%Ocasionales=();
%Puntuacion=();
$archivo = "sindromes.db";
open(FILE,"$archivo");
flock(FILE, 1);
while(<FILE>) {
$linea= $_;
$linea =~ s/NULL//g;	
@valores = split(/\|/, $linea);
$a=$valores[0];
$Frecuentes{$a} = 0;
$Ocasionales{$a} = 0;
#getc;
for ($i=1;$i<=50;$i++){
$b=$buscador[$i];
if ($b eq 1){
if ($valores[$i] eq "F"){$Frecuentes{$a}+=1;}
if ($valores[$i] eq "O"){$Ocasionales{$a}+=1;}
}
}
}
close(FILE);

$archivo = "sindromes.db";
open(FILE,"$archivo");
flock(FILE, 1);
while(<FILE>) {
$linea= $_;
$linea =~ s/NULL/-/g;	
@valores = split(/\|/, $linea);
$a=$valores[0];
if ($Frecuentes{$a} || $Ocasionales{$a}){
$numerosindromes++;

$introducidos2[$numerosindromes].="<TD>";
$introducidos2[$numerosindromes].=$a;
$introducidos2[$numerosindromes].="</TD>";
$Puntuacion{$numerosindromes}=($Frecuentes{$a}*3)+$Ocasionales{$a};
if ($Puntuacion{$numerosindromes}>$maxpuntuacion){$maxpuntuacion=$Puntuacion{$numerosindromes};}
#getc;
for ($i=1;$i<=50;$i++){
$b=$buscador[$i];
if ($b eq 1){
$introducidos2[$numerosindromes].="<TD>";
$introducidos2[$numerosindromes].=$valores[$i];
$introducidos2[$numerosindromes].="</TD>";
}}}

}
close(FILE);



&salida();

exit;

sub piedepagina{
print <<EOF;
<br><p>
EOF
$archivo = "pienuevo";
open(FILE,"$archivo");
while($entry = <FILE>) {
        print $entry;
}
close(FILE);
}
sub cabeceradepagina{
$archivo = "cabeceranueva";
open(FILE,"$archivo");
while($entry = <FILE>) {
        print $entry;
}
close(FILE);
$archivo = "cabeceranueva2";
open(FILE,"$archivo");
while($entry = <FILE>) {
        print $entry;
}
close(FILE);

}


sub salida{
print "Content-type: text/html\n\n";
&cabeceradepagina();
&formulario();
&piedepagina();
}




sub get_data {
    local($string);

    # get data
    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
        $_ = $string = $ENV{'QUERY_STRING'};
	tr/\"~;/_/;
	$string = $_;

    }				
    else { read(STDIN, $string, $ENV{'CONTENT_LENGTH'});
        $_ = $string;
	$OK_CHARS='a-zA-Z0-9=&%\n\/_\-\.@';
	tr/\"~;/_/;
	$string = $_;
	   }

    # split data into name=value pairs
    @rec = split(/&/, $string);
   
    # split into name=value pairs in associative array
    foreach (@rec) {
	split(/=/, $_);
	$_[0] =~ s/\+/ /g; # plus to space
	$_[0] =~ s/%(..)/pack("c", hex($1))/ge; # hex to alphanumeric
	$rec{"$_[0]"} = $_[1];
    }

    # translate special characters
    foreach (keys %rec) {
	$rec{"$_"} =~ s/\+/ /g; # plus to space
	$rec{"$_"} =~ s/%(..)/pack("c", hex($1))/ge; # hex to alphanumeric
    }

    %rec;			# return associative array of name=value
}


sub parse_form {
# --------------------------------------------------------
# Parses the form input and returns a hash with all the name
# value pairs. Removes SSI and any field with "---" as a value 
# (as this denotes an empty SELECT field.

	my (@pairs, %in);
	my ($buffer, $pair, $name, $value);	

	if ($ENV{'REQUEST_METHOD'} eq 'GET') {
		@pairs = split(/&/, $ENV{'QUERY_STRING'});
	}
	elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
 		@pairs = split(/&/, $buffer);
	}
	else {
		&cgierr ("This script must be called from the Web\nusing either GET or POST requests\n\n");
	}
	PAIR: foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		 
		$name =~ tr/+/ /;
		$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		$value =~ s/<!--(.|\n)*-->//g;			  # Remove SSI.
		if ($value eq "---") { next PAIR; }		  # This is used as a default choice for select lists and is ignored.
		(exists $in{$name}) ?
			($in{$name} .= "$value") :	      # If we have multiple select, then we tack on
			($in{$name}  = $value);				  # using the ~~ as a seperator.
	}
	return %in;
}

sub formulario{
print <<EOF;

<table border=0 cellpadding=5 cellspacing=3 width=100% align=center valign=top><tr><td colspan=2 bgcolor="#140059"><b><FONT FACE="Tahoma, arial,helvetica" size=3 color="#FFFFFF"> PROGRAMA INFORMATICO DE ORIENTACION AL DIAGNOSTICO SINDROMICO A PARTIR DE HALLAZGOS ECOGRAFICOS FETALES</b></td></tr></table></center>

<br><p>
<lbockquote><blockquote>
<p align=justify>Este programa permite buscar en el catalogo de Sindromes Malformativos Humanos publicado en <i>SMITH"'" S RECOGNIZABLE PATTERNS OF HUMAN MALFORMATION, 5 Ed.</i>, la ocurrencia de los hallazgos ecograficos fetales siguientes:
</blockquote></blockquote>
<form action="diagdiferencial.cgi" method="GET">
<center>
<P><TABLE CLASS='Bordernegro' WIDTH=90%>
<TR><td><b><u>HALLAZGOS ECOGRAFICOS OBSERVADOS:</u></b></td></TR>
<TR><td>
<P><TABLE CLASS='Bordernegro' WIDTH=100%><TR><TD>
EOF

#getc;
for ($i=1;$i<=50;$i++){
print <<EOF;
<LI><input type=checkbox value="1" name=$i> $hallazgos[$i]
EOF
if ($i==25){
print <<EOF;
</TD><TD>
EOF
}
}

print <<EOF;
</TD></TR></TABLE>
</TD></TR>
<TR><td>
<CENTER>
<INPUT TYPE="submit" VALUE="Buscar">
</FORM>
</CENTER>
</TD></TR>
</TABLE>
</form>
</center>
<br><p>
EOF

if ($maxpuntuacion>0){
print <<EOF;
<br><p>
<center><u><h4>SINDROMES MALFORMATIVOS QUE PUEDEN SER CONSIDERADOS EN EL DIAGNOSTICO DIFERENCIAL</h4></u>
<br>

<blockquote>
<p>(F) El hallazgo se presenta frecuentemente en el síndrome.<br><p>(O) El hallazgo se presenta ocasionalmente en el síndrome.
<br><p>

</blockquote>
<br>
<CENTER><TABLE CLASS='Bordernegro' WIDTH=90% border=1>
<TR>$introducidos2[0]</TR>
EOF

$a=$maxpuntuacion;

while ($a>0){
#getc;
for ($i=0;$i<=$numerosindromes;$i++){
if ($Puntuacion{$i}==$a){
print <<EOF;
<TR>$introducidos2[$i]</TR>
EOF
}
}
$a--;
}

print <<EOF;
</table>

</center>

<blockquote>
<br><p>Todos los resultados deben ser confirmados antes de ser usados clinicamente. Los resultados obtenidos no sustituyen el juicio cl&iacute;nico. Ni FetalTest.com ni nadie invoucrado en la preparaci&oacute;n o publicaci&oacute;n de este sitio web se hacen responsables de cualquier perjuicio que pudiera resultar en todo o en parte del uso del material publicado en este sitio web. 
</blockquote>

EOF

}
}
sub hallazgos{
@hallazgos=();
$hallazgos[1]="ATRESIA ANAL O ANO IMPERFORADO";
$hallazgos[2]="MACROSOMIA";
$hallazgos[3]="HYDROPS FETALIS";
$hallazgos[4]="CALCIFICACIONES";
$hallazgos[5]="MICROPENE";
$hallazgos[6]="GENITALES AMBIGUOS";
$hallazgos[7]="MALFORMACION RENAL";
$hallazgos[8]="ARTERIA UMBILICAL UNICA";
$hallazgos[9]="HERNIA DIAFRAGMATICA";
$hallazgos[10]="FISTULA TRAQUEOESOFAGICA O ATRESIA EOFAGICA";
$hallazgos[11]="SINDROME DE HIRSCHSPRUNG";
$hallazgos[12]="ATRESIA DUODENAL"; 
$hallazgos[13]="HEPATOMEGALIA";
$hallazgos[14]="DEFECTOS DE LA PARED ABDOMINAL";
$hallazgos[15]="HERNIA INGUINAL O UMBILICAL";
$hallazgos[16]="ARRITMIA CARDIACA";
$hallazgos[17]="MALFORMACION CARDIACA";
$hallazgos[18]="MANO EN GARRA";
$hallazgos[19]="PIE EQUINOVARO (TALIPES)";
$hallazgos[20]="PLIEGUE SIMIESCO";
$hallazgos[21]="SINDACTILIA (OSEA O CUTANEA)";
$hallazgos[22]="POLIDACTILIA";
$hallazgos[23]="APLASIA O HIPOPLASIA DE RADIO";
$hallazgos[24]="HIPOPLASIA O APLASIA DE PULGAR O PULGAR TRIFALANGICO";
$hallazgos[25]="CLINODACTILIA DE QUINTO DEDO";
$hallazgos[26]="MANOS Y/O  PIES PEQUEÑOS, INCLUYENDO BRAQUIDACTILIA";
$hallazgos[27]="REDUCCION MODERADA A SEVERA DE EXTREMIDADES";
$hallazgos[28]="EXTREMIDADES CORTAS";
$hallazgos[29]="FRACTURAS OSEAS";
$hallazgos[30]="ARACNODACTILIA";
$hallazgos[31]="ESCOLIOSIS";
$hallazgos[32]="CAJA TORACICA PEQUE&Ntilde;A";
$hallazgos[33]="HIPOPLASIA DE CLAVICULAS";
$hallazgos[34]="LABIO LEPORINO (CON O SIN PALADAR HENDIDO)";
$hallazgos[35]="PROGNATISMO";
$hallazgos[36]="MICROGNATIA";
$hallazgos[37]="MICROFTALMOS";
$hallazgos[38]="HIPERTELORISMO";
$hallazgos[39]="HIPOTELORISMO";
$hallazgos[40]="FRONTAL PROMINENTE";
$hallazgos[41]="CRANIOSINOSTOSIS";
$hallazgos[42]="MACROCEFALIA";
$hallazgos[43]="MICROCEFALIA";
$hallazgos[44]="HIDROCEFALIA";
$hallazgos[45]="AGENESIA DEL CORPUS CALLOSUM";
$hallazgos[46]="MALFORMACION DE DANDY-WALKER";
$hallazgos[47]="LISENCEFALIA";
$hallazgos[48]="HOLOPROSENCEFALIA";
$hallazgos[49]="ENCEFALOCELE";
$hallazgos[50]="ANENCEFALIA / MIELOMENINGOCELE";
}