#!/usr/bin/perl

=begin -------------------------------------------------------------------------
generates NYCRIS data feed for new and revised diagnoses during previous 1 month
creates pipe-delimited rows, one row per request
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 1; # skips ftp, puts data files in /tmp, emails just raj

BEGIN {
    use FindBin qw($Bin); # warn $Bin; exit;
    use lib "$Bin/../../../lib";
}

use IO::All;
use Config::Auto;
use Data::Dumper;
use DateTime::Format::MySQL;
use LIMS::Local::ScriptHelpers;
use Text::Wrap qw($columns fill); $columns = 68;

#################################
my $delimiter = '|';            #
my $duration  = 2; # months ago #
#################################

my $cfg_file = "$Bin/../lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # warn Dumper $settings;
    
# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();

my $sql_lib = $tools->sql_lib();
my $config  = $tools->config(); 
my $dbix    = $tools->dbix();
my $today   = $tools->time_now();

my $data_filename = sprintf 'hmds_%s', $today->ymd('_');

my @data = ();

# go:
{
    # get request ID's for horizontal & vertical tables:
    my $request_ids = get_request_ids(); # warn Dumper $request_ids;
    
    # get data maps of vertical tables - much faster than tying into main query:
    my $data_map = get_data_map($request_ids); # warn Dumper $data_map;

    # get request result 1-to-1 data:
    my $query = $sql_lib->retr('nycris_data');
    my $result = $dbix->query($query, @$request_ids);
    
    while ( my $vars = $result->hash ) { # warn Dumper $vars; next;
        my $row = parse_data($vars, $data_map); # combine horizontal & vertical tbls
		push @data, $row; # warn $row;
    } # warn Dumper \@data;
}

{ # create file & FTP:
    my $file_path = '/tmp/' . $data_filename;

    my $contents = join "\n", @data; 
    $contents > io($file_path); # warn $contents;

    # ftp file:
    unless ($JUST_TESTING) {
        my %args = (
            local_filename  => $file_path,
            remote_filename => $data_filename,
        );
        ftp_file(\%args);
    }
}

# archive results file:
unless ($JUST_TESTING) {}

# combine horizontal & vertical tables:
sub parse_data {
    my ($vars, $data_map) = @_;
    
    { # add data-map fields:
        my $request_id = $vars->{request_id};
        
        # specimen code(s):
        $vars->{specimen_code}
            = $data_map->{specimen}->{$request_id}->{specimen_code};
        # result summaries:
        map $vars->{$_} = $data_map->{result_summary}->{$request_id}->{$_},
            qw(immunocytochemistry flow_cytometry fish cytogenetics molecular);
        # reporter:
        map $vars->{$_} = $data_map->{reporter_data}->{$request_id}->{$_},
            qw(reporter_name reporter_code);
    }
    
    # tidy up (trim content & substitute new-line markers):
    map { $vars->{$_} = tidy($vars->{$_}) }
        grep $vars->{$_},
            qw(comment immunocytochemistry flow_cytometry fish cytogenetics
                gross_description molecular);
    
    $vars->{gender} ||= 'U';
    
    my @fields = qw(
        request_id
        labno
        request_date
		last_name
        first_name
        middle_name
		unit_number
		dob
		nhs_number
		gender
		referrer
		referrer_code
        location
		organisation_code
		specimen_code
        clinical_details
        gross_description
        specimen_quality
        comment
        diagnosis
        icdo3
        flow_cytometry
        immunohistochemistry
        molecular
        cytogenetics
        fish
        reporter_name
        reporter_code
		authorisation_date
	);
    
    no warnings 'uninitialized'; # lots in $vars
    my $row = join $delimiter, map $vars->{$_}, @fields;
    # row needs to start with request ID - in case unescaped new-line marker present
    die unless $row =~ /\A\d{6,}/;
    return $row;
}

sub get_request_ids {
    my @request_ids = ();
    { # new diagnoses:
        my $sql = $sql_lib->retr('nycris_new_diagnosis_request_ids');
        my $request_ids = $dbix->query($sql, $duration, $duration)->flat;
        push @request_ids, @$request_ids; # warn Dumper $request_ids;
    }    
    { # get revised diagnoses:
        my $sql = $sql_lib->retr('nycris_revised_diagnosis_request_ids');
        my $request_ids = $dbix->query($sql, $duration, $duration)->flat;
        push @request_ids, @$request_ids; # warn Dumper $request_ids;
    }
    # combine & eliminate duplicates
    my %request_ids = map { $_ => 1 } @request_ids; # warn Dumper \%request_ids;
    
    return [ keys %request_ids ];    
}

sub ftp_file { return 0;
    my $args = shift;
    
    my $cfg = $settings->{nycris_server};
    
    my %params = (
        local_filename  => $args->{local_filename},
        remote_filename => $args->{remote_filename},
        server_addr     => $cfg->{remote_address},
        username        => $cfg->{username},
        password        => $cfg->{password},
    );

    # ftp file (returns str on failure, undef on success):
    my $rtn = $tools->ftp_file(\%params);

    if ($rtn) {
        $tools->mail_admin({ script => $0, msg => $rtn });
        warn "$0 - $rtn\n"; # dump to logs but don't die!!
    }
    else {
        io($args->{local_filename})->unlink;
    }
}

sub user_codes {
    my $username = shift;
    
    my $national_codes = {
        swirsky  => 'C2202309',   
        burton   => 'C4370806',
        tooze    => 'C3664265',    
        cargo    => 'C6050871',
        jack     => 'C2547174',   
        owen     => 'C3271078',
        
        richards => 'CS01892',   
        rawstron => 'CS01874',
        oconnor  => 'CS01696',
        evans    => 'CS09254',         
	};
    
    return $national_codes->{$username}
    || 'H9999998'; # OTHER HEALTH CARE PROFESSIONAL
}

sub get_data_map {
    my $request_ids = shift;
    
    my $map = {};
    
    { # request_specimens:
        my $sql = q!select `request_id`,
            group_concat(`description` separator '/') as 'description',
            group_concat(`sample_code`) as 'code' from `request_specimen` rs
            join `specimens` s on rs.`specimen_id` = s.`id`
            where rs.`request_id` in (??) group by `request_id`!;
        my $result = $dbix->query($sql, @$request_ids);
        
        while ( my $vars = $result->hash ) { # warn Dumper $vars;
            my $request_id = $vars->{request_id};
            
            my %data = (
                specimen_code => $vars->{code},
                description   => $vars->{description},
            );
            $map->{specimen}->{$request_id} = \%data;
        }  # warn Dumper $map->{specimen};
    }
    { # reporter data:
        my $sql = q!select rh.request_id, u.username, u.first_name, u.last_name
            from request_history rh join users u on ( rh.user_id = u.id and
            action = 'reported' ) where request_id in (??)!;
            
        my $result = $dbix->query($sql, @$request_ids);

        while ( my $vars = $result->hash ) { # warn Dumper $vars;
            my $request_id = $vars->{request_id};
            
            my $reporter = join ' ',
                    ucfirst $vars->{first_name},
                    ucfirst $vars->{last_name};

            my $reporter_code = user_codes($vars->{username});
            
            my %data = (
                reporter_name => $reporter,
                reporter_code => $reporter_code,
            );
            $map->{reporter_data}->{$request_id} = \%data;
        } # warn Dumper $map->{reporter_data};
    }
    { # result_summaries:
        my $sql = q!select rs.`request_id`, rs.`results_summary`, ls.`section_name`
            from `request_result_summaries` rs join `lab_sections` ls on
            rs.`lab_section_id` = ls.`id` where rs.`request_id` in (??)!;
        my $result = $dbix->query($sql, @$request_ids);
        
        while ( my $vars = $result->hash ) { # warn Dumper $vars;
            my $request_id  = $vars->{request_id};
            my $section     = $vars->{section_name};
            my $result      = $vars->{results_summary};              
           
            $section =~ s/ /_/g;
            $map->{result_summary}->{$request_id}->{lc $section} = $result;
        } # warn Dumper $map->{result_summary}; 
    }
    
    return $map;
}

sub tidy {
    my $str = shift;
    
    # trim:
    $str =~ s/\A\s+//; # leading
    $str =~ s/\s+\Z//; # trailing
    
    $str =~ s/(\r\n)/[NEW_LINE]/g; # substitute new-line marker

    return $str;
}

=begin
# format text: indent, replace blanks with N/A, max 68 chars / line:
sub format_text {
	my $str = shift || ''; # needs to exist or uninitialized warnings below
	
    # put '07|' after of new-line markers:
    my $formatted_newline = $settings->{new_line};

	$str =~ s/^(\s+|\t)//; # remove leading spaces or tabs	
	$str =~ s/\|//g; # remove pipes if used!!

	$str ||= 'N/A'; # only applies to @formatted_fields, others already grepped

	my $wrapped_text = fill($settings->{indent}, $settings->{indent}, $str); # Text::Wrap function

	# new 07| in front of newly-wrapped lines:
	$wrapped_text =~ s/\n/$formatted_newline/g; # print $wrapped_text;

	return $wrapped_text; 
}

sub specimen_summary {
	local $_ = shift; # specimen string
	
	my @title; 
	
	push @title, 'peripheral blood' 	if /PB|CMP/; # CMP excluded
	push @title, 'chimerism' 			if /CHI/; # currently excluding chimerism screen
	push @title, 'bone marrow aspirate' if /BMA$|BMA\,/; # BMA[^T] doesn't work
	push @title, 'bone marrow biopsy' 	if /BMAT|T[B|S][L|P]/;
	push @title, 'tissue biopsy' 		if /[DGLRX][BL|F|SL|U|A]/;
	push @title, 'effusion' 			if /EF/;
	push @title, 'CSF' 					if /CF/;
	push @title, 'slide' 				if /HS/;
	push @title, 'serum' 				if /SE/;
	push @title, 'urine' 				if /URI/;

#	my $title = @title > 1 ? join (' & ' => join (', ' => @title[ 0 .. @title - 2 ]), $title[-1]) : $title[0]; 
	my $title = join '/', @title; # print Dumper ($title, length $title) if length $title > 40;
	$title ||= $_; # so var not empty if specimen doesn't match in regex's
	
	return ( length $title < 41 )
        ? $title
        : 'multiple blood/marrow/tissue specimens';
}


=cut