# gets all pack dispatches for all outreach patients and applies 'current status'
# logic from packs.tt
use SQL::Library;
use Modern::Perl;
use FindBin qw($Bin); # warn $Bin; exit;
use Data::Printer use_prototypes => 0;
use lib '/home/raj/perl-lib';
use Local::DB;
my $dbix = Local::DB->dbix({ dbname => 'hilis4' });
# pack dispatches:
my $sql = join '', <DATA>; # print $sql; exit;
my $today = DateTime->today->ymd(''); # p $today; exit;
my @all_outreach_patients =
$dbix->select('views.outreach_patients', 'nhs_number')->flat;
for my $nhs_number (@all_outreach_patients) { # p $nhs_number;
my @data = $dbix->query($sql, $nhs_number)->hashes; # p @data;
my $current_pack = $data[0]; # p $current_pack;
do { say "!!! $nhs_number has no current pack"; next; } if ! $current_pack;
my $registered = $current_pack->{registered}->ymd;
my $req_status = $current_pack->{request_status};
my $outcome = $current_pack->{outcome} || '';
if ( grep $_ eq 'dead', ( $outcome, $current_pack->{patient_status} ) ) {
# p [ $outcome, $current_pack->{patient_status} ];
my $res = "$nhs_number - patient died";
# p $res; # next;
}
elsif ( $req_status && $req_status eq 'complete' ) {
my $pack_due = $current_pack->{pack_due};
my $pack_sent = $current_pack->{pack_sent};
if ( $pack_due && $pack_due->ymd('') >= $today ) {
my $res = "$nhs_number - next assessment is due on "
. $current_pack->{pack_due}->dmy;
# p $res;
}
elsif ( $pack_sent && $pack_sent->ymd('') < $today ) {
my $date_pack_sent = $current_pack->{pack_sent}->ymd;
my $delta_pack_sent
= $current_pack->{pack_sent}->delta_days(DateTime->today)->delta_days;
my $res = "$nhs_number - pack was sent on $date_pack_sent [$delta_pack_sent "
. 'days ago but has not been received';
p $res; # last;
}
elsif ( $outcome && grep $outcome eq $_, ('return to clinic','other') ) {
my $res = "$nhs_number - $outcome";
# p $res;
}
else {
my $res = "$nhs_number - current request status complete but pack "
. 'due not > today and pack sent not < today';
# p $res; p $current_pack;
}
}
elsif ( $req_status eq 'new' ) {
my $res = "$nhs_number - pack was received on $registered and laboratory"
. ' tests have been initiated';
# p $res;
}
elsif ( $req_status eq 'screened' ) {
my $res = "$nhs_number - pack was received on $registered and initial results"
. ' indicate that no urgent action is required';
# p $res;
}
else {
my $res = qq|!!! $nhs_number - current request status = "$req_status"|;
# p $res; # p $current_pack; last;
}
}
__DATA__
SELECT
r.id,
r.request_number,
r.year,
so.description as 'request_status',
r.created_at as 'registered',
fo.`option`,
fo.`label` as 'outcome',
pd.`status` as 'patient_status',
rpd.pack_due,
rpd.pack_sent,
rpd.return_due
FROM requests r
JOIN status_options so on r.status_option_id = so.id
JOIN patient_case pc on r.patient_case_id = pc.id
JOIN patients p on pc.patient_id = p.id
JOIN patient_demographics pd on pd.patient_id = p.id
JOIN ( request_specimen rs JOIN specimens s on rs.specimen_id = s.id
and s.sample_code = 'CMP' ) on rs.request_id = r.id
LEFT JOIN outreach.request_pack_dispatch rpd on rpd.request_id = r.id
LEFT JOIN ( outreach.request_followup rfu JOIN outreach.followup_options fo
on rfu.followup_option_id = fo.id ) on rfu.request_id = r.id
WHERE p.nhs_number = ?
ORDER BY r.created_at DESC
LIMIT 10