XUIAMXML ;BHM/DLR,DRI - IAM ENTERPRISE NEW PERSON PROBABILISTIC SEARCH ;1/20/23 10:39
;;8.0;KERNEL;**731,799**;Jul 10, 1995;Build 3
;;Per VHA Directive 2004-038, this routine should not be modified
;
;Utilizes SPML (Service Provisioning Markup Language) for IAM lookup to
;PSIM (Person Services Identity Management)
;
;**731, VAMPI-8214 (dri) - create api to lookup user by secid and retrieve user traits **799 VAMPI-22625
USER(RETURN,MPIARR) ; - query PSIM to find USER traits
; Input (one of the following):
; MPIARR("samacctnm") = SECURITY ACCOUNT MANAGER/NETWORK USERNAME
; or MPIARR("VAemail") = ACTIVE DIRECTORY USER PRINCIPLE NAME/EMAIL ADDRESS
; or MPIARR("secId") = SECURITY ID
;
; Output (array of traits):
; RETURN("city")=CITY
; RETURN("dob")=DOB (HL7 format)
; RETURN("email")=EMAIL ADDRESS
; RETURN("firstName")=FIRST NAME
; RETURN("gender")=SEX
; RETURN("identityTheft")="N" or "Y"
; RETURN("lastName")=FAMILY (LAST) NAME
; RETURN("mcid")=PSIM MESSAGE CONTROL ID
; RETURN("middleName")=MIDDLE NAME
; RETURN("orgId")=SUBJECT ORGANIZATION
; RETURN("phone")=PHONE NUMBER
; RETURN("pnid")=PERSON NUMBER IDENTIFIED/SSN
; RETURN("postalCode")=ZIP CODE
; RETURN("samacctnm")=SECURITY ACCOUNT MANAGER/NETWORK USERNAME
; RETURN("secId")=SECURITY ID
; RETURN("state")=STATE
; RETURN("street_1")=STREET ADDRESS 1
; RETURN("subjectOrg")=SUBJECT ORGANIZATION
; RETURN("vauid")=VA ACTIVE DIRECTORY UNIQUE ID (for 200AD)
; RETURN("vistaid")=STATION NUMBER|USERID or DUZ^SOURCE ID TYPE^STATION NUMBER^ASSIGNING AUTHORITY| (repeating)
;
; Example calling api:
; S MPIARR("VAemail")="first.lastname@domain.ext"
; or S MPIARR("samacctnm")="VHAMOCLASTNAMEF"
; or S MPIARR("secId")=##########
;
; D USER^XUIAMXML(.RETURN,.MPIARR)
; ZW RETURN ;returns array of traits
;
N MPIXML,MPIXMLR,MPID,MPIPAT K RETURN
S MPIXML=$$SXMLBLD(.MPIARR) ;build spml search request
D POST(MPIXML,.MPIXMLR) ;send spml to psim
I '$D(MPIXMLR) S RETURN="-1^Unable to communicate with the Enterprise Database." Q
D SPARSE(.RETURN,.MPIXMLR) ;parse psim response of returned spml
N MPIFLD F MPIFLD="firstName","middleName","lastName","gender" I $G(RETURN(MPIFLD))?.E1L.E S RETURN(MPIFLD)=$$UP^XLFSTR(RETURN(MPIFLD)) ;insure upper case
Q
;
SNDUSER(RETURN,MPIARR) ; - update PSIM with USER traits
; Input: MPIARR - Array of trait(s) to update
; Output: RETURN - Array of traits psim has
;
N MPIXML,MPIXMLR,MPID,MPIPAT K RETURN
S MPIXML=$$AXMLBLD(.MPIARR) ;build spml for psim
D POST(MPIXML,.MPIXMLR) ;send spml to psim
I '$D(MPIXMLR) S RETURN="-1^Unable to communicate with the Enterprise Database." Q
D SPARSE(.RETURN,.MPIXMLR) ;parse psim response of returned spml
Q
;
QRYUSER(RETURN,MPIARR) ; - query PSIM with additional traits to find USER traits ;**663 - STORY 783347 (dri)
; Input: MPIARR - Array of trait(s) to use for lookup
; Output: RETURN - Array of traits psim has
;
N MPIXML,MPIXMLR,MPID,MPIPAT K RETURN
S MPIXML=$$QXMLBLD(.MPIARR) ;build spml for psim
D POST(MPIXML,.MPIXMLR) ;send spml to psim
I '$D(MPIXMLR) S RETURN="-1^Unable to communicate with the Enterprise Database." Q
D PARSE(.RETURN,.MPIXMLR) ;parse psim response of returned spml
I $O(RETURN(0)) D ;massage returned person(s) data
.N L S L="RETURN" F S L=$Q(@L) Q:L="" S @L=$$STRIP^XLFSTR(@L,"""") ;strip out double quotes
.N CNT,MPIFLD S CNT=0 F S CNT=$O(RETURN(CNT)) Q:'CNT D
..F MPIFLD="firstName","middleName","lastName","gender" I $G(RETURN(CNT,MPIFLD))?.E1L.E S RETURN(CNT,MPIFLD)=$$UP^XLFSTR(RETURN(CNT,MPIFLD)) ;insure upper case
Q
;
ORCHUSER(RETURN,MPIARR) ; - orchestrate USER so SECID is returned ;**663 - STORY 783347 (dri) **799 VAMPI-22625
; Input: MPIARR - Array of trait(s) to use for lookup
; Output: RETURN - Array of traits psim has
;
N MPIXML,MPIXMLR,MPID,MPIPAT K RETURN
S MPIXML=$$OXMLBLD(.MPIARR) ;build spml for psim
D POST(MPIXML,.MPIXMLR) ;send spml to psim
I '$D(MPIXMLR) S RETURN="-1^Unable to communicate with the Enterprise Database." Q
D PARSE(.RETURN,.MPIXMLR) ;parse psim response of returned spml
I $O(RETURN(0)) D ;massage returned person(s) data
.N L S L="RETURN" F S L=$Q(@L) Q:L="" S @L=$$STRIP^XLFSTR(@L,"""") ;strip out double quotes
.N CNT,MPIFLD S CNT=0 F S CNT=$O(RETURN(CNT)) Q:'CNT D
..F MPIFLD="firstName","middleName","lastName","gender" I $G(RETURN(CNT,MPIFLD))?.E1L.E S RETURN(CNT,MPIFLD)=$$UP^XLFSTR(RETURN(CNT,MPIFLD)) ;insure upper case
Q
;
SXMLBLD(MPIARR) ; setup xml to search for user
; Input: MPIARR - Array of traits to search
; Output: XML for the search
; $$SITE^VASITE - IA #10112
;
N MPIXML,MPISITE,QUOTE,MPITHRES,MPIDT,MPIDUZ,MPIPRID
S QUOTE="""",MPISITE=$P($$SITE^VASITE,"^",3),MPIPRID=$P($$PARAM^HLCS2,"^",3),MPIDT=$$FMTHL7^XLFDT($$NOW^XLFDT),MPITHRES=80
I $G(DUZ)>0 S MPIDUZ=$P(^VA(200,DUZ,0),"^") D STDNAME^XLFNAME(.MPIDUZ,"C")
; heading
S MPIXML="<spml:lookupRequest requestID="_QUOTE_516.2018053111223344_QUOTE_" returnData="_QUOTE_"data"_QUOTE_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_">"
I $G(MPIARR("secId"))'="" S MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_MPIARR("secId")_"^PN^200PROV^USDVA"_QUOTE_" targetID="_QUOTE_"not_used"_QUOTE_"/>" ;lookup secid
I $G(MPIARR("secId"))="" S MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_$S($G(MPIARR("VAemail"))'="":MPIARR("VAemail"),1:$G(MPIARR("samacctnm")))_"^PN^200AD^USDVA"_QUOTE_" targetID="_QUOTE_"not_used"_QUOTE_"/>" ;or lookup by vaemail or samacctnm
S MPIXML=MPIXML_"</spml:lookupRequest>"
K MPIARR("MPIVar")
Q MPIXML
;
MSGID() ;
N XUNOW S XUNOW=$$NOW^XLFDT
Q $P($$SITE^VASITE,"^",3)_"."_$P(XUNOW,".",1)_$P(XUNOW,".",2)_$J_$R(999999)
;
AXMLBLD(MPIARR) ; setup xml to add or modify a user
; Input: MPIARR - Array of traits for add or modify
; Output: XML for the add or modify
; $$SITE^VASITE - IA #10112
;
N MPIXML
S MPIXML=$$AXMLBLD^XUIAMXML2(.MPIARR) ;MOVED DUE TO ROUTINE SIZE
Q MPIXML
;
QXMLBLD(MPIARR) ;setup xml for enhanced query of PSIM for user
; Input: MPIARR - Array of traits for enhanced search
; Output: XML for the enhanced search
; $$SITE^VASITE - IA #10112
;
N MPIPRID,MPISITE,MPIXML,QUOTE
S QUOTE="""",MPISITE=$P($$SITE^VASITE,"^",3) ;station number
S MPIPRID=$P($$PARAM^HLCS2,"^",3) ;'p'roduction or 't'est
; heading
S MPIXML="<spml:modifyRequest"_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_" requestID="_QUOTE_$$MSGID()_QUOTE_" targetID="_QUOTE_$P($$SITE^VASITE(),"^",3)_QUOTE_" executionMode="_QUOTE_"synchronous"_QUOTE_">"
S MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_$S($G(MPIARR("VAemail"))'="":MPIARR("VAemail"),1:$G(MPIARR("samacctnm")))_"^PN^200AD^USDVA"_QUOTE_" targetID="_QUOTE_"not_used"_QUOTE_"/>" ;pass vaemail or samacctnm
S MPIXML=MPIXML_"<spml:modification"_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_" modificationMode="_QUOTE_"add"_QUOTE_">"
S MPIXML=MPIXML_"<spml:data>"
S MPIXML=MPIXML_"<spml:user>"
; user data
D IFADD("firstName",.MPIARR,.MPIXML,"spml:firstName")
;D IFADD("middleName",.MPIARR,.MPIXML,"spml:middleName")
D IFADD("lastName",.MPIARR,.MPIXML,"spml:lastName")
;
D IFADD("gender",.MPIARR,.MPIXML,"spml:gender")
D IFADD("dob",.MPIARR,.MPIXML,"spml:dob")
D IFADD("pnid",.MPIARR,.MPIXML,"spml:ssn") ;ssn
;
S MPIXML=MPIXML_"</spml:user>"
S MPIXML=MPIXML_"</spml:data>"
S MPIXML=MPIXML_"<spml:capabilityData>"
S MPIXML=MPIXML_"<spml:operationData requestor="_QUOTE_MPIARR("WHO")_QUOTE_">"
S MPIXML=MPIXML_"</spml:operationData>"
S MPIXML=MPIXML_"</spml:capabilityData>"
S MPIXML=MPIXML_"</spml:modification>"
S MPIXML=MPIXML_"</spml:"_"modifyRequest"_">"
Q MPIXML
;
OXMLBLD(MPIARR) ;setup xml for PSIM to orchestrate user
; Input: MPIARR - Array of traits for orchestration
; Output: XML for the orchestration (a secid should be returned)
; $$SITE^VASITE - IA #10112
;
N MPIPRID,MPISITE,MPIXML,QUOTE
S QUOTE="""",MPISITE=$P($$SITE^VASITE,"^",3) ;station number
S MPIPRID=$P($$PARAM^HLCS2,"^",3) ;'p'roduction or 't'est
; heading
S MPIXML="<spml:addRequest"_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_" requestID="_QUOTE_$$MSGID()_QUOTE_" targetID="_QUOTE_$G(MPIARR("icn"))_QUOTE
S MPIXML=MPIXML_" returnData="_QUOTE_"Identifier"_QUOTE_" executionMode="_QUOTE_"synchronous"_QUOTE_">"
S MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_$G(MPIARR("email"))_"^PN^200AD^USDVA"_QUOTE_" targetID="_QUOTE_$G(MPIARR("icn"))_QUOTE_"/>" ;pass email
S MPIXML=MPIXML_"<spml:data>"
S MPIXML=MPIXML_"<spml:user>"
S MPIXML=MPIXML_"<note>"_$G(MPIARR("note"))_"</note>"
; user data
D IFADD("firstName",.MPIARR,.MPIXML,"spml:firstName")
D IFADD("lastName",.MPIARR,.MPIXML,"spml:lastName")
D IFADD("dob",.MPIARR,.MPIXML,"spml:dob")
D IFADD("pnid",.MPIARR,.MPIXML,"spml:ssn") ;ssn
;
S MPIXML=MPIXML_"</spml:user>"
S MPIXML=MPIXML_"</spml:data>"
S MPIXML=MPIXML_"<spml:capabilityData>"
S MPIXML=MPIXML_"<spml:environment code="_QUOTE_MPIPRID_QUOTE_"/>"
S MPIXML=MPIXML_"<spml:operationData requestor="_QUOTE_MPIARR("WHO")_QUOTE_"/>"
S MPIXML=MPIXML_"</spml:capabilityData>"
S MPIXML=MPIXML_"</spml:"_"addRequest"_">"
Q MPIXML
;
IFADD(MPIVAR,MPIARR,MPIXML,MPIXMLN) ;check if there, if so add it to the XML
; MPIVAR is the MPIARR variable name
; MPIXMLN is the name of the XML to encase
; modifies MPIXML to add if it is there
I $G(MPIARR(MPIVAR))'="" S MPIXML=MPIXML_"<"_MPIXMLN_">"_MPIARR(MPIVAR)_"</"_MPIXMLN_">"
Q
;
SPARSE(MPIDATA,MPIXML) ; - parse the data from user query or user update
; EN^MXMLPRSE - IA #4149
;
K ^TMP($J,"XUIAMXML_PARSE")
N MPICB,MPIUSE,MPIVAR,MPIPAT,MPIALIAS,MPILOC,MPIIDS
S (MPIPAT,MPIIDS)=0
S MPICB("STARTELEMENT")="SE^XUIAMXML",MPICB("CHARACTERS")="VALUE^XUIAMXML"
S ^TMP($J,"XUIAMXML_PARSE",1)=MPIXML
D EN^MXMLPRSE($NA(^TMP($J,"XUIAMXML_PARSE")),.MPICB)
K ^TMP($J,"XUIAMXML_PARSE")
Q
;
SE(MPIN,MPIA) ; - used by the parser for user query or user update to call back with STARTELEMENT
; just to protect the process
S MPIN=$G(MPIN),MPIVAR=""""_MPIN_"""",MPILOC="MPIDATA("
S MPIA("error")=$G(MPIA("error"))
S MPIA("lastName")=$G(MPIA("lastName"))
S MPIA("middleName")=$G(MPIA("middleName"))
S MPIA("firstName")=$G(MPIA("firstName"))
S MPIA("dob")=$G(MPIA("dob"))
S MPIA("pnid")=$G(MPIA("pnid"))
S MPIA("secId")=$G(MPIA("secId"))
S MPIA("dob")=$G(MPIA("dob"))
S MPIA("vistaid")=$G(MPIA("vistaid"))
S MPIA("gender")=$G(MPIA("gender"))
; my variable to protect
;I MPIN="user" S MPIPAT=MPIPAT+1,MPIALIAS=0,MPILOC="MPIDATA("_MPIPAT Q
S MPIUSE=$G(MPIUSE)
; got a business rule error
;I MPIN="RESULT",MPIA("type")="AA",MPIA("subtype")="QE" S MPIDATA("Result")="QE" Q
; don't use these
Q
;
PARSE(MPIDATA,MPIXML) ; - parse the data from additional traits user query
; EN^MXMLPRSE - IA #4149
;
K ^TMP($J,"XUIAMXML_PARSE")
N MPICB,MPIVAR,MPIPAT,MPILOC,MPIIDS
S (MPIPAT,MPIIDS)=0
S MPICB("STARTELEMENT")="SEQ^XUIAMXML",MPICB("CHARACTERS")="VALUE^XUIAMXML"
S ^TMP($J,"XUIAMXML_PARSE",1)=MPIXML
D EN^MXMLPRSE($NA(^TMP($J,"XUIAMXML_PARSE")),.MPICB)
K ^TMP($J,"XUIAMXML_PARSE")
Q
;
SEQ(MPIN,MPIA) ; - used by the parser for additional traits user query to call back with STARTELEMENT
I MPIN="user" S MPIPAT=MPIPAT+1,MPILOC="MPIDATA("_MPIPAT_"," ;Q
I '$D(MPILOC) S MPILOC="MPIDATA(" ;no 'user' traits, an error being returned
S MPIVAR=""""_MPIN_""""
Q
;
VALUE(MPIT) ; - used by the parser to call back with CHARACTERS
S:$D(MPIVAR) @(MPILOC_MPIVAR_")")=MPIT K MPIVAR Q
Q
;
POST(MPIXML,MPIXMLR) ; - post XML to the execute server
; $$GETPROXY^XOBWLIB - IA #5421
N $ETRAP,$ESTACK,SVC
S $ETRAP="DO ERROR^XUIAMXML" ; set error trap
I $D(^XTMP("XUIAMXML_EDIT")) D TEST("OUTGOING",.MPIXML) ; test mode (outgoing)?
S SVC=$$GETPROXY^XOBWLIB("MPI_PSIM_NEW EXECUTE","MPI_PSIM_NEW EXECUTE")
S MPIXMLR=SVC.execute(MPIXML)
; in case debugging needed, save both out and return
I $D(^XTMP("XUIAMXML_DEBUG")) D
.N XUIAMSAVE
.S XUIAMSAVE=$O(^XTMP("XUIAMXML_DEBUG",":"),-1)+1
.S ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,0)=$$NOW^XLFDT
.S ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,"OUT")=MPIXML
.S ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,"RETURN")=MPIXMLR
; test mode (return)?
I $D(^XTMP("XUIAMXML_EDIT")) D TEST("RETURN",.MPIXMLR)
Q
;
ERROR ; - catch errors
; Set ecode to empty to return to calling function
; $$EOFAC^XOBWLIB, ZTER^XOBWLIB - IA #5421
; UNWIND^%ZTER - IA #1621
N MPIERR
S MPIERR=$$EOFAC^XOBWLIB()
D ZTER^XOBWLIB(MPIERR)
S $ECODE=""
D UNWIND^%ZTER
Q
;
TEST(TYPE,MPIXML) ; - call to possibly edit the xml string
; used for testing purposes only.
; production NOT allowed
I $$PROD^XUPROD Q
I $E($G(IOST),1,2)'="C-" Q
N DIC,X,L,T,C,%,%Y
W !!,"Do you want to edit the "_TYPE_" XML"
S %=2 D YN^DICN I %'=1 Q
K ^TMP("XUIAMXML_TEST",$J)
S L=0,T=""
F X=1:1 S C=$E(MPIXML,X) Q:C="" D
. I C="<",T'="" S L=L+1,^TMP("XUIAMXML_TEST",$J,L,0)=T,T=C Q
. S T=T_C
S DIC="^TMP(""XUIAMXML_TEST"",$J,"
D EN^DIWE
S MPIXML=""
S X=0 F S X=$O(^TMP("XUIAMXML_TEST",$J,X)) Q:'X S MPIXML=MPIXML_^TMP("XUIAMXML_TEST",$J,X,0)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUIAMXML 13248 printed Jan 29, 2026@15:08:18 Page 2
XUIAMXML ;BHM/DLR,DRI - IAM ENTERPRISE NEW PERSON PROBABILISTIC SEARCH ;1/20/23 10:39
+1 ;;8.0;KERNEL;**731,799**;Jul 10, 1995;Build 3
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 ;Utilizes SPML (Service Provisioning Markup Language) for IAM lookup to
+5 ;PSIM (Person Services Identity Management)
+6 ;
+7 ;**731, VAMPI-8214 (dri) - create api to lookup user by secid and retrieve user traits **799 VAMPI-22625
USER(RETURN,MPIARR) ; - query PSIM to find USER traits
+1 ; Input (one of the following):
+2 ; MPIARR("samacctnm") = SECURITY ACCOUNT MANAGER/NETWORK USERNAME
+3 ; or MPIARR("VAemail") = ACTIVE DIRECTORY USER PRINCIPLE NAME/EMAIL ADDRESS
+4 ; or MPIARR("secId") = SECURITY ID
+5 ;
+6 ; Output (array of traits):
+7 ; RETURN("city")=CITY
+8 ; RETURN("dob")=DOB (HL7 format)
+9 ; RETURN("email")=EMAIL ADDRESS
+10 ; RETURN("firstName")=FIRST NAME
+11 ; RETURN("gender")=SEX
+12 ; RETURN("identityTheft")="N" or "Y"
+13 ; RETURN("lastName")=FAMILY (LAST) NAME
+14 ; RETURN("mcid")=PSIM MESSAGE CONTROL ID
+15 ; RETURN("middleName")=MIDDLE NAME
+16 ; RETURN("orgId")=SUBJECT ORGANIZATION
+17 ; RETURN("phone")=PHONE NUMBER
+18 ; RETURN("pnid")=PERSON NUMBER IDENTIFIED/SSN
+19 ; RETURN("postalCode")=ZIP CODE
+20 ; RETURN("samacctnm")=SECURITY ACCOUNT MANAGER/NETWORK USERNAME
+21 ; RETURN("secId")=SECURITY ID
+22 ; RETURN("state")=STATE
+23 ; RETURN("street_1")=STREET ADDRESS 1
+24 ; RETURN("subjectOrg")=SUBJECT ORGANIZATION
+25 ; RETURN("vauid")=VA ACTIVE DIRECTORY UNIQUE ID (for 200AD)
+26 ; RETURN("vistaid")=STATION NUMBER|USERID or DUZ^SOURCE ID TYPE^STATION NUMBER^ASSIGNING AUTHORITY| (repeating)
+27 ;
+28 ; Example calling api:
+29 ; S MPIARR("VAemail")="first.lastname@domain.ext"
+30 ; or S MPIARR("samacctnm")="VHAMOCLASTNAMEF"
+31 ; or S MPIARR("secId")=##########
+32 ;
+33 ; D USER^XUIAMXML(.RETURN,.MPIARR)
+34 ; ZW RETURN ;returns array of traits
+35 ;
+36 NEW MPIXML,MPIXMLR,MPID,MPIPAT
KILL RETURN
+37 ;build spml search request
SET MPIXML=$$SXMLBLD(.MPIARR)
+38 ;send spml to psim
DO POST(MPIXML,.MPIXMLR)
+39 IF '$DATA(MPIXMLR)
SET RETURN="-1^Unable to communicate with the Enterprise Database."
QUIT
+40 ;parse psim response of returned spml
DO SPARSE(.RETURN,.MPIXMLR)
+41 ;insure upper case
NEW MPIFLD
FOR MPIFLD="firstName","middleName","lastName","gender"
IF $GET(RETURN(MPIFLD))?.E1L.E
SET RETURN(MPIFLD)=$$UP^XLFSTR(RETURN(MPIFLD))
+42 QUIT
+43 ;
SNDUSER(RETURN,MPIARR) ; - update PSIM with USER traits
+1 ; Input: MPIARR - Array of trait(s) to update
+2 ; Output: RETURN - Array of traits psim has
+3 ;
+4 NEW MPIXML,MPIXMLR,MPID,MPIPAT
KILL RETURN
+5 ;build spml for psim
SET MPIXML=$$AXMLBLD(.MPIARR)
+6 ;send spml to psim
DO POST(MPIXML,.MPIXMLR)
+7 IF '$DATA(MPIXMLR)
SET RETURN="-1^Unable to communicate with the Enterprise Database."
QUIT
+8 ;parse psim response of returned spml
DO SPARSE(.RETURN,.MPIXMLR)
+9 QUIT
+10 ;
QRYUSER(RETURN,MPIARR) ; - query PSIM with additional traits to find USER traits ;**663 - STORY 783347 (dri)
+1 ; Input: MPIARR - Array of trait(s) to use for lookup
+2 ; Output: RETURN - Array of traits psim has
+3 ;
+4 NEW MPIXML,MPIXMLR,MPID,MPIPAT
KILL RETURN
+5 ;build spml for psim
SET MPIXML=$$QXMLBLD(.MPIARR)
+6 ;send spml to psim
DO POST(MPIXML,.MPIXMLR)
+7 IF '$DATA(MPIXMLR)
SET RETURN="-1^Unable to communicate with the Enterprise Database."
QUIT
+8 ;parse psim response of returned spml
DO PARSE(.RETURN,.MPIXMLR)
+9 ;massage returned person(s) data
IF $ORDER(RETURN(0))
Begin DoDot:1
+10 ;strip out double quotes
NEW L
SET L="RETURN"
FOR
SET L=$QUERY(@L)
if L=""
QUIT
SET @L=$$STRIP^XLFSTR(@L,"""")
+11 NEW CNT,MPIFLD
SET CNT=0
FOR
SET CNT=$ORDER(RETURN(CNT))
if 'CNT
QUIT
Begin DoDot:2
+12 ;insure upper case
FOR MPIFLD="firstName","middleName","lastName","gender"
IF $GET(RETURN(CNT,MPIFLD))?.E1L.E
SET RETURN(CNT,MPIFLD)=$$UP^XLFSTR(RETURN(CNT,MPIFLD))
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
ORCHUSER(RETURN,MPIARR) ; - orchestrate USER so SECID is returned ;**663 - STORY 783347 (dri) **799 VAMPI-22625
+1 ; Input: MPIARR - Array of trait(s) to use for lookup
+2 ; Output: RETURN - Array of traits psim has
+3 ;
+4 NEW MPIXML,MPIXMLR,MPID,MPIPAT
KILL RETURN
+5 ;build spml for psim
SET MPIXML=$$OXMLBLD(.MPIARR)
+6 ;send spml to psim
DO POST(MPIXML,.MPIXMLR)
+7 IF '$DATA(MPIXMLR)
SET RETURN="-1^Unable to communicate with the Enterprise Database."
QUIT
+8 ;parse psim response of returned spml
DO PARSE(.RETURN,.MPIXMLR)
+9 ;massage returned person(s) data
IF $ORDER(RETURN(0))
Begin DoDot:1
+10 ;strip out double quotes
NEW L
SET L="RETURN"
FOR
SET L=$QUERY(@L)
if L=""
QUIT
SET @L=$$STRIP^XLFSTR(@L,"""")
+11 NEW CNT,MPIFLD
SET CNT=0
FOR
SET CNT=$ORDER(RETURN(CNT))
if 'CNT
QUIT
Begin DoDot:2
+12 ;insure upper case
FOR MPIFLD="firstName","middleName","lastName","gender"
IF $GET(RETURN(CNT,MPIFLD))?.E1L.E
SET RETURN(CNT,MPIFLD)=$$UP^XLFSTR(RETURN(CNT,MPIFLD))
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
SXMLBLD(MPIARR) ; setup xml to search for user
+1 ; Input: MPIARR - Array of traits to search
+2 ; Output: XML for the search
+3 ; $$SITE^VASITE - IA #10112
+4 ;
+5 NEW MPIXML,MPISITE,QUOTE,MPITHRES,MPIDT,MPIDUZ,MPIPRID
+6 SET QUOTE=""""
SET MPISITE=$PIECE($$SITE^VASITE,"^",3)
SET MPIPRID=$PIECE($$PARAM^HLCS2,"^",3)
SET MPIDT=$$FMTHL7^XLFDT($$NOW^XLFDT)
SET MPITHRES=80
+7 IF $GET(DUZ)>0
SET MPIDUZ=$PIECE(^VA(200,DUZ,0),"^")
DO STDNAME^XLFNAME(.MPIDUZ,"C")
+8 ; heading
+9 SET MPIXML="<spml:lookupRequest requestID="_QUOTE_516.2018053111223344_QUOTE_" returnData="_QUOTE_"data"_QUOTE_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_">"
+10 ;lookup secid
IF $GET(MPIARR("secId"))'=""
SET MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_MPIARR("secId")_"^PN^200PROV^USDVA"_QUOTE_" targetID="_QUOTE_"not_used"_QUOTE_"/>"
+11 ;or lookup by vaemail or samacctnm
IF $GET(MPIARR("secId"))=""
SET MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_$SELECT($GET(MPIARR("VAemail"))'="":MPIARR("VAemail"),1:$GET(MPIARR("samacctnm")))_"^PN^200AD^USDVA"_QUOTE_" targetID="_QUOTE_"not_used"_QUOTE_"/>"
+12 SET MPIXML=MPIXML_"</spml:lookupRequest>"
+13 KILL MPIARR("MPIVar")
+14 QUIT MPIXML
+15 ;
MSGID() ;
+1 NEW XUNOW
SET XUNOW=$$NOW^XLFDT
+2 QUIT $PIECE($$SITE^VASITE,"^",3)_"."_$PIECE(XUNOW,".",1)_$PIECE(XUNOW,".",2)_$JOB_$RANDOM(999999)
+3 ;
AXMLBLD(MPIARR) ; setup xml to add or modify a user
+1 ; Input: MPIARR - Array of traits for add or modify
+2 ; Output: XML for the add or modify
+3 ; $$SITE^VASITE - IA #10112
+4 ;
+5 NEW MPIXML
+6 ;MOVED DUE TO ROUTINE SIZE
SET MPIXML=$$AXMLBLD^XUIAMXML2(.MPIARR)
+7 QUIT MPIXML
+8 ;
QXMLBLD(MPIARR) ;setup xml for enhanced query of PSIM for user
+1 ; Input: MPIARR - Array of traits for enhanced search
+2 ; Output: XML for the enhanced search
+3 ; $$SITE^VASITE - IA #10112
+4 ;
+5 NEW MPIPRID,MPISITE,MPIXML,QUOTE
+6 ;station number
SET QUOTE=""""
SET MPISITE=$PIECE($$SITE^VASITE,"^",3)
+7 ;'p'roduction or 't'est
SET MPIPRID=$PIECE($$PARAM^HLCS2,"^",3)
+8 ; heading
+9 SET MPIXML="<spml:modifyRequest"_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_" requestID="_QUOTE_$$MSGID()_QUOTE_" targetID="_QUOTE_$PIECE($$SITE^VASITE(),"^",3)_QUOTE_" executionMode="_QUOTE_"synchronous"_QUOTE_">"
+10 ;pass vaemail or samacctnm
SET MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_$SELECT($GET(MPIARR("VAemail"))'="":MPIARR("VAemail"),1:$GET(MPIARR("samacctnm")))_"^PN^200AD^USDVA"_QUOTE_" targetID="_QUOTE_"not_used"_QUOTE_"/>"
+11 SET MPIXML=MPIXML_"<spml:modification"_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_" modificationMode="_QUOTE_"add"_QUOTE_">"
+12 SET MPIXML=MPIXML_"<spml:data>"
+13 SET MPIXML=MPIXML_"<spml:user>"
+14 ; user data
+15 DO IFADD("firstName",.MPIARR,.MPIXML,"spml:firstName")
+16 ;D IFADD("middleName",.MPIARR,.MPIXML,"spml:middleName")
+17 DO IFADD("lastName",.MPIARR,.MPIXML,"spml:lastName")
+18 ;
+19 DO IFADD("gender",.MPIARR,.MPIXML,"spml:gender")
+20 DO IFADD("dob",.MPIARR,.MPIXML,"spml:dob")
+21 ;ssn
DO IFADD("pnid",.MPIARR,.MPIXML,"spml:ssn")
+22 ;
+23 SET MPIXML=MPIXML_"</spml:user>"
+24 SET MPIXML=MPIXML_"</spml:data>"
+25 SET MPIXML=MPIXML_"<spml:capabilityData>"
+26 SET MPIXML=MPIXML_"<spml:operationData requestor="_QUOTE_MPIARR("WHO")_QUOTE_">"
+27 SET MPIXML=MPIXML_"</spml:operationData>"
+28 SET MPIXML=MPIXML_"</spml:capabilityData>"
+29 SET MPIXML=MPIXML_"</spml:modification>"
+30 SET MPIXML=MPIXML_"</spml:"_"modifyRequest"_">"
+31 QUIT MPIXML
+32 ;
OXMLBLD(MPIARR) ;setup xml for PSIM to orchestrate user
+1 ; Input: MPIARR - Array of traits for orchestration
+2 ; Output: XML for the orchestration (a secid should be returned)
+3 ; $$SITE^VASITE - IA #10112
+4 ;
+5 NEW MPIPRID,MPISITE,MPIXML,QUOTE
+6 ;station number
SET QUOTE=""""
SET MPISITE=$PIECE($$SITE^VASITE,"^",3)
+7 ;'p'roduction or 't'est
SET MPIPRID=$PIECE($$PARAM^HLCS2,"^",3)
+8 ; heading
+9 SET MPIXML="<spml:addRequest"_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_" requestID="_QUOTE_$$MSGID()_QUOTE_" targetID="_QUOTE_$GET(MPIARR("icn"))_QUOTE
+10 SET MPIXML=MPIXML_" returnData="_QUOTE_"Identifier"_QUOTE_" executionMode="_QUOTE_"synchronous"_QUOTE_">"
+11 ;pass email
SET MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_$GET(MPIARR("email"))_"^PN^200AD^USDVA"_QUOTE_" targetID="_QUOTE_$GET(MPIARR("icn"))_QUOTE_"/>"
+12 SET MPIXML=MPIXML_"<spml:data>"
+13 SET MPIXML=MPIXML_"<spml:user>"
+14 SET MPIXML=MPIXML_"<note>"_$GET(MPIARR("note"))_"</note>"
+15 ; user data
+16 DO IFADD("firstName",.MPIARR,.MPIXML,"spml:firstName")
+17 DO IFADD("lastName",.MPIARR,.MPIXML,"spml:lastName")
+18 DO IFADD("dob",.MPIARR,.MPIXML,"spml:dob")
+19 ;ssn
DO IFADD("pnid",.MPIARR,.MPIXML,"spml:ssn")
+20 ;
+21 SET MPIXML=MPIXML_"</spml:user>"
+22 SET MPIXML=MPIXML_"</spml:data>"
+23 SET MPIXML=MPIXML_"<spml:capabilityData>"
+24 SET MPIXML=MPIXML_"<spml:environment code="_QUOTE_MPIPRID_QUOTE_"/>"
+25 SET MPIXML=MPIXML_"<spml:operationData requestor="_QUOTE_MPIARR("WHO")_QUOTE_"/>"
+26 SET MPIXML=MPIXML_"</spml:capabilityData>"
+27 SET MPIXML=MPIXML_"</spml:"_"addRequest"_">"
+28 QUIT MPIXML
+29 ;
IFADD(MPIVAR,MPIARR,MPIXML,MPIXMLN) ;check if there, if so add it to the XML
+1 ; MPIVAR is the MPIARR variable name
+2 ; MPIXMLN is the name of the XML to encase
+3 ; modifies MPIXML to add if it is there
+4 IF $GET(MPIARR(MPIVAR))'=""
SET MPIXML=MPIXML_"<"_MPIXMLN_">"_MPIARR(MPIVAR)_"</"_MPIXMLN_">"
+5 QUIT
+6 ;
SPARSE(MPIDATA,MPIXML) ; - parse the data from user query or user update
+1 ; EN^MXMLPRSE - IA #4149
+2 ;
+3 KILL ^TMP($JOB,"XUIAMXML_PARSE")
+4 NEW MPICB,MPIUSE,MPIVAR,MPIPAT,MPIALIAS,MPILOC,MPIIDS
+5 SET (MPIPAT,MPIIDS)=0
+6 SET MPICB("STARTELEMENT")="SE^XUIAMXML"
SET MPICB("CHARACTERS")="VALUE^XUIAMXML"
+7 SET ^TMP($JOB,"XUIAMXML_PARSE",1)=MPIXML
+8 DO EN^MXMLPRSE($NAME(^TMP($JOB,"XUIAMXML_PARSE")),.MPICB)
+9 KILL ^TMP($JOB,"XUIAMXML_PARSE")
+10 QUIT
+11 ;
SE(MPIN,MPIA) ; - used by the parser for user query or user update to call back with STARTELEMENT
+1 ; just to protect the process
+2 SET MPIN=$GET(MPIN)
SET MPIVAR=""""_MPIN_""""
SET MPILOC="MPIDATA("
+3 SET MPIA("error")=$GET(MPIA("error"))
+4 SET MPIA("lastName")=$GET(MPIA("lastName"))
+5 SET MPIA("middleName")=$GET(MPIA("middleName"))
+6 SET MPIA("firstName")=$GET(MPIA("firstName"))
+7 SET MPIA("dob")=$GET(MPIA("dob"))
+8 SET MPIA("pnid")=$GET(MPIA("pnid"))
+9 SET MPIA("secId")=$GET(MPIA("secId"))
+10 SET MPIA("dob")=$GET(MPIA("dob"))
+11 SET MPIA("vistaid")=$GET(MPIA("vistaid"))
+12 SET MPIA("gender")=$GET(MPIA("gender"))
+13 ; my variable to protect
+14 ;I MPIN="user" S MPIPAT=MPIPAT+1,MPIALIAS=0,MPILOC="MPIDATA("_MPIPAT Q
+15 SET MPIUSE=$GET(MPIUSE)
+16 ; got a business rule error
+17 ;I MPIN="RESULT",MPIA("type")="AA",MPIA("subtype")="QE" S MPIDATA("Result")="QE" Q
+18 ; don't use these
+19 QUIT
+20 ;
PARSE(MPIDATA,MPIXML) ; - parse the data from additional traits user query
+1 ; EN^MXMLPRSE - IA #4149
+2 ;
+3 KILL ^TMP($JOB,"XUIAMXML_PARSE")
+4 NEW MPICB,MPIVAR,MPIPAT,MPILOC,MPIIDS
+5 SET (MPIPAT,MPIIDS)=0
+6 SET MPICB("STARTELEMENT")="SEQ^XUIAMXML"
SET MPICB("CHARACTERS")="VALUE^XUIAMXML"
+7 SET ^TMP($JOB,"XUIAMXML_PARSE",1)=MPIXML
+8 DO EN^MXMLPRSE($NAME(^TMP($JOB,"XUIAMXML_PARSE")),.MPICB)
+9 KILL ^TMP($JOB,"XUIAMXML_PARSE")
+10 QUIT
+11 ;
SEQ(MPIN,MPIA) ; - used by the parser for additional traits user query to call back with STARTELEMENT
+1 ;Q
IF MPIN="user"
SET MPIPAT=MPIPAT+1
SET MPILOC="MPIDATA("_MPIPAT_","
+2 ;no 'user' traits, an error being returned
IF '$DATA(MPILOC)
SET MPILOC="MPIDATA("
+3 SET MPIVAR=""""_MPIN_""""
+4 QUIT
+5 ;
VALUE(MPIT) ; - used by the parser to call back with CHARACTERS
+1 if $DATA(MPIVAR)
SET @(MPILOC_MPIVAR_")")=MPIT
KILL MPIVAR
QUIT
+2 QUIT
+3 ;
POST(MPIXML,MPIXMLR) ; - post XML to the execute server
+1 ; $$GETPROXY^XOBWLIB - IA #5421
+2 NEW $ETRAP,$ESTACK,SVC
+3 ; set error trap
SET $ETRAP="DO ERROR^XUIAMXML"
+4 ; test mode (outgoing)?
IF $DATA(^XTMP("XUIAMXML_EDIT"))
DO TEST("OUTGOING",.MPIXML)
+5 SET SVC=$$GETPROXY^XOBWLIB("MPI_PSIM_NEW EXECUTE","MPI_PSIM_NEW EXECUTE")
+6 SET MPIXMLR=SVC.execute(MPIXML)
+7 ; in case debugging needed, save both out and return
+8 IF $DATA(^XTMP("XUIAMXML_DEBUG"))
Begin DoDot:1
+9 NEW XUIAMSAVE
+10 SET XUIAMSAVE=$ORDER(^XTMP("XUIAMXML_DEBUG",":"),-1)+1
+11 SET ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,0)=$$NOW^XLFDT
+12 SET ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,"OUT")=MPIXML
+13 SET ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,"RETURN")=MPIXMLR
End DoDot:1
+14 ; test mode (return)?
+15 IF $DATA(^XTMP("XUIAMXML_EDIT"))
DO TEST("RETURN",.MPIXMLR)
+16 QUIT
+17 ;
ERROR ; - catch errors
+1 ; Set ecode to empty to return to calling function
+2 ; $$EOFAC^XOBWLIB, ZTER^XOBWLIB - IA #5421
+3 ; UNWIND^%ZTER - IA #1621
+4 NEW MPIERR
+5 SET MPIERR=$$EOFAC^XOBWLIB()
+6 DO ZTER^XOBWLIB(MPIERR)
+7 SET $ECODE=""
+8 DO UNWIND^%ZTER
+9 QUIT
+10 ;
TEST(TYPE,MPIXML) ; - call to possibly edit the xml string
+1 ; used for testing purposes only.
+2 ; production NOT allowed
+3 IF $$PROD^XUPROD
QUIT
+4 IF $EXTRACT($GET(IOST),1,2)'="C-"
QUIT
+5 NEW DIC,X,L,T,C,%,%Y
+6 WRITE !!,"Do you want to edit the "_TYPE_" XML"
+7 SET %=2
DO YN^DICN
IF %'=1
QUIT
+8 KILL ^TMP("XUIAMXML_TEST",$JOB)
+9 SET L=0
SET T=""
+10 FOR X=1:1
SET C=$EXTRACT(MPIXML,X)
if C=""
QUIT
Begin DoDot:1
+11 IF C="<"
IF T'=""
SET L=L+1
SET ^TMP("XUIAMXML_TEST",$JOB,L,0)=T
SET T=C
QUIT
+12 SET T=T_C
End DoDot:1
+13 SET DIC="^TMP(""XUIAMXML_TEST"",$J,"
+14 DO EN^DIWE
+15 SET MPIXML=""
+16 SET X=0
FOR
SET X=$ORDER(^TMP("XUIAMXML_TEST",$JOB,X))
if 'X
QUIT
SET MPIXML=MPIXML_^TMP("XUIAMXML_TEST",$JOB,X,0)
+17 QUIT
+18 ;
