#!/usr/bin/perl =begin ------------------------------------------------------------------------- emails .csv list of new Hodgkin diagnoses, or any previous Hodgkin diagnosis changed to something else, over specified duration, for LTH & Bradford Hospitals, to Blood Bank contacts - can be set to test mode using $JUST_TESTING =cut --------------------------------------------------------------------------- use strict; use warnings; my $JUST_TESTING = 0; # email to ra.jones only ############ recipients from contacts.lib ###################################### my @recipients = qw( terrence.haines david.beale raj.secure ); my $duration = 7; # over past number of days ################################################################################ use lib '/home/raj/perl5/lib/perl5'; use Data::Dumper; use FindBin qw($Bin); # warn $Bin; use lib $Bin . '/../../../lib'; use LIMS::Local::ScriptHelpers; # get tools from LIMS::Local::ScriptHelpers: my $tools = LIMS::Local::ScriptHelpers->new(); $tools->test_only($JUST_TESTING); #------------------------------------------------------------------------------- my $date = $tools->time_now->dmy; my $filename = 'hodgkin.csv'; my $subject = "New/amended Hodgkin lymphomas for week ending $date"; # csv file headers: my @headers = qw(LastName FirstName DoB PatientID NHSNumber Location Diagnosis); # fields for formatting data in _process_data(): my @fields = qw(last_name first_name dob unit_number nhs_number location diagnosis); #------------------------------------------------------------------------------- my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = $tools->dbix(); my @rows; { # new hodgkin cases: my $query = $sql_lib->retr('hodgkin'); my $result = $dbix->query($query, $duration); while (my $ref = $result->hash) { # warn Dumper $vars; next; my $row = _process_data($ref); push @rows, $row; } } { # get cases which have diagnoses revised to other than hodgkin: my $query = $sql_lib->retr('ex-hodgkin'); my $result = $dbix->query($query, $duration); while (my $ref = $result->hash) { # warn Dumper $vars; next; my $row = _process_data($ref); push @rows, $row; } } my %mail = ( subject => $subject, config => $config, ); # warn Dumper \%mail; # next; if (@rows) { # send attachment: # add headers to beginning of @rows: unshift @rows, join ',', @headers; my $content = join "\n", @rows; $mail{attachment} = $content; $mail{filename} = $filename; } else { # send message: $mail{message} = "no new Hodgkin diagnoses for week ending $date\n"; my $script_name = $tools->script_filename; print "$script_name: no new Hodgkin diagnoses for week ending $date\n"; } $tools->send_mail(\%mail, \@recipients); sub _process_data { my $data = shift; # warn Dumper $data; # get rid of csv field delimiters and ensure no undef's: map { $data->{$_} =~ s/\,//g } qw(location diagnosis); map { $data->{$_} ||= '' } qw(dob nhs_number); # case transform: $data->{first_name} = ucfirst $data->{first_name}; $data->{last_name} = uc $data->{last_name}; # join data fields: my $row = join ',', @{$data}{@fields}; return $row; }