package LIMS::Controller::Roles::PatientDemographics; use Moose::Role; use Data::Dumper; use XML::Simple qw(:strict); # need to specify ForceArray & KeyAttr if using :strict here use lib '/home/raj/perl-lib'; # PDS classes # PDS::* classes generated using SOAP::WSDL function: # wsdl2perl.pl -b lib -p PDS:: file:RenalWebService.wsdl.xml use PDS::Interfaces::PatientInterface::PatientInterfaceSoap; # SOAP::WSDL classes sub get_pds_data { my $self = shift; my $args = shift; # warn Dumper $args->{patient}->as_tree(deflate => 0); my $patient = $args->{data}->as_tree(deflate => 0); # warn Dumper $patient; my $messages = $args->{msgs}; my $config = $args->{config}; # warn $config->{pds_proxy}; # reformat dob as yyyymmdd if supplied (mandatory field so should be): if ( $patient->{dob} ) { my $str = $patient->{dob}->ymd(''); # string, no spaces $patient->{dob} = $str; } # warn Dumper $patient; my %h = ( NHSNumber => 9450584184, # $patient->{nhs_number}, DOB => 19990716, # $patient->{dob}, # Surname => $some_value, # string # Forename => $some_value, # string # Gender => $some_value, # string # Postcode => $some_value, # string # VitalDataUserID => $some_value, # string ); =begin use SOAP::WSDL::Client; my $urn = 'urn:Leeds-Renal.service/' . 'LTH.Renal.BusinessService.RenalWebService.GetPatientDetails'; my %method = ( soap_action => $urn, operation => 'GetPatientDetails', style => 'document', use => 'literal', ); my @parts = %h; warn Dumper \@parts; my $soap = SOAP::WSDL::Client->new({ proxy => $config->{pds_proxy} }); my $result2 = $soap->call( \%method, [] ); warn Dumper $result2; =cut my $pds = PDS::Interfaces::PatientInterface::PatientInterfaceSoap->new(); $pds->set_proxy($config->{pds_proxy}); # dev server can't find 'regint' my $result; eval { # in case we're in off-line testing mode local $SIG{ALRM} = sub { warn $messages->{pas_timeout} . "\n"; # NB \n required }; alarm 15; $result = $pds->GetPatientDetails(\%h); # warn $result; return $result if not $result; # see docs for reasons for stupid syntax alarm 0; }; # warn Dumper $result; # parse XML return: my $data = $self->_process_pds_response($result); # warn Dumper $data; return $data; } sub _process_pds_response { my $self = shift; my $xml = shift; my $ref = XMLin($xml, ForceArray => 0, KeyAttr => ''); # warn Dumper $o; my $patient = $ref->{GetPatientDetailsResult}; # hashref my %data = ( prefix => $patient->{Prefix}, first_name => $patient->{GivenName1}, middle_name => $patient->{GivenName2}, last_name => $patient->{FamilyName}, post_code => $patient->{HomePostCode}, ); { # create $data{home_address} attr from non-ref HomeAddr1 .. HomeAddr5 components: my $home_address = join ', ', map $patient->{'HomeAddr'.$_}, grep { ! ref $patient->{'HomeAddr'.$_} } (1 .. 5); # empty field is {} $data{home_address} = $home_address; } return \%data; } 1;