#!/usr/bin/perl

    use DBI;
    use DBD::Oracle;

    # Constants:
    use constant field0  =>  0;
    use constant field1  =>  1;
    use constant field2  =>  2;
    use constant field3  =>  3;
    use constant field4  =>  4;
    use constant field5  =>  5;
    use constant field6  =>  6;
    use constant field7  =>  7;
    use constant field8  =>  8;
    use constant field9  =>  9;
    use constant field10  => 10;
    use constant field11  => 11;
    use constant field12  => 12;
    use constant field13  => 13;
    use constant field14  => 14;
    use constant field15  => 15;
    use constant field16  => 16;
    use constant field17  => 17;
    use constant field18  => 18;
    use constant field19  => 19;
    use constant field20  => 20;
    use constant field21  => 21;
    use constant field22  => 22;
    use constant field23  => 23;
    use constant field24  => 24;
    use constant field25  => 25;
    use constant field26  => 26;
    use constant field27  => 27;
    use constant field28  => 28;
    use constant field29  => 29;
    use constant field30  => 30;
    use constant field31  => 31;
    use constant field32  => 32;
    use constant field33  => 33;
    use constant field34  => 34;
    use constant field35  => 35;
    use constant field36  => 36;
    use constant field37  => 37;
    use constant field38  => 38;
    use constant field39  => 39;
    use constant field40  => 40;
    use constant field41  => 41;
 
    # Capture Directory Path from Environment Variable:
    my $DIRECTORY = $ENV{DATADIR};

    # Process Counters:
    my %fileCntr = (
        ccr1  => 0,
        ccr2  => 0,
        ccr3  => 0,
        ccr4  => 0,
        ccr5  => 0
       );

    # Process Control Hashes:
    my %xref = ();

    # Process Control Variables:
    my $diag = 0;
    my $proc = 0;
    my $ndcc = 0;
    my $previous = "";

    # Claims Extract array:
    my @arr = ();
    my $hdr = "";

    # Accept/Parse DSS Connection String:
    $ENV{PSWD} =~ /(.+)\/(.+)\@(.+)/;
    my $USER = $1;
    my $PASS = $2;
    my $CONN = 'DBI:Oracle:' . $3;

    # ALTER Date format:
    my $ATL = qq(ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD');

    # Database Connection:
    my $dbh = DBI->connect( $CONN, $USER, $PASS, { RaiseError => 1, AutoCommit => 0 } );
      $dbh->do($ATL);	# Execute ALTER session.

    my $SQL = qq(
     SELECT ... here is a big sql query
    );

    # Open OUTPUT file for CCR processing:
    open OUT1, ">$DIRECTORY/ccr1.dat" or die "Unable to open OUT1 file: $!\n";
    open OUT2, ">$DIRECTORY/ccr2.dat" or die "Unable to open OUT2 file: $!\n";
    open OUT3, ">$DIRECTORY/ccr3.dat" or die "Unable to open OUT3 file: $!\n";
    open OUT4, ">$DIRECTORY/ccr4.dat" or die "Unable to open OUT4 file: $!\n";
    open OUT5, ">$DIRECTORY/ccr5.dat" or die "Unable to open OUT5 file: $!\n";

    # Redirect STDOUT to log file:
    open STDOUT, ">$DIRECTORY/ccr.log"   or die "Unable to open LOG file: $!\n";

    # Prepare $SQL for execution:
    my $sth = $dbh->prepare($SQL);
    $sth->execute();

    # Produce out files:
    {
      local $, = "|";
      local $\ = "\n";

      while (@arr = $sth->fetchrow_array)
      {
        # Direct Write of CCR1&2 records:
        &BuildCCR12();

        # Write and Wipe CCR3 HASH Table:
        &WriteCCR3() unless ($arr[field0] == $previous);
        &BuildCCR3();

        # Loop processing for CCR4:
        &BuildCCR4();

        # Loop processing for CCR5:
        &BuildCCR5();
      }
    }

    # Print Record Counts for OUTPUT files:
    foreach my $key (keys %fileCntr) { print "$key: " . $fileCntr{$key} . "\n"; }

    # Terminate DB connection:
    $sth->finish();
    $dbh->disconnect();

    # Close all output files:
    close(OUT1); close(OUT2); close(OUT3);
    close(OUT4); close(OUT5);

    {
     # Reassign Output End-of-record across subroutine block:
     local $\ = "\n";

     sub BuildCCR12
     {
      # Write CCR1 Table:
      print OUT1 $arr[field6]  . '|' . $arr[field7]   . '|' . $arr[field5];

      $fileCntr{ccr1}++;

      # Write CCR2 Table:
      unless ($arr[field17] eq '###########') {
                print OUT2 ++$ndcc . "|" .  $arr[field0]     . "|" . 
                $arr[field6];
                $fileCntr{ccr2}++;
                }
     }

     sub WriteCCR3
     {
      unless ($previous == "")
      {
       # Produce ccr3 from DISTINCT combo listing:
       foreach $key (keys %xref) { print OUT3 $xref{$key}; $fileCntr{ccr3}++; }
       %xref = ();
      }
     }

     sub BuildCCR3
     {
      # Spin off relationship:
      for (my $i = field8; $i <= field13; $i++)
      {
       unless ($arr[$i] == -1)
       {
        $xref{$arr[field0] . "|" . $arr[$i]} = $arr[field0] . "|" . $arr[$i];
       }
      }
       $previous = $arr[field0];
     }

     sub BuildCCR4
     {
      # Spin off relationship:
      for (my $i = field26; $i <= field37; $i++)
      {
       my $sak = $arr[field0] . $arr[field6] . $arr[field7] . $arr[$i];
       unless (($arr[$i] eq '#######') or ($arr[$i] eq '######')) {
                            print OUT4 ++$diag . '|' . $arr[field0] . '|' . 
                                  $arr[field6] . '|' .
                                  $arr[field7] . '|' . $arr[$i];
                        $fileCntr{ccr4}++;
                      }
      }
     }

     sub BuildCCR5
     {
      # Spin off field0/Procedure relationship:
      for (my $i = field20; $i <= field23; $i++)
      {
       my $sak = $arr[field0] . $arr[field6] . $arr[field7] . $arr[$i];
       unless ($arr[$i] eq '######' or $arr[$i] eq '####') {
                     print OUT5 ++$proc . '|' .  $arr[field0] . '|' . $arr[field6] . '|' .
                             $arr[field7]   . '|' . $arr[$i];
                     $fileCntr{ccr5}++;
                   }
      }
     }
    }