• Files
• Commits
• Log
• Graph
• Stats

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};
    
    # 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;