#!/usr/bin/perl

use strict;
use warnings;
use autodie;

use DBI;

# Constants:
use constant {
    FIELD0  =>  0,  FIELD1  =>  1,  FIELD2  =>  2,
    FIELD3  =>  3,  FIELD4  =>  4,  FIELD5  =>  5,
    FIELD6  =>  6,  FIELD7  =>  7,  FIELD8  =>  8,
    FIELD9  =>  9,  FIELD10 => 10,  FIELD11 => 11,
    FIELD12 => 12,  FIELD13 => 13,  FIELD14 => 14,
    FIELD15 => 15,  FIELD16 => 16,  FIELD17 => 17,
    FIELD18 => 18,  FIELD19 => 19,  FIELD20 => 20,
    FIELD21 => 21,  FIELD22 => 22,  FIELD23 => 23,
    FIELD24 => 24,  FIELD25 => 25,  FIELD26 => 26,
    FIELD27 => 27,  FIELD28 => 28,  FIELD29 => 29,
    FIELD30 => 30,  FIELD31 => 31,  FIELD32 => 32,
    FIELD33 => 33,  FIELD34 => 34,  FIELD35 => 35,
    FIELD36 => 36,  FIELD37 => 37,  FIELD38 => 38,
    FIELD39 => 39,  FIELD40 => 40,  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, $proc, $ndcc ) = ( 0, 0, 0 );
my $previous = ""; ## An emptry STRING.  Maybe you mean '= undef'?

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

# Accept/Parse DSS Connection String:
my ( $USER, $PASS, $CONN );
if( $ENV{PSWD} =~ /(.+)\/(.+)\@(.+)/ ){
    $USER = $1;
    $PASS = $2;
    $CONN = 'DBI:Oracle:' . $3;
} else {
    die "Failed to match \$ENV{PSWD} for a " .
        "username, password, and DB connection.\n";
}

# 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.


# ######### What's missing here? ############ #
my $SQL = qq(
    SELECT ... here is a big sql query
);

# Open OUTPUT files for CCR processing:
my $out_number = 1;
open $_, '>', "$DIRECTORY/ccr" . $out_number++ . ".dat"
    for( *OUT1, *OUT2, *OUT3, *OUT4, *OUT5 );



# 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:


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 $_ foreach ( *OUT1, *OUT2, *OUT3, *OUT4, *OUT5 );



sub BuildCCR12 {
    # Write CCR1 Table:
    print OUT1 
        $arr[FIELD6] . '|' . 
        $arr[FIELD7] . '|' . 
        $arr[FIELD5] . "\n";
    $fileCntr{ccr1}++;

    # Write CCR2 Table:
    unless ( $arr[FIELD17] eq '###########' ) {
        print OUT2 
            ++$ndcc      . "|" . 
            $arr[FIELD0] . "|" . 
            $arr[FIELD6] . "\n";
        $fileCntr{ccr2}++;
    }
}



sub WriteCCR3 {
    unless ($previous eq "") {
        # Produce ccr3 from DISTINCT combo listing:
        foreach my $key ( keys %xref ) { 
            print OUT3  $xref{ $key } . "\n"; 
            $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 ]   . "\n";
            $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 ]   . "\n";
            $fileCntr{ccr5}++;
        }
    }
}
[download]