package LIMS::Controller::Ajax;

use Moose;
BEGIN { extends 'LIMS::Base'; }
with 'LIMS::Controller::Roles::Aspell';
__PACKAGE__->meta->make_immutable(inline_constructor => 0);

use IO::All;
use Data::Dumper;
use Regexp::Common;
use LIMS::Local::Utils;
use Data::FormValidator;
use FormValidator::Simple;
use CGI::Application::Plugin::JSON ':all';

=begin # this causes problems, and doesn't work anyway - a) cannot modify
$tt_config and then hand back to $self, or get circular ref when tt_process()
called; b) deletion of WRAPPER persists across all requests until server is
restarted; c) doesn't have any effect on tt rendering anyway as the original
config at server startup is used; solution is to use [% content_only %] in all
class templates

# override base cgiapp_init, remove TT wrapper for templates:
sub cgiapp_init {
    my $self = shift;

	# get tt_config:
	my $tt_config = $self->cfg('tt_config');
	# delete wrapper option:
	$tt_config->{TEMPLATE_OPTIONS}->{WRAPPER} = undef; # modification of hashref persists
	# load modified tt_config (don't use $self, causes circular ref when tt_process() used) 
    # __PACKAGE__->tt_config( $tt_config ); # ? superfluous - $tt_config is hashref    

	# load cgiapp_init:
    $self->SUPER::cgiapp_init; # doesn't seem to matter where this is called !!
}
=cut

# only uses dfv_msgs for errors, formatted as dfv-style in _format_as_dfv():
sub err_msg {
	my $self = shift;
	my $msg  = shift;
	
	return $self->messages('dfv_msgs')->{$msg};
}

# ------------------------------------------------------------------------------
# expects query string: /ajax?fname=do_ajax&args=<value>&<field_name>=<value> if
# <field_name> matches 'is_valid_' send query->vars to _validate_param(), otherwise
# to _db_lookup()
sub do_ajax : StartRunmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    # ajax query string has 3 params - fname, args & <field_name>
    my $vars = $self->query->Vars; # $self->debug($vars);

    # delete keys fname & args, leaving only <field_name>:
    map delete $vars->{$_}, qw(fname args); # $self->debug($vars);

    # if one (or more) Vars() = is_valid_*, needs validating
    if ( grep $_ =~ /^is_valid_/, keys %$vars ) {
        return $self->_validate_param($vars);
    }
    # else needs a db lookup to see if param exists:
    else {
        return $self->_db_lookup($vars);
    }
}

# ------------------------------------------------------------------------------
sub get_email_addresses : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	my $param = $self->query->Vars(); # $self->debug($param); 
	
    my $addr = $self->model('Ajax')->get_email_addresses($param);

    my $xml = $self->_format_as_xml({ type => 'email_addresses', data => $addr });

	# set header type to xml:
    $self->header_props(-type=>'text/xml');

    return $xml;	
}

# ------------------------------------------------------------------------------
sub seek_new_messages : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	
    my $tt = $self->query->param('tt'); # warn Dumper $tt;
    return undef if grep $tt =~ /$_\.tt\Z/, qw(hello user_messages); # can already see them!!
    
    my $username = $self->authen->username || return undef; # maybe not logged in
    
    my $i = $self->model('User')->any_new_messages($username) || return undef;
    return $self->tt_process('user/new_msg_alert.tt', { count => $i });
}

# ------------------------------------------------------------------------------
sub get_referral_sources : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	# string submitted from new clinician (as 'hospital') or new request (as 'location'):
    my $location
		= $self->query->param('location') || $self->query->param('hospital');

	# hospital (optional):
	my $hospital = $self->query->param('hospital') || 0;
	
    # active only (optional):
	my $active_only = $self->query->param('is_active') || 0;
    
    return unless $location &&
		length $location >= $self->cfg('settings')->{min_char_length};

    my %args = (
		location => $location,
        active_only => $active_only,
		# only want hospitals for new clinician entry
		hospitals_only => $hospital,
	);

    my $sources = $self->model('Ajax')->get_referral_sources(\%args);

    my $xml = $self->_format_as_xml({ type => 'sources', data => $sources });

    # set header type to xml:
    $self->header_props(-type=>'text/xml');

    return $xml;
}

# ------------------------------------------------------------------------------
sub get_parent_organisations : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	my $vars = $self->query->Vars();

    my $entry = $vars->{organisation} || $vars->{practice};
    my $min_length = $self->cfg('settings')->{min_char_length};

    return unless $entry && length $entry >= $min_length;

    my $data = $self->model('Ajax')->get_parent_organisations($vars);
	
    my $xml = $self->_format_as_xml({ type => 'parent_orgs', data => $data });

    # set header type to xml:
    $self->header_props(-type=>'text/xml');

    return $xml;	
}

# ------------------------------------------------------------------------------
sub get_practice_from_gp : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	my $gp_name = $self->query->param('name');
    $gp_name =~ s/\,(\s+)?/ /g; # remove comma
    
    return unless $gp_name && length $gp_name >= 3;

    my $practices = $self->model('Ajax')->get_practice_by_practitioner($gp_name);
	
    my $xml = $self->_format_as_xml({ type => 'practices', data => $practices });

    # set header type to xml:
    $self->header_props(-type=>'text/xml');

    return $xml;	
}

# ------------------------------------------------------------------------------
sub get_diagnoses : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	my $param = $self->query->Vars(); # $self->debug($param);
	
	my $diagnoses = $self->model('Ajax')->get_diagnoses($param);

    my $xml = $self->_format_as_xml({ type => 'diagnoses', data => $diagnoses });

	# set header type to xml:
    $self->header_props(-type=>'text/xml');

    return $xml;
}

# ------------------------------------------------------------------------------
sub get_clinicians : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	my $param = $self->query->Vars(); # $self->debug($param);
	
    # must be integer only:
    return unless $param->{source_id} && $param->{source_id} =~ /^\d+$/;

    my $referrers
        = $self->model('Ajax')->get_clinicians_for_source($param);

    my $xml = $self->_format_as_xml({ type => 'clinicians', data => $referrers });

	# set header type to xml:
    $self->header_props(-type=>'text/xml');

    return $xml;
}

# ------------------------------------------------------------------------------
sub load_template : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);   

    $self->query->param('template')
	# TODO: this will load in iframe - might be better to just die():
    || return $self->error(q!no such query param 'template'!);

    # create unique filename (username + time-based entity):
    my $filename = join '.',
        $self->authen->username, ( unpack "H*", pack "NS", time, $$ );
    my $temp_file = join '/', $self->cfg->{tmpdir}, $filename; # warn Dumper $temp_file;

    my $fh = $self->query->upload('template'); # CGI method

    { # create temp file:
        my $buffer;
        while ( read( $fh, $buffer, 16_384 ) ) {
            io($temp_file)->append($buffer);
        }
        close $fh;
    }
    # read temp file into $contents:
    my $contents = io($temp_file)->slurp;
    # delete temp file:
    io($temp_file)->unlink;

=begin # causes circular ref - why ?? - see local cgiapp_init() above
    $self->tt_params( file_contents => $contents );
    
    my $tt = $self->tt_process('result/template.tt');
    # $self->debug($contents); $self->debug(${$tt}); # both same, so return $contents
    return $tt;
=cut
    return $contents;
}

# ------------------------------------------------------------------------------
sub add_word : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	my $word = $self->param('id'); # warn $word;
    
    # force to lowercase if word begins with CAPS eg Myeloma:
    if ( $word =~ /^[A-Z][a-z]+/ ) {
        $word = lc $word;
    }

    my $speller = $self->speller();

    my $result = $speller->add_to_personal($word) ? 'OK' : $speller->errstr;

    $speller->save_all_word_lists;

	return $self->tt_process('report/speller_update.tt', { result => $result });	
}

# ------------------------------------------------------------------------------
sub check_date_valid : Runmode { # jQuery validation ajax call
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	# key is field name, which is variable (eg start_date => 1/1/1900)
	my ($v, $date) = $self->query->Vars(); # warn Dumper [$v,$date];
	
    return LIMS::Local::Utils::check_date($date); # true if valid date
}

# ------------------------------------------------------------------------------
# jQuery validationEngine.js ajax call - returns JSON:
sub jquery_check_value : Runmode { 
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	my $vars = $self->query->Vars(); # warn Dumper $vars; 
	
	my $field = $vars->{validateId}; # pack_due, first_appointment, etc
	my $value = $vars->{validateValue} # will get invalid flag on empty field unless:
		|| return $self->_format_json('true', $vars); 
	
	my $check_date = sub { LIMS::Local::Utils::check_date(@_) };
	my $check_zip  = sub { LIMS::Local::Utils::format_postcode(@_) };
	my $check_any_date # add flag to check_date() to allow future dates:
		= sub { LIMS::Local::Utils::check_date(@_, 1) }; 
	
	my %validation_method = ( # methods must return true if valid:
        return_due        => $check_any_date, # allow future date
		pack_due  	      => $check_any_date, 
        
		deceased  		  => $check_date,
		diagnosis 		  => $check_date,
		palliative_care   => $check_date,
		first_appointment => $check_date,
        
		post_code 		  => $check_zip,
	);	
	
	my $validator = ( $field =~ /date/ ) # assumed to be a date field
		? $check_date
		: $validation_method{$field}; # warn Dumper $validator;

	if (! $validator) {
		warn "no validation method available for field = $field"; # can't pass to form ??
		return $self->_format_json('false', $vars); # persistent fail until fixed
	}

	my $result = &$validator($value) ? 'true' : 'false'; # method returns true if valid
	
	# formats json return & resets header_type to text/html:
	my $json = $self->_format_json($result, $vars); # warn Dumper $json; 
	return $json;
}

# ------------------------------------------------------------------------------
sub jquery_within_range : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	my $vars = $self->query->Vars(); # warn Dumper $vars; 
	
	my ($field) = $vars->{validateId} =~ /\w+?_(.*)/; # warn $vars->{validateId};
	my $value = $vars->{validateValue}; # warn Dumper [$field,$value];
	
	my $d = $self->model('HMRN')->get_defaults_and_ranges($field); # warn Dumper $d;
	
	my $result = (
		( $value >= $d->{min_value} && $value <= $d->{max_value} )
        || grep $value == $_, ($d->{not_stated}, $d->{not_done})
	) ? 'true' : 'false';
	
	# formats json return & resets header_type to text/html:
	my $json = $self->_format_json($result, $vars); # warn Dumper $json; 
	return $json;
}

# ------------------------------------------------------------------------------
# jQuery validationEngine.js ajax call for 'always pass' fields - returns JSON:
sub jquery_dummy_pass : Runmode { 
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	my $vars = $self->query->Vars();
	return $self->_format_json('true', $vars);
}

# ------------------------------------------------------------------------------
sub _format_json {
	my ($self, $result, $vars) = @_; $self->_debug_path();
	
	my $err   = $vars->{validateError}; # warn $err;
	my $field = $vars->{validateId};    # warn $field;

	my $json = $self->json_body({ jsonValidateReturn => [$field, $err, $result] } );
	
	# validateEngine.js expects plain content from php, not json:
	$self->header_add( type => 'text/html' ); # warn Dumper $json; 
	return $json;
}

# ------------------------------------------------------------------------------
sub _db_lookup {
    my $self = shift; $self->_debug_path();
    my $vars = shift; # $self->debug($vars);

    my ($field_name, $val) = %$vars;

    # create lookup table for $field_name to get class/method:
	# if field_name is unique in db (eg group_detail), hash value
	# is scalar (class/method), but for ambiguous field_names (eg name),
	# hash value is arrayref of field_name & class/method:
    my %index = (
    #   field_name         LIMS::DB::class & ::Manager method	
		audit_options       => [ qw(description audit_request_option) ],
		consent_label       => 'consent_option',
		consent_name        => 'consent_option',
		data_type	        => [ qw(description lab_test_result_data_type) ],
		detail			    => 'lab_section_status_option',
#		diagnostic_category => [ qw(description diagnostic_categories) ], # plurals !!
		diagnosis_change    => [ qw(option_name diagnosis_change_option) ],
        error_code          => [ qw(code error_code) ],
#        field_label         => 'lab_test', # uses 3-col key so can't test
        function_detail     => 'user_function',
        function_name       => 'user_function',
        group_detail        => 'user_group',
        group_label         => 'user_group',
        group_name          => 'user_group',
        location_name       => 'user_location',
		national_code		=> 'referrer',
		new_diagnosis		=> [ qw(name diagnosis) ], # non-unique col name
		option_label        => 'additional_option',
		option_name         => 'additional_option',
        organisation_code   => 'referral_source',
		parent_code			=> 'parent_organisation',
		parent_description  => [ qw(description parent_organisation) ],
        ref_source_name     => [ qw(display_name referral_source) ],
        sample_code         => 'specimen',
#		screen_description  => [ qw(description screen) ], # uses 2-col key so can't test
        section_name        => 'lab_section',
		test_status_option  => [ qw( description lab_test_status_option ) ],
        trial_name          => 'clinical_trial',
        username            => 'user',
    );

    my $class_name = $index{$field_name} # or die otherwise error msg ends up in span.ajax_error in tmpl
        || die "no field_name '$field_name' found in Ajax::do_ajax() index table";

    # args for check_exists():
    my %args = (
        vars => $vars,
        func => $class_name,
    );

    my $i = $self->model('Ajax')->check_exists(\%args); # DEBUG $i;

	my $msg = $self->err_msg('not_unique');
    return $i ? $self->_format_as_dfv($msg) : '';
}

# ------------------------------------------------------------------------------
sub _format_as_dfv {
	my $self = shift; $self->_debug_path();
	my $str  = shift;

	my $tmpl = $self->cfg->{dfv_defaults}->{msgs}->{format};
	
	return sprintf $tmpl, $str;
}

# ------------------------------------------------------------------------------
sub _format_as_xml {
    my $self = shift; $self->_debug_path();
    my $args = shift; # warn Dumper $args;

	my $data = $args->{data};
	my $type = $args->{type};

	my %h = ( # dispatch table for all param types
		email_addresses => sub { $self->_format_contact_addr(@_) },
		parent_orgs 	=> sub { $self->_format_parent_orgs(@_)	 },
		clinicians  	=> sub { $self->_format_clinicians(@_) 	 },
		diagnoses   	=> sub { $self->_format_diagnoses(@_)  	 },
		practices		=> sub { $self->_format_practices(@_)    },
		sources     	=> sub { $self->_format_sources(@_)    	 },
	);
	
	my @rs = $h{$type} # return error formatted as <rs> if no method found:
		? $h{$type}->($data)
		: _format_undef($type); # warn Dumper \@rs;
	
    my $results =
        sprintf q!<?xml version="1.0" encoding="utf-8" ?><results>%s</results>!,
			( join '', @rs );
    return $results;
}

# format <rs id="?" info="??">??</rs>
sub _format_rs_html { sprintf q!<rs id="%s" info="%s">%s</rs>!, @_ }

# need to escape any chars like '&' ($q->escapeHTML) or output silently fails:
sub _escape { shift->query->escapeHTML(@_) }

sub _format_undef { # in case method for $type not defined
	my $type = shift;
	return _format_rs_html("", "", qq!ERROR: method undefined for "$type"!);
}

sub _format_practices {
	my ($self, $data) = @_;

	map {
        _format_rs_html(
            '', # id - don't need it
            '', # info - don't need it
            $self->_escape( sprintf '%s, %s [%s]', @$_ ),
		);
	} @$data;
}

sub _format_contact_addr {
	my ($self, $data) = @_;

	map {
        _format_rs_html(
            $_->address,
            '', # info - don't need it
            $self->_escape($_->address),
		);
	} @$data;
}

sub _format_parent_orgs {
	my ($self, $data) = @_;

	map {
        _format_rs_html(
            $_->id,
            $_->parent_code,
            $self->_escape($_->description),
		);
	} @$data;
}

sub _format_diagnoses {
	my ($self, $data) = @_;

	map {
        _format_rs_html(
			$_->id,
			$_->icdo3 || '', 
			$self->_escape($_->name),
		);
	} @$data;
}

sub _format_clinicians {
	my ($self, $data) = @_;
	
	my @ary = map {
        _format_rs_html(
            $_->referrer->national_code,
            $self->_escape($_->hospital_department->display_name),
            $_->referrer->name,
		);
	} @$data;

    # add default unknown clinician code:
    my $referral_type = $self->model('Referrer')->get_referral_type('clinician');
    push @ary, _format_rs_html(
        $referral_type->default_unknown,
		'Unknown department',
		'Unknown clinician',
	);
	return @ary;
}

sub _format_sources {
	my ($self, $data) = @_;

	map {
		_format_rs_html(
			$_->id,
            $_->organisation_code,
            $self->_escape($_->display_name),
		);
	} @$data;
}

# ------------------------------------------------------------------------------
sub _validate_param {
    my $self = shift; $self->_debug_path();
    my $vars = shift; # $self->debug($vars);
	
    # unit number:
    if ( $vars->{unit_number} ) {
        my %data = map {
            $_ => $vars->{$_};
        } qw(last_name first_name unit_number);

        $data{nhs_number} = $vars->{is_valid_nhsno};
        $data{dob} = join '-', map $vars->{'is_valid_'.$_}, qw(year month day);

        my $valid = $self->model('PatientCase')->validate_patient_case(\%data);
    }
	# date fields (request_date or dob):
	elsif (grep $_ =~ /^is_valid_date/, keys %$vars) {
        my %date; # capture is_valid_date_* params, eg is_valid_date_dob_day, etc
        while ( my ($param_name, $val) = each %$vars ) {
            map {
                $date{$_} = $val if $param_name =~ /$_/; # eg is_valid_date_dob_year =~ /year/
            } qw(day month year);
        } # warn Dumper \%date;
		return $self->_validate_date_fields(\%date);
	}
	# request number:
	elsif ( $vars->{is_valid_request_no} ) {
		my $constraints = $self->validate('get_request_number_constraints');
		my $messages    = $self->validate('get_request_number_messages');

		my $field_name = 'is_valid_request_no';

		my $dfv_profile = {
			required => $field_name,
			constraint_methods => {
				$field_name => $constraints,
			},
			msgs => $messages,
		};

        my $result = $self->_dfv_check($dfv_profile);
        return $result;
	}
	# specimen:
    elsif ( $vars->{is_valid_specimen} ) { 
		my $constraints = $self->validate('get_specimen_constraints');
		my $field_name  = 'is_valid_specimen';

		my $dfv_profile = {
			required => $field_name,
			constraint_methods => {
				$field_name => $constraints,
			},
		}; # warn Dumper $dfv_profile;

        my $result = $self->_dfv_check($dfv_profile);
        return $result;
	}
    # post_code:
    elsif ( my $post_code = $vars->{is_valid_post_code} ) {
        my $ok = LIMS::Local::Utils::format_postcode( $post_code );
		my $msg = $self->err_msg('invalid_entry');
		return ! $ok ? $self->_format_as_dfv($msg) : 'OK';        
    }
	# nhs number:
    elsif ( defined $vars->{is_valid_nhsno} ) {
		my $result = $self->_check_nhs_number('is_valid_nhsno'); # DFV object
		my $msg = $self->err_msg('invalid_entry');
		return $result->has_invalid ?
			$self->_format_as_dfv($msg) : 'OK';
    }
	# nhs number unique (and valid):
    elsif ( defined $vars->{is_valid_and_unique_nhsno} ) {
		my $field_name = 'is_valid_and_unique_nhsno';
		my $result = $self->_check_nhs_number($field_name); # DFV object
		
		if ( $result->has_invalid ) { # don't try check_patient_nhs_number_count()
			my $msg = $self->err_msg('invalid_entry');
			return $self->_format_as_dfv($msg);
		}

		my $data = $result->valid; # warn Dumper $data;

		# returns true value if already exists:
		my $nhs_number_exists = $self->model('Patient')
			->check_patient_nhs_number_count($data->{$field_name});
		
		if ( $nhs_number_exists ) {
			my $msg = $self->err_msg('not_unique');
			return $self->_format_as_dfv($msg);
		}
		return 'OK'; # all OK
    }
	# no idea what to do with it:
    else {
        return 'unknown input';
    }
}

# ------------------------------------------------------------------------------
sub _check_nhs_number {
	my ($self, $field_name) = @_;
	
	my $constraints = $self->validate('check_nhsno_is_valid');

	my $dfv_profile = {
		required => $field_name,
		field_filters => {
			$field_name => 'digit', # remove spaces & non-digits
		},
		constraint_methods => {
			$field_name => $constraints,
		},
	};
	my $dfv = $self->_data_formvalidator($dfv_profile); # warn Dumper $dfv;
	return $dfv;
}

# ------------------------------------------------------------------------------
sub _validate_date_fields {
	my $self = shift; $self->_debug_path();
	my $date = shift; # hashref of year, month, day
    
    return if grep $date->{$_} =~ /(dd|mm|yyyy)/, qw(year month day); # JQuery watermark
    # return 'dd-mm-yyyy' if grep ! $date->{$_}, qw(year month day); # require all 3

	{ # require 4-digit year:
		my $msg = $self->err_msg('year_digits');
		return $self->_format_as_dfv($msg) if length $date->{year} != 4;
	}
	{ # check date is valid:
		my $result = FormValidator::Simple->check(
			$date => [
				{ date => [ qw(year month day) ] } => [ 'DATE' ],
			]
		);
		if ($result->has_error) {
			my $msg = $self->err_msg('invalid_date');
			return $self->_format_as_dfv($msg);
		}
	}
	{ # OK, now test for date in future:			
		my $dt = LIMS::Local::Utils::to_datetime($date); # warn Dumper $dt->datetime;
	
		my $msg = $self->err_msg('future_date');
		return $dt > DateTime->now ? $self->_format_as_dfv($msg) : 'OK';
	}
}

# ------------------------------------------------------------------------------
# uses Data::FormValidator::check directly:
sub _data_formvalidator {
    my ($self, $profile) = @_; $self->_debug_path();

	my $dfv_defaults = $self->cfg('dfv_defaults');

	my $dfv = Data::FormValidator->new({}, $dfv_defaults)
        ->check($self->query, $profile); # $self->debug($dfv->msgs);
	return $dfv;
}

# ------------------------------------------------------------------------------
# uses Data::FormValidator::check directly:
sub _dfv_check {
    my ($self, $profile) = @_; $self->_debug_path();

    my $field_name = $profile->{required};

	my $dfv = $self->_data_formvalidator($profile); # $self->debug($dfv);
	return $dfv->has_invalid ? $dfv->msgs->{'error_'.$field_name} : 'OK';
}

=begin # done in Request controller now:
# ------------------------------------------------------------------------------
sub get_practitioners {
        my %args = (
			object_class => 'GeneralPractitioner',
			args_for_search => {
				query => [
					practice_code => $location->organisation_code,
					name => { like => $self->query->param('referrer_name') . '%'},
				],
				sort_by => 'name',
			},
		);

		my $referrers = $self->model('Base')->get_objects(\%args);
		@rs = map {
			sprintf q!<rs id="%s" info="%s">%s</rs>!,
				$_->national_code,
				$_->practice_code,
				$_->name,
		} @$referrers;

		push @rs, q!<rs id="G9999998" info="">[ Unlisted GP ]</rs>!;
    }
}
=cut

=begin
# ------------------------------------------------------------------------------
sub _get_referrers : Runmode {
    my $self = shift;

    my $source_id = $self->query->param('source_id');

    # must be integer only:
    return unless $source_id && $source_id =~ /^\d+$/;

    my $location = $self->model('ReferralSource')->get_referral_source($source_id);

    my %args;

    if ( $location->location_type eq 'hospital' ) {
        my @organisation_code_chars = split '', $location->organisation_code;
        # take 1st 3 chars:
        my $region_prefix = join '', @organisation_code_chars[0..2];

        $args{args_for_search} = {
            query        => [ region_prefix => { like => $region_prefix . '%' } ],
            with_objects => [ qw(clinician hospital_department) ],
            sort_by      => [ qw(clinician.surname clinician.initials) ],
        };
        $args{object_class} = 'ClinicianOrganisation';
    }
    else {
        $args{args_for_search} = {
            query   => [ practice_code => $location->organisation_code ],
            sort_by => 'name',
        };
		$args{object_class} = 'GeneralPractitioner';
    }

    my $referrers = $self->model('Base')->get_objects(\%args);

	my $tmpl = $args{object_class} eq 'ClinicianOrganisation' ?
		'clinicians_list' : 'practitioners_list';

    $self->tt_process('referrer/'.$tmpl.'.tt', { referrers => $referrers });
}
=cut

1;