__DATA__
0024.118.3A F T TFF     
0024.118.3B F T TFF
0024.118.3C F T TFF
0024.118.3D F T TFF
0024.118.4  F F TFF

should (and does) produce the following groups

0024FT containing 0024.118.3A,B,C,D  TFF
0024FF containing 0024.118.4         TFF (coincidently)
the degree causes the change in grouping

##</code><code>##

__DATA__
0039.04    N N OTH
0039.205.2 F T OTH
0039.205.6 F T TFF

should produce

0039NN       containing 0039.04    OTH
0039.205.2FT containing 0039.205.2 OTH
0039.205.6FT containing 0039.205.6 TFF
where the change in casetype changes the grouping

but instead the code produces

0039NN       containing 0039.04    OTH
0039.205.2FT containing 0039.205.2 OTH
0039FT       containing 0039.205.6 TFF

##</code><code>##

#! usr/bin/perl
# Compiler directives and Includes
use strict;
use warnings;
use diagnostics;
use Data::Dumper;

# Global declarations;

# Constants and pragmas
use constant MINSTATLEN03 => scalar 4;

#main()
{
    my $db01    = '';
    my %statgrp = ();
    my $table   = 'pgmsvcs.statgrp_ld';
    my $rptfh   = '';
    my $rtncd   = 0;
    
    $rtncd = FindStatGrps(\%statgrp, $table);
    exit;
} #end main()

sub FindStatGrps{
my $statgrp = shift;
my $table   = shift;

my $rtncd     = 0;
my @statlst01 = ();

push @statlst01, [ split /\s+/ ] while(<DATA>);

my %grplst = ();
my %placedstats = ();

STATUTE: foreach my $idx (0..$#statlst01){

  my $statute = $statlst01[$idx][0].$statlst01[$idx][1];
  
  next STATUTE if(exists($placedstats{$statute})); # skip if statute
                                                   # already classified

  GROUP: for my $i (MINSTATLEN03..length($statlst01[$idx][0])){
  
    next if substr($statute,$i-1,1) eq '.'; # skip if subgrp ends on
                                            # a subfield seperator (.)
    my $grpformatch = substr($statute,0,$i);
    my $levdeg = $statlst01[$idx][1];

                                            # initialize category bins
    my %srsgrp = (CM=>[],NCM=>[] ,SO=>[],ROB=>[],OTH=>[],BURG=>[],
                  TFF=>[],WC=>[],PROP=>[],DRG=>[],MISD=>[],OTH=>[],
                  DNC=>[]);

    my $j = $idx;
    do{                     # load indiv stats into respective bins
                            # does indiv stat belong to group?
      if($statlst01[$j]->[0] =~ /^$grpformatch/){
        if($statlst01[$j]->[1] eq $levdeg){
          push @{$srsgrp{$statlst01[$j]->[2]}}, $statlst01[$j];
        }
      }else{                # if statute does not match, stop looking
          $j = @statlst01;  # since list is ordered
      }
    }while(++$j < @statlst01);
                                                        
                            # check if more than one bin is occupied
    my $nrgrps = 0;
    (scalar @{$srsgrp{$_}} > 0) && $nrgrps++ foreach (keys %srsgrp);

    if($nrgrps > 1){        # 2 or more bins are occupied
      next GROUP;           # try inclrease group and try again
    }
    elsif($nrgrps == 1){    # only 1 bin occupied -- good
      my $srscat = undef;                    # determin bin name
      ($srscat || ((scalar @{$srsgrp{$_}} > 0) && ($srscat = $_))) 
                                               foreach (keys %srsgrp); 

      my $grp = $grpformatch.$levdeg;        # define group key
      $statgrp->{$grp} = [];

      foreach (@{$srsgrp{$srscat}}){       # save indiv statute data
        push @{$statgrp->{$grp}}, $_;      # & updt list of already
        $placedstats{$_->[0].$_->[1]} = 1; # classified statutes
      }
      next STATUTE;         # group found, go to next statute
    }
    else{                   # zerp bins are occupied -- error
      die "error!!";        # at least one bin should be occupied
    }
  }
}
print Dumper($statgrp);
return $rtncd;
} #end FindStatGrps()

__DATA__
0024.118.3A FT TFF
0024.118.3B FT TFF
0024.118.3C FT TFF
0024.118.3D FT TFF
0024.118.4  FF TFF
0039.04     NN OTH
0039.205.2  FT OTH
0039.205.6  FT TFF
409.176.12A FT TFF
409.176.12B FT TFF
409.176.12C FT TFF
409.176.12D FT OTH
409.176.12E FT OTH