#!/usr/bin/perl =begin ------------------------------------------------------------------------- notifies billing department of new referral locations on 1st use =cut --------------------------------------------------------------------------- use strict; use warnings; my $JUST_TESTING = 0; # email to ra.jones only BEGIN { use FindBin qw($Bin); # warn $Bin; use lib ( "$Bin/../../../lib", '/home/raj/perl5/lib/perl5', ); } use Data::Dumper; use LIMS::Local::ExcelHandler; use LIMS::Local::ScriptHelpers; my $tools = LIMS::Local::ScriptHelpers->new(); $tools->test_only($JUST_TESTING); ############ recipients from contacts.lib ###################################### my @recipients = qw( katie.wheatley tim.branch philip.keogh raj ); ################################################################################ # get tools from LIMS::Local::ScriptHelpers: my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = $tools->dbix(); # email subject line: my $subject = "New Referral Source"; # get list of referral_source ids where location only used once: my $ids = _get_single_use_referral_sources(); # get id(s) of single_use referral_sources registered yesterday: my $sql = $sql_lib->retr('new_referral_sources'); my $locations = $dbix->query($sql, @$ids)->hashes; exit unless @$locations; # warn Dumper $locations; my @new_locations; for my $d(@$locations) { my $xl = LIMS::Local::ExcelHandler->new(); # $self->debug($xl); $xl->source($d->{description}); # array of hashrefs: my $match = $xl->parse($d->{organisation_code}); # warn Dumper $matches; # check only 1: if ( scalar @$match == 1 ) { push @new_locations, $match->[0]; } else { # not hospital or practice, or > 1 match for org_code: my %data = ( code => $d->{organisation_code}, display => $d->{display_name}, ); push @new_locations, \%data; } } # warn Dumper \@new_locations; my $message_body = join "\n", map { join ', ', @{$_}{qw(code display)} } @new_locations; my %mail = ( config => $config, message => $message_body, subject => $subject, ); # warn Dumper \%mail; # next; $tools->send_mail(\%mail, \@recipients); sub _get_single_use_referral_sources { my $sql = $sql_lib->retr('single_use_referral_sources'); my $ids = $dbix->query($sql)->flat; return $ids; }