It's tough to figure out what is trying to be done, but here is my stab at a rewrite:

$infile = shift || die "Need a filename!\n";
open(INFILE, "$infile") || die "Could not open $infile: $!\n";
while(<INFILE>) {
  chop;
  tr/A-Z/a-z/;  ## lowercase all characters
  s/\s+/ /g;    ## remove extra spaces
  for $x (split(/\d*\./, $_)) {

    ## Set each to "0" if not found in the hash:
    $site      = $site{$x}      || "0";
    $specimin  = $specimin{$x}  || "0";
    $procedure = $procedure{$x} || "0";

    ## Do not go on if any were not found:
    next unless ($site && $specimin && $procedure);

    ## Grab the results of assigncode:
    $code=&assigncode($site,$specimen,$procedure);

    ## Exit while loop if a good $code is found:
    last if $code;
  }
}
close(IN);

print "$code " if $code;
print "$line\n";
[download]

Notes:

• You don't need all the subs. Looks like you are coming from a C background?
• The whitespace substitution needs a 'g' on the end
• All the things that btrott noted above
• The subroutines were missing closing brackets
• Parenthesis on 'my' must be to the left of the equal sign:
  my(@sample)=@_;
• You don't need to sort they keys if you are just looping through to look for a specific value, unless the matches are more likely to be found at the start of the alphabet
• Adding a chop is probably a good idea, or you get a newline on the final value returned from the split
• The above code assumes that you have &assigncode and $line defined elsewhere.