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::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); # get list of lab_tests for immunohistochemistry section: my %args = ( section_name => 'Immunohistochemistry', ); my $lab_tests = $self->model('LabTest')->get_section_lab_tests(\%args); # 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 = ( # status_option_id => 1, # if we need to restrict to status = 'new' 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); # 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; } return \@requests; } } # ------------------------------------------------------------------------------ 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 $test (@$investigations) { next TEST if grep $test 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} ) { for my $lbl (@$label_list) { # warn Dumper $lbl; my $data = $self->_format_label_data(\%d, $lbl); $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); $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 _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 push @{ $map{$request_id} }, $test_name; } # 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; push @{ $panels{$panel_name} }, $test_name; } # warn Dumper \%panels; return \%panels; } 1;