#!/usr/bin/perl =begin ------------------------------------------------------------------------- list of unfixed histology specimens for requests authorised during past 7 days =cut --------------------------------------------------------------------------- use strict; use warnings; my $JUST_TESTING = 0; # email to ra.jones only ################################################################################ my @recipients = qw( wheeler raj ); my $duration = 7; # how many working days since report date ################################################################################ BEGIN { use FindBin qw($Bin); # warn $Bin; use lib ( "$Bin/../../../lib", '/home/raj/perl5/lib/perl5', ); } use Data::Dumper; use Date::Calc qw(Delta_Days); use LIMS::Local::ScriptHelpers; # get tools from LIMS::Local::ScriptHelpers: my $tools = LIMS::Local::ScriptHelpers->new(); $tools->test_only($JUST_TESTING); my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = $tools->dbix(); my $query = $sql_lib->retr('unfixed_histology_specimens'); my $result = $dbix->query($query, $duration); my $sql = q!select 1 from request_lab_test_status r join lab_tests lt on (r.lab_test_id = lt.id) join lab_sections ls on (lt.lab_section_id = ls.id) where r.request_id = ? and ls.section_name = 'FISH'!; my @rows = (); while (my @vals = $result->list) { # warn Dumper $ref; next; # has FISH been requested: $dbix->query($sql, $vals[0])->into(my $fish); push @rows, [ @vals, $fish ? 'x' : '']; } # warn Dumper \@rows; my $dates = sprintf '%s to %s', $tools->date_subtract(days => $duration)->dmy('.'), $tools->date_subtract(days => 1)->dmy('.'); # warn $dates; my %data = ( dates => $dates, rows => \@rows ); # template: my $tt_file = 'cron/histology_samples.tt'; my $message_body = $tools->process_template($tt_file, \%data); my %mail = ( subject => "Histology unfixed samples - $dates", message => $message_body, content => 'html', config => $config, ); # warn Dumper \%mail; $tools->send_mail(\%mail, \@recipients);