#!/usr/bin/env perl # CENTRE=bristol perl $0 # manual run (need CENTRE to find usrname in users table) use Getopt::Std; getopts('tm:'); # testing, months our($opt_m,$opt_t); use strict; use warnings; my $JUST_TESTING = $opt_t || 0; # dumps xl file only ### recipients ################################################################# my @recipients = qw(raj.secure paul.virgo.secure); # ################################################################################ use lib '/home/raj/perl5/lib/perl5'; # *must* come before FindBin($Bin) use SQL::Abstract::More; use FindBin qw($Bin); # warn $Bin; exit; use Data::Printer; use lib $Bin . '/../../../lib'; use LIMS::Local::ScriptHelpers; use lib '/home/raj/per-lib'; use Local::WriteExcel; use Local::DB; my $tools = LIMS::Local::ScriptHelpers->new(); $tools->test_only($JUST_TESTING); my $config = $tools->config(); my $date = $tools->time_now(); # uncomment to force specific date: # DateTime->new(year => 2018, month => 3, day => 1); #------------------------------------------------------------------------------- my $duration = $opt_m || 3; # months ago # get ref-date $duration months ago: my $ref_date = $date->clone->subtract( months => $duration ); my $filename = sprintf 'nbt_activity_%s.xls', $date->ymd(''); my $subject = sprintf 'NBT activity data %s-%s %s', $ref_date->month_abbr, $ref_date->clone->add(months => 2)->month_abbr, $ref_date->year; # warn $subject; # exit; my @months = ( $ref_date->month .. $ref_date->month + 2 ); # p @months; my $dbix = Local::DB->dbix({ dbname => 'bristol' }); my $xl = Local::WriteExcel->new( filetype => 'xlsx' ); # set worksheet name to Qn: my $quarter = int ( $ref_date->clone->add(months => 2)->month / 3 ); # p $quarter; $xl->worksheet_name('Activity data Q'.$quarter); my @cols = qw( request_number year last_name first_name dob nhs_number unit_number location registered sample test_name test_status section_name results_summary diagnosis external_reference ); $xl->write_bold_row(\@cols); my @rows = do { my ($sql, @bind) = _query(); $dbix->query($sql, @bind)->arrays; # for XL output }; $xl->write_row($_) for @rows; if ($JUST_TESTING) { $xl->save(join '/',$Bin,$filename); exit; } my %mail = ( config => $config, subject => $subject, filename => $filename, attachment => $xl->data, ); $tools->send_mail(\%mail, \@recipients); sub _query { my @cols = ( qw/ r.request_number r.year p.last_name p.first_name p.dob p.nhs_number pc.unit_number rs1.display_name|location r.created_at|registered group_concat(s.sample_code)|sample lt.test_name so.description|test_status ls.section_name rrs.results_summary d.name|diagnosis rer.external_reference /, ); # p @cols; my @rels = ( 'requests|r' => q{r.patient_case_id=pc.id} , 'patient_case|pc' => q{pc.patient_id=p.id} , 'patients|p' => q{pc.referral_source_id=rs1.id} , 'referral_sources|rs1' => q{rs2.request_id=r.id} , 'request_specimen|rs2' => q{rs2.specimen_id=s.id} , 'specimens|s' => q{ts.request_id=r.id} , 'request_lab_test_status|ts' => q{ts.status_option_id=so.id} , 'lab_test_status_options|so' => q{ts.lab_test_id=lt.id} , 'lab_tests|lt' => q{lt.lab_section_id=ls.id} , 'lab_sections|ls' => q{=>rrd.request_id=r.id} , 'request_report_detail|rrd' => q{=>rrd.diagnosis_id=d.id} , 'diagnoses|d' => q{=>rrs.lab_section_id=ls.id,rrs.request_id=r.id} , 'request_result_summaries|rrs' => q{=>rer.request_id=r.id} , 'request_external_ref|rer' ); # previous 3 months: my %where = ( 'month(ts.time)' => { -in => \@months }, 'year(ts.time)' => $ref_date->year, # only works for @months 1..3, 4..6, etc ); my @args = ( -columns => \@cols, -from => [ -join => @rels ], -where => \%where, -group_by => [ qw(r.id lt.id ) ], # for group_concat(s.sample_code) -order_by => [ qw(r.year r.request_number lt.test_name) ], ); # p @args; my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind; # $dbix->dump_query($sql, @bind); exit; return ($sql, @bind); }