package LIMS::Model::HMRN;

use Moose;
extends 'LIMS::Model::Base';
with (
	'LIMS::Model::HMRN::Data',
    'LIMS::Model::Roles::Query', # get_sql_with_constraint(), sql_lib()
	'LIMS::Model::HMRN::PrognosticIndicator',
);
use namespace::clean -except => 'meta';

has _patient_id => (is => 'rw', isa => 'Int'); # set in get_all_hmrn_data()

has actions => (
    is      => 'ro',
    isa     => 'ArrayRef[Str]',
	traits  => ['Array'],
    default => sub { [] },
    lazy    => 1,
	handles => {
		add_to_actions => 'push',
		unique_actions => 'uniq', # skip duplicates
		all_actions    => 'elements',
	},
);

__PACKAGE__->meta->make_immutable;

use LIMS::Local::Utils;
use Data::Dumper;
use Data::Printer;

# for Roles (HMRN::Data & HMRN::PrognosticIndicator):
sub patient_id { return shift->_patient_id }
# load test db if running under test mode:
sub hmrn_db { shift->lims_db->database eq 'lims_test' ? 'hmrn_test' : 'hmrn' }
# get query from sql_lib:
sub get_query {
    my ($self, $item) = @_;
    my $sql = $self->sql_lib->retr($item)
        or die "cannot find [$item] in sql library";
    $sql =~ s/hmrn\./hmrn_test./g if $self->hmrn_db =~ /test/;
    return $sql;
}

# ------------------------------------------------------------------------------
sub has_data {
    my ($self, $patient_id) = @_; # warn $patient_id;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

    # minimum data set for hmrn is mdt or chronology:
    for ( qw/event mdt_dates/ ) {
        my $tbl = sprintf '%s.patient_%s', $db_name, $_;
        return 1 if $dbix->select($tbl, 1, { patient_id => $patient_id })->list;
    }
    return 0;
}

# ------------------------------------------------------------------------------
sub get_all_hmrn_data {
    my $self = shift;
	my $args = shift;

	my $vars = $args->{vars}; # supplied if tx_details required

    my $patient_id = $args->{patient_id};
	$self->_patient_id($patient_id); # for HMRN::PrognosticIndicator

    my $data = { # initialise following keys:
		maps   => {},      # options for drop-down menus
		params => {        # data params from categories:
			myeloid => {}, lymphoid => {}, plasmacell => {}, precursor => {},
			indices => {}, # calculated prognostic indicators (IPI, FLIPI, etc)
			comment => {}, # free-text comment
		},
		imaging     => {}, # CT & PET scan data
		event_dates => {},  # event dates
		referrals   => [],  # referral pathway
		antecedent  => {},  # antecedent events
		treatments  => [],  # list of treatment episodes
		all_diagnoses => [], # all (ICDO3+) diagnoses for this patient
		category_has_data => {}, # which dataset(s) we have eg myeloid => nn
		category_has_data_include_shared => {}, # which dataset(s) we have eg myeloid => nn (including shared data)
	};

	{ # get all this patients diagnoses (with an ICDO3 designation):
        my $icdo3_diagnoses = $self->_get_all_icdo3_diagnoses($patient_id); # arrayref
        $data->{all_diagnoses} = $icdo3_diagnoses;
    }
	# dates of MDT meetings:
	$self->mdt_dates($data);
	# event (diagnosed, first appointment, etc) dates:
	$self->event_dates($data);
	# referral pathway:
	$self->referral_pathway($data);
	# antecedent events & previous radio & chemotherapy:
	$self->antecedent_events($data);
	# treatment history:
	$self->treatment($data);
	# laboratory, physiological, etc parameters:
	$self->data_params($data);
	# which dataset(s) do we have:
	$self->dataset_type($data);
	# imaging data (CT & PET scan - nodal & extranodal site involvements):
	$self->imaging_data($data);
	# comments:
	$self->comments($data);
    { # get select option maps (pass vars in case tx_details req'd):
		my $select_option_data = $self->_get_select_option_data($vars);
		$data->{maps} = $select_option_data;
	}
	# calculated prognostic indices (IPI, Ann Arbor, etc):
	$self->calculated_indices($data);

	return $data;
}

#-------------------------------------------------------------------------------
sub get_mdt_data {
	my ($self, $id) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my $data = $dbix->select("$db_name.patient_mdt_dates",
        '*', { id => $id })->hash;
	# inflate 'date' val to DT object:
	$self->inflate_mysql_dates_to_datetime($data, ['date']);
	return $data;
}

#-------------------------------------------------------------------------------
sub get_categories {
	my $self = shift;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my $categories = $dbix->select("$db_name.categories", 'category')->flat;
	return $categories;
}

#-------------------------------------------------------------------------------
sub get_active_params_for_category {
	my ($self, $category) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my $category_params = do {
        my $sql = $self->get_query('hmrn_category_params');
        $dbix->query($sql, $category)->map;
    };
	my $all_params
        = $dbix->select("$db_name.parameters", ['param_name','id'])->map;

	my %map = map {
		$_ => {
			id => $all_params->{$_},
			selected => $category_params->{$_} ? 1 : 0,
		},
	} keys %$all_params; # warn Dumper \%map;
	return \%map;
}

#-------------------------------------------------------------------------------
sub update_category_parameter {
	my $self = shift;
	my $args = shift;

	my $param_ids = $args->{param_ids};
	my $category  = $args->{category};

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my $tbl = "$db_name.category_parameter";

	my $sql = "select id from $db_name.categories where category = ?";
	$dbix->query($sql, $category)->into(my $category_id );

	my $update = sub {
		# clear exsiting params for this category:
		$dbix->delete($tbl, { category_id => $category_id });
		$dbix->insert($tbl, { category_id => $category_id, parameter_id => $_ })
			for @$param_ids;
	};

	my $db = $self->lims_db;  # ie LIMS::DB->new_or_cached;

	my $ok = $db->do_transaction($update);

	# don't need return value unless error:
    return $ok ? 0 : 'update_category_parameter() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub get_imaging_data {
	my ($self, $event_id) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my %h = ( imaging_event_id => $event_id );

	my %data;
	{ # patient_imaging options:
		my $map = $dbix->select("$db_name.patient_imaging_option",
            ['imaging_option_id', 1], \%h )->map;
		$data{options_map} = $map; # warn Dumper $map;
	}
	{ # patient_imaging_other.details:
		my $tbl = "$db_name.patient_imaging_other";
		$dbix->select($tbl, ['details'], \%h)->into(my $details);
		$data{details} = $details; # warn Dumper $details;
	}
	{ # scan date:
        my @fields = qw(id scan_type dataset stage date);
        my $ref = $dbix->select("$db_name.patient_imaging_event",
            \@fields, { id => $event_id })->hash;
    	$self->inflate_mysql_dates_to_datetime($ref, ['date']);

        $data{$_} = $ref->{$_} for @fields;
	}
    { # SUV & deauville data - only exists for pet scan:
        my @cols = qw(param result);
		my $map = $dbix->select("$db_name.patient_pet_score", \@cols, \%h)->map;
		$data{pet_scan_scores} = $map; # warn Dumper $map;
    }
	return \%data;
}

#-------------------------------------------------------------------------------
sub get_referral_data {
	my ($self, $id) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

    my $tbl = "$db_name.patient_referrals";

    my $meta = $self->dbix_get_meta($tbl); # warn Dumper $meta;
   	my @cols = keys %$meta; # warn Dumper \@cols;

	my $data = $dbix->select($tbl, \@cols, { id => $id })->hash;
	# inflate dates:
	my @dates = qw(referral_date date_first_seen);
	$self->inflate_mysql_dates_to_datetime($data, \@dates);

    { # get select option maps:
		my @cols = qw(description id); # same for both tables
		{ # referral_types:
            my $tbl = "$db_name.referral_type_options";
			my $map = $dbix->select($tbl, \@cols)->map;
			$data->{maps}{referral_types} = $map;
		}
		{ # referral_sources:
            my $tbl = "$db_name.referral_source_options";
			my $map = $dbix->select($tbl, \@cols)->map;
			$data->{maps}{referral_sources} = $map;
		}
	} # warn Dumper $data;

	return $data;
}

#-------------------------------------------------------------------------------
sub get_treatment_data {
	my ($self, $id) = @_;

	my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

    my $tbl = "$db_name.patient_treatment";

    my $meta = $self->dbix_get_meta($tbl); # warn Dumper $meta;
   	my @cols = keys %$meta; # warn Dumper \@cols;

	my $data = $dbix->select($tbl, \@cols, { id => $id })->hash;
	# inflate dates:
	$self->inflate_mysql_dates_to_datetime($data, [ qw(start_date end_date) ]);

    { # get select option maps (don't need antecedent data, but all rest req'd):
        my %h = ( tx_type_id => $data->{tx_type_id} ); # supply tx_type_id for select menu:
		my $select_option_data = $self->_get_select_option_data(\%h);
		$data->{maps} = $select_option_data;
	} # warn Dumper $data;

	return $data;
}

#-------------------------------------------------------------------------------
sub get_imaging_options {
    my $self = shift;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my $map = $dbix->select("$db_name.imaging_options", ['description', 'id'])->map;
	return $map;
}

#-------------------------------------------------------------------------------
sub get_treatment_options {
    my $self = shift;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

    my %opts = ();
    {
        my $tx_types = $self->get_tx_type_map;
        $opts{tx_types} = $tx_types;
    }
	{ # unique tx_type_ids from treatment_details table:
		my $sql = qq!select distinct(type_id) from $db_name.treatment_details!;
		my $unique_tx_type_ids = $dbix->query($sql)->flat;
		$opts{tx_type_ids} = $unique_tx_type_ids;
	} # warn Dumper \%opts;

	# -- new lookups hashes to get description from id: - James Doughty
	{
		my $sql = qq!select id, description from $db_name.treatment_types!;
		$opts{tx_lookup_types} = $dbix->query($sql)->map;
	}
	{
		my $sql = qq!select id, description from $db_name.treatment_details!;
		$opts{tx_lookup_details} = $dbix->query($sql)->map;
	}
	#------------------------------

    return \%opts;
}

#-------------------------------------------------------------------------------
sub edit_tx_description {
    my ($self, $vars, $edit_mode_ref, $tx_ids_hashref) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $edit_mode = $$edit_mode_ref;  # dereference edit mode

	my $update = sub {
		if ($edit_mode eq 'TYPE') {
			my $type_id  = $tx_ids_hashref->{type_id};
			my $new_desc = $vars->{tr_type};

			my $table = "$db_name.treatment_types";
			$dbix->update($table,
                { description => $new_desc }, { id => $type_id } );

		}
        elsif ($edit_mode eq 'DETAIL') {
			my $detail_id = $tx_ids_hashref->{detail_id};
			my $new_desc = $vars->{tr_detail};

			my $table = "$db_name.treatment_details";
			$dbix->update($table,
                { description => $new_desc }, { id => $detail_id } );
		}
	};

	my $ok = $db->do_transaction( $update );

	# don't need return value unless error:
	return $ok ? 0 : 'edit_tx_description() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub get_defaults_and_ranges {
	my ($self, $param) = @_;

	my $dbix = $self->lims_dbix;

	my $sql = $self->get_query('hmrn_defaults_and_ranges');

	my $data = $dbix->query($sql, $param)->hash;
	return $data;
}

#-------------------------------------------------------------------------------
sub get_parameter_constraints {
	my $self = shift;

	my $dbix = $self->lims_dbix;

	my $sql = $self->get_query('hmrn_parameter_constraints');

	my $constraints = $dbix->query($sql)->map_hashes('param_name');

	return $constraints;
}

#-------------------------------------------------------------------------------
sub update_params {
    my $self = shift;
    my $args = shift; # warn Dumper $args;

    my $patient_id = $args->{patient_id};
    my $form_data  = $args->{data}; # warn Dumper $form_data;
    my $data_type  = $args->{data_type};

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

    my $params_map;
    { # get param_names for data type:
        my $sql = $self->get_query('hmrn_category_params');
        $params_map = $dbix->query($sql, $data_type)->map; # warn Dumper $params_map;
    }

    # get existing data:
    my $sql = $self->get_query('hmrn_category_patient_params');
    my $data = $dbix->query($sql, $patient_id, $data_type)->map; # warn Dumper $data;

	my $table = "$db_name.patient_params";

	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $tx = sub {
		if (%$data) { # update of existing:
			no warnings 'uninitialized';
			PARAM:
			while ( my ($param_name, $param_id) = each %$params_map ) {
				my $new = $form_data->{$param_name}; # warn Dumper $new;
				my $old = $data->{$param_name};      # warn Dumper $old;

				next PARAM if $new eq $old; # both same or both null

				my %params = (
					patient_id => $patient_id,
					param_id   => $param_id,
				); # need to test for defined values to handle zeros:
				if (defined $new && ! defined $old) { # add new param:
					$dbix->insert($table, { %params, result => $new });
					$self->add_to_actions("added new $param_name value");
				}
				elsif (defined $old && ! defined $new) { # delete record:
					$dbix->delete($table, \%params);
					$self->add_to_actions("deleted $param_name value");
				}
				else { # $new ne $old, so update result:
					$dbix->update($table, { result => $new }, \%params );
					$self->add_to_actions(
						"updated $param_name value [$old -> $new]"
					);
				}
			}
		}
		else { # new data:
			PARAM:
			while ( my ($param_name, $param_id) = each %$params_map ) {
				defined $form_data->{$param_name} || next PARAM; # maybe '0'

				my %data = (
					patient_id => $patient_id,
					param_id   => $param_id,
					result 	   => $form_data->{$param_name},
				); # warn Dumper \%data;
				$dbix->insert($table, \%data);
			}
			$self->add_to_actions("added new $data_type data set");
		}
		$self->do_history($patient_id);
	};

	my $ok = $db->do_transaction($tx);

	# don't need return value unless error:
    return $ok ? 0 : 'update_params_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub new_imaging_data {
	my $self = shift;
	my $args = shift; # warn Dumper $args;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $to_mysql_date = sub { # for imaging_event
		LIMS::Local::Utils::to_datetime_using_datecalc(@_)->ymd;
	};

	my $new = sub {
		my $event_id; # set below:
        { # imaging event:
            my $tbl = "$db_name.patient_imaging_event";

			my %h = map +($_ => $args->{$_}), qw(patient_id dataset scan_type); # warn Dumper \%h;
			$h{stage} = $args->{scan_stage};
			$h{date} = &$to_mysql_date($args->{scan_date});

			$dbix->insert($tbl, \%h);
            $event_id = $dbix->dbh->last_insert_id( undef, undef, $tbl, 'id' );
		}
		if ( $args->{option_id} ) { # patient_imaging options:
			# option_id MUST be arrayref (single val passed as scalar):
			my $option_id = ref $args->{option_id} eq 'ARRAY'
				? $args->{option_id} : [ $args->{option_id} ];

			for (@$option_id) {
				my %h = (imaging_event_id => $event_id, imaging_option_id => $_);
				$dbix->insert("$db_name.patient_imaging_option", \%h);
			}
		}
		if ( my $details = $args->{details} ) { # patient_imaging_other:
			my %h = ( imaging_event_id => $event_id, details => $details );
			$dbix->insert("$db_name.patient_imaging_other", \%h);
		}
        PARAM: for my $p( qw/suv_max deauville/ ) { # pet scan opts
            my $result = $args->{$p} or next PARAM;
            my %h = (
                imaging_event_id => $event_id, param => $p, result => $result,
            );
            $dbix->insert("$db_name.patient_pet_score", \%h);
        }

		my $str = sprintf 'added new %s scan dataset', uc $args->{scan_type};
		$self->add_to_actions($str);
		$self->do_history($args->{patient_id});
	};

	my $ok = $db->do_transaction($new);

	# don't need return value unless error:
    return $ok ? 0 : 'new_imaging_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub new_referral_data {
	my $self = shift;
	my $args = shift; # warn Dumper $args;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $tbl = "$db_name.patient_referrals";

	my $meta = $self->dbix_get_meta($tbl); # warn Dumper $meta;

	my @cols = grep { $_ !~ /\A(id|timestamp)\Z/ } keys %$meta; # warn Dumper \@cols;
	my @date_cols = grep { $meta->{$_}->{type} eq 'date' } keys %$meta; # warn Dumper \@date_cols;

	my %data = map {
		$_ => $args->{$_};
	} grep $args->{$_}, @cols;

	map { # transform EU dates to MySQL format:
		$data{$_} = LIMS::Local::Utils::date_to_mysql($data{$_})
	} @date_cols; # warn Dumper \%data;

	my $new = sub {
		$dbix->insert($tbl, \%data);
		$self->add_to_actions('added new referral dataset');
		$self->do_history($args->{patient_id}); # same as $data{patient_id}
	};

	my $ok = $db->do_transaction($new);

	# don't need return value unless error:
    return $ok ? 0 : 'new_referral_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub new_treatment_data {
	my $self = shift;
	my $args = shift; # warn Dumper $args;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $tbl = "$db_name.patient_treatment";

	my $meta = $self->dbix_get_meta($tbl); # warn Dumper $meta;

	my @cols = grep { $_ !~ /\A(id|timestamp)\Z/ } keys %$meta; # warn Dumper \@cols;
	my @date_cols = grep { $meta->{$_}->{type} eq 'date' } keys %$meta; # warn Dumper \@date_cols;

	my %data = map {
		$_ => $args->{$_};
	} grep $args->{$_}, @cols;

	map { # transform EU dates to MySQL format:
		$data{$_} = LIMS::Local::Utils::date_to_mysql($data{$_})
	} @date_cols; # warn Dumper \%data;

	my $new = sub {
		$dbix->insert($tbl, \%data);
		$self->add_to_actions('added new treatment dataset');
		$self->do_history($args->{patient_id}); # same as $data{patient_id}
	};

	my $ok = $db->do_transaction($new);

	# don't need return value unless error:
    return $ok ? 0 : 'new_treatment_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub get_tx_type_map {
	my $self = shift;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my $map = $dbix->select("$db_name.treatment_types", [qw/description id/])->map;

	return $map;
}

#-------------------------------------------------------------------------------
sub get_history {
    my ($self, $id) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

    my $sql = qq!select * from $db_name.history h join users u on
        h.user_id = u.id where patient_id = ? order by time!;
    my $data = $dbix->query($sql, $id)->hashes;

    $self->inflate_mysql_timestamp_to_datetime($_, ['time']) for @$data;
    return $data;
}

#-------------------------------------------------------------------------------
sub update_tx_options {
    my ($self, $vars) = @_;

    my $new_tx_detail = $vars->{new_tx_detail};
    my $new_tx_type   = $vars->{new_tx_type};
    my $tx_type_id    = $vars->{tx_type_id};

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

    # possibilities are: new tx_type, new tx_detail (requires tx_type_id), or both:
    my $update = sub {
        if ( $new_tx_type ) {
            my $tbl = $db_name . '.treatment_types';
            my $sql = "select 1 from $tbl where description = ?";
            unless ( $dbix->query($sql, $new_tx_type)->list ) { # check not exists
                $dbix->insert($tbl, { description => $new_tx_type });
                # need to get last_insert_id if also have new_tx_detail:
                if ($new_tx_detail) {
                    $tx_type_id = $dbix->dbh->last_insert_id(
                        undef, undef, $tbl, 'id'
                    );
                }
            }
        }
        if ( $new_tx_detail && $tx_type_id ) { # need tx_type_id to add new:
            my %data = (
                description => $new_tx_detail,
                type_id     => $tx_type_id,
            );
            my $sql = qq!select 1 from $db_name.treatment_details where
                description = ? and type_id = ?!;
            # check combination doesn't already exist:
            unless ( $dbix->query($sql, $new_tx_detail, $tx_type_id)->list ) {
                $dbix->insert("$db_name.treatment_details", \%data);
            }
        }
    };

    my $ok = $db->do_transaction( $update );

	# don't need return value unless error:
    return $ok ? 0 : 'update_tx_options() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_imaging_data {
	my $self = shift;
	my $args = shift; # warn Dumper $args;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $scan_stage = $args->{scan_stage}; # required
	my $option_id  = $args->{option_id};  # scalar || arrayref (optional)
	my $scan_type  = $args->{scan_type};  # required
	my $scan_date  = $args->{scan_date};  # required
	my $event_id   = $args->{event_id};   # required
	my $dataset    = $args->{dataset};    # required
	my $details    = $args->{details};    # optional

    # option_id MUST be arrayref (single val passed as scalar):
    $option_id = [ $option_id ] if $option_id && ref $option_id ne 'ARRAY';
    $option_id ||= []; # warn Dumper $option_id; # set undef to an empty aref f

	# common fields for update & delete:
	my %h = (imaging_event_id => $event_id); # warn Dumper \%h;

	my $to_mysql_date = sub { # for stage_date
		LIMS::Local::Utils::to_datetime_using_datecalc(@_)->ymd;
	};

	my $action = sprintf 'updated %s scan dataset #%s',	uc $scan_type, $dataset;

	my $update = sub {
		{ # update patient_imaging entries:
			my $tbl = "$db_name.patient_imaging_option";
            my $entries = $dbix->select($tbl, 'imaging_option_id', \%h)->flat; # warn Dumper $entries;

            my $diff = LIMS::Local::Utils::get_array_diff($entries, $option_id);
            if ($diff) { # warn $diff; # will be integer equal to number of diffs
                $dbix->delete($tbl, \%h); # delete existing

                if (@$option_id) { # insert new ones (if supplied):
					my %c = %h; # clone to preserve original
                    for (@$option_id) {
                        $c{imaging_option_id} = $_;
                        $dbix->insert($tbl, \%c);
                    }
                }
				$self->add_to_actions($action);
            }
		}
		{ # update patient_imaging_other.details:
			my $tbl = "$db_name.patient_imaging_other";
			my $d = $dbix->select($tbl, 'details', \%h)->list;

			if ($d && not $details) { # delete entry:
				$dbix->delete($tbl, \%h);
				$self->add_to_actions($action);
			}
			elsif ($details && not $d) { # insert new entry:
				my %c = %h; # clone to preserve original
				$c{details} = $details;
				$dbix->insert($tbl, \%c);
				$self->add_to_actions($action);
			}
			elsif ($d && $details && $d ne $details) { # update:
				$dbix->update( $tbl, { details => $details }, \%h );
				$self->add_to_actions($action);
			}
		}
		{ # scan stage & date:
			my $tbl = "$db_name.patient_imaging_event";
			my $data = $dbix->select($tbl,
				['patient_id', 'stage', 'date'], { id => $event_id })->hash;

			my $date = &$to_mysql_date($scan_date); # warn $date;
			# add patient_id to $args for do_history():
			$args->{patient_id} = $data->{patient_id};

			my %h;
			unless ( $date eq $data->{date} ) {
				$h{date} = $date;
			}
			unless ( $scan_stage eq $data->{stage} ) {
				$h{stage} = $scan_stage;
			};
			if (%h){
				$dbix->update($tbl, \%h, { id => $event_id } );
				$self->add_to_actions($action);
			}
		}
        { # pet suv_max & deauville score:
			my $tbl = "$db_name.patient_pet_score";
            for my $param( qw/suv_max deauville/ ) {
                my %h = ( param => $param, imaging_event_id => $event_id );
                my $result = $dbix->select($tbl, 'result', \%h )->list; # warn $result;

                if ($args->{$param} && $result && $args->{$param} ne $result) { # update:
                    $dbix->update($tbl, { result => $result }, \%h);
                    $self->add_to_actions($action);
                }
                elsif ($args->{$param} && ! $result) { # insert:
                    my %c = %h; # clone to preserve original
                    $c{result} = $args->{$param};
                    $dbix->insert($tbl, \%c);
                    $self->add_to_actions($action);
                }
                elsif ($result && ! $args->{$param}) { # delete:
                    my %c = %h; # clone to preserve original
                    $c{result} = $result;
                    $dbix->delete($tbl, \%c);
                    $self->add_to_actions($action);
                }
            }
        }
		$self->do_history($args->{patient_id});
	};

    my $ok = $db->do_transaction( $update );

	# don't need return value unless error:
    return $ok ? 0 : 'update_imaging_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub update_treatment_data {
	my $self = shift;
	my $args = shift; # warn Dumper $args;

    my $db_name = $self->hmrn_db;

	$args->{_tbl} = "$db_name.patient_treatment";
	$args->{_section} = 'treatment';

	my $rtn = $self->update_hmrn_data($args); # returns err or 0
	return $rtn ? 'update_treatment_data() error - ' . $rtn : 0;
}

#-------------------------------------------------------------------------------
sub update_referral_data {
	my $self = shift;
	my $args = shift; # warn Dumper $args;

    my $db_name = $self->hmrn_db;

	$args->{_tbl} = "$db_name.patient_referrals";
	$args->{_section} = 'referral';

	my $rtn = $self->update_hmrn_data($args); # returns err or 0
	return $rtn ? 'update_referral_data() error - ' . $rtn : 0;
}

#-------------------------------------------------------------------------------
sub update_hmrn_data { # shared with update_referral_data, update_treatment_data
	my $self = shift;
	my $args = shift; # warn Dumper $args;

	my $tbl = $args->{_tbl};
	my $row_id = $args->{id};
	my $section = $args->{_section};

	my $meta = $self->dbix_get_meta($tbl); # warn Dumper $meta;

	# get table data cols (ie not PK or timestamp):
	my @cols = grep { $_ !~ /\A(id|timestamp)\Z/ } keys %$meta; # warn Dumper \@cols;
	# date cols:
	my @date_cols = grep $meta->{$_}->{type} eq 'date', keys %$meta; # warn Dumper \@date_cols;

	$args->{$_} = LIMS::Local::Utils::to_datetime_using_datecalc($args->{$_})
		for grep $args->{$_}, @date_cols; # warn Dumper $args;

	my $dbix = $self->lims_dbix;

	my $data = $dbix->select( $tbl, \@cols, { id => $row_id } )->hash; # warn Dumper $data;
	$self->inflate_mysql_dates_to_datetime($data, \@date_cols); # inflate $data dates

	my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $update = sub {
		my @updates = ();
		# non-date cols:
		COL: for my $col(@cols) {
			next COL if $meta->{$col}->{type} eq 'date' # skip date cols - done later
			|| $col eq 'patient_id'; # don't receive data on this col

			my $new = $args->{$col};
			my $old = $data->{$col};

			if ($new && $old && $new ne $old) { # changed
				push @updates, ( $col => $new );
				$self->add_to_actions("updated $section $col [id = $args->{id}]");
			}
			elsif ($new && ! $old) {
				push @updates, ( $col => $new );
				$self->add_to_actions("added new $section $col [id = $args->{id}]");
			}
			elsif ($old && ! $new) {
				push @updates, ( $col => undef );
				$self->add_to_actions("deleted $section $col [id = $args->{id}]");
			}
			else { next COL } # both same or null so skip
		}
		# date cols:
		COL: for my $col(@date_cols) {
			my $new = $args->{$col}; # warn $new->datetime
			my $old = $data->{$col}; # warn $old->datetime

			if ($new && $old) {
				next COL unless DateTime->compare($old, $new); # true if different
				push @updates, ( $col => $new->ymd );
				$self->add_to_actions("updated $section $col [id = $args->{id}]");
			}
			elsif ($new && ! $old) {
				push @updates, ( $col => $new->ymd );
				$self->add_to_actions("added new $section $col [id = $args->{id}]");
			}
			elsif ($old && ! $new) {
				push @updates, ( $col => undef );
				$self->add_to_actions("deleted $section $col [id = $args->{id}]");
			}
			else { next COL } # both null so skip
		}

		if (@updates) { # warn Dumper \@updates; warn Dumper [$self->all_actions];
			$dbix->update($tbl, { @updates }, { id => $args->{id} });
			$self->do_history($data->{patient_id});
		}
	};

	my $ok = $db->do_transaction($update);

	# don't need return value unless error:
    return $ok ? 0 : $db->error;
}

#-------------------------------------------------------------------------------
sub update_mdt_date {
	my $self = shift;
	my $args = shift; # warn Dumper $args;

	my $date = LIMS::Local::Utils::to_datetime_using_datecalc($args->{date});

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $tbl = "$db_name.patient_mdt_dates";

	my $patient_id = $dbix->select("$db_name.patient_mdt_dates",
        'patient_id', { id => $args->{id} } )->list;

	my $update = sub {
		$dbix->update("$db_name.patient_mdt_dates",
			{ date => $date->ymd },
			{ id => $args->{id} }
		);
		$self->add_to_actions("updated mdt date [id = $args->{id}]");
		$self->do_history($patient_id);
	};

	my $ok = $db->do_transaction($update);

	# don't need return value unless error:
    return $ok ? 0 : 'update_mdt_date() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub delete_mdt_date {
	my ($self, $id) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $tbl = "$db_name.patient_mdt_dates";

	my $patient_id
		= $dbix->query("select patient_id from $tbl where id = ?", $id)->list;

	my $delete = sub {
		$dbix->delete($tbl, { id => $id });
		$self->add_to_actions('deleted mdt date');
		$self->do_history($patient_id);
	};

	my $ok = $db->do_transaction($delete);

    # don't need return value unless error:
    return $ok ? 0 : 'delete_mdt_date() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub delete_treatment_data {
	my ($self, $id) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $tbl = "$db_name.patient_treatment";

	my $patient_id = $dbix->select( $tbl, 'patient_id', { id => $id } )->list;

	my $delete = sub {
		$dbix->delete($tbl, { id => $id });
		$self->add_to_actions('deleted treatment data');
		$self->do_history($patient_id);
	};

	my $ok = $db->do_transaction($delete);

    # don't need return value unless error:
    return $ok ? 0 : 'delete_treatment_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub delete_referral_data {
	my ($self, $id) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $tbl = "$db_name.patient_referrals";

	my $patient_id = $dbix->select( $tbl, 'patient_id', { id => $id } )->list;

	my $delete = sub {
		$dbix->delete($tbl, { id => $id });
		$self->add_to_actions('deleted referral dataset');
		$self->do_history($patient_id);
	};

	my $ok = $db->do_transaction($delete);

    # don't need return value unless error:
    return $ok ? 0 : 'delete_referral_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub delete_imaging_data {
	my ($self, $args) = @_; # href (event_id, scan_type)

    my $scan_type = $args->{scan_type};
    my $event_id  = $args->{event_id};

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $main_tbl = "$db_name.patient_imaging_event";
    my @tbls = qw(
        patient_imaging_option
        patient_imaging_other
        patient_pet_score
    );

	my $patient_id
        = $dbix->select( $main_tbl, 'patient_id', { id => $event_id } )->list;

	my $delete = sub {
        $dbix->delete("$db_name.$_", { imaging_event_id => $event_id }) for @tbls;
		$dbix->delete( $main_tbl, { id => $event_id } ); # do main_tbl last

        my $action = sprintf 'deleted imaging dataset (%s)', $scan_type;
		$self->add_to_actions($action);
		$self->do_history($patient_id);
	};

	my $ok = $db->do_transaction($delete);

    # don't need return value unless error:
    return $ok ? 0 : 'delete_imaging_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub delete_section_data {
    my ($self, $args) = @_; # p $args;

    my $patient_id = $args->{patient_id};
    my $section    = $args->{section};

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $table; # hilis4.patient_demographics, or hmrn.*

    my %restriction = ( patient_id => $patient_id ); # restriction common to all

    # if patient_params section, add param_ids to restriction:
    if ( grep $section eq $_, qw/myeloid lymphoid plasmacell precursor/ ) {
        $table = "$db_name.patient_params";

        my $param_id = do {
            my $sql = $self->get_query('hmrn_section_data');
            $dbix->query( $sql, $section )->flat;
        }; # warn Dumper $param_id;
        $restriction{param_id} = $param_id;
    }
    elsif ( $section eq 'antecendent_and_concurrent_events' ) { # two tables:
       $table = [
            "$db_name.patient_prior_therapies", "$db_name.patient_antecedent"
        ];
    }
    elsif ( $section eq 'patient_demographics' ) { # hilis4 table:
        $table = 'patient_demographics';
    }
    else { # hmrn table:
        $table = join '.', $db_name, $section;
    } # p $table;

    my $tx = sub {
        if ( ref $table eq 'ARRAY' ) { # multiple tables:
            $dbix->delete( $_, \%restriction ) for @$table;
        }
        else { # single table:
            $dbix->delete( $table, \%restriction );
        }

        $section =~ s/_/ /g; # for history
        my $action = sprintf 'deleted %s dataset', $section;

        $self->add_to_actions($action);
        $self->do_history($patient_id); # die 'just kidding';
    };

	my $ok = $db->do_transaction($tx);

    # don't need return value unless error:
    return $ok ? 0 : 'delete_param_data() error - ' . $db->error;
}

#-------------------------------------------------------------------------------
sub get_new_diagnoses {
	my $self = shift;
	my $args = shift;

    # get HMRN parent organisation ids:
    my $o = LIMS::DB::LocalNetworkLocation::Manager->get_local_network_locations;
    my @parent_organisation_ids = map { $_->parent_id } @$o;

	# get referral_type.id for practices (saves multi_many_ok flag in query):
	my $ref_type = LIMS::DB::ReferralType->new(description => 'practice')->load;

	my @query = (
		'request_history.action' => 'authorised',
		or => [ # any network hospital or GP practice:
			'parent_organisations.id' => \@parent_organisation_ids,
			'parent_organisations.referral_type_id' => $ref_type->id, # GP's
		],
		or => [ # ICDO3 or MGUS diagnoses:
			'request_report.diagnosis.icdo3' => { like  => '%3' },
			'request_report.diagnosis.name'  => { rlike => 'MGUS' },
		],
	);

	{ # calculate requested duration (previous_week, days, date_range, etc):
		my $constraints = $self->_get_hmrn_new_diagnoses_constraints($args);
		push @query, @$constraints;
	}

	my @tables = qw(parent_organisations request_history diagnoses);
	my %params = ( query => \@query );

	my %data;
	# get count, check not exceeding reasonable number:
	$data{count} = do {
		my $relationships = $self->get_relationships(\@tables);
		local $params{require_objects} = $relationships;
		LIMS::DB::Request::Manager->get_requests_count(%params);
	}; # warn $data{count};
	return \%data if ! $data{count} || $data{count} > 1000;

	$data{cases} = do {
		push @tables, qw( patients diagnostic_categories request_history
			referrers );
		my $relationships = $self->get_relationships(\@tables);
		local $params{require_objects} = $relationships;
        local $params{multi_many_ok} = 1; # required if using diagnostic_categories rel.
		LIMS::DB::Request::Manager->get_requests(%params);
	};
	return \%data;
}

# ------------------------------------------------------------------------------
# get all diagnoses with ICD03 entry (NB includes /1, /3, /6):
sub get_previous_icdo3_diagnoses {
    my ($self, $data) = @_;

    my %patient_ids = map { $_->patient_case->patient_id => 1 } @$data;
    my @pids = keys %patient_ids; # array of unique patient.id's

    my $all_icdo3 = $self->all_icdo3_diagnoses(\@pids); # warn Dumper $previous;

	my %h;
    my @mgus_icdo3 = ( '9765/1', '9761/1' ); # 9769/1 = Primary amyloidosis +/- MGUS

	for (@$all_icdo3) {
		my $icdo3 = $_->request_report->diagnosis->icdo3; # warn Dumper $icdo3;
        my $pid   = $_->patient_case->patient_id;

		# skip case if ICDO3 ends in /1 or /6, and is not MGUS:
		if ( $icdo3 =~ /[16]\Z/ ) {
			next unless grep { $icdo3 eq $_ } @mgus_icdo3;
		}
		my %d = (
			diagnosis => $_->request_report->diagnosis->name,
			icdo3     => $icdo3,
			date      => $_->created_at,
		);
		push @{ $h{$pid} }, \%d;
	}
    return \%h;
}

# ------------------------------------------------------------------------------
sub get_total_request_counts {
    my ($self, $patient_ids) = @_; # warn Dumper $patient_ids;

    my $dbix = $self->lims_dbix;

    my $sql = $self->get_query('hmrn_total_request_counts');
    my $counts = $dbix->query($sql, @$patient_ids)->map; # warn Dumper $counts;
    return $counts;
}

# ------------------------------------------------------------------------------
sub get_patient_demographics {
	my ($self, $patient_id) = @_;

	my $data = LIMS::DB::PatientDemographic->new(patient_id => $patient_id)
		->load( with => [ 'referrer', 'practice' ], speculative => 1 );

	return $data;
}

# ------------------------------------------------------------------------------
sub get_post_code_at_diagnosis {
	my ($self, $patient_id) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

    my $data = $dbix->select("$db_name.patient_post_code",
        'post_code', { patient_id => $patient_id })->list;
	return $data;
}

# ------------------------------------------------------------------------------
sub update_post_code_at_diagnosis {
	my ($self, $data) = @_; # warn Dumper $data;

	my $patient_id = $data->{patient_id}; # warn Dumper $patient_id;
    my $post_code  = $data->{post_code}; # warn Dumper $post_code;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

    my $tbl = "$db_name.patient_post_code";

    my $update = sub {
        my $sql = "select 1 from $tbl where patient_id = ?";
        if ( $dbix->query($sql, $patient_id)->list ) { # warn 'here';
            $dbix->update( $tbl,
                { post_code => $post_code}, { patient_id => $patient_id }
            );
            $self->add_to_actions('updated post-code at diagnosis');
        }
        else { # warn 'here';
            $dbix->insert( $tbl, {
                patient_id => $patient_id,
                post_code  => $post_code,
            });
            $self->add_to_actions('new post-code at diagnosis')
                unless $data->{address}; # don't log if part of original demographics entry
        }
        $self->do_history($patient_id);
    };

	my $ok = $db->do_transaction($update);

	# don't need return value unless error:
    return $ok ? 0 : 'update_post_code_at_diagnosis() error - ' . $db->error;
}

# ------------------------------------------------------------------------------
sub update_comment {
	my ($self, $data) = @_; # warn Dumper $data;

	my $patient_id = $data->{patient_id}; # warn Dumper $patient_id;
	my $form_param = $data->{comment}; # warn Dumper $form_param;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $table = "$db_name.patient_comments";

	my $update = sub {
		my $sql = "select comment from $table where patient_id = ?";

		if ( my $comment = $dbix->query($sql, $patient_id)->list ) { # warn Dumper $comment;
			return 0 if $form_param && $form_param eq $comment; # skip if no change

			if ($form_param) { # have both & they're different so do update:
				$dbix->update($table,
					{ comment => $form_param }, { patient_id => $patient_id }
				);
				$self->add_to_actions('updated comment');
			}
			else { # no form_param so delete:
				$dbix->delete($table, { patient_id => $patient_id });
				$self->add_to_actions('deleted comment');
			}
		}
		elsif ($form_param) { # if have new data:
			$dbix->insert($table,
				{ patient_id => $patient_id, comment => $form_param }
			);
			$self->add_to_actions('added comment');
		}

		$self->do_history($patient_id);
	};

	my $ok = $db->do_transaction($update);

	# don't need return value unless error:
    return $ok ? 0 : 'update_comment() error - ' . $db->error;
}

# ------------------------------------------------------------------------------
sub update_antecedent_events {
	my ($self, $args) = @_; # warn Dumper $args;

	my $patient_id = $args->{patient_id};

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $antecedent_tbl = "$db_name.patient_antecedent";
	my $prior_tx_tbl   = "$db_name.patient_prior_therapies";

	my $therapy_opts = $self->get_enum_opts($prior_tx_tbl, 'therapy'); # ie Rx, Cx

	my %w = ( patient_id => $patient_id ); # common 'where' statement

	my $update = sub {
		{ # antecedent event:
			my $event_id = $args->{event_id}; # required field

			if ( $dbix->select($antecedent_tbl, 'event_id', \%w)->into(my $id) ) { # warn Dumper $data;
				if ( $event_id != $id ) {
					$dbix->update($antecedent_tbl, {event_id => $event_id}, \%w);
					$self->add_to_actions('updated antecedent event');
				}
			}
			else {
				my %data = (
					patient_id => $patient_id,
					event_id   => $event_id,
				);
				$dbix->insert($antecedent_tbl, \%data);
				$self->add_to_actions('added new antecedent event');
			}
		}
		{ # prior therapies:
			my $list = $dbix->select($prior_tx_tbl, 'therapy', \%w)->flat; # warn Dumper $data;

			if (@$list) {
				my %old = map { $_ => 1 } @$list; # create hash for comp. with $args

				foreach my $tx(@$therapy_opts) { # warn Dumper $tx;
					my %data = (
						patient_id => $patient_id,
						therapy    => $tx,
					);

					my $have_new = $args->{$tx}; # will be 1 or 0
					my $have_old = $old{$tx};    # will be 1 or 0

					if ( $have_new && ! $have_old ) { # warn 'have new & not old';
						$dbix->insert($prior_tx_tbl, \%data);
						$self->add_to_actions("added new prior Tx $tx");
					}
					elsif ( $have_old && ! $have_new ) { # warn 'have old & not new';
						$dbix->delete($prior_tx_tbl, \%data );
						$self->add_to_actions("deleted prior Tx $tx entry");
					}
					else { } # old & new both same value or null, so skip
				}
			}
			else {
				foreach my $tx(@$therapy_opts) {
					next unless $args->{$tx};
					my %data = (
						patient_id => $patient_id,
						therapy    => $tx,
					);
					$dbix->insert($prior_tx_tbl, \%data);
					$self->add_to_actions("added new prior Tx $tx");
				}
			}
		}
		$self->do_history($patient_id);
	};

	my $ok = $db->do_transaction($update);

	# don't need return value unless error:
    return $ok ? 0 : 'update_antecedent_events() error - ' . $db->error;
}

# ------------------------------------------------------------------------------
sub update_patient_events {
	my ($self, $args) = @_; # warn Dumper $args; # patient_id + dates

	my $patient_id = $args->{patient_id};

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;
	my $db      = $self->lims_db; # ie LIMS::DB->new_or_cached;

	my $tbl = "$db_name.patient_event";

	my $o = do { # get existing events data:
		my $sql = qq!select t2.description, t1.date from $tbl t1 join
			$db_name.events t2 on t1.event_id = t2.id where t1.patient_id = ?!;
		$dbix->query($sql, $patient_id)->hashes;
	};
	my %data = map +( $_->{description} => $_->{date} ), @$o;

	my $events = $dbix->select("$db_name.events", ['description', 'id'] )->map;

    my $to_mysql_date = sub { LIMS::Local::Utils::date_to_mysql(@_) };
    my $to_datetime = sub { LIMS::Local::Utils::to_datetime_using_datecalc(@_) };

	my $update = sub {
		if (%data) { # update existing:
			EVENT:
			while ( my ($event, $id) = each %$events ) {
				my $new = $args->{$event}; # in EU format
				my $old = $data{$event}; # in MySQL format

				if ( $new && $old ) {
					# convert new to DT object:
					my $dt1 = &$to_datetime($new);
					my $dt2 = $self->inflate_mysql_date_to_datetime($old);
					next EVENT unless DateTime->compare($dt1, $dt2); # true if different

					$dbix->update($tbl, { date => $dt1->ymd },
						{ patient_id => $patient_id, event_id => $id } );
					$self->add_to_actions("updated date $event");
				}
				elsif ( $old && ! $new ) {
					$dbix->delete($tbl,
						{ patient_id => $patient_id, event_id => $id } );
					$self->add_to_actions("deleted date $event");
				}
				elsif ( $new && ! $old ) {
					my %h = (
						patient_id => $patient_id,
						event_id   => $id,
						date       => &$to_datetime($new),
					);
					$dbix->insert($tbl, \%h);
					$self->add_to_actions("added new date $event");
				}
				else { next EVENT } # ignore if no new or old
			}
		}
		else { # add new dataset:
			EVENT:
			while ( my ($event, $id) = each %$events ) {
				my $date = $args->{$event} || next EVENT;

				my %h = (
					patient_id => $patient_id,
					event_id   => $id,
					date       => &$to_mysql_date($date),
				);
				$dbix->insert($tbl, \%h);
			}
			$self->add_to_actions("added new event data");
		}

		# mdt_date always new (not edited):
		if ( my $mdt_date = $args->{mdt_date} ) {
			my $date = &$to_mysql_date($mdt_date);
			my %data = (
				patient_id => $patient_id,
				date       => $date,
			); # warn Dumper \%data;
			$dbix->insert("$db_name.patient_mdt_dates", \%data);
			$self->add_to_actions("added new mdt meeting date");
		}
=begin # synchronise hilis4.patient_demographics.dod field: TODO
        if ( $args->{deceased} ) { # warn $args->{deceased};
            my $dod = &$to_datetime($args->{deceased})->ymd;

            my $sql = 'select * from patient_demographics where patient_id = ?';
            my $h = $dbix->query($sql, $patient_id)->hash; # warn Dumper $h;

            no warnings 'uninitialized'; # %$h vals possibly
            unless ($h->{dod} eq $dod) {
               $dbix->update('patient_demographics', { dod => $dod },
                    { patient_id => $patient_id } );
            }
            unless ($h->{status} eq 'dead') {
               $dbix->update('patient_demographics', { status => 'dead' },
                    { patient_id => $patient_id } );
            }
        }
=cut
		$self->do_history($patient_id);
#		die 'rollover beethoven';
	};

	my $ok = $db->do_transaction($update);

	# don't need return value unless error:
    return $ok ? 0 : 'update_patient_events() error - ' . $db->error;
}

sub do_history {
	my ($self, $patient_id) = @_;

	my @actions = $self->unique_actions; # update_imaging_data can duplicate

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my $user_id = $self->user_profile->{id};

	for my $action(@actions) {
		my %data = (
			patient_id => $patient_id,
			user_id    => $user_id,
			action 	   => $action,
		); # warn Dumper \%data;
		$dbix->insert("$db_name.history", \%data);
	}
}

# ------------------------------------------------------------------------------
sub is_in_outreach {
	my ($self, $patient_id) = @_;

	my $dbix = $self->lims_dbix;

	my $sql = 'select 1 from outreach.patient_dispatch_detail where patient_id = ?';
	return $dbix->query( $sql, $patient_id )->list;
}

# ------------------------------------------------------------------------------
sub get_tx_details_for_tx_type {
	my ($self, $type_id) = @_;

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my $sql = qq!select id, description from $db_name.treatment_details where
		type_id = ? order by description!;
	return $dbix->query( $sql, $type_id )->hashes; # array(ref) of hashes
}

# ----------------------- private methods --------------------------------------
sub _get_hmrn_new_diagnoses_constraints {
	my ($self, $args) = @_;

	# if request for single lab number:
	if ( my $lab_number = $args->{lab_number} ) {
		my ($request_number, $year) = LIMS::Local::Utils::split_labno($lab_number);

		return [ request_number => $request_number, year => $year ];
	}
    # if request for particular request id:
    elsif ( my $request_id = $args->{request_id} ) {
        return [ id => $request_id ];
    }
	# if date range requested:
	elsif ($args->{date_from}) { # date_from is minimun required to trigger date range
        my $start_date
			= LIMS::Local::Utils::to_datetime_using_datecalc($args->{date_from});

		my $end_date
			= $args->{date_to} # date_to is optional
			? LIMS::Local::Utils::to_datetime_using_datecalc($args->{date_to})
			: DateTime->today->ymd; # make it today if not supplied
		# warn Dumper [$start_date, $end_date];

		return [
			'request_history.time' => { gt => $start_date },
			'request_history.time' => { le => $end_date },
		];
	}
	else {
		my $days = $args->{duration} || 7; # value for 'previous_week' param & default
		my $days_ago
			= $self->time_now->subtract( days => $days )->truncate( to => 'day' );

		return [ 'request_history.time' => { gt => $days_ago } ];
	}
}

sub _get_all_icdo3_diagnoses {
    my ($self, $patient_id) = shift;

    my $diagnoses = $self->all_icdo3_diagnoses($patient_id); # arrayref

    # get unique diagnosis list:
    my %unique;
    for (@$diagnoses) {
        my $diagnosis = $_->{request_report}->{diagnosis}->{name};
        $unique{$diagnosis}++;
    }
    return [ keys %unique ];
}

sub _get_select_option_data {
	my $self = shift;
	my $args = shift || {}; # optional - supplied only if tx_details required

    my $db_name = $self->hmrn_db;
	my $dbix    = $self->lims_dbix;

	my %maps = ();

	{ # diagnostic_categories:
		my $diagnostic_categories =
            $dbix->select('diagnostic_categories', ['id' ,'description'])->map;
		$maps{diagnostic_categories} = $diagnostic_categories;
	}

	{ # locations:
        my $tbl = "$db_name.locations";
		my $locations = $dbix->select($tbl, ['location' ,'id'])->map;
		$maps{location} = $locations;
	}
	{ # antecedent events:
        my $tbl = "$db_name.antecedent_events";
		my $antecedent = $dbix->select($tbl, ['event','id'] )->map;
		$maps{antecedent} = $antecedent;
	}
	{ # treatment types:
        my $tbl = "$db_name.treatment_types";
		my $tx_types = $dbix->select($tbl, ['description', 'id'])->map;
		$maps{tx_type} = $tx_types;
	}
	{ # unique tx_type_ids from treatment_details table:
        my $tbl = "$db_name.treatment_details";
		my $ids = $dbix->select($tbl, 'distinct(type_id)')->flat;
		$maps{tx_type_ids} = $ids; # warn Dumper $ids;
	}
	{ # treatment responses:
        my $tbl = "$db_name.response_options";
		my $opts = $dbix->select($tbl, ['description', 'id'])->map;
		$maps{response} = $opts; # warn Dumper $opts;
	}
	{ # parameter validation data:
		my $sql = qq!select * from $db_name.parameters!;
		my $data = $dbix->query($sql)->map_hashes('param_name'); # HoH with keys = param_name

		{ # then modify data to include categories the parameter appears in (JD):
			foreach my $param_name (keys %$data) {
				my $sql = $self->get_query('hmrn_param_categories');
				my @categories = $dbix->query($sql, $param_name)->flat;
				$data->{$param_name}{in_categories} = \@categories;
			}
		}
		$maps{parameters} = $data; # warn Dumper $data;
	}
	{ # parameter menu options:  (vertical tables, instead of from CSV)
		my $sql = $self->get_query('hmrn_parameter_menu_items');
		my $data = $dbix->query($sql)->hashes; # HoH with keys = param_name
		$maps{parameter_menu_items} = $data; # warn Dumper $data;
	}
	# treatment details for treatment_type (if submitted):
	if ( my $tx_type_id = $args->{tx_type_id} ) {
		my $tx_details = $dbix->select( "$db_name.treatment_details",
            [ qw(description id) ], { type_id => $tx_type_id } )->map;
		# tx_details is ajax function in original form, so not loaded in _get_select_option_data()
		$maps{tx_details} = $tx_details;
	}
	{ # imaging_options - need 2 maps: id => { description & option_type } & description => id:
		my $opts = do {
            my @cols = qw( id description option_type );
            $dbix->select("$db_name.imaging_options", \@cols)->map_hashes('id');
        };
        $maps{imaging_options}{map} = $opts; # warn Dumper $data;
		{ # also need description => id:
			my %h = map { $opts->{$_}->{description} => $_ } keys %$opts; # HoH with keys = description
			$maps{imaging_options}{description} = \%h; # warn Dumper \%h;
		}
    }
	{ # referral_types (pathway):
		my @cols = qw(description id);
		my $map = $dbix->select("$db_name.referral_type_options", \@cols)->map;
		$maps{referral_types} = $map;
	}
	{ # referral_sources (pathway):
		my @cols = qw(description id);
		my $map = $dbix->select("$db_name.referral_source_options", \@cols)->map;
		$maps{referral_sources} = $map;
	}
    return \%maps;
}

1;