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', unit_number => 'uc', nhs_number => 'digit', # remove spaces & non-digits month => \&remove_jquery_watermark, year => \&remove_jquery_watermark, day => \&remove_jquery_watermark, }, 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', nhs_number => 'digit', # remove spaces & non-digits }, 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 { my @required = qw( last_name first_name day month year gender error_code_id ); my @optional = qw( middle_name nhs_number use_patient_id this_record_only all_records request_id ); return { required => \@required, optional => \@optional, require_some => { # require one from this group: confirm_change => [ 1, qw( all_records this_record_only ) ], }, }; } #------------------------------------------------------------------------------- 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_is_valid(), # mailto => $self->check_secure_email_domain(), # done in C now }, msgs => { constraints => { # foo => $self->messages->{invalid_domain}, # checked in C ::Request now }, }, } } #------------------------------------------------------------------------------- sub new_request { # profile validated OK my $self = shift; # get request_number messages: my $msgs = $self->get_request_number_messages(); # formatted to share with ajax method # add block_reference message: $msgs->{constraints}->{block_reference} = $self->messages->{need_block_ref}; 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', ], field_filters => { specimen => 'uc', }, constraint_methods => { request_number => $self->get_request_number_constraints(), specimen => $self->get_new_request_specimen_constraints(), }, dependency_groups => { # if either filled in, both required: # trial_group => [ qw( trial_id trial_number) ], # using dependencies }, dependencies => { trial_number => 'trial_id', # make trial_id required if trial_no entered }, msgs => $msgs, }; } #------------------------------------------------------------------------------- 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' ], default_user_timeout => [ 'NOT_BLANK', 'INT' ], email_from => [ 'NOT_BLANK', 'EMAIL_LOOSE' ], entries_per_page => [ 'NOT_BLANK', 'INT' ], lab_name_abbreviation => [ 'NOT_BLANK' ], lab_number_prefix => [ 'NOT_BLANK' ], local_network_restriction => [ 'NOT_BLANK', 'INT' ], local_prefix => [ 'NOT_BLANK' ], max_request_number_length => [ 'NOT_BLANK', 'INT' ], 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 specific_year previous_days date_from date_to logic kwd patient_id id ) ], field_filters => { # remove dd/mm/yyyy jQuery watermarks if used: request_month => \&remove_jquery_watermark, request_year => \&remove_jquery_watermark, request_day => \&remove_jquery_watermark, dob_month => \&remove_jquery_watermark, dob_year => \&remove_jquery_watermark, dob_day => \&remove_jquery_watermark, }, dependency_groups => { # if any one field is filled in, they all become required request_dates => [ qw(request_year request_month request_day) ], dob_dates => [ qw(dob_year dob_month dob_day) ], 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}, }, }, } } # used by search() to remove dd, mm & yyyy from date fields: sub remove_jquery_watermark { my $v = shift; # warn $v; $v =~ s/^(dd|mm|yyyy)$//o; # warn $v; $v; # returns expression (maybe empty) } #------------------------------------------------------------------------------- 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; my @required = qw( status clinical_details specimen_quality diagnosis_id comment ); my @optional = qw( authorise general_notes final_diagnosis gross_description teaching option_id followup_option_id maybe_diagnosis_revision confirm_outstanding_tests confirm_outstanding_results _diagnosis_id _have_outstanding_tests _have_outstanding_results ); return { required => \@required, optional => \@optional, dependencies => { _have_outstanding_results => 'confirm_outstanding_results', _have_outstanding_tests => 'confirm_outstanding_tests', _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 is_branch parent_practice_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 ) ], }, is_branch => 'parent_practice_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 sub_category_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) ], }, field_filters => { # remove dd/mm/yyyy jQuery watermarks if used: month => \&remove_jquery_watermark, year => \&remove_jquery_watermark, day => \&remove_jquery_watermark, }, 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->check_param_ownership([ 'username', 'User' ]), last_name => $self->check_username(), # taken from last_name 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 => { username => $self->messages->{username}, 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_id _section_name) ], # _section_name only used with foreign_id optional => [ 'test_id', # investigation/test id(s) 'section_notes', # textarea entry 'lab_section_id', # lab_section.id 'foreign_id', # free text entry (maybe move to results_data_entry) ], } } #------------------------------------------------------------------------------- sub results_data_entry { return { required => [ qw( _section_name _section_id ) ], optional => [ '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 ) ], dependencies => { status_option_id => { 3 => [ 'confirm_delete' ], # 3 = DELETE }, } } } #------------------------------------------------------------------------------- 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', 'cells for flow', '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 force_tmpl 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( diagnosis 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(), diagnosis => $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_imaging { my $self = shift; my $constraint_methods = $self->get_hmrn_param_constraints([ qw/deauville suv_max/ ]); $constraint_methods->{scan_date} = $self->check_EU_date_is_valid(); return { required => [ qw(dataset scan_type scan_stage scan_date) ], optional => [ qw(option_id details suv_max deauville) ], ajax_methods => { # for jQuery ajax call scan_date => 'check_date_valid', }, constraint_methods => $constraint_methods, 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_id 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; my @optional = qw( gp_id practice_id ); return { required => [ qw( address post_code status ) ], # GP can only be selected AFTER practice - default loaded in Model if absent # and practice id not re-submitted when GP submitted: optional => \@optional, require_some => { # require one from this group gp_or_practice => [ 1, @optional ], }, constraint_methods => { post_code => $self->check_post_code_is_valid(), }, } } #------------------------------------------------------------------------------- sub hmrn_myeloid { my $self = shift; my @optional = qw( epo rcm transfusion cytopenias karyotype cd34 ); my @required = qw(splenomegaly hepatomegaly detection_liver detection_spleen wbc hb pcv neutrophils monocytes plts); my $constraint_methods = $self->get_hmrn_param_constraints([ @required, @optional ]); return { required => \@required, optional => \@optional, require_some => { # require at least one from this group mds_or_mpd => [ 1, @optional ], }, 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 }, constraint_methods => $constraint_methods, } } #------------------------------------------------------------------------------- sub hmrn_lymphoid { my $self = shift; my @optional = qw( binet plts stage ); my @required = qw( ecog hb bm wbc sweats lymphs fever albumin wt_loss b2m ct ldh ); my $constraint_methods = $self->get_hmrn_param_constraints([ @required, @optional ]); return { required => \@required, optional => \@optional, require_some => { # require at least one from this group cll_or_non_cll => [ 1, @optional ], }, dependency_groups => { # if any one field is filled in, they all become required cll => [ qw( binet plts ) ], }, constraint_methods => $constraint_methods, } } #------------------------------------------------------------------------------- sub hmrn_plasmacell { my $self = shift; my @required = qw( paraprotein pp_level bence_jones serum_kappa serum_lambda igs bone_disease bone_lesions b2m mri creatinine skeletal_survey hb calcium albumin ); my @optional = (); # none my $constraint_methods = $self->get_hmrn_param_constraints(\@required); return { required => \@required, constraint_methods => $constraint_methods, } } #------------------------------------------------------------------------------- sub hmrn_precursor { return { required => ['cns'] } # the only field - required if data group submitted } #------------------------------------------------------------------------------- sub outreach_questionnaire { my $self = shift; =begin # refactored - all optional now my @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 ); my @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 usual_activity discomfort anxiety health_index ); my @combined = (@required, @optional); # temporary during switch-over return { required => [ ], optional => \@combined, 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' ], }, } =cut my @optional = qw( pain weight_loss night_sweats pain_option_id nodal_option_id opinion mobility self_care usual_activity discomfort anxiety health_index ); return { required => [ ], optional => \@optional, } } #------------------------------------------------------------------------------- sub outreach_demographics { my $self = shift; return { required => [ qw( address post_code practice_id gp_id dispatch_to status ) ], optional => [ qw(contact_number) ], 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( department) ], optional => [ qw(IgA IgG IgM electrophoresis globulin paraprotein) ], }, biochemistry => { required => [ qw( department ) ], optional => [ qw(sodium potassium urea alk_phos albumin phosphate total_protein creatinine calcium bilirubin alt) ], }, 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( department ) ], optional => [ qw(hb wbc plts lymphs) ], }, } } #------------------------------------------------------------------------------- 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_data' ], # composite of status_option_id & position } } =begin sub _build_lab_tests_count { my $self = shift; my $count = $self->models->{get_lab_tests_count}; return $count; } =cut 1;