• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Local::Labels;

# provides methods for printing slide labels - requires entry in config/.local/worklists.yml

use base 'LIMS::Base';

use IO::Socket;

use Moose;
with (
	'LIMS::Controller::Roles::Misc',
	'LIMS::Controller::Roles::ULISA',
	'LIMS::Controller::Roles::DataMap',
);

has labels => (
	is  => 'ro',
	isa => 'ArrayRef[HashRef]',
	default => sub { [] },
	lazy => 1,
	traits => ['Array'],
	handles  => {
        add_to_labels => 'push',
    },
);

__PACKAGE__->meta->make_immutable(inline_constructor => 0);

use Data::Dumper;

# ------------------------------------------------------------------------------
sub default : StartRunmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	# get label_type from query param, or return to start (in case user cleared menu):
	my $label_type = $self->query->param('label_type')
	|| return $self->redirect( $self->query->url . '/worklist' );

	# check method exists or return error:
	unless ( UNIVERSAL::can($self, $label_type) ) {
		return $self->error( qq!no method  "$label_type" found at !
		. $self->get_current_runmode );
	}

	# forward to required method to generate data for template:
	my $data = $self->forward($label_type);
    $self->tt_params( labels => $data );

	return $self->render_view('worklist/local/labels/'.$label_type.'.tt', {});
}

# ------------------------------------------------------------------------------
sub histology_staining : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	# get lab_test details (H&E and H&E/Giemsa):

    my @lab_test_ids = map {
        $self->get_lab_test_for_unique_test_name($_)->id;
    } qw( haematoxylin_eosin h_and_e_giemsa ); # warn Dumper \@lab_test;

    # have to die as default() caller doesn't handle err rtn:
	@lab_test_ids == 2 || die 'expected test_names either not found, or not unique';

	{ # get requests where test status is not complete:
        my %args = ( # don't supply status_option_id, forces model to load id <> 2
			lab_test_id => \@lab_test_ids,
			fetch_only  => [ 'request' ], # don't need all cols from model
		);

		my $data = $self->model('WorkList')->get_outstanding_investigations(\%args);

		return $data;
	}
}

# ------------------------------------------------------------------------------
sub immunohistology_panels : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
    return $self->forward('_ihc_tests'); # don't restrict on status option
}

# ------------------------------------------------------------------------------
sub dako_link : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
    return $self->forward('_ihc_tests', { status_option => 'new' });
}

# ------------------------------------------------------------------------------
sub do_ulisa : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	my @request_ids = $self->query->param('request_id'); # warn Dumper \@request_ids;

	# if ! @request_ids, don't return via rm or may get loop if arrived via timeout:
	unless (@request_ids) {
		return $self->redirect(
			$self->query->url . '/local_labels?label_type=dako_link'
		);
	}

	my $yaml = $self->get_yaml_file('print_labels')
		|| return $self->error('no config file found'); # warn Dumper $yaml;
	my $config = $yaml->{dako_link};

	# get immunohistology panel lab-tests:
	my $panels = $self->_get_immunohistology_panel_lab_tests(); # warn Dumper $panels;

	# some tests don't require labels:
	my $skip_tests = $config->{skip_tests};

	# get map of request_id => test_name(s):
	my $request_lab_test_map = $self->_get_request_test_name_map(\@request_ids);

	# just need request, investigation_name(s) & patient data on request_ids:
	for my $id (@request_ids) { # don't sort - need original submission order
		my $o = $self->model('Request')->get_patient_and_request_data($id);
            # $self->debug( [$o->request_number, $o->year] );
		my %d = (
			request => $o->as_tree(max_depth => 0), # only want base object data
			patient => $o->patient_case->patient->as_tree, # don't need dt object
		); # warn Dumper \%d;

		# get list of tests/panels for this request:
		my $investigations = $request_lab_test_map->{$id}; # warn Dumper $investigations;
		# for each test/panel, calculate how many labels of each type required:

		TEST:
		for my $ref (@$investigations) { # warn Dumper $ref;
            my $test_name = $ref->{test_name};
			next TEST if grep $test_name eq $_, @$skip_tests; # skip unwanted tests

			# if test_name is in panel_lab_test (ie it's a panel), get individual tests:
			if ( my $label_list = $panels->{$test_name} ) { # warn Dumper $label_list;
                push @{ $d{lab_test} }, $_ for @$label_list;
			}
			else { # probably individual test:
                push @{ $d{lab_test} }, $ref; # warn Dumper $ref;
			}
		} # warn Dumper \%d;
        # add 1 negative label (ficticious lab_test_id = 000):
        push @{ $d{lab_test} }, { test_id => '000', test_name => 'NEG' };

        my $rtn = $self->send_xml(\%d); # C::R::ULISA
        # return error if method rtn value:
        return $self->error($rtn) if $rtn;
	}

	# set flash message:
	$self->flash( info => $self->messages('worklist')->{dako_link_ok} );

	{ # make hash of request_id's for template:
		my %done = map { $_ => 1 } @request_ids;
		$self->tt_params( done => \%done );
    }
    return $self->forward('default');
}

# ------------------------------------------------------------------------------
sub dna_quantification : Runmode {
    return shift->_get_quantification_data('dna_quantification');
}

# ------------------------------------------------------------------------------
sub rna_quantification : Runmode {
    return shift->_get_quantification_data('rna_quantification');
}

# ------------------------------------------------------------------------------
sub _get_quantification_data {
	my ($self, $test_name) = @_; $self->_debug_path($self->get_current_runmode);

    my $lab_test_id = $self->get_lab_test_for_unique_test_name($test_name)->id;

	# get requests where test status is not complete:
    my %args = ( # don't supply status_option_id, forces model to load id <> 2
		lab_test_id => $lab_test_id,
		fetch_only  => [ 'request' ], # don't need all cols from model
	);
	my $data = $self->model('WorkList')->get_outstanding_investigations(\%args);
	return $data;
}

# ------------------------------------------------------------------------------
sub print_lab_section_labels : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	my @request_ids = $self->query->param('request_id'); # warn Dumper \@request_ids;

    my $specimen_map = $self->specimen_map(\@request_ids); # warn Dumper $specimen_map;

	for my $id (@request_ids) {
		my $o = $self->model('Request')->get_patient_and_request_data($id);
            # $self->debug( [$o->request_number, $o->year] );
		my %d = (
			request => $o->as_tree(max_depth => 0), # only want base object data
			patient => $o->patient_case->patient->as_tree, # don't need dt object
		);

		my $specimens = $specimen_map->{$id}->{sample_code}; # arrayref
		for my $sample_code (@$specimens) {
			my $label = $self->_format_label_data(\%d, $sample_code);
			$self->add_to_labels($label);
		}
	}
    # do print_labels function:
    my $rtn = $self->_do_print_labels();
	# return error if method rtn value:
    return $self->error($rtn) if $rtn;

	# set flash message:
	$self->flash( info => $self->messages('worklist')->{print_labels_ok} );

    # store request_ids in session:
    $self->session->param( lab_section_labels => \@request_ids );

	my $addr = $self->query->param('query_string'); # warn $addr;
	return $self->redirect( $addr );
}

# ------------------------------------------------------------------------------
sub print_histology_panel_labels : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	my @request_ids = $self->query->param('request_id'); # warn Dumper \@request_ids;

	# if ! @request_ids, don't return via rm or may get loop if arrived via timeout:
	unless (@request_ids) {
		return $self->redirect(
			$self->query->url . '/local_labels?label_type=immunohistology_panels'
		);
	}

	my $yaml = $self->get_yaml_file('print_labels')
		|| return $self->error('no config file found'); # warn Dumper $yaml;
	my $config = $yaml->{immunohistology_panels};

	# get immunohistology panel lab-tests:
	my $panels = $self->_get_immunohistology_panel_lab_tests(); # warn Dumper $panels;

	# some tests don't require labels:
	my $skip_tests = $config->{skip_tests};

	# get map of request_id => test_name(s):
	my $request_lab_test_map = $self->_get_request_test_name_map(\@request_ids);

	# just need request, investigation_name(s) & patient data on request_ids:
	for my $id (@request_ids) { # don't sort - need original submission order
		my $o = $self->model('Request')->get_patient_and_request_data($id);
            # $self->debug( [$o->request_number, $o->year] );
		my %d = (
			request => $o->as_tree(max_depth => 0), # only want base object data
			patient => $o->patient_case->patient->as_tree, # don't need dt object
		);

		# get list of tests/panels for this request:
		my $investigations = $request_lab_test_map->{$id};

		my $blank_label = $self->_format_label_data(\%d, undef); # don't need a title

		# for each test/panel, calculate how many labels of each type required:
		TEST:
		for my $ref (@$investigations) {
            my $test_name = $ref->{test_name};
			next TEST if grep $test_name eq $_, @$skip_tests; # skip unwanted tests

			# if test_name is in panel_lab_test (ie it's a panel), add 1 label
			# for each label_list entry:
			if ( my $label_list = $panels->{$test_name} ) {
				for my $ref (@$label_list) { # warn Dumper $ref; href (test_name & test_id)
                    my $label = $ref->{test_name};
					my $data  = $self->_format_label_data(\%d, $label);
					$self->add_to_labels($data);
				}
                { # add 1 negative:
                    my $neg = $self->_format_label_data(\%d, 'NEG');
                    $self->add_to_labels($neg);
                }
                if ( my $n = $config->{panel_blank_labels} ) { # add blank labels:
                    $self->add_to_labels($blank_label) for (1 .. $n);
                }
			}
			else { # probably individual test:
				my $label = $self->_format_label_data(\%d, $test_name); # warn $test_name;
				$self->add_to_labels($label);
                if ( my $n = $config->{test_blank_labels} ) { # add blanks:
                    $self->add_to_labels($blank_label) for (1 .. $n);
                }
			}
		}
	}

    # do print_labels function:
    my $rtn = $self->_do_print_labels();
	# return error if method rtn value:
    return $self->error($rtn) if $rtn;

	# set flash message:
	$self->flash( info => $self->messages('worklist')->{print_labels_ok} );

	{ # make hash of request_id's for template:
		my %done = map { $_ => 1 } @request_ids;
		$self->tt_params( done => \%done );
	}

    return $self->forward('default');
}

# ------------------------------------------------------------------------------
sub print_histology_staining_labels : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	my @request_ids = $self->query->param('request_id'); # warn Dumper \@request_ids;

	# if ! @request_ids, don't return via rm or may get loop if arrived via timeout:
	unless (@request_ids) {
		return $self->redirect(
			$self->query->url . '/local_labels?label_type=histology_staining'
		);
	}

	# get specimen_map for request_ids:
	my $specimen_map = $self->specimen_map(\@request_ids);

	my $yaml = $self->get_yaml_file('print_labels'); # warn Dumper $yaml;

	# get specimen_type defs from histology_staining section of yaml config:
	my $specimen_regex = $yaml->{histology_staining}->{specimen_types};
		# warn Dumper $specimen_regex;

	# just need request, specimen & patient data on request_ids:
	for my $id (sort @request_ids) {
		my $o = $self->model('Request')->get_patient_and_request_data($id);

		my %d = (
			request => $o->as_tree(max_depth => 0), # only want base object data
			patient => $o->patient_case->patient->as_tree, # don't need dt object
		);

		my $specimen = $specimen_map->{$id}->{sample_code};

		# for each request_specimen, calculate how many labels of each type required:
		while ( my ($sample_code_regex, $label_list) = each %$specimen_regex ) {
			SPECIMEN:
			for my $sample_code (@$specimen) { # warn $sample_code;
				next SPECIMEN unless $sample_code =~ /$sample_code_regex/;
				# send request/patient data & label name to _format_label_data():
				for my $lbl (@$label_list) { # warn Dumper $lbl;
					my $data = $self->_format_label_data(\%d, $lbl);
					$self->add_to_labels($data);
				}
			}
		}
	}

    # do print_labels function:
    my $rtn = $self->_do_print_labels();
	# return error if method rtn value:
    return $self->error($rtn) if $rtn;

	# set flash message:
	$self->flash( info => $self->messages('worklist')->{print_labels_ok} );

	{ # make hash of request_id's for template:
		my %done = map { $_ => 1 } @request_ids;
		$self->tt_params( done => \%done );
	}

    return $self->forward('default');
}

# ------------------------------------------------------------------------------
sub print_dna_extraction_labels : Runmode {
    my $self = shift;

    my $vars = $self->query->Vars(); # warn Dumper $vars;

    # retrieve data from session (param = dna_extraction_request_specimen):
    my $data = $self->session->param('dna_extraction_request_specimen');
        # warn Dumper $data;

    my %request_specimens; # create HoA of requests & specimens
	my @all_request_ids; # to hold req_id * in same order as $data *

    for (@$data) {
        my ($request_id, $specimen) = split '~';
		push @all_request_ids, $request_id;
        push @{ $request_specimens{$request_id} }, $specimen;
    } # warn Dumper \%request_specimens;

    # extract (unique) request_id's:
    my $request_ids = LIMS::Local::Utils::get_unique_elements(\@all_request_ids);

	for my $id (@$request_ids) { # warn Dumper $id;
		my $o = $self->model('Request')->get_patient_and_request_data($id);
            # $self->debug( [$o->request_number, $o->year] );
		my %d = (
			request => $o->as_tree(max_depth => 0), # only want base object data
			patient => $o->patient_case->patient->as_tree, # don't need dt object
		);

		my $specimens = $request_specimens{$id}; # array(ref) of sample codes
		for my $sample_code (@$specimens) {
			my $label = $self->_format_label_data(\%d, $sample_code);
			$self->add_to_labels($label);
		}
	}
    # do print_labels function:
    my $rtn = $self->_do_print_labels();
	# return error if method rtn value:
    return $self->error($rtn) if $rtn;

	# set flash message:
	$self->flash( info => $self->messages('worklist')->{print_labels_ok} );

    my $args = sprintf 'extraction_type=dna;function_name=%s;lab_section=%s;'
        . 'print_labels=1', $vars->{function_name}, $vars->{lab_section}; # warn $args;

	my $addr = join '?', '/local_worklist/xna_extraction_worksheet', $args; # warn $addr;
    return $self->redirect( $self->query->url . $addr );
}

# ------------------------------------------------------------------------------
sub print_xna_quantification_labels : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

	my @request_ids = $self->query->param('request_id'); # warn Dumper \@request_ids;

	# if ! @request_ids, don't return via rm or may get loop if arrived via timeout:
	unless (@request_ids) {
		return $self->redirect(
			$self->query->url . '/local_labels?label_type=' .
                $self->query->param('label_type')
		);
	}

	# get specimen_map for request_ids:
	my $specimen_map = $self->specimen_map(\@request_ids); # warn Dumper $specimen_map;

	for my $id (@request_ids) {
		my $o = $self->model('Request')->get_patient_and_request_data($id);
            # $self->debug( [$o->request_number, $o->year] );
		my %d = (
			request => $o->as_tree(max_depth => 0), # only want base object data
			patient => $o->patient_case->patient->as_tree, # don't need dt object
		);

		my $specimens = $specimen_map->{$id}->{sample_code}; # array(ref) of sample codes
		for my $sample_code (@$specimens) {
			my $label = $self->_format_label_data(\%d, $sample_code);
			$self->add_to_labels($label);
		}
	}

    # do print_labels function:
    my $rtn = $self->_do_print_labels();
	# return error if method rtn value:
    return $self->error($rtn) if $rtn;

	# set flash message:
	$self->flash( info => $self->messages('worklist')->{print_labels_ok} );

	{ # make hash of request_id's for template:
		my %done = map { $_ => 1 } @request_ids;
		$self->tt_params( done => \%done );
	}

    return $self->forward('default');
}

# ------------------------------------------------------------------------------
# shared by dako_link() & immunohistology_panels() to retrieve IHC tests:
sub _ihc_tests : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    my $args = shift; # optional href, if need to restrict by status opt

	# get list of lab_tests for immunohistochemistry section:
	my $lab_tests = do {
        my %args = ( section_name => 'Immunohistochemistry' );
        $self->model('LabTest')->get_section_lab_tests(\%args);
    }; # warn Dumper $lab_tests;

	# some tests don't require labels:
	my $yaml = $self->get_yaml_file('print_labels'); # warn Dumper $yaml;
	my $skip_tests = $yaml->{immunohistology_panels}->{skip_tests};

    my @lab_test_ids = ();
    for my $t (@$lab_tests) {
        next if grep $t->test_name eq $_, @$skip_tests; # only skips tests, not panels
        push @lab_test_ids, $t->id;
    } # warn Dumper \@lab_test_ids;

	{ # get requests where test status is not complete:
		my %args = (
			lab_test_id      => \@lab_test_ids,
			fetch_only       => [ 'request' ], # don't need all cols from model
		);
        # if we need to restrict to particular status option:
        if ( my $status_option = $args->{status_option} ) {
            my $option_id = do {
                my $map = $self->lab_test_status_options_map('description');
                $map->{$status_option}->{id};
            };
            $args{status_option_id} = $option_id;
        }

		my $data = $self->model('WorkList')->get_outstanding_investigations(\%args);

        # get_outstanding_investigations() returns one row per test, need unique requests:
        my (@requests, %seen);
        for my $r (@$data) {
            my $id = $r->request->id;
            next if $seen{$id}++;
            push @requests, $r->request;
        } # warn Dumper \@requests;
		return \@requests;
	}
}

# ------------------------------------------------------------------------------
sub _do_print_labels {
    my $self = shift; $self->_debug_path();

	my $labels = $self->labels; # warn Dumper $labels;

	my $peer_addr =
        $ENV{LOCALHOST_SOCKET} # print to a localhost socket for testing
            ? 'localhost'
            : $self->cfg('settings')->{label_printer_addr};

	$peer_addr || return 'no setting for label printer address found in config file';

    my $socket = new IO::Socket::INET(
        PeerAddr => $peer_addr,
        PeerPort => 9100,
        Proto 	 => 'tcp',
		Timeout  => 10,
    ) || return 'could not create socket: ' . $!;

    # need to shift 1st item from @data to format 1st label:
    my $first_label = shift @$labels;

    my %first_label_data = (
		labno => $first_label->{labno},
		name  => $first_label->{name},
		label => $first_label->{label},
	);

	# process label.tt template:
	my $label_body = do {
		$self->tt_process('worklist/local/labels/label.tt', \%first_label_data);
	};

	# send 1st label to printer:
	print $socket ${$label_body}; # deref

    # (R)eplace 'labno', 'name' & 'label' params for rest of labels:
    for my $next_label (@$labels) { # warn Dumper $next_label;
		for my $field( qw/labno name label/ ) { # eg R LABEL;Giemsa R LABNO;H1/10 etc
			print $socket sprintf "R %s;%s\n", uc $field, $next_label->{$field};
		}
		print $socket "A 1\n"; # print 1 label each
    }

    close $socket;

	return 0; # as caller expects only errors returned
}

# ------------------------------------------------------------------------------
sub _format_label_data {
	my $self  = shift; $self->_debug_path();
	my $data  = shift; # hashref
	my $label = shift || ''; # warn $label; # can be blank for controls

	# need lab_no, patient name & label name:
	my $name  = ucfirst $data->{patient}->{last_name}; # truncate if too long
	my $labno = sprintf 'H%s/%s',
		$data->{request}{request_number}, $data->{request}{year} - 2000;

	my %data = (
		name  => $name,
		labno => $labno,
		label => $label,
	);

	return \%data;
}

# ------------------------------------------------------------------------------
sub _get_request_test_name_map {
	my ($self, $request_ids) = @_; $self->_debug_path();

	my %args = (
		section_name => 'Immunohistochemistry',
		request_id   => $request_ids,
        description  => { ne => 'complete' },
	);

	my $o = $self->model('LabTest')->get_request_lab_tests_status_for_section(\%args);

	my %map;
	for my $data (@$o) {
		my $request_id = $data->request_id;
		my $test_name = $data->lab_test->test_type eq 'panel'
            ? $data->lab_test->test_name # for use in print_labels.yml
            : $data->lab_test->field_label; # printed direct to label

        my %h = ( test_name => $test_name, test_id => $data->lab_test->id );
		push @{ $map{$request_id} }, \%h;
	} # warn Dumper \%map;

	return \%map;
}

# ------------------------------------------------------------------------------
sub _get_immunohistology_panel_lab_tests {
    my $self = shift; $self->_debug_path();

    my $o = $self->model('LabTest')->get_panel_lab_tests('immunohistochemistry');

    # need HoA:
    my %panels = ();
    for (@$o) {
        my $panel_name = $_->panel_test->test_name;
        my $test_name  = $_->lab_test->field_label;

        my %h = ( test_name => $test_name, test_id => $_->lab_test->id );
        push @{ $panels{$panel_name} }, \%h;
    } # warn Dumper \%panels;
    return \%panels;
}

1;