#!/usr/bin/env perl =begin ------------------------------------------------------------------------- RfC343L - discontinued Jan/2019 Emails list of 100K Genomics samples with DNA sample saved last calendar month use -m2 for last-but-one month etc. Garry Quested Mon Dec 18 13:10:40 GMT 2017 =cut --------------------------------------------------------------------------- use Getopt::Std; getopts('m:tq'); # month, testing, query output our($opt_m,$opt_t,$opt_q); # warn $opt_t; exit; use strict; use warnings; my $JUST_TESTING = $opt_t || 0; # email to ra.jones only ############ recipients from contacts.lib ####################################### my @recipients = qw( polly.talley.secure raj.secure ); my $duration = $opt_m // 1; # month ################################################################################ use lib '/home/raj/perl5/lib/perl5'; use Data::Printer; use SQL::Abstract::More; use Spreadsheet::WriteExcel::Simple; 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 $ref_date = $tools->date_subtract( months => $duration ); my $subject = sprintf '100K Genomes - DNA sample saved [%s]', $ref_date->month_name; # warn $subject; my $filename = sprintf '100k_patients_%s-%s.xls', $ref_date->year, $ref_date->month; # warn $filename; # xl file headers: my @headers = ( 'Request number', 'Year', 'Last name', 'First name', 'Middle name', 'DoB', 'Date registered', 'Presentation', 'Source', 'Referrer', 'Diagnosis' ); #------------------------------------------------------------------------------- my $config = $tools->config(); my $dbix = $tools->dbix(); my ($sql, @bind) = _get_query(); my @data = $dbix->query( $sql, @bind )->arrays; # p @data; #$DB::single=1; exit unless @data; my $xl = Spreadsheet::WriteExcel::Simple->new; $xl->write_bold_row(\@headers); $xl->write_row($_) for @data; $xl->save($filename) if $JUST_TESTING; my %mail = ( config => $config, subject => $subject, attachment => $xl->data, filename => $filename, ); $tools->send_mail(\%mail, \@recipients) unless $opt_q; sub _get_query { my @cols = ( 'r.request_number', 'r.year', 'p.last_name', 'p.first_name', 'p.middle_name', 'p.dob', 'date(r.created_at)|registered', 's.description|presentation', 'rs.display_name|location', 'ref.name|referrer', 'd.name|diagnosis' ); my @rels = ( 'requests|r' => q{r.id=rlts.request_id}, 'request_lab_test_status|rlts' => q{rlts.lab_test_id=lt.id}, 'lab_tests|lt' => q{=>rrd.request_id=r.id}, 'request_report_detail|rrd' => q{=>rrd.diagnosis_id=d.id}, 'diagnoses|d' => q{r.patient_case_id=pc.id}, 'patient_case|pc' => q{pc.patient_id=p.id}, 'patients|p' => q{pc.referral_source_id=rs.id}, 'referral_sources|rs' => q{r.referrer_department_id=rd.id}, 'referrer_department|rd' => q{rd.referrer_id=ref.id}, 'referrers|ref' => q{r.id=ris.request_id}, 'request_initial_screen|ris' => q{ris.screen_id=s.id}, 'screens|s' ); my %where = ( 'year(r.created_at)' => $ref_date->year, 'month(r.created_at)' => $ref_date->month, 'lt.test_name' => '100kg_dna_extraction', ); my @args = ( -columns => \@cols, -from => [ -join => @rels ], -where => \%where, -order_by => 'r.id', ); # p @args; my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p \@bind; $dbix->dump_query($sql, @bind) if $opt_q; # exit; return ($sql, @bind); }