package LIMS::Validate;
# returns hashref for Data::FormValidator profile, or arrayref for FormValidator::Simple profile
# uses LIMS::Validate::Roles::ConstraintMethods for constraint_method helpers
use Data::Dumper;
use Moose; # all constraint_method helpers located in:
with 'LIMS::Validate::Roles::ConstraintMethods';
has models => ( is => 'ro', isa => 'HashRef' ); # LIMS::Base::validation_models()
has messages => ( is => 'ro', isa => 'HashRef' ); # $self->cfg('msg')->{dfv_msgs}
has settings => ( is => 'ro', isa => 'HashRef' ); # $self->cfg('settings')
# has lab_tests_count => ( is => 'ro', isa => 'Int', lazy_build => 1 );
__PACKAGE__->meta->make_immutable;
#-------------------------------------------------------------------------------
sub new_patient { # profile validated OK
my $self = shift;
# get js_new_patient() profile:
my $js_new_patient = js_new_patient(); # warn Dumper $js_edit_patient;
my %profile = (
require_some => { # require one from this group
patient_id => [ 1, qw(nhs_number unit_number) ],
},
field_filters => {
last_name => 'lc',
first_name => 'lc',
middle_name => 'lc',
},
constraint_methods => {
nhs_number => $self->join_these(
$self->check_nhsno_is_valid(), # default msg OK
$self->check_nhsno_is_unique(), # name = 'is_unique'
),
year => $self->get_date_constraints(),
},
msgs => {
constraints => {
is_unique => $self->messages->{not_unique},
yyyy_format => $self->messages->{year_digits},
future_date => $self->messages->{future_date},
valid_date => $self->messages->{invalid_date},
},
},
);
map {
$profile{$_} = $js_new_patient->{$_};
} keys %$js_new_patient;
return \%profile;
}
sub js_new_patient {
return {
required => [ qw( last_name first_name day month year gender referral_source_id ) ],
optional => [ qw( middle_name nhs_number patient_number ) ],
};
}
#-------------------------------------------------------------------------------
sub edit_patient { # profile validated OK
my $self = shift;
# get js_edit_patient() profile:
my $js_edit_patient = js_edit_patient(); # warn Dumper $js_edit_patient;
my %profile = (
field_filters => {
last_name => 'lc',
first_name => 'lc',
middle_name => 'lc',
},
constraint_methods => {
nhs_number => $self->join_these(
$self->check_nhsno_is_valid(),
$self->check_param_ownership(['nhs_number','Patient']), # name = 'ownership'
),
year => $self->get_date_constraints(),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
yyyy_format => $self->messages->{year_digits},
future_date => $self->messages->{future_date},
valid_date => $self->messages->{invalid_date},
},
},
);
# add js_edit_patient profile:
map {
$profile{$_} = $js_edit_patient->{$_};
} keys %$js_edit_patient;
push @{ $profile{optional} }, '_record_id'; # required if editing patient
return \%profile;
}
# doesn't support constraint => sub {}
sub js_edit_patient {
return {
required => [
qw( last_name first_name day month year gender error_code_id confirmation )
],
optional => [ qw( middle_name nhs_number use_patient_id ) ],
};
}
#-------------------------------------------------------------------------------
sub email_contacts {
my $self = shift;
# email_contacts uses a 2-col unique key, so need to supply both:
my @fields = qw(type contact_address);
return {
required => [
qw( display_name scope referral_source_id type contact_address
is_active )
],
optional => '_record_id', # for validation of edit submission
constraint_methods => {
contact_address => $self->check_email_is_valid(),
type => $self->check_param_ownership(
[ \@fields, 'EmailContact' ]
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
};
}
#-------------------------------------------------------------------------------
sub email_report {
my $self = shift;
return {
required => [ qw(mailto sender) ],
constraint_methods => {
mailto => $self->check_email_domain(),
},
msgs => {
constraints => {
foo => $self->messages->{invalid_domain},
},
},
}
}
#-------------------------------------------------------------------------------
sub new_request { # profile validated OK
my $self = shift;
return {
required => [ qw( referral_source_id referrer_code request_number specimen ) ],
optional => [
qw( trial_id trial_number external_reference ), # request details
qw( urgent private doi copy_to ), # additional options
qw( storage research treatment monitoring ), # consent
'error_code_id',
],
constraint_methods => {
request_number => $self->get_request_number_constraints(),
specimen => $self->get_specimen_constraints(),
},
msgs => $self->get_request_number_messages(),
dependency_groups => { # if either filled in, both required:
# trial_group => [ qw( trial_id trial_number) ],
},
dependencies => {
trial_number => 'trial_id', # make trial_id required if trial_no entered
}
};
}
#-------------------------------------------------------------------------------
sub change_password { # profile validated OK
my $self = shift;
return $self->get_change_password_profile();
}
#-------------------------------------------------------------------------------
sub js_change_pwd { # only for JavaScript::FormValidator - using FormValidator::Simple for server-side
return {
required => [ qw(old_password new_password new_password_confirm) ],
};
}
#-------------------------------------------------------------------------------
sub change_user_location {
return {
required => [ qw(location_id password) ],
}
}
#-------------------------------------------------------------------------------
sub change_user_email {
my $self = shift;
return {
required => [ qw(email email2 password) ],
constraint_methods => {
email => $self->join_these(
$self->check_email_is_valid(),
$self->check_param_ownership([ 'email', 'User' ]),
),
email2 => $self->check_emails_match(),
},
msgs => {
constraints => {
email_mismatch => 'e-mail addresses do not match',
},
},
}
}
#-------------------------------------------------------------------------------
sub config_settings_profile { # profile not tested in t/validation_profiles/
my $self = shift;
# NB - new entries require entering in settings.txt as blank line
# eg 'some_new_entry='
return [
admin_contact => [ 'NOT_BLANK', 'EMAIL_LOOSE' ],
admin_timeout => [ 'NOT_BLANK', 'INT' ],
application_name => [ 'NOT_BLANK' ],
cfh_downloads => [ 'NOT_BLANK' ],
email_from => [ 'NOT_BLANK', 'EMAIL_LOOSE' ],
entries_per_page => [ 'NOT_BLANK', 'INT' ],
external_user_timeout => [ 'NOT_BLANK', 'INT' ],
internal_user_timeout => [ 'NOT_BLANK', 'INT' ],
lab_name_abbreviation => [ 'NOT_BLANK' ],
lab_number_prefix => [ 'NOT_BLANK' ],
local_network_restriction => [ 'NOT_BLANK', 'INT' ],
local_prefix => [ 'NOT_BLANK' ],
min_char_length => [ 'NOT_BLANK', 'INT' ],
pas_address => [ 'NOT_BLANK' ],
pas_pwd => [ 'NOT_BLANK' ],
pas_username => [ 'NOT_BLANK' ],
print_run_max => [ 'NOT_BLANK', 'INT' ],
require_spell_check => [ 'NOT_BLANK' ],
report_display_notes => [ 'NOT_BLANK' ],
server_username => [ 'NOT_BLANK' ],
service_address => [ 'NOT_BLANK' ],
service_name => [ 'NOT_BLANK' ],
service_telno => [ 'NOT_BLANK' ],
service_url => [ 'NOT_BLANK' ],
smtp => [ 'NOT_BLANK' ],
unreported_duration => [ 'NOT_BLANK', 'INT' ],
valid_recipient_domains => [ 'NOT_BLANK' ],
];
}
sub js_config_settings {
my $self = shift;
my $config_settings = $self->config_settings_profile; # warn Dumper $config_settings;
# convert array(ref) to hash so we can extract keys:
my %cfg = @$config_settings; # warn Dumper [ keys %cfg ];
# required = arrayref of %cfg keys:
return {
required => [ keys %cfg ],
};
}
#-------------------------------------------------------------------------------
sub search { # profile validated OK
my $self = shift;
return {
optional => [ qw(
last_name first_name nhs_number unit_number trial_id trial_number
lab_number specimen_code referral_source_id referrer_name urgent
copy_to external_reference private dob_day dob_month dob_year
request_day request_month request_year date_extend sql_simple_search
logic kwd patient_id id )
],
dependency_groups => { # if any one field is filled in, they all become required
dates => [ qw(year month day) ], # now request_* or dob_*
sql_simple => [ qw(sql_simple_search logic kwd) ],
},
constraint_methods => {
request_year => $self->get_date_constraints('request'), # optional prefix
dob_year => $self->get_date_constraints('dob'), # optional prefix
specimen_code => [ # TODO: join_these() doesn't work here
$self->check_param_length(4), # prohibits multiple specimen search
$self->get_specimen_constraints,
],
nhs_number => $self->check_nhsno_is_valid(),
},
msgs => {
constraints => {
yyyy_format => $self->messages->{year_digits},
future_date => $self->messages->{future_date},
max_length => $self->messages->{alphanumeric},
valid_date => $self->messages->{invalid_date},
},
},
}
}
#-------------------------------------------------------------------------------
sub error_codes { # profile validated OK
my $self = shift;
return {
required => [ qw( code description active ) ],
optional => [
'_record_id', # for error_code validation
'is_unique', # only required for new system err code, not report err codes
],
field_filters => {
code => 'lc',
},
constraint_methods => {
code => $self->check_param_ownership( ['code', 'ErrorCode'] ),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
}
},
}
}
#-------------------------------------------------------------------------------
sub error_codes_config {
my $self = shift;
return {
required => 'type',
optional => 'error_code_id', # collected as arrayref
}
}
#-------------------------------------------------------------------------------
sub report {
my $self = shift;
return {
required => [ qw( status clinical_details specimen_quality diagnosis_id
comment ) ],
optional => [ qw( general_notes gross_description confirm_outstanding
teaching revision _have_outstanding_tests _diagnosis_id
authorise final_diagnosis maybe_diagnosis_revision
followup_option_id) ],
dependencies => {
# _is_diagnosis_revision => 'revision',
_have_outstanding_tests => 'confirm_outstanding',
_want_gross_description => 'gross_description', # might not need this
},
# require reason for changing diagnosis:
constraint_methods => {
_diagnosis_id => $self->check_report_params(),
},
msgs => {
constraints => {
diagnosis_resubmission => $self->messages->{report_confirm},
}
}
}
}
#-------------------------------------------------------------------------------
sub general_notes { # doesn't need validation
return {
optional => [ 'general_notes' ],
}
}
#-------------------------------------------------------------------------------
sub report_error_code {
my $self = shift;
return {
required => [ qw( code description active ) ],
optional => '_record_id', # for error_code validation
}
}
#-------------------------------------------------------------------------------
sub request_error { # profile validated OK
return {
optional => [ qw(error_code_id LIC) ],
require_some => { # require one from this group:
error_group => [ 1, qw(LIC error_code_id) ],
},
}
}
#-------------------------------------------------------------------------------
sub specimens { # profile validated OK
my $self = shift;
my $settings = $self->settings;
my @required = qw( sample_code description active );
push @required, 'sample_type_id' if $settings->{lab_section_sample_type};
return {
required => \@required,
optional => '_record_id', # for sample_code validation
field_filters => {
sample_code => 'uc',
},
constraint_methods => {
sample_code => $self->join_these(
$self->check_param_length(4),
$self->check_no_spaces(),
$self->check_param_ownership( ['sample_code', 'Specimen'] ),
),
},
msgs => {
constraints => {
max_length => $self->messages->{too_long},
no_spaces => $self->messages->{single_word},
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub initial_screen { # profile validated OK
my $self = shift;
my $settings = $self->settings;
my @required = qw(screen_id);
push @required, 'option_id' if $settings->{have_request_audit};
return {
required => \@required,
}
}
#-------------------------------------------------------------------------------
sub referral_sources { # profile validated OK
my $self = shift;
return {
required => [ qw( referral_type organisation_code is_active ) ],
optional => [ qw( parent_organisation_id display_name practice_name
practice_address practice_zip _record_id ) ],
field_filters => {
organisation_code => 'uc',
},
require_some => { # require one from this group
source_name => [ 1, qw(display_name practice_name) ],
},
dependency_groups => { # if any one field is filled in, they all become required
practices => [ qw(practice_name practice_address practice_zip) ],
},
dependencies => {
# if referral_type is hospital, require parent_organisation:
referral_type => {
hospital => [ qw( parent_organisation_id ) ],
},
},
constraint_methods => {
organisation_code => $self->join_these(
$self->check_param_length(6),
$self->check_no_spaces(),
$self->check_param_ownership( ['organisation_code', 'ReferralSource'] ),
),
display_name =>
$self->check_param_ownership( ['display_name', 'ReferralSource'] ),
},
msgs => {
constraints => {
max_length => $self->messages->{too_long},
no_spaces => $self->messages->{single_word},
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub general_practitioners { # edit function only - insufficient to require tests
return {
required => [ qw( name active ) ], # can only modify these 2 fields
field_filters => {
name => 'uc',
},
}
}
#-------------------------------------------------------------------------------
sub new_clinician { # profile validated OK
my $self = shift;
return {
required => [ qw( prefix national_code surname initials_1 referral_source_id
hospital_department_code ) ],
optional => [ qw(initials_2 initials_3 initials_4) ],
field_filters => {
national_code => 'uc',
},
constraint_methods => {
national_code => $self->join_these(
$self->check_no_spaces(),
$self->check_numeric(), # name = 'numeric_format'
$self->check_param_length(7),
),
},
msgs => {
constraints => {
numeric_format => $self->messages->{numbers_only},
max_length => $self->messages->{too_high},
# no_spaces => $self->messages->{single_word}, # default OK
},
},
}
}
#-------------------------------------------------------------------------------
sub edit_referrer { # profile validated OK
my $self = shift;
return {
required => [ qw(name national_code referral_type_id active) ],
optional => '_record_id',
constraint_methods => {
national_code => $self->join_these(
$self->check_referrer_code(), # name = 'referrer_code'
$self->check_param_ownership( ['national_code', 'Referrer'] ),
),
},
msgs => {
constraints => {
referrer_code => $self->messages->{referrer_code},
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub new_location { # profile validated OK
return {
required => [ qw( referral_source_id ) ],
optional => [ qw( unit_number ) ],
}
}
#-------------------------------------------------------------------------------
sub diagnosis { # profile validated OK
my $self = shift;
return {
required => [ qw( name diagnostic_category_id active ) ],
optional => [ qw( icdo3 _record_id ) ],
constraint_methods => {
name => $self->check_param_ownership( ['name', 'Diagnosis'] ),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub diagnostic_categories { # profile validated OK
my $self = shift;
return {
required => [ qw( description category_type active ) ],
optional => '_record_id',
constraint_methods => {
description => $self->check_param_ownership(
['description', 'DiagnosticCategory']
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub diagnosis_context { # validation not required
return {
required => [ qw( diagnosis_id context_warning_id ) ],
}
}
#-------------------------------------------------------------------------------
sub diagnosis_change { # validation not required
return {
required => [ qw( option_name description is_active ) ],
}
}
#-------------------------------------------------------------------------------
sub context_warnings { # validation not required
return {
required => [ qw( description is_active ) ],
}
}
#-------------------------------------------------------------------------------
sub patient_case { # validation not tested
return {
optional => [ 'unit_number' ],
}
}
#-------------------------------------------------------------------------------
sub patient_merge { # validation not tested
return {
require_some => { # require ONE from this group - need to OMIT leading
# digit of arrayref (defaults to 1 anyway) as it gets included in
# $data->valid, which causes fatal error if pat.id = 1 used (eg test suite):
patient_id => [ undef, qw(last_name unit_number dob_year) ],
},
dependency_groups => { # if any one field is filled in, they all become required
dates => [ qw(dob_year dob_month dob_day) ],
},
optional => [ qw(last_name first_name unit_number dob_year dob_month dob_day) ],
}
}
#-------------------------------------------------------------------------------
sub trials { # profile validated OK
my $self = shift;
return {
required => [ qw( trial_name active ) ],
optional => '_record_id',
constraint_methods => {
trial_name => $self->check_param_ownership(
['trial_name', 'ClinicalTrial']
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub screening_terms { # profile validated OK
my $self = shift;
my @fields = qw(description category_id); # 2-col unique key
return {
required => [ qw(description category_id active) ],
optional => '_record_id',
constraint_methods => {
description => $self->check_param_ownership([ \@fields, 'Screen' ]),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
};
}
#-------------------------------------------------------------------------------
sub lab_tests { # profile validated OK
my $self = shift;
# lab_tests uses a 3-col unique key, so need to supply all 3:
my @fields = qw(test_name lab_section_id test_type);
return {
required => [
qw(field_label test_name lab_section_id test_type has_results is_active)
],
optional => '_record_id',
constraint_methods => {
field_label => $self->join_these(
$self->check_param_length(25),
$self->check_param_ownership([ \@fields, 'LabTest' ]),
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
max_length => $self->messages->{too_long},
},
},
};
}
#-------------------------------------------------------------------------------
sub lab_sections { # profile validated OK
my $self = shift;
my $settings = $self->settings;
my @required = qw( section_name has_result_summary has_section_notes
has_test_sign_out has_results_import has_foreign_id is_active );
push @required, 'sample_type_id' if $settings->{lab_section_sample_type};
return {
required => \@required,
optional => '_record_id',
constraint_methods => {
section_name => $self->check_param_ownership(
[ 'section_name', 'LabSection' ]
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
};
}
#-------------------------------------------------------------------------------
sub screen_categories {
my $self = shift;
return {
required => [ qw( name is_active ) ],
optional => '_record_id',
constraint_methods => {
category_name => $self->check_param_ownership(
[ 'name', 'ScreenCategory' ]
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
};
}
#-------------------------------------------------------------------------------
sub result_data_types {
my $self = shift;
return {
required => [ qw( description is_active ) ],
optional => '_record_id',
constraint_methods => {
description => $self->check_param_ownership(
[ 'description', 'LabTestResultDataType' ]
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub parent_organisations { # profile validated OK
my $self = shift;
return {
required => [ qw( parent_code description referral_type ) ],
optional => '_record_id',
field_filters => {
description => 'uc', # needs to be UPPERCASE
parent_code => 'uc',
},
constraint_methods => {
parent_code => $self->join_these(
$self->check_param_length(6),
$self->check_no_spaces(),
$self->check_param_ownership(
[ 'parent_code', 'ParentOrganisation' ]
),
),
description => $self->check_param_ownership(
[ 'description', 'ParentOrganisation' ]
),
},
msgs => {
constraints => {
max_length => $self->messages->{too_long},
ownership => $self->messages->{not_unique},
no_spaces => $self->messages->{single_word},
},
},
};
}
=begin if we need this, move it to Roles::ConstraintMethods
#-------------------------------------------------------------------------------
sub patient_data { # uses lyo.kato DatePlugin (DATE_GREATER_THAN)
return [
{ date => [ qw(year month day) ] } => [ 'DATE' ],
{ grouped => [qw(year month day)] } => [ ['DATE_GREATER_THAN', DateTime->now ] ],
];
}
=cut
#-------------------------------------------------------------------------------
sub patient_search_data { # profile validated OK
my $self = shift;
return {
optional => [ qw(patient_id name year month day patient_no) ], # id from edit_patient rtn
require_some => {
data => [ 1, qw(patient_id name year patient_no) ],
},
dependency_groups => { # if any one field is filled in, they all become required
dates => [ qw(year month day) ],
},
constraint_methods => {
year => $self->get_date_constraints()
},
msgs => {
constraints => {
yyyy_format => $self->messages->{year_digits},
future_date => $self->messages->{future_date},
valid_date => $self->messages->{invalid_date},
},
},
# untaint_all_constraints => 1,
};
}
#-------------------------------------------------------------------------------
sub user_functions { # profile validated OK
my $self = shift;
return {
required => [ qw( function_name function_detail active ) ],
optional => '_record_id',
constraint_methods => {
function_name => $self->join_these(
$self->check_no_spaces(),
$self->check_param_ownership(
[ 'function_name', 'UserFunction' ]
),
),
function_detail => $self->check_param_ownership(
[ 'function_detail', 'UserFunction' ]
),
},
msgs => {
constraints => {
no_spaces => $self->messages->{single_word},
ownership => $self->messages->{not_unique},
},
},
};
}
#-------------------------------------------------------------------------------
sub user_locations { # profile validated OK
my $self = shift;
return {
required => [ qw( location_name active ) ], # email_contact
optional => [ qw( _record_id region_code ) ],
constraint_methods => {
location_name => $self->check_param_ownership(
[ 'location_name', 'UserLocation' ]
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
};
}
#-------------------------------------------------------------------------------
sub user_groups { # profile validated OK
my $self = shift;
return {
required => [ qw( group_name group_label group_detail active ) ],
optional => '_record_id',
constraint_methods => {
group_name => $self->join_these(
$self->check_no_spaces(),
$self->check_param_ownership(
[ 'group_name', 'UserGroup' ]
),
),
group_label => $self->join_these(
$self->check_param_ownership(
[ 'group_label', 'UserGroup' ]
),
),
},
msgs => {
constraints => {
no_spaces => $self->messages->{no_spaces},
ownership => $self->messages->{not_unique},
},
},
};
}
#-------------------------------------------------------------------------------
sub user_details { # profile validated OK
my $self = shift;
my @name = qw(first_name last_name);
return {
required => [
qw( username first_name last_name password user_location_id
designation group_id email active)
],
optional => '_record_id', # for validation of edited user
constraint_methods => {
username => $self->join_these(
$self->check_no_spaces(),
$self->check_param_ownership([ 'username', 'User' ]),
),
first_name => $self->check_param_ownership([ \@name, 'User' ]),
email => $self->join_these(
$self->check_email_is_valid(),
$self->check_param_ownership([ 'email', 'User' ]),
),
},
msgs => {
constraints => {
no_spaces => $self->messages->{no_spaces},
ownership => $self->messages->{not_unique},
},
},
};
}
#-------------------------------------------------------------------------------
sub result_summary_options { # profile validated OK
my $self = shift;
# result_summary_options uses a 2-col unique key, so need to supply both:
my @fields = qw(description lab_section_id);
return {
required => [ qw( description lab_section_id is_active ) ],
optional => [ qw( _record_id ) ],
constraint_methods => {
description => $self->check_param_ownership(
[ \@fields, 'ResultSummaryOption' ]
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub update_results { #
return {
required => [ qw( _section_name _section_id ) ],
optional => [
'test_id', # investigation/test id(s)
'section_notes', # textarea entry
'lab_section_id', # lab_section.id
'foreign_id', # free text entry
'results_summary', # free text entry
'_results_summary', # drop-down entry
'complete_all_tests', # checkbox
],
}
}
#-------------------------------------------------------------------------------
sub update_request { #
my $self = shift;
return {
required => [ qw( error_code_id ) ], # for both data types
optional => [ qw(
unit_number referral_source_id _location_name scope
_referrer referrer_code specimen_code trial_id trial_number urgent
external_reference private doi copy_to storage treatment research
monitoring use_patient_case_id
) ],
dependency_groups => { # if any one field is filled in, they all become required
_request_data => [ qw( _request_data specimen_code _referrer ) ] # _request_data is hidden flag
},
dependencies => {
trial_number => 'trial_id', # make trial_id required if trial_no entered
scope => '_location_name', # referral_source_id only submitted if changed
},
constraint_methods => {
specimen_code => $self->get_specimen_constraints(),
},
}
}
#-------------------------------------------------------------------------------
sub delete_request { # # profile validated OK
return {
required => [ qw( confirm_delete reason ) ],
}
}
=begin # example of message construction which works with JS::DVF
constraints => {
reason => [
{ name => 'no_spaces', constraint => '/^\\S*$/' },
{ name => 'word_chars', constraint => '/^\\w+$/' }
],
},
msgs => {
constraints => {
no_spaces => 'no spaces allowed',
word_chars => 'require word chars',
},
},
=cut
#-------------------------------------------------------------------------------
sub request_audit_options {
my $self = shift;
return {
required => [ qw( description category_id active ) ],
optional => [ qw( _record_id ) ],
constraint_methods => {
description => $self->check_param_ownership(
['description', 'AuditRequestOption']
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub consent_options {
my $self = shift;
return {
required => [ qw( consent_name consent_label is_active ) ],
optional => [ qw( _record_id ) ],
constraint_methods => {
consent_name => $self->join_these(
$self->check_no_spaces(),
$self->check_param_ownership(['consent_name', 'ConsentOption']),
),
consent_label => $self->join_these(
$self->check_no_spaces(),
$self->check_param_ownership(['consent_label', 'ConsentOption']),
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
no_spaces => $self->messages->{single_word},
},
},
}
}
#-------------------------------------------------------------------------------
sub request_options {
my $self = shift;
return {
required => [ qw( option_name option_label is_active ) ],
optional => [ qw( _record_id ) ],
constraint_methods => {
consent_name => $self->join_these(
$self->check_no_spaces(),
$self->check_param_ownership(['option_name', 'RequestOption']),
),
consent_label => $self->join_these(
$self->check_no_spaces(),
$self->check_param_ownership(['option_label', 'RequestOption']),
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
no_spaces => $self->messages->{single_word},
},
},
}
}
#-------------------------------------------------------------------------------
sub request_audit_categories { # profile validated OK
my $self = shift;
return {
required => [ qw( description active ) ],
optional => [ qw( _record_id ) ],
constraint_methods => {
description => $self->check_param_ownership(
['description', 'AuditRequestCategory']
),
},
msgs => {
constraints => {
ownership => $self->messages->{not_unique},
},
},
}
}
#-------------------------------------------------------------------------------
sub referrer_search { # search profile - doesn't need validating
my @fields = qw(name national_code);
return {
optional => \@fields,
require_some => {
data => [ 1, @fields ],
},
}
}
#-------------------------------------------------------------------------------
sub referral_source_search { # search profile - doesn't need validating
my @fields = qw(display_name organisation_code referral_type_id);
return {
optional => \@fields,
require_some => {
data => [ 1, @fields ],
},
}
}
#-------------------------------------------------------------------------------
sub parent_organisation_search { # search profile - doesn't need validating
my @fields = qw(description parent_code referral_type_id);
return {
optional => \@fields,
require_some => {
data => [ 1, @fields ],
},
}
}
#-------------------------------------------------------------------------------
sub phonelog { # profile validated OK
my @optionals = qw( summary comments );
return {
required => [ qw( user_id status contact ) ],
optional => \@optionals,
require_some => {
text => [ 1, @optionals ],
},
}
}
#-------------------------------------------------------------------------------
sub worklist { # profile only used for obtaining form params
my $self = shift;
return {
required => [ qw( lab_section_id ) ],
optional => [
qw( lab_test_id test_status status_option_id lab_number_from sort_by ), # test_id
],
}
}
#-------------------------------------------------------------------------------
sub worklist_update_status {
return {
required => [ qw( user_id status_option_id ) ],
}
}
#-------------------------------------------------------------------------------
sub histology_processing { # just used for valid fields:
return {
required => [ qw(user_id lab_section_id lab_test_id) ], # drop-down & 2 hidden fields
optional => [
qw(frozen_tissue pieces_blocks), # results fields
# status fields:
'initial cut-up', 'prepared dabs', 'final cut-up', 'complete',
],
}
}
#-------------------------------------------------------------------------------
sub histology_staining { # just used for valid fields:
return {
required => [ qw(user_id lab_section_id lab_test_id) ], # drop-down & 2 hidden fields
optional => [
'haematoxylin_eosin', # results fields
# status fields:
'block out', 'microtomy', 'H & E stain', 'giemsa stain', 'QC',
'complete',
],
}
}
#-------------------------------------------------------------------------------
sub histology_immunochemistry { # just used for valid fields:
return {
required => [ qw(user_id lab_section_id lab_test_id) ], # drop-down & 2 hidden fields
optional => [
'haematoxylin_eosin', # results fields
# status fields:
'microtomy', 'ICC staining', 'QC', 'complete',
],
}
}
#-------------------------------------------------------------------------------
sub hmrn_new_diagnoses {
my @fields = qw(previous_week duration date_from date_to lab_number request_id);
return {
optional => \@fields,
require_some => { # require at least one from this group
duration_args => [ 1, @fields ],
},
}
}
#-------------------------------------------------------------------------------
sub hmrn_antecedent {
return {
required => [ 'event_id '],
}
}
#-------------------------------------------------------------------------------
sub hmrn_chronologies {
my $self = shift;
return {
required => [], # none
optional => [ qw( diagnosed first_appointment palliative_care deceased
mdt_date ) ],
constraint_methods => {
first_appointment => $self->check_EU_date_is_valid(),
palliative_care => $self->check_EU_date_is_valid(),
diagnosed => $self->check_EU_date_is_valid(),
deceased => $self->check_EU_date_is_valid(),
mdt_date => $self->check_EU_date_is_valid(),
},
msgs => {
constraints => {
valid_date => $self->messages->{invalid_date},
},
},
}
}
#-------------------------------------------------------------------------------
sub hmrn_mdt_date {
my $self = shift;
return {
required => [ 'date' ],
constraint_methods => {
date => $self->check_EU_date_is_valid(),
},
ajax_methods => { # for jQuery ajax call
date => 'check_date_valid',
},
msgs => {
constraints => {
valid_date => $self->messages->{invalid_date},
},
},
}
}
#-------------------------------------------------------------------------------
sub hmrn_treatment {
my $self = shift;
my $hmrn_treatment_types = $self->models->{hmrn_treatment_types};
# force creation of hashref map:
my $txTypeIdFor = &$hmrn_treatment_types(); # warn Dumper $txTypeIdFor;
my $clinical_trial_id = $txTypeIdFor->{'clinical trial'}; # warn Dumper $clinical_trial_id;
my $chemotherapy_id = $txTypeIdFor->{'chemotherapy'}; # warn Dumper $chemotherapy_id;
return {
required => [ qw( location_id tx_type_id ) ], # minimum data set
optional => [ qw( start_date end_date response tx_detail_id ) ],
constraint_methods => {
start_date => $self->join_these(
$self->check_EU_date_is_valid(),
$self->check_date_order( [ qw(start_date end_date) ] ),
),
end_date => $self->join_these(
$self->check_EU_date_is_valid(),
$self->check_date_order( [ qw(start_date end_date) ] ),
),
},
dependencies => {
# if tx_type = chemoTx or trial, require tx_detail:
tx_type_id => {
$clinical_trial_id => [ qw( tx_detail_id ) ],
$chemotherapy_id => [ qw( tx_detail_id ) ],
},
},
ajax_methods => { # for jQuery ajax call
start_date => 'check_date_valid',
end_date => 'check_date_valid',
},
msgs => {
constraints => {
valid_date => $self->messages->{invalid_date},
date_order => $self->messages->{date_order},
},
},
}
}
#-------------------------------------------------------------------------------
sub hmrn_demographics {
my $self = shift;
return {
required => [ ], # none
optional => [ qw( address post_code status practice_id gp_id ) ],
constraint_methods => {
post_code => $self->check_post_code_is_valid(),
},
}
}
#-------------------------------------------------------------------------------
sub hmrn_myeloid {
my @optionals = qw( epo rcm transfusion cytopenias karyotype cd34 );
return {
required => [ qw(splenomegaly hepatomegaly detection_liver detection_spleen) ],
optional => \@optionals,
require_some => { # require at least one from this group
mds_or_mpd => [ 1, @optionals ],
},
dependency_groups => { # if any one field is filled in, they all become required
mds => [ qw( transfusion cytopenias karyotype cd34 ) ], # MDS fields
mpd => [ qw( epo rcm ) ], # MPD fields
},
}
}
#-------------------------------------------------------------------------------
sub hmrn_lymphoid {
my @optionals = qw( binet plts stage );
return {
required => [
qw( ecog hb bm wbc sweats lymphs fever albumin wt_loss b2m ct ldh )
],
optional => \@optionals,
require_some => { # require at least one from this group
cll_or_non_cll => [ 1, @optionals ],
},
dependency_groups => { # if any one field is filled in, they all become required
cll => [ qw( binet plts ) ],
},
}
}
#-------------------------------------------------------------------------------
sub hmrn_precursor {
return { required => ['cns'] } # the only field - required if data group submitted
}
#-------------------------------------------------------------------------------
sub hmrn_plasmacell {
return {
required => [
qw(
paraprotein pp_level bence_jones serum_kappa serum_lambda igs
bone_disease bone_lesions b2m mri creatinine skeletal_survey
hb calcium albumin
)
],
}
}
#-------------------------------------------------------------------------------
sub outreach_questionnaire {
my $self = shift;
return {
required => [ qw(
hospital_referral
new_medication
serious_infection
weight_loss
night_sweats persistent_night_sweats
rib_pain persistent_rib_pain
back_pain persistent_back_pain
arm_pain persistent_arm_pain
leg_pain persistent_leg_pain
cervical_swelling axillary_swelling
abdominal_swelling inguinal_swelling
location_preference
transport_arrangements
transport_difficulty )
],
optional => [ qw(
weight waiting_duration excessive_wait imperial_stones imperial_pounds
hospital_referral_details new_medication_details monitoring_comments
serious_infection_details transport_difficulty_details swelling_details
mobility self_care_1 self_care_2 discomfort anxiety health_index )
],
require_some => { # require one from this group:
weight => [ 1, qw/weight imperial_stones/ ],
},
dependencies => {
transport_difficulty => { Y => [ 'transport_difficulty_details' ] },
serious_infection => { Y => [ 'serious_infection_details' ] },
hospital_referral => { Y => [ 'hospital_referral_details' ] },
new_medication => { Y => [ 'new_medication_details' ] },
waiting_duration => [ 'excessive_wait' ],
},
}
}
#-------------------------------------------------------------------------------
sub outreach_demographics {
my $self = shift;
return { # TODO: gp_id may need moving to optional for new cases (needs practice_id)
required => [ qw( address post_code status gp_id dispatch_to ) ],
optional => [ qw(contact_number practice_id) ], # practice_id only on new or change
constraint_methods => {
post_code => $self->check_post_code_is_valid(),
},
}
}
#-------------------------------------------------------------------------------
sub outreach_followup {
return {
required => [ 'followup_option_id' ],
optional => [ 'pack_due', 'return_due' ],
}
}
#-------------------------------------------------------------------------------
sub outreach_lab_results {
return {
immunology => {
required => [ qw(paraprotein department) ],
optional => [ qw(IgA IgG IgM electrophoresis globulin) ],
},
biochemistry => {
required => [ qw(creatinine calcium department) ],
optional => [
qw(sodium potassium urea alk_phos albumin phosphate total_protein)
],
},
flow_cytometry => {
required => [
qw(total_b_cells kappa lambda sIg_neg cd5_pos neoplastic_b_cells
total_plasma_cells cd19_neg_pc department)
],
optional => [],
},
haematology => {
required => [ qw(hb wbc plts lymphs department) ],
optional => [],
},
}
}
#-------------------------------------------------------------------------------
sub pre_screen_data {
return {
required => [ qw(surname specimen lab_section_id) ],
optional => [ qw(
plasma_cell b_lymphoid t_lymphoid rituximab outreach stem_cell
) ],
}
}
#-------------------------------------------------------------------------------
sub pre_screen_new {
return {
required => [ qw(specimen lab_section_id) ],
require_some => { # require one from this group
lab_tests => [ 1,
qw(plasma_cell b_lymphoid t_lymphoid rituximab outreach stem_cell)
],
},
}
}
#-------------------------------------------------------------------------------
=begin # passing data from form as lab_test_id_(\d) now:
sub results_data {
my $self = shift;
my $lab_tests_count = $self->lab_tests_count;
return {
optional => [ ( 1 .. $lab_tests_count ) ],
}
}
=cut
#-------------------------------------------------------------------------------
sub lab_test_data_type {
return {
required => [ qw( data_type_id is_active ) ],
}
}
#-------------------------------------------------------------------------------
sub status_options {
return {
required => [ qw(description is_active) ],
}
}
#-------------------------------------------------------------------------------
sub pre_authorisation_check {
return {
required => [ 'diagnosis_id' ],
}
}
#-------------------------------------------------------------------------------
sub lab_test_result_options {
return {
required => [ qw(data_type_id value is_active) ],
optional => '_record_id',
}
}
#-------------------------------------------------------------------------------
sub specimen_lab_test { # doesn't need validating
return {
optional => [ 'specimen_id' ],
}
}
#-------------------------------------------------------------------------------
sub section_status_options { # doesn't need validating
return {
optional => [ 'option_id' ],
}
}
=begin
sub _build_lab_tests_count {
my $self = shift;
my $count = $self->models->{get_lab_tests_count};
return $count;
}
=cut
1;
