#!/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}++; } } }