package LIMS::Controller::Roles::PatientDemographics; use Moose::Role; use SOAP::Lite; use Data::Dumper; use LWP::UserAgent; use XML::Simple qw(:strict); # need to specify ForceArray & KeyAttr if using :strict here sub get_pds_data { my $self = shift; my $args = shift; # warn Dumper $args->{patient}->as_tree(deflate => 0); my $patient = $args->{patient}->as_tree(deflate => 0); # warn Dumper $patient; 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 = ( # data structure with required field format: DoB => 20091207, # $patient->{dob}, NHSNumber => 9450579091, # $patient->{nhs_number}, # Surname => $patient->{last_name}, # Forename => $patient->{first_name}, # Postcode => $patient->{patient_demographic}->{post_code}, # Gender => $patient->{gender}, VitalDataUserID => undef, ); my @attr = ( RootName => 'GetPatientDetails', KeyAttr => '', # required for strict mode NoAttr => 1, # hash key/values represented as nested elements AttrIndent => 1, # attributes printed one-per-line rather than all on one line SuppressEmpty => 0, # skip empty nodes ); my $xml = XMLout(\%h, @attr); warn $xml; my $ua = $self->_user_agent($config); # full url for query: my $ua_url = sprintf 'http://%s:%s', @{$config}{qw/addr port/}; # warn $ua_url; my $soap_url = sprintf 'http://%s', $config->{addr}; # warn $soap_url; my $r; # captures return from query sent to PDS interface =begin =cut eval { # in case we're in off-line testing mode local $SIG{ALRM} = sub { die $self->messages->{pas_timeout} . "\n"; # NB \n required }; alarm 15; my %foo = ( GetPatientDetails => { NHSNumber => 9450584036, DOB => 20110928, }, ); my $soap = SOAP::Lite -> uri('urn:Leeds-Renal.Service') -> proxy($soap_url); my $r = $soap->PatientInterface($xml); # long delay but $r undef # 500 Can't use an undefined value as a HASH reference at [..]/MiniSpine.pm line 63 unless ($r->fault) { print $r->result(); } else { print join ', ', $r->faultcode, $r->faultstring; } # $r = $ua->post( $ua_url, Content_Type => 'text/xml', Content => $xml ); alarm 0; }; # warn $r->error_as_HTML unless $r->is_success; #warn $r->as_string; warn $@ if $@; warn Dumper $r; return $r; } #------------------------------------------------------------------------------- sub _user_agent { my $self = shift; my $config = shift; # use a private var to hold UserAgent object as we can be called >1 per query: # return $self->{__user_agent} if $self->{__user_agent}; # variable: $ua # creates LWP::UserAgent object my $ua = LWP::UserAgent->new; # $ua->timeout(20); # pas server handles this, but need it for off-line testing # variable: $pas_server_address # PAS interface IP (163.160.107.60 = live system, 163.160.104.239/sysdev01 = test system) # my $pas_addr = $config->{pas_address}; # warn $config->{pas_address}; # my $username = $config->{pas_username}; # my $password = $config->{pas_pwd}; # get server IP address from $pas_addr (ie (foo)/bar/etc): # my ($server_ip_addr) = $pas_addr =~ m!\A(.*?)/.*!; # warn $server_ip_addr; # supply port, username & password to PAS interface for authorisation # $ua->credentials( $server_ip_addr . ':80', '', $username, $password ); # add user_agent to $self for _do_query(): # $self->{__user_agent} = $ua; return $ua; } 1; __DATA__ Example: 20091207 9450579091