#!/usr/bin/perl =begin ------------------------------------------------------------------------- Generates spreadsheet on Roche Gallium trial cases. Assumptions for cases referred to Kiel: if diagnosis is, or was, "Gallium trial - referred to Kiel", date of referral = authorisation date. If diagnosis subsequently updated, then return date assumed to be date of diagnosis change (taken from request_diagnosis_history table where entry = "Gallium trial - referred to Kiel") =cut --------------------------------------------------------------------------- use strict; use warnings; my $JUST_TESTING = 0; # email to ra.jones only use lib '/home/raj/perl5/lib/perl5'; use FindBin qw($Bin); # warn $Bin; use lib "$Bin/../../../lib"; use Data::Dumper; use LIMS::Local::Utils; use LIMS::Local::GalliumTrial; use LIMS::Local::ScriptHelpers; use Spreadsheet::WriteExcel::Simple; my $tools = LIMS::Local::ScriptHelpers->new(); $tools->test_only($JUST_TESTING); my $today = $tools->time_now->ymd; ################################################################################ my @recipients = qw(archana.ambily irfan.shaikh hmds.lth@nhs.net); my $filename = sprintf 'gallium_data_%s.xls', $today; my $subject = sprintf 'GALLIUM trial data %s', $today; ################################################################################ # xl file headers: my @cols = ; chomp(@cols); # warn Dumper @cols; push @recipients, 'raj' if $JUST_TESTING; # will be sole recipient # get tools from LIMS::Local::ScriptHelpers: my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = $tools->dbix(); # ensure case-sensitivity of col names preserved (eg bcl2 & BCL2): $dbix->lc_columns = 0; # get cases referred to Kiel: my $referrals = do { my $sql = $sql_lib->retr('gallium_trial_referred_to_kiel'); $dbix->query($sql)->map; }; my $requests = do { my $sql = $sql_lib->retr('gallium_trial_data'); # warn $sql; $dbix->query($sql); }; # get specimens - can't combine GROUP_CONCAT with MAX(CASE .. WHEN .. THEN ..END) # used for results_summaries my $specimens = do { my $sql = $sql_lib->retr('gallium_trial_request_specimen'); $dbix->query($sql)->map_hashes('request_id'); }; my $trim = sub { LIMS::Local::Utils::trim(@_) }; my @rows; ROW: while ( my $vars = $requests->hash ) { # warn Dumper $vars; my $gallium = LIMS::Local::GalliumTrial->new(data => $vars); my $request_id = $vars->{request_id}; # lab role (first-time reviewer / adjudicator): if ( my $result = $gallium->get_lab_role ) { # warn Dumper $result; $vars->{lab_role} = $result; } # slides & blocks: if ( my $exref = $gallium->get_external_reference ) { # warn Dumper $exref; $vars->{$_} = $exref->{$_} for qw(block_id slides blocks); } # lymphoma grade: if ( my $grade = $gallium->get_lymphoma_grade ) { # extract grade (only if FL): $vars->{lymphoma_grade} = $grade; } # IgH PCR: if ( my $result = $gallium->get_igh_pcr ) { $vars->{$_} = $result->{$_} for grep $result->{$_}, qw(igh_pcr_assay igh_pcr_result igh_pcr_bp_length igh_pcr_comment); } # RNA result: if ( my $result = $gallium->get_rna_results ) { # warn Dumper $vars; $vars->{$_} = $result->{$_} for grep $result->{$_}, qw(rna_volume rna_concentration rna_purity rna_sections); } { # referred to/from Kiel (from separate query): my $diagnosis = $vars->{diagnosis} || ''; # avoid uninitialized warning if ( $referrals->{$request_id} || $diagnosis =~ /referred to kiel/i ) { $vars->{referred_to_kiel} = $vars->{reported}; # date } if ( my $return_date = $referrals->{$request_id} ) { # assume diagnosis change date $vars->{returned_from_kiel} = $return_date; } } if ( my $result = $gallium->is_retest_required ) { $vars->{retest_required} = $result; } my @data = @{$vars}{@cols}; # warn Dumper $vars; push @rows, \@data; } exit if ! @rows; { # construct excel spreadsheet: my $xl = Spreadsheet::WriteExcel::Simple->new; $xl->write_bold_row(\@cols); $xl->write_row($_) for @rows; # save to file if just testing: $xl->save($Bin.'/'.$filename) if $JUST_TESTING; my %mail = ( attachment => $xl->data, filename => $filename, subject => $subject, config => $config, ); # warn Dumper \%mail; $tools->send_mail(\%mail, \@recipients); } __DATA__ hmds_ref lab_role accession_number site_id patient_id dob gender specimen_quality retest_required registered reported slides blocks block_id consent immuno_summary cd3 cd5 cd10 cd20 cd23 cd79 cyclin_d1 bcl2 bcl6 irf4 ki67 foxp1 kappa lambda immuno_status igh_pcr_assay igh_pcr_result igh_pcr_bp_length igh_pcr_comment fish_summary BCL2 BCL6 BCL2_IgH rna_volume rna_concentration rna_purity rna_sections referred_to_kiel returned_from_kiel diagnosis lymphoma_grade icdo3 comment