• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Roles::ResultHandler;

use strict;
use Data::Dumper;
use Moose::Role;

#-------------------------------------------------------------------------------
# accepts single record $request_data, extracts raw lab test data, creates new
# hashref of { lab_test => result } for each lab_test in each lab_section, puts
# new hashref into $request_data using key 'all_results':
sub process_raw_lab_test_data { 
    my ($self, $request_data) = @_;

    # get 'raw_lab_test_data' from Roles::RecordHandler::get_single_request_data()
    # hashref with keys:
    #    * all_lab_tests
	# 	 * lab_tests_status
	#    * lab_test_results
    #    * all_lab_sections
    #    * result_summaries

	my $raw_lab_test_data = $request_data->{raw_lab_test_data};	

	my %data; 

	{ # get section details:
		my $all_lab_sections = $raw_lab_test_data->{all_lab_sections};
		foreach (@$all_lab_sections) { # warn Dumper $_;
			my $section_name = $_->section_name;
			$data{$section_name} = $_->as_tree; # warn Dumper \%data;
			
			# just check 'lab_tests' is not defined (needed below):
			die 'cannot use "lab_tests" as hashref key'
				if defined $data{$section_name}{lab_tests};
		}
	}
	{ # all lab tests - $data{section_name}{field_label} = lab_test hashref:
		my $lab_test_results = $raw_lab_test_data->{lab_test_results};
		my %test_results_map = map { $_->lab_test_id => $_->result }
			@$lab_test_results; # don't have access to Role::DataMap here
		
		my $all_lab_tests = $raw_lab_test_data->{all_lab_tests};
		foreach my $lab_test (@$all_lab_tests) { # warn Dumper $lab_test;
			my $section_name = $lab_test->lab_section->section_name; # warn Dumper $section_name;
			my $field_label  = $lab_test->field_label;
			my $test_type    = $lab_test->test_type;
			my $lab_test_id  = $lab_test->id;
			
			# object -> hashref:
			my $test_data = $lab_test->as_tree;
			
			# add result (if exists):
			$test_data->{result} = $test_results_map{$lab_test_id};
			
			$data{$section_name}{$test_type}{$field_label} = $test_data;
		}
	}
	{ # request lab test status - $data{section_name}{field_label}{test_data}:
		my $lab_tests_status = $raw_lab_test_data->{lab_tests_status};
		foreach (@$lab_tests_status) { # $self->debug($_);
			my $section_name = $_->lab_test->lab_section->section_name;
			my $field_label  = $_->lab_test->field_label;
			my $test_type    = $_->lab_test->test_type;
			
			{ # add user data:
				my $user   = $_->user->as_tree; # object -> hashref
				$data{$section_name}{$test_type}{$field_label}{user} = $user;
			}
			{ # add status:
				my $status = $_->status->description;
				$data{$section_name}{$test_type}{$field_label}{status} = $status;
			}			
		}
	}

    # put processed data into 'get_single_request_data' hashref:
    $request_data->{all_results} = \%data; # $self->debug(\%data);	
	
	{ # get result summary options: 
		my $o = $self->model('Result')->get_results_summary_options;        
        my %opts = (); # convert AoA into HoA (keys = lab-section name):
        for my $row (@$o) {
            my $section_name = $row->lab_section->section_name;
            push @{ $opts{$section_name} }, $row->description;
        }
		$request_data->{results_summary_opts} = \%opts;
	}
	
=begin # uncomment to dump data structure
    use Data::Dumper;
    foreach my $section (sort keys %request_data) { warn $section;
        foreach my $test (sort keys %{ $request_data{$section} } ) {
            warn Dumper [$test, $request_data{$section}{$test}];
        }
    }
=cut
}

#-------------------------------------------------------------------------------
# accepts single record $request_data, extracts lab test data, formats it & puts
# it into $request_data hashref using key 'formatted_test_data':
sub format_raw_lab_test_data { 
    my ($self, $request_data) = @_;

	my $raw_lab_test_data = $request_data->{raw_lab_test_data};

    # extract lab_test data from $raw_lab_test_data:
    my $all_lab_tests    = $raw_lab_test_data->{all_lab_tests};
    my $all_lab_sections = $raw_lab_test_data->{all_lab_sections};
	my $lab_tests_status = $raw_lab_test_data->{lab_tests_status};   

    my %data; 

    # for each lab section:
    foreach my $section (@$all_lab_sections) { # warn $_->section_name;
        my $section_name = $section->section_name;

        # for each lab test in $request_lab_tests array(ref):
        foreach my $test (@$lab_tests_status) { # warn Dumper $test;
            # if test is for this $section, push test_status onto
            # %data <section_name> key:
            if ( $test->lab_test->lab_section_id == $section->id ) {
                my %result = (
					test_status => $test->status->description,
                    test_name   => $test->lab_test->field_label,
                    user_name   => $test->user->username,
                );
                push @{ $data{$section_name} }, \%result;
            }
        }
	}
	
	# put formatted lab_test data into $request_data:
	$request_data->{formatted_test_data} = \%data;
}

#-------------------------------------------------------------------------------
sub get_requested_tests {
    my ($self, $results) = @_;
    
    my @test_ids = ();
    
    my $panel_lab_test_map = $self->panel_lab_test_map; # warn Dumper $panel_lab_test_map;
    
    while ( my ($section, $d) = each %$results) { 
        next unless $d->{is_active} eq 'yes';
        
        if ( my $panel = $d->{panel} ) {
            PANEL: while ( my ($test_name, $p) = each %$panel ) {
                next PANEL unless $p->{status}; # only defined if requested
                my $panel_id = $p->{id};
                if ( my $panel_tests = $panel_lab_test_map->{$panel_id} ) {
                    my @panel_test_ids = keys %$panel_tests;
                    push @test_ids, @panel_test_ids; # warn Dumper \@panel_test_ids;
                }
            }
        }
        # just add requested tests direct:
        if ( my $test = $d->{test} ) {
            while ( my ($test_name, $t) = each %$test ) {
                push @test_ids, $t->{id} if $t->{status};
            }
        }
    } # warn Dumper \@panel_ids;

    my %map = map { $_ => 1 } @test_ids; # warn Dumper \%map; # return lookup hash map
    return \%map;
}

1;