package LIMS::Model::Result;

use Moose;
extends 'LIMS::Model::Base';
with (
  	'LIMS::Model::Roles::QueryFormatter', # get_relationships()
    'LIMS::Model::Roles::SessionData', # provides $self->user_profile
    'LIMS::Model::Roles::ResultsUpdate', # do_[lab_tests/results_summary]_update()
	'LIMS::Model::Roles::RequestUpdate',
	'LIMS::Model::Roles::ReportUpdate',
);
use MooseX::AttributeHelpers;
use namespace::clean -except => 'meta';

has $_ => ( is => 'ro', isa => 'HashRef', lazy_build => 1 )
    foreach ( qw/
		lab_test_map
		lab_test_status_options_map
	/ );
    
has form_data => ( is => 'rw', isa => 'HashRef', default => sub { {} } );

has result_updates => (
    is         => 'ro',
    isa        => 'ArrayRef[HashRef]',
    default    => sub { [] },
    metaclass  => 'Collection::Array',
	provides   => {
        push  => 'add_to_updates',
        count => 'count_updates',
    },
#    auto_deref => 1, # not needed
);

has update_failures => (
    is         => 'ro',
    isa        => 'ArrayRef[Str]',
    default    => sub { [] },
    metaclass  => 'Collection::Array',
	provides   => {
        push  => 'add_to_failures',
        count => 'count_failures',
    },
#    auto_deref => 1, # not needed
);

__PACKAGE__->meta->make_immutable;

use Data::Dumper;

#-------------------------------------------------------------------------------
sub update_lab_test_requests {
    my $self = shift;  
    my $data = shift; # $self->debug($data); 

    # put $dfv->valid into $self:
    $self->form_data($data);    
    
    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $update_lab_tests = sub {
		# new investigation/test(s):
		if ( my $test_id = $data->{test_id} ) {
			if ( ref $test_id eq 'ARRAY' ) {
				for my $id(@$test_id) {				
					$self->do_new_lab_investigation($id);
				}
			}
			else {
				$self->do_new_lab_investigation($test_id);
			}
            # check request_status, maybe revert from 'complete':
            $self->do_request_status_check();
		}
		{ # insert/update section notes:
			$self->do_section_notes_update();			
		}
		{ # insert/update remote system id:
			$self->do_foreign_id_update();                                                
		}
    };
    
#$self->set_rose_debug(1);
    # do_transaction() returns true if succeeds; sets $db->error on failure:
    my $ok = $db->do_transaction( $update_lab_tests );
#$self->set_rose_debug(0);

    return $ok ? 0 : 'update_lab_test_requests() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
# so far ONLY used by C::DataImport::do_bcr_abl() - does auto_report as well:
sub update_results_summary {
	my $self = shift;
	my $args = shift; # hashref of LabSection object, request_id & result

    my $request_id = $args->{request_id};
	my $section    = $args->{section}; # LabSection object
	my $result     = $args->{result};
    
	# Roles::do_results_summary_update() requires _section_id, _section_name,
	# _request_id & results_summary:	
	my %data = (
		results_summary => $result,
		_section_name   => $section->section_name,
		_request_id     => $request_id,
		_section_id	    => $section->id,
	); # warn Dumper \%data;
	
    # add auto_reportable_config if exists:
    if ( my $auto_rpt_cfg = $args->{auto_reportable_config} ) {
        $data{auto_reportable_config} = $auto_rpt_cfg; # for do_auto-report()
        $data{lab_test_data} = $args->{lab_test_data}; # for set_lab_test_complete()
    }
    
    # put %data into $self for do_results_summary_update() & do_auto_report():
    $self->form_data(\%data); # warn Dumper \%data;
	
    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

	$self->reset_actions; # in case we're called in a loop (eg upload bcr-abl file)
	
	my $update = sub {
		$self->do_results_summary_update();
        $self->set_lab_test_complete();
		$self->do_auto_report(); # will silently skip if no config supplied or already reported
	};
	
	my $ok = $db->do_transaction($update);
	
	return $ok ? 0 : 'update_results_summary() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub get_request_lab_test_results {
	my ($self, $request_id) = @_;
	
	my %args = (
		query => [ request_id => $request_id ],
		require_objects => 'lab_test',
	);
	
	my $lab_test_results = LIMS::DB::RequestLabTestResult::Manager
		->get_request_lab_test_results(%args);

	return $lab_test_results;
}

#-------------------------------------------------------------------------------
sub get_request_results_summary {
	my $self = shift;
	my $args = shift;
	
    my %args = (
        request_id     => $args->{request_id},
        lab_section_id => $args->{section_id},
    );

    my $results_summary = LIMS::DB::RequestResultSummary->new(%args);

    # return row object if exists:
    if (my $o = $results_summary->load_speculative) {
        return $o;
    }
    return $results_summary;
}

#-------------------------------------------------------------------------------
sub get_section_lab_test_results {
    my ($self, $vars) = @_; # warn Dumper $vars;
    
    # get all test results for user-selected section:
    my $results = $self->_section_lab_test_results($vars);

    # get requests data for all entries in test results dataset:
	my @request_ids = ( keys %$results );
	return 0 unless @request_ids;
	
	my @tables = qw( sample_code diagnoses results_summary );	
	my $relationships = $self->get_relationships(\@tables); # warn Dumper $relationships;
 	
    my $requests = LIMS::DB::Request::Manager->get_requests(
        query => [ id => \@request_ids ],
        require_objects => $relationships,
		multi_many_ok => 1,
        sort_by => [ qw(year request_number) ],
    );
    return 0 unless @$requests; # warn Dumper $requests->[0]->as_tree;
	
	# create map of request.id => specimen(s):
	my %request_specimen = map {
		my $rs = $_->request_specimen; # always arrayref
		$_->id => ( join ', ', map { $_->specimen->sample_code } @$rs );
	} @$requests; # warn Dumper \%request_specimen;
	
	# create map of request.id => { lab_section_id => result }
	my %results_summary = ();
	for my $request (@$requests) {
		for (@{ $request->results_summary }) { # always arrayref
			my $section_id = $_->lab_section_id;
			my $result     = $_->results_summary;
			
			$results_summary{$request->id}{$section_id} = $result;
		}
	} # warn Dumper \%results_summary;
	
	my $lab_section_id = $vars->{section_id};
	
    # get lab test objects for lab section:
    my @query = ( lab_section_id => $lab_section_id, test_type => 'test' );
    my $tests = LIMS::DB::LabTest::Manager->get_lab_tests(
        query => \@query,
		sort_by => 'field_label',
    );
	
    my @fields  = map $_->field_label, @$tests; # warn Dumper \@fields;
	my @headers = ( qw/request year diagnosis specimen summary/, @fields );
    
    my @data = map {
        [ # arrayrefs for Spreadsheet::WriteExcel::Simple->write_row()
            $_->request_number,
            $_->year,
            $_->request_report->diagnosis->name,
			$request_specimen{$_->id}, # specimen(s)
			$results_summary{$_->id}{$lab_section_id},
            @{ $results->{$_->id} }{@fields}, # sort results in @fields order
        ]
    } @$requests; 
    
    return { headers => \@headers, results => \@data };
}

sub _section_lab_test_results { # get all test results for user-selected section:
    my ($self, $vars) = @_; # warn Dumper $vars;
    
    my @query = ( 'lab_section_id' => $vars->{section_id} );
	my @objects = 'lab_test'; # minimum require_objects item
		
	if ( $vars->{date_from} || $vars->{date_to} ) { # optional constraints
		my $dt = sub { LIMS::Local::Utils::to_datetime_using_parsedate(@_) };
		# NB: silently fails if date is invalid:
		if ( my $start = &$dt($vars->{date_from}) ) {
            push @query, ( 'request.created_at' => { ge => $start } );
        }
		if ( my $end = &$dt($vars->{date_to}) ) {
            my $date = $end->add(days => 1); # ie created_at <= midnight on date + 1
            push @query, ( 'request.created_at' => { le => $date } );
        }	
		push @objects, 'request';
	}
    if ( my $category_id = $vars->{category_id} ) { # optional constraint
        my $str = 'request.request_report.diagnosis.icdo3_category';
        push @query, ( "$str.diagnostic_category_id" => $category_id );
        push @objects => $str,
    } # warn Dumper \@query;
		
	my @args = ( require_objects => \@objects, query => \@query );
	my $results = LIMS::DB::RequestLabTestResult::Manager
		->get_request_lab_test_results(@args);

	my %h; # create hash of test results; key = request ID:
    $h{$_->request_id}{$_->lab_test->field_label} = $_->result for @$results; # warn Dumper \%h;
    
    return \%h;
}

#-------------------------------------------------------------------------------
sub general_notes { # uses Role::RequestUpdate::update_general_notes() method:
	my $self = shift;
	my $data = shift;
	
	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;	
	
	my $update = sub {		
		$self->update_general_notes($data);
	};
	
	# do it as transaction to use Role::RequestUpdate method & capture any errs:
	my $ok = $db->do_transaction( $update );
	
	return $ok ? 0 : 'update_general_notes() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub get_status_option_count {
    my ($self, $option_id) = @_;
    
    my %args = (
        query => [ status_option_id => $option_id ],
    );
    
    my $count = LIMS::DB::RequestLabTestStatus::Manager
		->get_request_lab_test_status_count(%args);
        
    return $count;
}

#-------------------------------------------------------------------------------
sub get_haematology_data {
	my ($self, $request) = @_;	# warn Dumper $request;
	
	my $labno = sprintf '%02d_%05d',
        $request->{year} - 2000, $request->{request_number};
	my $data = LIMS::DB::RequestHaematology->new(lab_number => $labno)
		->load_speculative;
	return $data;
}

#-------------------------------------------------------------------------------
sub accept_haematology_data {
	my ($self, $args) = @_; # warn Dumper $args;	

    my $lab_number = $args->{lab_number}; # required
    my $request_id = $args->{request_id}; # optional, only if registered
    
    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached
    
    my $update = sub {
        my $o = LIMS::DB::RequestHaematology->new(lab_number => $lab_number)->load;
        $o->status('verified');
        $o->updated($self->time_now);
        $o->save(changes_only => 1);
        
        if ($request_id) { # only if request already registered
            my %args = (
                request_id => $request_id,
                user_id    => $self->user_profile->{id},
                action     => 'validated haematology data',
            );
            LIMS::DB::RequestLabTestHistory->new(%args)->save;
        }
    };
    my $ok = $db->do_transaction( $update );
	return $ok ? 0 : 'accept_haematology_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub delete_haematology_data {
	my ($self, $args) = @_; # warn Dumper $args;	

    my $lab_number = $args->{lab_number}; # required
    my $request_id = $args->{request_id}; # optional, only if registered
    
    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached
    
    my $delete = sub {
        my $o = LIMS::DB::RequestHaematology->new(lab_number => $lab_number)->load;
        $o->delete;
        
        if ($request_id) { # only if request already registered
            my %args = (
                request_id => $request_id,
                user_id    => $self->user_profile->{id},
                action     => 'deleted haematology data',
            );
            LIMS::DB::RequestLabTestHistory->new(%args)->save;
        }
    };
    my $ok = $db->do_transaction( $delete );
	return $ok ? 0 : 'delete_haematology_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_request_lab_test_results {
	my $self = shift;
	my $data = shift; # warn Dumper $data;
	
	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;	

	my $lab_test_data = $data->{lab_test_data} || {}; # in case submitted empty to clear

	my @lab_test_ids = keys %$lab_test_data; # warn Dumper \@lab_test_ids;
	
    $self->form_data($data); # for do_results_summary_update()
    
	my $update = sub {
        # first clear any existing test result data for this request_id:		
		if (@lab_test_ids) {
			my %args = (
				where => [
					request_id  => $data->{_request_id},
					lab_test_id => \@lab_test_ids,
				],
			);        
			LIMS::DB::RequestLabTestResult::Manager
				->delete_request_lab_test_results(%args);
            { # insert new data:
                while ( my ($test_id, $result) = each %$lab_test_data ) {
                    next unless $result; # warn Dumper($test_id, $result);
                    
                    my %data = (
                        request_id 	=> $data->{_request_id},
                        lab_test_id	=> $test_id,
                        result 		=> $result,
                    );
                    LIMS::DB::RequestLabTestResult->new(%data)->save;
                }
            }
		}
        { # insert/update results_summary:
            $self->do_results_summary_update(); # all params as $self->param
        }
		# maybe set all section test/investigation(s) to 'complete':
		if ( $data->{complete_all_tests} ) { 
			$self->do_complete_all_tests;
		}
		# last action - if auto_reportable config:
		if ( $data->{auto_reportable_config} ) { 
			$self->do_auto_report();
		}
	};
	
	my $ok = $db->do_transaction( $update );
	
	return $ok ? 0 : 'update_results_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub check_request_lab_test { # just need to check lab-test been requested:
    my $self = shift;
    my $args = shift; # warn Dumper $args;
    
    my $lab_test_data = $args->{lab_test_data};
    my $request_id = $args->{request_id};
    
	my $lab_test_id = $self->_get_lab_test_id($lab_test_data); # warn $lab_test_id;

    my %params = (
		lab_test_id => $lab_test_id,
		request_id 	=> $request_id,
	);

    my $o = LIMS::DB::RequestLabTestStatus->new(%params)->load(speculative => 1);
    return $o ? 1 : 0; # just return success flag
}

#-------------------------------------------------------------------------------
sub import_results {
    my $self = shift;
    my $data = shift; # $self->debug($data);
	
	# $data = hashref of report, result_summary & lab_test data + request_id:
	my $result_data   = $data->{result_summary_data};
	my $lab_test_data = $data->{lab_test_data};
	my $report_data   = $data->{report_data};
	my $request_id 	  = $data->{request_id}; # warn $request_id;
	
	my $user_profile_id = $self->user_profile->{id};
	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
	
	my $import = sub {
		if ($lab_test_data) {
			{ # update request_lab_test_status to complete:
				my $date_acquired = $lab_test_data->{date_acquired}; # DT object
				my $acquisition_userid = $lab_test_data->{acquisition_userid};
				
				my $status_option = LIMS::DB::LabTestStatusOption
					->new(description => 'complete')->load;
				my $lab_test_id = $self->_get_lab_test_id($lab_test_data);

				# load request_lab_test_status object on unique_key:
				my %params = (
					lab_test_id => $lab_test_id,
					request_id 	=> $request_id,
				);
				my $o = LIMS::DB::RequestLabTestStatus->new(%params)->load;
				# update request_lab_test_status object:
				$o->status_option_id($status_option->id);
				$o->user_id($acquisition_userid);
				$o->time($date_acquired);				
				$o->save(changes_only => 1);
			}
            { # request_lab_test history:
				my $acquisition_userid = $lab_test_data->{acquisition_userid};
				my $lab_test_name 	   = $lab_test_data->{lab_test_name};
				
				my $action = "set $lab_test_name status to complete";

				# if logged_in user id NOT same as datafile user id:
				if ( $acquisition_userid != $user_profile_id ) {
					my $user = uc $lab_test_data->{acquired_by};
					$action .= " for $user";
				}
				
				my %args = (
					request_id => $request_id,
					user_id    => $user_profile_id, # id of LOGGED IN USER HERE
					action     => $action,
				);
				LIMS::DB::RequestLabTestHistory->new(%args)->save;
            }
		}
		{ # request_result_summaries:
			my $results_summary = $result_data->{results_summary};
			my $section_name    = $result_data->{lab_section};
			
			my $lab_section
				= LIMS::DB::LabSection->new(section_name => $section_name)->load;
			
			my %data = (
				results_summary => $results_summary,
				lab_section_id  => $lab_section->id,
				request_id      => $request_id,
			);			
			LIMS::DB::RequestResultSummary->new(%data)->save;
		}
        { # results_summary histories:
			my $lab_section = $result_data->{lab_section};
			my $action 		= "new $lab_section result summary";
				
			my %args = (
				request_id => $request_id,
				user_id    => $user_profile_id, # id of LOGGED IN USER HERE
				action     => $action,
			);
			LIMS::DB::RequestLabTestHistory->new(%args)->save;
		}
		{ # report:
			# add db & request_id directly to $report_data:
			$report_data->{request_id} = $request_id;
			# get diagnosis.id & delete 'diagnosis' key:
			my $diagnosis_id = $self->_get_diagnosis_id($report_data);
			# load request_report object:
			my $o = LIMS::DB::RequestReport->new(%$report_data);
			# update request_report object:
			$o->diagnosis_id($diagnosis_id);
			$o->save;
		}
	};

#$self->set_rose_debug(1);
	my $ok = $db->do_transaction( $import );
#$self->set_rose_debug(0);    
	
	return $ok ? 0 : 'import_results() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
# shared by __PACKAGE__check_request_lab_test() & __PACKAGE__import_results()
sub _get_lab_test_id {
	my $self = shift;
	my $data = shift;
	
	# lab_test has U.K. on field_label, lab_section_id & test_type
	my $lab_section
		= LIMS::DB::LabSection->new(section_name => $data->{lab_section})->load;
	my %data = (
		lab_section_id => $lab_section->id,
		test_name      => $data->{lab_test_name},
		test_type      => $data->{test_type}
	);
	
	my $lab_test = LIMS::DB::LabTest->new(%data)->load;
	
	return $lab_test->id;
}

#-------------------------------------------------------------------------------
sub update_lab_tests_from_worklist {
    my $self = shift;
    my $data = shift; # $self->debug($data); # hashref

	my $request_lab_test_ids = $data->{request_lab_test_ids};
	my $status_option_id 	 = $data->{status_option_id};
    my $user_id 			 = $data->{user_id};
	
    # get map of lab_test_status_options:
    my $status_option = $self->lab_test_status_options_map; # warn Dumper $status_option;
	# get status from form submission:
	my $status = $status_option->{$status_option_id}->{description}; # warn $status;
	# get user profile:
    my $user_profile = $self->user_profile;	
    
	# check user_id matches user_profile id, or get new user_profile:
    if ($user_id != $user_profile->{id}) {
        my $o = LIMS::DB::User->new(id => $user_id)->load;
        $user_profile = $o->as_tree;
    }
    
    # get users' initials:
    my @name = map $user_profile->{$_}, qw(first_name last_name);  
    my $initials = join '', map { $_ =~ /^(\w)/ } @name; # warn $inits;
    
    my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
    
    my $update = sub {
        LABTEST:
        foreach my $id (@$request_lab_test_ids) {
            my $o = LIMS::DB::RequestLabTestStatus->new(id => $id);
            my @args = ( # need request for template display:
                with => ['request','lab_test'],
                speculative => 1,
            );
            
            if (! $o->load(@args) ) { # in case back-button & resubmit deletions:
                $self->add_to_failures($id);
                next LABTEST;
            }
			
            my $lab_test   = $o->lab_test->field_label;
            my $request_id = $o->request_id;
            
			# update test status (even for delete - for template):
            $o->status_option_id($status_option_id);
            $o->user_id($user_id);
			
            my $entry = $o->as_tree;

			# if request to delete && success, add entry to result_updates:
			if ( $status eq 'delete' ) {
                # check no foreign key constraint ??                
				$self->add_to_updates($entry) if $o->delete;
			}
            # if update success, add entry to result_updates:
            else { 
                $self->add_to_updates($entry) if $o->save(changes_only => 1);
            }
            
            { # history log:
				my $history = $status eq 'delete'
					? "deleted $lab_test entry"
					: "set $lab_test status to $status";
					
				# if logged_in user id NOT same as submitted user id:
				if ($self->user_profile->{id} != $user_profile->{id}) {
					my $user = uc $user_profile->{username};
					$history .= " for $user";
				}

                my %args = (
                    request_id => $request_id,
                    user_id    => $self->user_profile->{id}, # id of LOGGED IN USER HERE
                    action     => $history,
                );
                LIMS::DB::RequestLabTestHistory->new(%args)->save;
            }
        }
    };
    
    my $ok = $db->do_transaction($update);

=begin # causes error after search involving a date field - "error" stays in system    
    if (my $err = $db->error) {
        return { error => 'update_lab_tests_from_worklist() error - ' . $err };
    }
    else {
        return {
            updates  => $self->result_updates,
            success  => $self->count_updates,
            failures => $self->count_failures,
        };
    }
=cut
    if ($ok) {
        return {
            updates  => $self->result_updates,
            success  => $self->count_updates,
            failures => $self->count_failures,
        };        
    }
    else {
        my $err = $db->error;
        return { error => 'update_lab_tests_from_worklist() error - ' . $err };
	}    
}

#-------------------------------------------------------------------------------
sub get_results_summary_options {
    my $self = shift;
    
    my %args = (
        sort_by => 'description',
        require_objects => 'lab_section',
    );
    
    my $results_summary_options = LIMS::DB::ResultSummaryOption::Manager
        ->get_result_summary_options(%args);
        
    return $results_summary_options;
}

#-------------------------------------------------------------------------------
sub get_result_data_type {
	my ($self, $data_type_id) = @_;
	
	my $data_type
		= LIMS::DB::LabTestResultDataType->new(id => $data_type_id)->load;
    
    return $data_type;
}

# ------------------------------------------------------------------------------
sub update_result_data_type {
    my $self = shift;
    my $data = shift; # $self->debug( $data );

    my %args = ( class => 'LabTestResultDataType', data => $data );
    
    return $self->update_object(\%args);    
}

#-------------------------------------------------------------------------------
sub get_results_summary_option {
    my ($self, $option_id) = @_;
    
    my $option = LIMS::DB::ResultSummaryOption->new(id => $option_id)->load;
    
    return $option;
}

#-------------------------------------------------------------------------------
sub get_results_summary_options_for_section {
    my ($self, $section_id) = @_;

    my %args = (
        query => [ lab_section_id => $section_id ],
        sort_by => 'description',
#        require_objects => 'lab_section',
    );
    
    my $results_summary_options = LIMS::DB::ResultSummaryOption::Manager
        ->get_result_summary_options(%args);
        
    return $results_summary_options;    
}

# ------------------------------------------------------------------------------
sub update_result_summary_options {
    my $self = shift;
    my $data = shift; # $self->debug( $data );

    my %args = ( class => 'ResultSummaryOption', data  => $data );
    
    return $self->update_object(\%args);    
}

#-------------------------------------------------------------------------------
sub _get_diagnosis_id {
	my $self = shift;
	my $data = shift;
	
	my $diagnosis = LIMS::DB::Diagnosis->new(name => $data->{diagnosis})->load;
	
	# delete unrequired 'diagnosis' key:
	delete $data->{diagnosis};
	
	return $diagnosis->id;
}

#-------------------------------------------------------------------------------
# returns hashref of lab_test.id => lab_test.field_label for submitted lab section:
sub _build_lab_test_map {
    my $self = shift;
    
    my %args = (
        query => [ lab_section_id => $self->form_data->{_section_id} ],
    );
    my $o = LIMS::DB::LabTest::Manager->get_lab_tests(%args);
        
    my %lab_test_map = map {
        $_->id => $_->field_label;
    } @$o; # warn Dumper \@lab_test_ids;
    
    return \%lab_test_map;
}

#-------------------------------------------------------------------------------
sub _build_lab_test_status_options_map {
	my $self = shift;
	
	my $o = LIMS::DB::LabTestStatusOption::Manager->get_lab_test_status_options;
	
	my %map = map {
		$_->id => $_->as_tree;
	} @$o;
	
	return \%map;
}

1;