• Files
• Commits
• Log
• Graph
• Stats

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 to 'is_active' col:
            my $o = LIMS::DB::ReferrerDepartment->new(id => $id)->load;
            $o->is_active($data->{is_active});
            $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_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;