Established Complications I Listing

#!/usr/local/bin/perl -w
# The statistic spkomp1 should be produced here.

use DBhand;

# Table verlauf should be evaluated here.
$ag = 110000;                 # Minumum Age
if ($#ARGV == 0 && $ARGV[0] eq "dbf") { 
   $outfile = "spkomp1.dbf";
} else {
   $outfile = '&STDOUT';
}
if ($#ARGV == -1) { $outfile = "BS"; }
open(DB,"verlauf.dbf");
while (<DB>) {
   @werte = splitdb($_);
   # 0: PatNr, 1: Date, 14:aug_r, 15:aug_l
   # $aug{datum}{Nr} enthaelt Wert
   $year = int($werte[1] / 10000);
   $quartal = int((2+int($werte[1] / 100) - $year*100) / 3);
   $aug_dia_r = $werte[14];
   $aug_dia_l = $werte[15];
   if ($aug_dia_l eq "") {$aug_dia_l = 0};
   if ($aug_dia_r eq "") {$aug_dia_r = 0};
   if ($aug_dia_r || $aug_dia_l) { # + removed
      if ($aug_dia_r == 12) {$aug_dia_r = 1};
      if ($aug_dia_l == 12) {$aug_dia_l = 1};
      $aug_dia_r = $aug_dia_l if $aug_dia_r<$aug_dia_l;
      if ((!defined $aug{5+$year*5}{$werte[0]}) || 
         ($aug{5+$year*5}{$werte[0]} < 6)) {
            $aug{5+$year*5}{$werte[0]} = $aug_dia_r;
      }
      if ((!defined $aug{$year*5+$quartal}{$werte[0]}) || 
         ($aug{$year*5+$quartal}{$werte[0]} < 6)) {
            $aug{$year*5+$quartal}{$werte[0]} = $aug_dia_r;
      }
   }
}
close DB;
print "Through read eyes. \n";
foreach $t (sort(keys %aug)) {
   foreach $nr (sort(keys %{$aug{$t}})) {
      for ($i = 0; $i < 3; $i++) {
         $erg{$t}[$i] = 0 if !defined($erg{$t}[$i]);
      }
      $erg{$t}[2] += 1;  # Erhoehe die Anzahl der Augenfaelle
      if ($aug{$t}{$nr} > 2) {
         if ($aug{$t}{$nr} < 6) {
            $erg{$t}[0] += 1;
         } else {
            $erg{$t}[1] += 1;
         }
      }
   }
}
undef %aug; # Destroy it to free memory
print "Open diabetik \n";
open(DB,"diabetik.dbf");
while (<DB>) {
   @werte = splitdb($_);
   $age{$werte[0]} = $werte[3];
}
close DB;
print "Open ualbumin \n";
open(DB,"ualbumin.dbf");
while (<DB>) {
   @werte = splitdb($_);
   # 0: PatNr, 3: Date, 4: ualbumin
   $werte[4] = 0 if $werte[4] eq "";
   if (($werte[4]>0) && ($werte[3] >= $ag + $age{$werte[0]})) {
      # Is the a value and is the patient older than ag?
      $year = int($werte[3] / 10000);
      $quartal = int((2 + int($werte[3] / 100) - $year*100) / 3);
      # PatNr 1 is Number, 2 Amount
      (defined ($album1{5+$year*5}{$werte[0]})? 
         ($album1{5+$year*5}{$werte[0]} += 1):
         ($album1{5+$year*5}{$werte[0]} = 1));
      (defined ($album1{$year*5+$quartal}{$werte[0]})? 
         ($album1{$year*5+$quartal}{$werte[0]} += 1):
         ($album1{$year*5+$quartal}{$werte[0]} = 1));
      (defined ($album2{5+$year*5}{$werte[0]})? 
         ($album2{5+$year*5}{$werte[0]} += $werte[4]):
         ($album2{5+$year*5}{$werte[0]} = $werte[4]));
      (defined ($album2{$year*5+$quartal}{$werte[0]})? 
         ($album2{$year*5+$quartal}{$werte[0]} += $werte[4]):
         ($album2{$year*5+$quartal}{$werte[0]} = $werte[4]));
   }
}
print "Now do album calc.\n";
# [3]: 200-200, [4]>200, [5] anz
foreach $t (sort(keys %album1)) {
   foreach $nr (sort(keys %{$album1{$t}})) {
      $album2{$t}{$nr} /= $album1{$t}{$nr};
      for ($i = 3; $i < 6; $i++) {
         $erg{$t}[$i] = 0 if !defined($erg{$t}[$i]);
      }
      $erg{$t}[5] += 1;  # Erhoehe die Anzahl der Faelle
      if ($album2{$t}{$nr} >= 20.0) {
         if ($album2{$t}{$nr} <= 200.0) 
            {$erg{$t}[3] += 1;} else {$erg{$t}[4] += 1;}
      }
   }
}
print "Now the output\n";
if ($outfile ne "BS") { open(DB, ">$outfile"); }
foreach $t (sort{$b <=> $a}(keys %erg)) {
   $year = int $t / 5;
   $quartal = int $t % 5;
   if ($quartal == 0) {$year -= 1; $quartal = 5;}
   if ($erg{$t}[2]) {
      $erg{$t}[0] *= 100.0 / $erg{$t}[2];
      $erg{$t}[1] *= 100.0 / $erg{$t}[2];
   }
   if ($erg{$t}[5]) {
      $erg{$t}[3] *= 100.0 / $erg{$t}[5];
      $erg{$t}[4] *= 100.0 / $erg{$t}[5];
   }
   for ($i = 0; $i < 6; $i++) {
      $erg{$t}[$i] = 0 if !defined($erg{$t}[$i]);
   }
   if ($outfile ne "BS") {
      printf DB "\"DPV - Version 3.0c\",%d,%d", $year, $quartal;
      for ($i = 0; $i < 6; $i++) {
         if ($i % 3 == 2) {
            printf DB ",%d", $erg{$t}[$i];
         } else {
            printf DB ",%.2f", $erg{$t}[$i];
         }
      }
      print DB ",\"20-200  >200  ug/min\"\n";
   } else {
      write;
   }
}
if ($outfile ne "BS") { close DB; }

format STDOUT_TOP =
Year/Q.  Bck.   Pro.  #Aug   Mic.   Mac.  #Uri 
------- ------ ------ ----  ------ ------ ----
.
format STDOUT =
@<<<<@<@###.##@###.##@#### @###.##@###.##@####
$year, $quartal, $erg{$t}[0], $erg{$t}[1], $erg{$t}[2],
$erg{$t}[3], $erg{$t}[4], $erg{$t}[5]
.