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); 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;