XUIAMXML ;BHM/DLR,DRI - IAM ENTERPRISE NEW PERSON PROBABILISTIC SEARCH ; Dec 18, 2020@15:00
;;8.0;KERNEL;**731**;Jul 10, 1995;Build 0
;;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
USER(RETURN,MPIARR) ; - query PSIM for 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
;
;I $D(RETURN("dob")) S RETURN("dob")=$$HL7TFM^XLFDT(RETURN("dob")) ;leave dob in hl7 format
;
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
;
;I $D(RETURN("dob")) S RETURN("dob")=$$HL7TFM^XLFDT(RETURN("dob")) ;leave dob in hl7 format
;I $D(RETURN("subjectOrg")) S RETURN("subjectOrg")=$$TITLE^XLFSTR($E(RETURN("subjectOrg"),1,50)) ;subject organization sometimes coming from adr improperly formatted
;
Q
;
SXMLBLD(MPIARR) ; setup xml to search for user
; Input:
; MPIARR - Array of traits for search
;
; Output:
; XML for the search
;
; $$SITE^VASITE - IA #10112
;
N MPIXML,MPISITE,QUOTE,MPITHRES,MPIDT,MPIDUZ,MPIPRID
S QUOTE=""""
S MPISITE=$P($$SITE^VASITE,"^",3)
S MPIPRID=$P($$PARAM^HLCS2,"^",3)
S MPIDT=$$FMTHL7^XLFDT($$NOW^XLFDT)
I $G(DUZ)>0 S MPIDUZ=$P(^VA(200,DUZ,0),"^") D STDNAME^XLFNAME(.MPIDUZ,"C")
S MPITHRES=80
;
; 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 IAM search
;
; Output:
; XML for the add or modify
;
; $$SITE^VASITE - IA #10112
;
N MPIPRID,MPISITE,MPIXML,QUOTE
S QUOTE=""""
S MPISITE=$P($$SITE^VASITE,"^",3) ;station number
S MPIPRID=$P($$PARAM^HLCS2,"^",3) ;'p'roduction or 't'est
;
; heading
S MPIXML="<spml:"_$S(MPIARR("REQTYPE")="ADD":"addRequest",1:"modifyRequest")_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_" requestID="_QUOTE_$$MSGID()_QUOTE_">"
S MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_MPIARR("vistaid")_QUOTE_"></spml:psoID>"
I MPIARR("REQTYPE")="MODIFY" S MPIXML=MPIXML_"<spml:modification modificationMode="_QUOTE_"replace"_QUOTE_">"
S MPIXML=MPIXML_"<spml:data>"
S MPIXML=MPIXML_"<spml:user>"
S MPIXML=MPIXML_"<spml:environment>"_MPIPRID_"</spml:environment>"
;don't default in subjectOrg or orgId, should be returned by psim
D IFADD("subjectOrg",.MPIARR,.MPIXML,"spml:subjectOrg") ;S MPIXML=MPIXML_"<spml:subjectOrg>Department Of Veterans Affairs</spml:subjectOrg>"
D IFADD("orgId",.MPIARR,.MPIXML,"spml:orgId") ;S MPIXML=MPIXML_"<spml:orgId>urn:oid:2.16.840.1.113883.4.349</spml:orgId>"
;
; 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("adUPN",.MPIARR,.MPIXML,"spml:adUPN")
D IFADD("email",.MPIARR,.MPIXML,"spml:email")
D IFADD("disabled",.MPIARR,.MPIXML,"spml:disabled") ;disuser
D IFADD("termDate",.MPIARR,.MPIXML,"spml:termDate") ;termination date
D IFADD("pnid",.MPIARR,.MPIXML,"spml:ssn") ;ssn
D IFADD("secId",.MPIARR,.MPIXML,"spml:secId")
D IFADD("uid",.MPIARR,.MPIXML,"spml:uid")
D IFADD("npi",.MPIARR,.MPIXML,"spml:npi")
D IFADD("samAccountName",.MPIARR,.MPIXML,"spml:samAccountName")
D IFADD("lastAccess",.MPIARR,.MPIXML,"spml:lastAccess")
;
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>"
I MPIARR("REQTYPE")="MODIFY" S MPIXML=MPIXML_"</spml:modification>"
S MPIXML=MPIXML_"</spml:"_$S(MPIARR("REQTYPE")="ADD":"addRequest",1:"modifyRequest")_">"
;
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))'="" D
. S MPIXML=MPIXML_"<"_MPIXMLN_">"_MPIARR(MPIVAR)_"</"_MPIXMLN_">"
Q
;
CONV(FIELD) ;check for &, ', > and <
I FIELD["&" S FIELD=$P(FIELD,"&")_"&"_$P(FIELD,"&",2)
I FIELD["'" S FIELD=$P(FIELD,"'")_"'"_$P(FIELD,"'",2)
S:(FIELD["<") FIELD=$$CONVA(FIELD,"<")
S:(FIELD[">") FIELD=$$CONVA(FIELD,">")
Q FIELD
;
CONVA(FIELD,ENCHAR) ;handle <<pob city>>
N I,X,VAL
S VAL="",I=$L(FIELD,ENCHAR) F X=1:1:I S VAL=VAL_$P(FIELD,ENCHAR,X)
Q VAL
;
SPARSE(MPIDATA,MPIXML) ; - parse the data
;
; 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"
S 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 for the parser to call back with STARTELEMENT
;
; just to protect the process
S MPIN=$G(MPIN)
S MPIVAR=""""_MPIN_""""
S 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
;
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
; set error trap
S $ETRAP="DO ERROR^XUIAMXML"
; test mode (outgoing)?
I $D(^XTMP("XUIAMXML_EDIT")) D TEST("OUTGOING",.MPIXML)
; make the call
;**63 STORY 317469 HTTPS OR HTTP
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 10549 printed Dec 13, 2024@02:09:38 Page 2
XUIAMXML ;BHM/DLR,DRI - IAM ENTERPRISE NEW PERSON PROBABILISTIC SEARCH ; Dec 18, 2020@15:00
+1 ;;8.0;KERNEL;**731**;Jul 10, 1995;Build 0
+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
USER(RETURN,MPIARR) ; - query PSIM for USER traits
+1 ; Input (one of the following):
+2 ; MPIARR("samacctnm") = SECURITY ACCOUNT MANAGER/NETWORK USERNAME
+3 ; or
+4 ; MPIARR("VAemail") = ACTIVE DIRECTORY USER PRINCIPLE NAME/EMAIL ADDRESS
+5 ; or
+6 ; MPIARR("secId") = SECURITY ID
+7 ;
+8 ; Output (array of traits):
+9 ; RETURN("city")=CITY
+10 ; RETURN("dob")=DOB (HL7 format)
+11 ; RETURN("email")=EMAIL ADDRESS
+12 ; RETURN("firstName")=FIRST NAME
+13 ; RETURN("gender")=SEX
+14 ; RETURN("identityTheft")="N" or "Y"
+15 ; RETURN("lastName")=FAMILY (LAST) NAME
+16 ; RETURN("mcid")=PSIM MESSAGE CONTROL ID
+17 ; RETURN("middleName")=MIDDLE NAME
+18 ; RETURN("orgId")=SUBJECT ORGANIZATION
+19 ; RETURN("phone")=PHONE NUMBER
+20 ; RETURN("pnid")=PERSON NUMBER IDENTIFIED/SSN
+21 ; RETURN("postalCode")=ZIP CODE
+22 ; RETURN("samacctnm")=SECURITY ACCOUNT MANAGER/NETWORK USERNAME
+23 ; RETURN("secId")=SECURITY ID
+24 ; RETURN("state")=STATE
+25 ; RETURN("street_1")=STREET ADDRESS 1
+26 ; RETURN("subjectOrg")=SUBJECT ORGANIZATION
+27 ; RETURN("vauid")=VA ACTIVE DIRECTORY UNIQUE ID (for 200AD)
+28 ; RETURN("vistaid")=STATION NUMBER|USERID or DUZ^SOURCE ID TYPE^STATION NUMBER^ASSIGNING AUTHORITY| (repeating)
+29 ;
+30 ; Example calling api:
+31 ; S MPIARR("VAemail")="first.lastname@domain.ext"
+32 ; or
+33 ; S MPIARR("samacctnm")="VHAMOCLASTNAMEF"
+34 ; or
+35 ; S MPIARR("secId")=##########
+36 ;
+37 ; D USER^XUIAMXML(.RETURN,.MPIARR)
+38 ; ZW RETURN ;returns array of traits
+39 ;
+40 ;
+41 NEW MPIXML,MPIXMLR,MPID,MPIPAT
+42 KILL RETURN
+43 ;build spml search request
SET MPIXML=$$SXMLBLD(.MPIARR)
+44 ;send spml to psim
DO POST(MPIXML,.MPIXMLR)
+45 IF '$DATA(MPIXMLR)
SET RETURN="-1^Unable to communicate with the Enterprise Database."
QUIT
+46 ;parse psim response of returned spml
DO SPARSE(.RETURN,.MPIXMLR)
+47 ;
+48 ;I $D(RETURN("dob")) S RETURN("dob")=$$HL7TFM^XLFDT(RETURN("dob")) ;leave dob in hl7 format
+49 ;
+50 QUIT
+51 ;
SNDUSER(RETURN,MPIARR) ; - update PSIM with USER traits
+1 ; Input
+2 ; MPIARR - Array of trait(s) to update
+3 ; Output
+4 ; RETURN - Array of traits psim has
+5 ;
+6 NEW MPIXML,MPIXMLR,MPID,MPIPAT
+7 KILL RETURN
+8 ;build spml for psim
SET MPIXML=$$AXMLBLD(.MPIARR)
+9 ;send spml to psim
DO POST(MPIXML,.MPIXMLR)
+10 IF '$DATA(MPIXMLR)
SET RETURN="-1^Unable to communicate with the Enterprise Database."
QUIT
+11 ;parse psim response of returned spml
DO SPARSE(.RETURN,.MPIXMLR)
+12 ;
+13 ;I $D(RETURN("dob")) S RETURN("dob")=$$HL7TFM^XLFDT(RETURN("dob")) ;leave dob in hl7 format
+14 ;I $D(RETURN("subjectOrg")) S RETURN("subjectOrg")=$$TITLE^XLFSTR($E(RETURN("subjectOrg"),1,50)) ;subject organization sometimes coming from adr improperly formatted
+15 ;
+16 QUIT
+17 ;
SXMLBLD(MPIARR) ; setup xml to search for user
+1 ; Input:
+2 ; MPIARR - Array of traits for search
+3 ;
+4 ; Output:
+5 ; XML for the search
+6 ;
+7 ; $$SITE^VASITE - IA #10112
+8 ;
+9 NEW MPIXML,MPISITE,QUOTE,MPITHRES,MPIDT,MPIDUZ,MPIPRID
+10 SET QUOTE=""""
+11 SET MPISITE=$PIECE($$SITE^VASITE,"^",3)
+12 SET MPIPRID=$PIECE($$PARAM^HLCS2,"^",3)
+13 SET MPIDT=$$FMTHL7^XLFDT($$NOW^XLFDT)
+14 IF $GET(DUZ)>0
SET MPIDUZ=$PIECE(^VA(200,DUZ,0),"^")
DO STDNAME^XLFNAME(.MPIDUZ,"C")
+15 SET MPITHRES=80
+16 ;
+17 ; heading
+18 SET MPIXML="<spml:lookupRequest requestID="_QUOTE_516.2018053111223344_QUOTE_" returnData="_QUOTE_"data"_QUOTE_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_">"
+19 ;lookup secid
IF $GET(MPIARR("secId"))'=""
SET MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_MPIARR("secId")_"^PN^200PROV^USDVA"_QUOTE_" targetID="_QUOTE_"not_used"_QUOTE_"/>"
+20 ;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_"/>"
+21 SET MPIXML=MPIXML_"</spml:lookupRequest>"
+22 ;
+23 KILL MPIARR("MPIVar")
+24 QUIT MPIXML
+25 ;
MSGID() ;
+1 NEW XUNOW
+2 SET XUNOW=$$NOW^XLFDT
+3 QUIT $PIECE($$SITE^VASITE,"^",3)_"."_$PIECE(XUNOW,".",1)_$PIECE(XUNOW,".",2)_$JOB_$RANDOM(999999)
+4 ;
AXMLBLD(MPIARR) ; setup xml to add or modify a user
+1 ; Input:
+2 ; MPIARR - Array of traits for IAM search
+3 ;
+4 ; Output:
+5 ; XML for the add or modify
+6 ;
+7 ; $$SITE^VASITE - IA #10112
+8 ;
+9 NEW MPIPRID,MPISITE,MPIXML,QUOTE
+10 SET QUOTE=""""
+11 ;station number
SET MPISITE=$PIECE($$SITE^VASITE,"^",3)
+12 ;'p'roduction or 't'est
SET MPIPRID=$PIECE($$PARAM^HLCS2,"^",3)
+13 ;
+14 ; heading
+15 SET MPIXML="<spml:"_$SELECT(MPIARR("REQTYPE")="ADD":"addRequest",1:"modifyRequest")_" xmlns:spml="_QUOTE_"urn:oasis:names:tc:SPML:2:0"_QUOTE_" requestID="_QUOTE_$$MSGID()_QUOTE_">"
+16 SET MPIXML=MPIXML_"<spml:psoID ID="_QUOTE_MPIARR("vistaid")_QUOTE_"></spml:psoID>"
+17 IF MPIARR("REQTYPE")="MODIFY"
SET MPIXML=MPIXML_"<spml:modification modificationMode="_QUOTE_"replace"_QUOTE_">"
+18 SET MPIXML=MPIXML_"<spml:data>"
+19 SET MPIXML=MPIXML_"<spml:user>"
+20 SET MPIXML=MPIXML_"<spml:environment>"_MPIPRID_"</spml:environment>"
+21 ;don't default in subjectOrg or orgId, should be returned by psim
+22 ;S MPIXML=MPIXML_"<spml:subjectOrg>Department Of Veterans Affairs</spml:subjectOrg>"
DO IFADD("subjectOrg",.MPIARR,.MPIXML,"spml:subjectOrg")
+23 ;S MPIXML=MPIXML_"<spml:orgId>urn:oid:2.16.840.1.113883.4.349</spml:orgId>"
DO IFADD("orgId",.MPIARR,.MPIXML,"spml:orgId")
+24 ;
+25 ; user data
+26 DO IFADD("firstName",.MPIARR,.MPIXML,"spml:firstName")
+27 DO IFADD("middleName",.MPIARR,.MPIXML,"spml:middleName")
+28 DO IFADD("lastName",.MPIARR,.MPIXML,"spml:lastName")
+29 ;
+30 DO IFADD("gender",.MPIARR,.MPIXML,"spml:gender")
+31 DO IFADD("dob",.MPIARR,.MPIXML,"spml:dob")
+32 DO IFADD("adUPN",.MPIARR,.MPIXML,"spml:adUPN")
+33 DO IFADD("email",.MPIARR,.MPIXML,"spml:email")
+34 ;disuser
DO IFADD("disabled",.MPIARR,.MPIXML,"spml:disabled")
+35 ;termination date
DO IFADD("termDate",.MPIARR,.MPIXML,"spml:termDate")
+36 ;ssn
DO IFADD("pnid",.MPIARR,.MPIXML,"spml:ssn")
+37 DO IFADD("secId",.MPIARR,.MPIXML,"spml:secId")
+38 DO IFADD("uid",.MPIARR,.MPIXML,"spml:uid")
+39 DO IFADD("npi",.MPIARR,.MPIXML,"spml:npi")
+40 DO IFADD("samAccountName",.MPIARR,.MPIXML,"spml:samAccountName")
+41 DO IFADD("lastAccess",.MPIARR,.MPIXML,"spml:lastAccess")
+42 ;
+43 SET MPIXML=MPIXML_"</spml:user>"
+44 SET MPIXML=MPIXML_"</spml:data>"
+45 ;
+46 SET MPIXML=MPIXML_"<spml:capabilityData>"
+47 SET MPIXML=MPIXML_"<spml:operationData requestor="_QUOTE_MPIARR("WHO")_QUOTE_">"
+48 SET MPIXML=MPIXML_"</spml:operationData>"
+49 SET MPIXML=MPIXML_"</spml:capabilityData>"
+50 IF MPIARR("REQTYPE")="MODIFY"
SET MPIXML=MPIXML_"</spml:modification>"
+51 SET MPIXML=MPIXML_"</spml:"_$SELECT(MPIARR("REQTYPE")="ADD":"addRequest",1:"modifyRequest")_">"
+52 ;
+53 QUIT MPIXML
+54 ;
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))'=""
Begin DoDot:1
+5 SET MPIXML=MPIXML_"<"_MPIXMLN_">"_MPIARR(MPIVAR)_"</"_MPIXMLN_">"
End DoDot:1
+6 QUIT
+7 ;
CONV(FIELD) ;check for &, ', > and <
+1 IF FIELD["&"
SET FIELD=$PIECE(FIELD,"&")_"&"_$PIECE(FIELD,"&",2)
+2 IF FIELD["'"
SET FIELD=$PIECE(FIELD,"'")_"'"_$PIECE(FIELD,"'",2)
+3 if (FIELD["<")
SET FIELD=$$CONVA(FIELD,"<")
+4 if (FIELD[">")
SET FIELD=$$CONVA(FIELD,">")
+5 QUIT FIELD
+6 ;
CONVA(FIELD,ENCHAR) ;handle <<pob city>>
+1 NEW I,X,VAL
+2 SET VAL=""
SET I=$LENGTH(FIELD,ENCHAR)
FOR X=1:1:I
SET VAL=VAL_$PIECE(FIELD,ENCHAR,X)
+3 QUIT VAL
+4 ;
SPARSE(MPIDATA,MPIXML) ; - parse the data
+1 ;
+2 ; EN^MXMLPRSE - IA #4149
+3 ;
+4 KILL ^TMP($JOB,"XUIAMXML_PARSE")
+5 NEW MPICB,MPIUSE,MPIVAR,MPIPAT,MPIALIAS,MPILOC,MPIIDS
+6 SET (MPIPAT,MPIIDS)=0
+7 SET MPICB("STARTELEMENT")="SE^XUIAMXML"
+8 SET MPICB("CHARACTERS")="VALUE^XUIAMXML"
+9 SET ^TMP($JOB,"XUIAMXML_PARSE",1)=MPIXML
+10 DO EN^MXMLPRSE($NAME(^TMP($JOB,"XUIAMXML_PARSE")),.MPICB)
+11 KILL ^TMP($JOB,"XUIAMXML_PARSE")
+12 QUIT
+13 ;
SE(MPIN,MPIA) ; - used for the parser to call back with STARTELEMENT
+1 ;
+2 ; just to protect the process
+3 SET MPIN=$GET(MPIN)
+4 SET MPIVAR=""""_MPIN_""""
+5 SET MPILOC="MPIDATA("
+6 SET MPIA("error")=$GET(MPIA("error"))
+7 SET MPIA("lastName")=$GET(MPIA("lastName"))
+8 SET MPIA("middleName")=$GET(MPIA("middleName"))
+9 SET MPIA("firstName")=$GET(MPIA("firstName"))
+10 SET MPIA("dob")=$GET(MPIA("dob"))
+11 SET MPIA("pnid")=$GET(MPIA("pnid"))
+12 SET MPIA("secId")=$GET(MPIA("secId"))
+13 SET MPIA("dob")=$GET(MPIA("dob"))
+14 SET MPIA("vistaid")=$GET(MPIA("vistaid"))
+15 SET MPIA("gender")=$GET(MPIA("gender"))
+16 ; my variable to protect
+17 ;I MPIN="user" S MPIPAT=MPIPAT+1,MPIALIAS=0,MPILOC="MPIDATA("_MPIPAT Q
+18 SET MPIUSE=$GET(MPIUSE)
+19 ;
+20 ; got a business rule error
+21 ;I MPIN="RESULT",MPIA("type")="AA",MPIA("subtype")="QE" S MPIDATA("Result")="QE" Q
+22 ; don't use these
+23 ;
+24 QUIT
+25 ;
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
+4 SET $ETRAP="DO ERROR^XUIAMXML"
+5 ; test mode (outgoing)?
+6 IF $DATA(^XTMP("XUIAMXML_EDIT"))
DO TEST("OUTGOING",.MPIXML)
+7 ; make the call
+8 ;**63 STORY 317469 HTTPS OR HTTP
+9 SET SVC=$$GETPROXY^XOBWLIB("MPI_PSIM_NEW EXECUTE","MPI_PSIM_NEW EXECUTE")
+10 SET MPIXMLR=SVC.execute(MPIXML)
+11 ; in case debugging needed, save both out and return
+12 IF $DATA(^XTMP("XUIAMXML_DEBUG"))
Begin DoDot:1
+13 NEW XUIAMSAVE
+14 SET XUIAMSAVE=$ORDER(^XTMP("XUIAMXML_DEBUG",":"),-1)+1
+15 SET ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,0)=$$NOW^XLFDT
+16 SET ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,"OUT")=MPIXML
+17 SET ^XTMP("XUIAMXML_DEBUG",XUIAMSAVE,"RETURN")=MPIXMLR
End DoDot:1
+18 ; test mode (return)?
+19 IF $DATA(^XTMP("XUIAMXML_EDIT"))
DO TEST("RETURN",.MPIXMLR)
+20 QUIT
+21 ;
ERROR ; - catch errors
+1 ; Set ecode to empty to return to calling function
+2 ;
+3 ; $$EOFAC^XOBWLIB, ZTER^XOBWLIB - IA #5421
+4 ; UNWIND^%ZTER - IA #1621
+5 NEW MPIERR
+6 SET MPIERR=$$EOFAC^XOBWLIB()
+7 DO ZTER^XOBWLIB(MPIERR)
+8 SET $ECODE=""
+9 DO UNWIND^%ZTER
+10 QUIT
+11 ;
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 ;
+6 NEW DIC,X,L,T,C,%,%Y
+7 WRITE !!,"Do you want to edit the "_TYPE_" XML"
+8 SET %=2
DO YN^DICN
IF %'=1
QUIT
+9 KILL ^TMP("XUIAMXML_TEST",$JOB)
+10 SET L=0
SET T=""
+11 FOR X=1:1
SET C=$EXTRACT(MPIXML,X)
if C=""
QUIT
Begin DoDot:1
+12 IF C="<"
IF T'=""
SET L=L+1
SET ^TMP("XUIAMXML_TEST",$JOB,L,0)=T
SET T=C
QUIT
+13 SET T=T_C
End DoDot:1
+14 SET DIC="^TMP(""XUIAMXML_TEST"",$J,"
+15 DO EN^DIWE
+16 SET MPIXML=""
+17 SET X=0
FOR
SET X=$ORDER(^TMP("XUIAMXML_TEST",$JOB,X))
if 'X
QUIT
SET MPIXML=MPIXML_^TMP("XUIAMXML_TEST",$JOB,X,0)
+18 QUIT
+19 ;
