RSS Git Download  Clone
Raw Blame History
# 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