use strict;
use Tie::IxHash;

###############################################################################
##### WHO, WHAT, WHERE, etc...
###############################################################################
#AUTHOR   Eric Matthews
#VERSION  09.4

#DESCRIPTION
## Converts Enscribe DDL to flattened DDL for use with our rules engines
##
##

#HISTORY
#Initial Writing - 10/9/2003  - Eric Matthews


###############################################################################
##### GLOBAL VARS
###############################################################################

my $ddlsize;
my $tmphase1filtoscalar;

#PROPERTIES##########################
my $schemaname;
my $defsize;

#####################################
my @occurs;
my @redefines; 
#####################################

my @occursranges; 
my @nestingoccurs;
my @procfirstoccurs; 

#named based on subs to which they were initially populated.
#some phases do not require new array, hence the gaps. see
#comments at end of code to see why i took this approach.

#DDL RECONSTRUCTION
my @phase2;
#Contains discrete lines:
#  * defname
#  * size
#  * statement tokens (1 per line no periods). occurs, redefines on seperate
#    line.

my $phase2cnt;
my @phase3;
#Contains discrete lines:
#  * one line per logical and physical element, redefines exist
#  * L (logical), P (physical) prefixes added to line

my @phase3withredefs;
#Contains discrete lines:
#  * a copy of @phase3

my @phase4;
#Contains discrete lines:
#  * physical fields
#  * non-nested occurs ONLY
#  * NO REDEFINES

my @phase5;
#Contains discrete lines:
#  * physical fields
#  * non-nested occurs resolved, enumerated, offset is accurate from BOF/EOF
#  * process occrs lines are retagged "LO", still exist as marker in array
my @phase5occurs;

my @phase6;
# @phase5 + resolves nested logical occurs
my @phase6occurs;

my @phase7;
# @phase6 + resolves physical occurs

#DDL REGENERATION

###############################################################################
##### MAIN
###############################################################################

 undef $/;
 $_ = <>;
 $tmphase1filtoscalar = $_; #just in case
 $tmphase1filtoscalar = phase1($tmphase1filtoscalar);
 ###print $tmphase1filtoscalar;  #for test...should be raw file ready to 
                                 #tokenize by "."
 $tmphase1filtoscalar = phase2($tmphase1filtoscalar);
 ###print $tmphase1filtoscalar;  #for test
 #We now hold our tokens in @phase1
 phase3();  #...more work to do
 ###print "$schemaname\n";       #for test
 print "$defsize\n";          #for test
 phase4();  #get non-redef phys fields/occurs that add up to def length
 phase5();  #resolve logical occurs that are not nested
 phase6();  #resolve nested occurs
 phase7();  #resolve physical occurs

 #phase8();  #deal with fieldname collisions
 #phase9();  #redo lexical levels
 #phase10(); #perform final alignment validation 

 #for test, just change to phase whose output you want to see
 open (STDOUT, ">out7.txt") or die $!;
 for (my $i=0; $i<@phase7; $i++)
 {
   print "$phase7[$i]\n";	
 }
	

###############################################################################
##### DDL RECONSTRUCTION
###############################################################################

 #produceRulesDDL();

#------------------------------------------------------------------------------#
sub phase1
#------------------------------------------------------------------------------#
##
## Prepare file to tokenize on "."
##
{
 my $synthesis1	= $_[0];
 $synthesis1 =~ ( s/!.+//g );  #get rid of ddlrep comments codes
 $synthesis1 =~ ( s/\n//g );   #shag newlines
 $synthesis1 =~ ( s/\s+/ /g ); #bag unneeded whitespace
 ###print $_;  #for test 
 return $synthesis1;
}  #end sub

#------------------------------------------------------------------------------#
sub phase2
#------------------------------------------------------------------------------#
{
##
## split on "."
##	
 my $synthesis2	= $_[0];
 my $returncde; 	
 @phase2 = split (/\./, $synthesis2);
 $phase2cnt = @phase2;
 ###print $phase2cnt;
 for (my $i=0; $i<@phase2; $i++)
 {
   ### print "$phase2[$i]"; #for test
   $returncde .= "$phase2[$i]";  
 }
 return $returncde;
}  #end sub	


#------------------------------------------------------------------------------#
sub phase3
#------------------------------------------------------------------------------#
##
## Finish creating token on "."
## We should only be left in our arrays with what amount to statements.
## Here we also will get properties like filesize, schema name, etc...
##
{
 my $p3ndx=0;
 my $occursndx=0;
 my $redefinesndx=0;
 for (my $i=0; $i<@phase2; $i++)
 {
   #get properties
   $defsize = $1 if $phase2[$i] =~ /([0-9]+) +bytes *$/i;
   $schemaname = $1 if $phase2[$i] =~ /\?section +(?:.+) +(.+) *$/i; 

   #ID physical/logical fields add to array
   if ($phase2[$i] =~ /^ *[0-9]+/)
   {
    #then we have a token
    #print "$phase2[$i]\n" ;  #for test   
    $phase2[$i] =~ ( s/^ +//g );  #bag any leading whitespace 
    $phase2[$i] =~ ( s/ +$//g );  #bag any trailing whitespace 
    #OK What type of element are we???
     if ($phase2[$i] =~ /^[0-9]+\s+[0-9]+\s+[0-9]{2}\s+.+\s+(?:type|pic)/i)
     {
     #I am physical
      $phase3[$p3ndx++] = "P $phase2[$i]."; 
     }
     else
     {
     #I am logical
      $phase3[$p3ndx++] = "L $phase2[$i].";      	
     }	    	
   }
   #id physical/logical fields that are occurs
   elsif ($phase2[$i] =~ /^ *(occurs.+)/) 
   {	
     $occurs[$occursndx++] = "$i~$1";
     $phase3[$p3ndx-1] =~ s/\n$//;
     $phase3[$p3ndx-1] .= "$phase2[$i]."; 
   }	
   #id physical/logical fields that are redefines
   elsif ($phase2[$i] =~ /^ *(redefines.+)/) 
   {	
     $redefines[$redefinesndx++] = "$i~$1";
     $phase3[$p3ndx-1] =~ s/\n$//;
     $phase3[$p3ndx-1] .= "$phase2[$i]."; 
   }
   	    
 } #end for loop

  @phase3withredefs = @phase3;
  #sanitize @phase3
  @phase3 =  presanitizePhasearray(@phase3);


}  #end sub

#------------------------------------------------------------------------------#
sub phase4
#------------------------------------------------------------------------------#
{
##
## Goal here is to read through the file and get all of the non-redefined occurs
## and physical fields that add up to the length of the record. We have 
## validated proper alignment at this stage as well.
##
## One drawback of not dealing with redefines is that some records like 
## ANCSVR-MSG are used to perform multiple business functions. For example,
## ancillary and nuclear medicine (among other). Unfortunately it is impossible
## for me to know the context of a redefine at this stage in the game. i think
## later we might be able to possibly write a service that would extract a
## desired redefine and append that segment of the source file, though i am
## not making any hard and fast promises here.
##

  my $start=0;
  my $sz = @phase3;
  @phase4 = getDDLchunk(\$start, \$sz, \@phase3);  


} #END SUB


#------------------------------------------------------------------------------#
sub phase5
#------------------------------------------------------------------------------#
{
##
## In this phase we resolve all logical occurs that are non nested
##

  my $ndx=0;
  my $n=0;
  for (my $i=0; $i<@phase4; $i++)
  {
   my @tmpoccurs;
   my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                       atomicline($phase4[$i]);

#get nesting logical occurs from @phase4                                             
   if ($phase4[$i] =~ / occurs/i and $leveltyp eq "L")
   {
     #print "$phase4[$i]\n"; 	
     my $occlen = getLogicalOccursMolecule($restofline);

    #differentiate from nested occurs
     my $tmpleveltyp = ($leveltyp .= "O");
     my $tmpstring = "$tmpleveltyp $offset $len $lexlevel $fieldname $restofline";

     push (@phase5occurs, $tmpstring);
 
     @tmpoccurs = procPhase3Array($offset,$fieldname,$len);
     @tmpoccurs = presanitizePhasearray(@tmpoccurs);

     @tmpoccurs = occursExpansion(\$occlen, \@tmpoccurs, \$len, \$offset, \$fieldname);
     push (@phase5occurs, @tmpoccurs);

   } 
   else
   {
     push (@phase5occurs, $phase4[$i]);	
   }	 
  
  } #end for
 
  @phase5 = @phase5occurs;
  
  @phase5 = recalcOffset(@phase5)

} #END SUB


#------------------------------------------------------------------------------#
sub phase6
#------------------------------------------------------------------------------#
{
##
## resolve non nested occurs
## 

 my $ndx=0;
 my $FirstOccursOffset=0; 
 my @p6tmp;
 for (my $i=0; $i<@phase5; $i++)
 {
   my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                       atomicline($phase5[$i]);

#KIS
  if ($leveltyp eq "P")
  {
    $phase6occurs[$ndx++] = $phase5[$i];	
  } #end if

  elsif ($leveltyp eq "LO")
  {  
    #print "  $phase5[$i]  $LOlen\n";    
    $phase6occurs[$ndx++] = $phase5[$i];    	
  } #end if
  
  elsif ($leveltyp eq "L") #we have a nested occurs to resolve
  {
    #print "     $phase5[$i]\n";   
    my $myoccurance = $1 if $fieldname =~ /.+~.+~([0-9]+)/;
    $FirstOccursOffset = $offset if $myoccurance == 1;

    #since occurs fieldname was appended and enumerated it will have the 
    #pattern groupname~fieldname~enumeration. We need to extract the fieldname
    my $tmpfieldname = $1 if $fieldname =~ /.+~(.+)~/;
    #$tmpfieldname is what we will send to the sub as well as $fieldname. The 
    #sub will use $tmpfieldname as part of it's positioning criteria. It will
    #use $fieldname to append to physical (and maybe logical) fields we process  

    #next determine the length of the occurs
    my $occlen = getLogicalOccursMolecule($restofline);
    my $newlen = ($len * $occlen);

####This may be a future enhancement in making this all recursive. For now I
####am only dealing with resolving occurs that have a depth no greater than 2.
####any we find we will substitute with psuedo filler.
    my $tmpleveltyp = ($leveltyp .= "N");
    my $tmpstring = "$tmpleveltyp $offset $len $lexlevel $fieldname $restofline";    
    
    $phase6occurs[$ndx++] = $tmpstring;   	

####Call sub to resolve nested occurs
## This is just filthy. Since we are nested we need to calculate the base offset
## of the occurs for occurs levels greater than 1, so we can look them up 
## properly and with a modicum of trust.

    #print "myoccurance=$myoccurance  offset=$offset len=$len  FirstOccursOffset=$FirstOccursOffset \n";
    
       @p6tmp     = resolveNestedOccurs(\$occlen, 
                                         \$newlen,       
                                         \$offset, 
                                         \$fieldname, 
                                         \$tmpfieldname,
                                         \$FirstOccursOffset,
                                         \$myoccurance
                                        );
    for (my $z=0; $z<@p6tmp; $z++)
    {
     print "$p6tmp[$z]\n";
     $phase6occurs[$ndx++] = $p6tmp[$z];	
    }	 

  } #end elsif 
  		
	
 } #end for loop	

  @phase6 = @phase6occurs;

  @phase6 = recalcOffset(@phase6);
#IMPORTANT NOTE: Any schema which starts with an occurs (i.e copay-scrnmsg)
#will fail validation, though all the fields transform correctly. This is
#because the sub @phase6() id premised on the fact that the first field is
#not an occurs. I will try to fix later.


} #end sub

#------------------------------------------------------------------------------#
sub phase7
#------------------------------------------------------------------------------#
{
##
## resolve physical occurs. Finally an easy task!!!
##
## Note: I waited this long to resolve these as it is very probable for 
## physical occurs to exist within logical occurs and i wanted to deal with
## them all at once.
 
  my $ndx=0;
  for (my $i=0; $i<@phase6; $i++)
  {
   my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                       atomicline($phase6[$i]);
   
    if ($leveltyp eq "P" and $restofline =~ / occurs/i)
    {
      ###$phase7[$ndx++] = $phase6[$i]; #left for test
      my ($chaff, $qty) = getPhysicalOccursMolecule($restofline); 
      for (my $val=1; $val<=$qty; $val++)
      {
        my $newf = $fieldname;
        $newf .= "-";
        $newf .= $val;
        if ($val == 1)
        {
          $phase7[$ndx++] = "$leveltyp $offset $len $lexlevel $newf";
        }
        elsif ($val > 1)
        {
          my $newoffset = ($offset + ($len * $val) - $len); 
          $phase7[$ndx++] = "$leveltyp $newoffset $len $lexlevel $newf";        	
        }	         	
      }	     	
    }
    elsif ($leveltyp eq "P" and $restofline !~ / occurs/i)
    {
      $phase7[$ndx++] = $phase6[$i];    	
    }
    elsif ($leveltyp eq "LO")
    {
      $phase7[$ndx++] = $phase6[$i];    	
    }			
    elsif ($leveltyp eq "LN")
    {
      $phase7[$ndx++] = $phase6[$i];    	
    }
    elsif ($leveltyp eq "L")
    {
      $phase7[$ndx++] = $phase6[$i];    	
    }
  	
                                                       
  } #end for loop	  


} #end sub phase7


###############################################################################
##### CARECAST/LASTWORD SPECIFIC SUBROUTINES
###############################################################################

#------------------------------------------------------------------------------#
sub betterqualuseseq   
### NOT BEING USED
#------------------------------------------------------------------------------#
##
## add group level name to dict-use/dict-seq pair
##
## since we are dealing with hierachical schema that can be either logical or 
## physical this is our first transation issue. Phdict fk's are oftentimes 
## stored as dict-use and dict-seq buried under a logical level. Other tools
## like mgmt reporter resolve these name ambiguities by enumeration, which is
## frankly a crappy (though much simpler technique to codify) method. Here we 
## are going to qualify the name by appending the logical name so it is easier 
## to understand by the person working with the def.

##NOTE-This is way to verbose and could be more terse, i just do not have time 
##to go back and recode this.
{
  my $size=0;
  my $size2=0;
  my @fieldlength;
  my @appendto;
  my $newfn;

  for (my $i=0; $i<@phase3; $i++)
  {

   my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                       atomicline($phase3[$i]);
                                                       
   if ($phase3[$i] =~ /DICT-USE/i)
   {
    #get field before dict-use field
    @appendto = atomicline($phase3[$i-1]);
    $appendto[4] =~ s/\.$//;

     if ($appendto[4] =~ /DICT-KEY/i)
     {	
      #this is an ambiguous name so we will get the one before this
      #It is unlikely that one would use dict-key without another logical unit
      #before it though i suppose it is possible. 
      @appendto = atomicline($phase3[$i-2]);
      $appendto[4] =~ s/\.$//;
      #print "$appendto[4]\n"; 

      #Determine length of string. DDL maz is 34 chars so we can append 26 new
      #chars count the -
      @fieldlength = $appendto[4];
      $size2 = @fieldlength;
      if ($size2 <= 25)
      {
       $newfn = "$appendto[4]-$fieldname";
       $fieldname = $newfn; 
      } 
      else
      {
      	#trim $appendto[4] to 25 chars
        $appendto[4] = substr($appendto[4], 0,25);
        $newfn = "$appendto[4]-$fieldname";
        $fieldname = $newfn;
      }	       
     } #end dict-key if
     else #what we got to begin with will do
     {	    
      @fieldlength = $appendto[4];
      $size = @fieldlength;
      if ($size2 <= 25)
      {      
       $newfn = "$appendto[4]-$fieldname";
       $fieldname = $newfn;
      }
      else
      {
      	#trim $appendto[4] to 25 chars
        $appendto[4] = substr($appendto[4], 0,25);      
        $newfn = "$appendto[4]-$fieldname";
        $fieldname = $newfn;      	      	
      }	 
     }
    $phase3[$i] = "$leveltyp $offset $len $lexlevel $fieldname $restofline";                                                       
    #print "$phase3[$i]\n";  #for test
   } #end dict-use if

   elsif ($phase3[$i] =~ /DICT-SEQ/i)
   {
    #get field before dict-use field
    @appendto = atomicline($phase3[$i-2]);
    $appendto[4] =~ s/\.$//;

     if ($appendto[4] =~ /DICT-KEY/i)
     {	
      #this is an ambiguous name so we will get the one before this
      #It is unlikely that one would use dict-key without another logical unit
      #before it though i suppose it is possible. 
      @appendto = atomicline($phase3[$i-3]);
      $appendto[4] =~ s/\.$//;
      #print "$appendto[4]\n"; 

      #Determine length of string. DDL maz is 34 chars so we can append 26 new
      #chars count the -
      @fieldlength = $appendto[4];
      $size2 = @fieldlength;
      if ($size2 <= 25)
      {
       $newfn = "$appendto[4]-$fieldname";
       $fieldname = $newfn; 
      } 
      else
      {
      	#trim $appendto[4] to 25 chars
        $appendto[4] = substr($appendto[4], 0,25);
        $newfn = "$appendto[4]-$fieldname";
        $fieldname = $newfn;
      }	       
     } #end dict-key if
     else #what we got to begin with will do
     {	    
      @fieldlength = $appendto[4];
      $size = @fieldlength;
      if ($size2 <= 25)
      {      
       $newfn = "$appendto[4]-$fieldname";
       $fieldname = $newfn;
      }
      else
      {
      	#trim $appendto[4] to 25 chars
        $appendto[4] = substr($appendto[4], 0,25);      
        $newfn = "$appendto[4]-$fieldname";
        $fieldname = $newfn;      	      	
      }	 
     }
    $phase3[$i] = "$leveltyp $offset $len $lexlevel $fieldname $restofline";                                                       
    #print "$phase3[$i]\n";  #for test
   } #end dict-seq if

   

  } #end for loop ...finally!

}  #end sub 

###############################################################################
##### GENERAL SUBROUTINES TO SUPPORT PHASES
###############################################################################
####
#### Where reuse was possible it is employed. However, given the unique nature
#### of the processing that occurs at each phase some subs remain discrete to
#### specific phases.
####
###############################################################################
#------------------------------------------------------------------------------#
sub atomicline
#------------------------------------------------------------------------------#
##
## This sub creates atoms for a phase3 array element, we accept an array 
##
##LEGEND
## Element#  Descriptor           Always?  Notes
## --------  -------------------  -------  ---------------------
##   [0]     Level type              Y     L=logical; P=Physical
##   [1]     Offset                  Y     
##   [2]     Length                  Y
##   [2]     Lexical level           Y
##   [4]     Fieldname               Y     if  Level type=L
##                                             will end with period
##                                             though occurs may follow 
##                                         if  Level type=P
##                                             always followed by datatype
##                                             may be followed by occurs
##                                             may be followed by redefine  
##-----------------------------------------------------------------------------
## THE REST is dependent on a pretty complex set of conditions that would
## better be handled by text not array processing.
## HENCE
##   [5]    Remainder of line       Y
{
 my $procln = $_[0];
 #print $procln;
#  P 00348 00004 06 ACCT-MOTHERS-ACCT Type binary 32.
#  L 00352 00016 06 ACCT-PLANS.
#  L 00352 00004 07 PLAN-KEY. occurs 4 times.

 ###print "$procln\n";  #for test
 my @a = split (/ +/, $procln);
 #print "@a ";
 my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline);

 $leveltyp = $a[0];
 $offset = $a[1];   	
 $len = $a[2];  
 $lexlevel = $a[3];  
 $fieldname = $a[4];
 $restofline = " ";  

 for (my $i=5; $i<@a; $i++)
 {
   if ($a[$i])
   {
     $restofline =~ s/^\s+//;
     $restofline .= "$a[$i] "; 
   }	   
 }	 
 
 return ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline); 	
}  #end sub

#------------------------------------------------------------------------------#
sub getPhysicalOccursMolecule   
#------------------------------------------------------------------------------#
{
  my ($datatyp, $qty) = ($1, $2)  if $_[0] =~ /(.+)\s+occurs\s+([0-9]+)/i;
  $datatyp .= ".";
  return ($datatyp,$qty);	
}	

#------------------------------------------------------------------------------#
sub getLogicalOccursMolecule   
#------------------------------------------------------------------------------#
{
  my $qty = $1  if $_[0] =~ /occurs\s+([0-9]+)/i;
  return $qty;	
}

#------------------------------------------------------------------------------#
sub getDDLchunk
#------------------------------------------------------------------------------#
##
## This sub accepts a length argument, an array start position arg, and an array
## arg. It returns an array of phys fields and occurs (excluding redefined data)
## It is used by the phase four. 
##
{
  my $startarr = ${$_[0]};
  my $proclen  = ${$_[1]}; 
  my @procarr  = @{$_[2]};
  
  my @resultsarr;
  
  my $runningtotal=0;
  my $firstPhy="no";
  my $nextPhy=0;
  
  my $ndx=0;
  my $endarr = @phase3;
  
  for (my $i=$startarr; $i<@procarr; $i++)
  {
   my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                       atomicline($procarr[$i]);

    if ($procarr[$i] =~ /^P/ and $runningtotal < $defsize and $offset == $runningtotal)
    {	
      if ($firstPhy eq "no")
      {
      	$firstPhy = "yes";
      	$nextPhy = ($offset + $len);
      	$runningtotal += $len;
      	###print "$nextPhy $runningtotal  $procarr[$i]\n"; #for test
      	$resultsarr[$ndx++] = $procarr[$i];
      }
      elsif ($firstPhy eq "yes")
      {

      	if ($offset == $nextPhy)
      	{	      
          if ($procarr[$i] =~ / occurs/i)
          {
            my ($zzz, $numoccurs) = getPhysicalOccursMolecule($restofline);
      	    $nextPhy = ($offset + ($len * $numoccurs));
      	    my $t = ($len * $numoccurs);
            $runningtotal += $t; 
       	    ###print "$nextPhy $runningtotal   $procarr[$i]\n"; #for test    
            $resultsarr[$ndx++] = $procarr[$i];         	
          }
          else
          {	
      	   $nextPhy = ($offset + $len);
           $runningtotal += $len;
      	   ###print "$nextPhy $runningtotal   $procarr[$i]\n"; #for test
           $resultsarr[$ndx++] = $procarr[$i]; 
      	  } 
        } #end if
      } #end elseif
    } #end if

      elsif ($procarr[$i] =~ /^L/ and $runningtotal < $defsize and $offset == $runningtotal)
      {
          if ($procarr[$i] =~ / occurs/i)
          {
            unless ($procarr[$i] =~ / redefines/)
            {   
              my $numoccurs = getLogicalOccursMolecule($restofline);
      	      $nextPhy = ($offset + ($len * $numoccurs));
      	      my $t = ($len * $numoccurs);
              $runningtotal += $t;  
       	      ###print "$nextPhy  $runningtotal   $procarr[$i]\n"; #for test        	
       	      $resultsarr[$ndx++] = $procarr[$i]; 
             }        	
          }	        
      }	
	
   }#end for loop

      ###print "RUNNINGTOTAL IS $runningtotal\n";
      ###print "DEFSIZE IS $defsize\n";
      ###print ($runningtotal - $defsize);

  return @resultsarr;
} #END SUB


#------------------------------------------------------------------------------#
sub procPhase3Array
#------------------------------------------------------------------------------#
##
## This sub accepts a start position, a length, and a fieldname
## arg. It returns an array of phys fields and occurs (excluding redefined data)
## It is used to resolve occurs in @phase4 by going back and getting the data
## from @phase3. The output is returned in array to caller. 
##
{
  my $s_offset     = $_[0];
  my $s_fieldname  = $_[1];
  my $proclen      = $_[2]; 
  
  my @resultsarr;
  
  my $runningtotal=0;
  my $firstPhy="no";
  my $nextPhy=0;
  
  my $ndx=0;
  my $endarr = @phase3;

#Find starting point in array
  my $startarr = 0;
  for (my $i=0; $i<@phase3; $i++)
  {
   my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                       atomicline($phase3[$i]);

    if ($s_offset == $offset and $s_fieldname eq  $fieldname)
    {
      $startarr = $i;
      #?#print "\$i=[$i]  $phase3[$i]\n";
      last;	
    }	
    
  }  

  $startarr += 1;
#Get data  
  for (my $i=$startarr; $i<@phase3; $i++)
  {

   my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                       atomicline($phase3[$i]);

    #print "\$i=[$i]  $phase3[$i]\n";
    if ($phase3[$i] =~ /^P/ and $runningtotal < $proclen)
    {	
      if ($firstPhy eq "no")
      {
      	$firstPhy = "yes";
      	$nextPhy = ($offset + $len);
      	$runningtotal += $len;
      	#?#print "$nextPhy $runningtotal  $phase3[$i]\n";
      	$resultsarr[$ndx++] = $phase3[$i];
      }
      elsif ($firstPhy eq "yes")
      {

      	if ($offset == $nextPhy)
      	{	      
          if ($phase3[$i] =~ / occurs/i)
          {
            my ($zzz, $numoccurs) = getPhysicalOccursMolecule($restofline);
      	    $nextPhy = ($offset + ($len * $numoccurs));
      	    my $t = ($len * $numoccurs);
            $runningtotal += $t; 
       	    #?#print "$nextPhy $runningtotal   $phase3[$i]\n";    
            $resultsarr[$ndx++] = $phase3[$i];         	
          }
          else
          {	
      	   $nextPhy = ($offset + $len);
           $runningtotal += $len;
      	   #?#print "$nextPhy $runningtotal   $phase3[$i]\n";
           $resultsarr[$ndx++] = $phase3[$i]; 
      	  } 
        } #end if
      } #end elseif
    } #end if

      elsif ($phase3[$i] =~ /^L/ and $runningtotal < $proclen)
      {
          if ($phase3[$i] =~ / occurs/i)
          {
            unless ($phase3[$i] =~ / redefines/)
            {   
              my $numoccurs = getLogicalOccursMolecule($restofline);
      	      $nextPhy = ($offset + ($len * $numoccurs));
      	      my $t = ($len * $numoccurs);
              $runningtotal += $t;  
       	      #?#print "$nextPhy  $runningtotal   $phase3[$i]\n";         	
       	      $resultsarr[$ndx++] = $phase3[$i]; 
             }        	
          }	        
      }	

	
   }#end for loop

      print "RUNNINGTOTAL IS $runningtotal\n";
      print "PROCLEN IS $proclen\n";
      print ($runningtotal - $proclen);
      print "\n";

  return @resultsarr;
} #END SUB

#------------------------------------------------------------------------------#
sub presanitizePhasearray
#------------------------------------------------------------------------------#
{
# It is possible that we have duplicates (this would typically be the result 
# of occurs that have nested redefines. An example of this can be found in the
# ACCT-SVRMSG (see levels PLAN-KEY and CARRIER-KEY. Best solution is to rid 
# outselves of this by saving to a hash @resultsarr with the following key
# key = $leveltyp  $offset $len
#       L  00352   00004
my @tmp = @_;
my %nodupshash;
tie (%nodupshash, 'Tie::IxHash');
for (my $i=0; $i<@tmp; $i++)
{
  my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                       atomicline($tmp[$i]);

  unless (exists($nodupshash{"$leveltyp $offset $len $lexlevel"}))
  {
   $nodupshash{"$leveltyp $offset $len $lexlevel"} = "$tmp[$i]";
  }	
} 

@tmp=();
my $iho=0;
my $key="";  
my $val="";
foreach $key (keys %nodupshash)
{
  ($key, $val) = each(%nodupshash);
  $tmp[$iho++] = $val;	
}	

###for (my $i=0; $i<@tmp; $i++)
###{
###  print "$tmp[$i]\n";	
###}	

return @tmp;
	
}  #END SUB		


#------------------------------------------------------------------------------#
sub occursExpansion
#------------------------------------------------------------------------------#
##
## accepts an array of occurs, expands array through enumeration, returns
## array.
##
{
  my $proclen  = ${$_[0]}; 
  my @procarr  = @{$_[1]};
  my $occurslen = ${$_[2]};
  my $startoffset = ${$_[3]};
  my $logfieldnm = ${$_[4]};  

  $logfieldnm = $1 if $logfieldnm =~ /(.+)\./;
  
  my @ret;
  my $ndx=0;

  #?#print "\n=====================================================\n";

  my $iterationoffset=0;
  my $vOff=0;
  for (my $i=1; $i<=$proclen; $i++)
  {
    $vOff = ($i - 1);
    $iterationoffset = ($startoffset * $vOff);
    my $newoffset=0;
    for (my $ii=0; $ii<@procarr; $ii++)
    {
     my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                atomicline($procarr[$ii]); 

###NOTE WE ARE USING TILDA's as it is an illegal DDL character so it is a
###mean of distinguishing our append from the original DDL source as source
###field element could contain a construct like # or -# which would confuse
###this program.

#!!!#NEED TO DEAL WITH 34 CHAR LIMIT HERE BEFORE APPENDING
     $fieldname = $1 if $fieldname =~ /(.+)\.$/;
     my $newfieldname = "$logfieldnm~";
     $newfieldname .= $fieldname; 
     $newfieldname .= "~$i"; #enumerate fieldname to occurs level
     
     if ($procarr[$ii] =~ /^P/)
     {
       	 $newoffset += $len;	        
         $ret[$ndx++] = "$leveltyp $newoffset $len $lexlevel $newfieldname $restofline";
     }
     elsif ($procarr[$ii] =~ /^L/)
     {
         my $numoccurs = getLogicalOccursMolecule($restofline);
       	 $newoffset += ($len * $numoccurs);	        
         $ret[$ndx++] = "$leveltyp $newoffset $len $lexlevel $newfieldname $restofline";
     }     	     	

    } #END inner for
  } #END outer for

# trying to inline the new offset is kicking my butt so i am reproc'ing
# @ret to calculate new offset. 

  #?#print "\n++++++++++++++++++++++++++++++++++++++++++++++++++++++\n";
  #?#print "!!!!!! starting offset  $startoffset  !!!!!\n";
  #?#print "!!!!!! occurs length    $occurslen    !!!!!\n";

  return @ret;	
}	

#------------------------------------------------------------------------------#
sub resolveNestedOccurs
#------------------------------------------------------------------------------#
##
## resolve nested occurs.
##
{

###NOTE TO ME: $proclen and $occurslen and input arg names are poorly named 
###both here and in sub occursExpansion()

### \$occlen, \$newlen, \$offset, \$fieldname, \$tmpfieldname
  my $proclen  = ${$_[0]}; 
  my $occurslen = ${$_[1]};
  my $startoffset = ${$_[2]};
  my $origfieldname = ${$_[3]};
  my $appendfieldname = ${$_[4]};
  my $firstOccursOffset = ${$_[5]};
  my $myoccurance = ${$_[6]};      

  my $runningtot=0;
  my @tmparr;
  my $tmpndx=0;
  my @ret;

  my $getoccursname = $1 if $origfieldname =~ /^(.+)~/;

#print "proclen=$proclen \n occurslen=$occurslen \n  startoffset=$startoffset  \n";
#print "origfieldname=$origfieldname \n appendfieldname=$appendfieldname \n";
#print "firstOccursOffset=$firstOccursOffset \n myoccurance=$myoccurance \n";
#print "\n --------------------------\n\n";

#The degree of processing here is overkill, but i do not want to figure out how
#to swap resolving nested occurs with nesting occurs as it present a whole new
#bag of pooh (and we are not talking winnie).
  my $startat=0;
  for (my $i=0; $i<@phase3; $i++)
  {
   my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                atomicline($phase3[$i]);

     #print "$phase3[$i]\n";	
     if ($leveltyp eq "L")
     {
      $fieldname = $1 if $fieldname =~ /(.+)\./ ;   
     }

     if ($firstOccursOffset == $offset and $appendfieldname eq $fieldname)
     {      	
     	print "$phase3[$i]\n";
        $startat = $i;
     	next;	
     }
     elsif ($firstOccursOffset <= $offset and $i > $startat and $runningtot < $proclen)
     {
       my $newfld="";
       if ($leveltyp eq "P" and $restofline !~ / redefines/i)
       {	      

         #print "$leveltyp $startoffset $len $lexlevel $fieldname $restofline\n";
         $newfld .= $appendfieldname;
         $newfld .= $myoccurance; 
         $newfld .= "~";
         $newfld .= $fieldname;
         $tmparr[$tmpndx++] = "$leveltyp $startoffset $len $lexlevel $newfld $restofline";
         $runningtot += $len;        	
       }    
       elsif ($leveltyp eq "L" and $restofline =~ / occurs/i and $restofline !~ / redefines/i)
       {	      
         #print "$leveltyp $startoffset $len $lexlevel $fieldname $restofline\n";
         $newfld .= $appendfieldname;
         $newfld .= $myoccurance;         
         $newfld .= "~";
         $newfld .= $fieldname;
         $tmparr[$tmpndx++] = "$leveltyp $startoffset $len $lexlevel $newfld $restofline";
         $runningtot += $len;
       } 
     } #end elsif
   
   } #end for loop

  my @finalret; 
  my $n=0;
  for (my $i=1; $i<=$proclen; $i++)
  {
    my $appfld="";
    for (my $ii=0; $ii<@tmparr; $ii++)
    {
     my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                atomicline($tmparr[$ii]);
     $appfld = $fieldname;
     $appfld .= "~"; 
     $appfld .= $i;
     $finalret[$n++] = "$leveltyp $offset $len $lexlevel $appfld $restofline"     	
    }		
  }	         		

  
  @ret = @finalret;  
  return @ret;
  	
} #end sub 
	

#------------------------------------------------------------------------------#
sub recalcOffset
#------------------------------------------------------------------------------#
##
## reclaculates offset column
##
{

  my @inp  = @_;
  my @retrecalc;
  my $lastoff=0;
  
  my $ofst=0;
  for (my $i=0; $i<@inp; $i++)
  {
     my ($leveltyp, $offset, $len, $lexlevel, $fieldname, $restofline) = 
                                                atomicline($inp[$i]);

      if ($i == 0)
      {
      	 $retrecalc[$i] = 
         "$leveltyp $offset $len $lexlevel $fieldname $restofline"; 
         $lastoff = $len;
      }

      elsif ($i > 0)
      {
         if ($leveltyp eq "P" and $restofline !~ / occurs/ and $restofline !~ / redefines/)
         {
            $retrecalc[$i] = 
            "$leveltyp $lastoff $len $lexlevel $fieldname $restofline";          	
            #$ofst += $len;
            $lastoff += $len;
         }	                                               
         elsif ($leveltyp eq "P" and $restofline =~ / occurs/ and $restofline !~ / redefines/)
         {
            my ($dummy, $numoccurs) = getPhysicalOccursMolecule($restofline);
            $retrecalc[$i] = 
            "$leveltyp $lastoff $len $lexlevel $fieldname $restofline";          	
             my $calcoffst = ($len * $numoccurs);
            #$ofst += $calcoffst;
            $lastoff += $calcoffst;            
         }
         elsif ($leveltyp eq "L")
         {
            my $numoccurs = getLogicalOccursMolecule($restofline);     	
            $retrecalc[$i] = 
            "$leveltyp $lastoff $len $lexlevel $fieldname $restofline";  
            $ofst = ($len * $numoccurs);
            $lastoff += $ofst;
         }
         else #no calc
         {
     	   $retrecalc[$i] = $inp[$i];
         }	 
     }

  } #end for loop	

  for (my $i=0; $i<@retrecalc; $i++)
  {
    #?#print "$retrecalc[$i]\n";	
  }	  

 return @retrecalc;
	
} #end sub