package LIMS::Model::Referrer;
use strict;
use warnings;
use base 'LIMS::Model::Base';
use Data::Dumper;
#-------------------------------------------------------------------------------
sub get_clinician_speculative {
my $self = shift;
my $code = shift;
my $clinician =
LIMS::DB::Referrer->new(national_code => $code)->load(speculative => 1);
return $clinician;
}
#-------------------------------------------------------------------------------
sub get_referrers_by_source_id {
my ($self, $source_id) = @_;
my %args = (
query => [ 'referral_sources.id' => $source_id ],
require_objects => [
'referrer',
'hospital_department',
'parent_organisation.referral_source'
],
);
# use ReferrerDepartment - easier to retrieve data from object:
my $referrers = LIMS::DB::ReferrerDepartment::Manager
->get_referrer_department(%args);
return $referrers;
}
#-------------------------------------------------------------------------------
sub get_referrer_parent_organisation {
my $self = shift;
my $data = shift; # DEBUG $data;
my %args = map { $_ => $data->{$_} } qw(referrer_id parent_organisation_id);
my $o = LIMS::DB::ReferrerDepartment->new(%args)->load(speculative => 1);
# only need true/false return:
return $o ? 1 : 0;
}
#-------------------------------------------------------------------------------
sub create_new_clinician {
my $self = shift;
my $data = shift;
# set cases on surname & initials:
my $clinician_name
= join ' ', ucfirst lc $data->{surname}, uc $data->{initials};
my %new_clinician = (
name => $clinician_name,
national_code => $data->{national_code},
);
my $referral_type
= LIMS::DB::ReferralType->new(description => 'clinician')->load;
my $clinician = LIMS::DB::Referrer->new(%new_clinician);
$clinician->referral_type($referral_type->id);
# TODO: handle exception - can't return $@, expecting $clinician object
eval { $clinician->save };
return $clinician;
}
#-------------------------------------------------------------------------------
sub update_referrer_department {
my $self = shift;
my $data = shift; # warn Dumper $data;
eval {
if ( my $id = $data->{id} ) { # update:
my $o = LIMS::DB::ReferrerDepartment->new(id => $id)->load;
$o->is_active($data->{is_active});
$o->hospital_department_code($data->{hospital_department_code});
$o->save( changes_only => 1 );
}
else { # new entry:
LIMS::DB::ReferrerDepartment->new(%$data)->save;
}
};
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub get_general_practitioners {
my $self = shift;
my $args = shift;
$args->{require_objects} = [
'referral_type',
'referrer_department.parent_organisation.referral_source',
]; # above relationship causing limit/offset to be ignored
$args->{multi_many_ok} = 1;
$args->{query} = [ 'referral_type.description' => 'practitioner' ];
# get all GPs as arrayref:
my $gps = LIMS::DB::Referrer::Manager->get_referrers(%$args);
return $gps;
}
#-------------------------------------------------------------------------------
sub get_general_practitioner_count {
my $self = shift;
my $args = shift;
$args->{with_objects} = 'referral_type';
$args->{query} = [ 'referral_type.description' => 'practitioner' ];
#$self->set_rose_debug(1);
my $total = LIMS::DB::Referrer::Manager->get_referrers_count(%$args);
#$self->set_rose_debug(0);
return $total;
}
#-------------------------------------------------------------------------------
sub get_referrer_count {
my $self = shift;
my $args = shift; # hashref of search_terms & referrer_type
my $search_terms = $args->{search_terms};
my $referrer_type = $args->{referrer_type};
# restrict query to practitioners or non-practitioners:
# ***** NB: this modifies callers' $search_terms ****
# need full rel. name to distinguish 'description' from parent_org col
# of same name
$search_terms->{'referral_type.description'} =
$referrer_type eq 'clinicians' ?
{ ne => 'practitioner' }
: 'practitioner';
my %args = (
query => [ %$search_terms ],
require_objects => 'referral_type',
); # $self->debug(\%args);
#$self->set_rose_debug(1);
my $total = LIMS::DB::Referrer::Manager->get_referrers_count(%args);
#$self->set_rose_debug(0);
return $total;
}
#-------------------------------------------------------------------------------
sub get_referrers {
my $self = shift;
my ($search_terms, $args) = @_; # $self->debug([$search_terms, $args]);
# format query - $search_terms includes 'referral_type.description' key
# acquired in get_referrers_count():
$args->{query} = [ %$search_terms ];
# sort_by name:
$args->{sort_by} = 'name';
# declare relationships for joins:
$args->{require_objects} = [ 'referral_type' ]; # arrayref so can:
# if gp's search, include parent_org for 'description' col:
if ($search_terms->{'referral_type.description'} eq 'practitioner') {
push @{ $args->{require_objects} },
'referrer_department.parent_organisation';
}
#$self->set_rose_debug(1);
my $requests = LIMS::DB::Referrer::Manager->get_referrers(%$args);
#$self->set_rose_debug(0);
return $requests;
}
#-------------------------------------------------------------------------------
sub get_referrer {
my ($self, $referrer_id) = @_;
my $referrer = LIMS::DB::Referrer->new(id => $referrer_id)->load;
return $referrer;
}
#-------------------------------------------------------------------------------
sub get_referrer_department {
my ($self, $referrer_department_id) = @_;
my $o = LIMS::DB::ReferrerDepartment
->new(id => $referrer_department_id)
->load(with => [ qw/referrer parent_organisation hospital_department/ ]);
return $o;
}
#-------------------------------------------------------------------------------
sub get_referrer_departments {
my ($self, $referrer_id) = @_;
my @args = (
query => [ id => $referrer_id ],
with_objects => [
'referrer_department.parent_organisation',
'referrer_department.hospital_department',
],
);
my $o = LIMS::DB::Referrer::Manager->get_referrers(@args);
return $o->[0]; # does the right thing - returns a hash with r_d as array
}
#-------------------------------------------------------------------------------
sub get_hospital_department {
my ($self, $display_name) = @_;
my $o = LIMS::DB::HospitalDepartment
->new(display_name => $display_name)->load;
return $o;
}
#-------------------------------------------------------------------------------
sub get_hospital_departments {
my $self = shift;
my $args = shift || {};
$args->{sort_by} ||= 'display_name';
my $departments = LIMS::DB::HospitalDepartment::Manager
->get_hospital_departments(%$args); # warn Dumper $departments;
return $departments;
}
#-------------------------------------------------------------------------------
sub get_referral_type {
my ($self, $description) = @_;
my $referral_type
= LIMS::DB::ReferralType->new(description => $description)->load;
return $referral_type;
}
#-------------------------------------------------------------------------------
sub get_referral_types {
my $self = shift;
my $referral_types
= LIMS::DB::ReferralType::Manager->get_referral_types(sort_by => 'description');
return $referral_types;
}
#-------------------------------------------------------------------------------
sub get_practitioner_by_code {
my $self = shift;
my $code = shift;
my $gp = LIMS::DB::Referrer->new(national_code => $code)->load;
return $gp;
}
#-------------------------------------------------------------------------------
sub get_practitioner_data {
my $self = shift;
my $referrer_id = shift;
#$self->set_rose_debug(1);
# need GP name and practice address for submitted referrer_id:
my $o = LIMS::DB::Referrer->new(id => $referrer_id)->load(
with => 'referrer_department.parent_organisation.referral_source',
);
#$self->set_rose_debug(0);
# referrer_department and referral_source both arrayrefs:
my $referrer_map = $o->referrer_department->[0];
my $ref_source = $referrer_map->parent_organisation->referral_source->[0];
# my @rels = ('parent_organisation.referral_source', 'referrer');
# ReferrerDepartment needs both referrer_id & parent_organisation_id:
# my $foo = LIMS::DB::ReferrerDepartment->new(referrer_id => $referrer_id)
# ->load(with => \@rels);
my %data = map {
$_ => $o->$_;
} qw(id name national_code active referral_type_id);
foreach ( qw/display_name organisation_code/ ) {
$data{$_} = $ref_source->$_;
}
return \%data;
}
#-------------------------------------------------------------------------------
sub update_clinician {
my $self = shift;
my $data = shift; # $self->debug( $data );
my %args = ( class => 'Referrer', data => $data );
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
# can only update name and active flag - national code & practice code from egpcur file
sub update_general_practitioner {
my $self = shift;
my $data = shift; # $self->debug($data);
my $gp = LIMS::DB::Referrer->new(id => $data->{id})->load; # $self->debug($gp);
map {
$gp->$_($data->{$_});
} qw(name active);
#$self->set_rose_debug(1);
eval {
$gp->save(changes_only => 1);
};
#$self->set_rose_debug(0);
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub regenerate_general_practitioners {
my ($self, $data) = @_; # $data = ref to array of hashrefs
return 0 unless @$data; # if no new GP's to add to referrers table
# update gp's in referrers & referrer_department tables in a transaction:
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $refresh_gps = sub {
GP:
foreach my $gp ( @$data ) { # warn $gp->{national_code};
my %referrer_data = map {
$_ => $gp->{$_}
} qw(name national_code referral_type_id);
# insert new gp & referrer_department entry if not exists:
my $referrer = LIMS::DB::Referrer->new(%referrer_data);
# if referrer loads, already exists so skip to next GP:
if ( my $o = $referrer->load(speculative => 1) ) {
next GP; # shouldn't happen as already checked in C method
}
else { # warn 'here';
my $new_gp = $referrer->save;
my %referrer_department_data = map {
$_ => $gp->{$_}
} qw(parent_organisation_id hospital_department_code);
my $referrer_department
= LIMS::DB::ReferrerDepartment->new(%referrer_department_data);
$referrer_department->referrer_id($new_gp->id);
$referrer_department->save;
}
}
};
# do_transaction() returns true if succeeds; sets $db->error on failure:
my $ok = $db->do_transaction($refresh_gps);
return $ok ? 0 : 'regenerate_general_practitioners() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
=begin # no longer in use
sub _get_practitioners_by_location {
my $self = shift;
my $location_code = shift;
my %args = (
query => [ organisation_code => $location_code ],
sort_by => 'referrer.name',
with_objects => 'referrer'
);
my $gps =
LIMS::DB::ReferrerOrganisation::Manager->get_referrer_organisation(%args);
return $gps;
}
=cut
#-------------------------------------------------------------------------------
=begin # far too many to display
sub _get_clinicians {
my $self = shift;
my $args = shift;
# need clinician hospital_department tables for template:
$args->{with_objects} = [ qw( clinician hospital_department ) ];
my $data = LIMS::DB::ClinicianOrganisation::Manager->get_clinician_organisation(
#sort_by => 'clinician.surname',
); # DEBUG $data;
return $data;
}
=cut
1;
