MPIFXMLP ;OAK/ELZ - MPIF PROBLISTIC SEARCH ;21 May 2020 1:20 PM
;;1.0;MASTER PATIENT INDEX VISTA;**61,67,74,79**;30 Apr 99;Build 2
;
;
PATIENT(RETURN,MPIARR) ; - query for patients based on traits
; MPIARR("")=""
;
;
N MPIXML,MPIXMLR,MPID,MPIPAT
K RETURN
S MPIXML=$$XMLBLD(.MPIARR)
D POST^MPIFHWSC(MPIXML,.MPIXMLR)
I '$D(MPIXMLR) S RETURN="-1^Query to Person Search returned nothing." Q
D PARSE(.RETURN,.MPIXMLR)
;
; convert dob to fm format
; Story 722746 need DOD formatted as well if there is one
S MPIPAT=0 F S MPIPAT=$O(RETURN(MPIPAT)) Q:'MPIPAT S:$D(RETURN(MPIPAT,"DOD")) RETURN(MPIPAT,"DOD")=$$HL7TFM^XLFDT(RETURN(MPIPAT,"DOD")) I $D(RETURN(MPIPAT,"DOB")) S RETURN(MPIPAT,"DOB")=$$HL7TFM^XLFDT(RETURN(MPIPAT,"DOB"))
;
;
Q
;
XMLBLD(MPIARR) ; setup xml to search
; MPIARR - Array of traits for seach
; Returns XML for the search
;
; $$SITE^VASITE - #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)
S MPIDUZ=$P(^VA(200,DUZ,0),"^") D STDNAME^XLFNAME(.MPIDUZ,"C")
S MPITHRES=80
;
; heading
S MPIXML="<IDM_REQUEST type="_QUOTE_"SEARCH_PROFILE"_QUOTE_"><METADATA>"
S MPIXML=MPIXML_"<FIELD name="_QUOTE_"SENDINGFACILITY"_QUOTE_" value="
S MPIXML=MPIXML_QUOTE_MPISITE_QUOTE_"/><FIELD name="_QUOTE_"matchType"
S MPIXML=MPIXML_QUOTE_" value="_QUOTE_"VISTA_REG"_QUOTE_"/><FIELD name="
S MPIXML=MPIXML_QUOTE_"returnMax"_QUOTE_" value="_QUOTE_"100"_QUOTE_"/>"
S MPIXML=MPIXML_"<FIELD name="_QUOTE_"algorithm"_QUOTE_" value="_QUOTE
S MPIXML=MPIXML_"PROB"_QUOTE_"/><FIELD name="_QUOTE_"minScore"_QUOTE
S MPIXML=MPIXML_" value="_QUOTE_MPITHRES_QUOTE_"/><FIELD name="_QUOTE
S MPIXML=MPIXML_"scopingOrganization"_QUOTE_" value="_QUOTE_"VA_DOD"
S MPIXML=MPIXML_QUOTE_"/><FIELD name="_QUOTE_"versionCode"_QUOTE
S MPIXML=MPIXML_" value="_QUOTE_"3.0"_QUOTE_"/><FIELD name="_QUOTE
S MPIXML=MPIXML_"sendingApplicationName"_QUOTE_" value="_QUOTE
S MPIXML=MPIXML_"VISTA_REG"_QUOTE_"/><FIELD name="_QUOTE_"PROCESSINGID"
S MPIXML=MPIXML_QUOTE_" value="_QUOTE_MPIPRID_QUOTE_"/>"
;**74,Story 1258907 (mko): Add the following to request that the Treating Facilities be returned
S MPIXML=MPIXML_"<FIELD name=""mviModifyCode"" value=""MVI.COMP1""/></METADATA>"
S MPIXML=MPIXML_"<ARGUMENTS><ARGUMENT name="_QUOTE
S MPIXML=MPIXML_"searchProfile"_QUOTE_"><IDMHEADER>"
S MPIXML=MPIXML_"<SENDING_APP>VISTA_REG</SENDING_APP><MSG_DATE_TIME>"
S MPIXML=MPIXML_MPIDT_"</MSG_DATE_TIME><MSG_CONTROL_ID>"_$J
S MPIXML=MPIXML_"</MSG_CONTROL_ID><PROCESSING_ID>"_MPIPRID
S MPIXML=MPIXML_"</PROCESSING_ID><TRIGGER><EVENT>Local Client</EVENT>"
S MPIXML=MPIXML_"<ACTOR>"_DUZ_"~PN~"_MPISITE_"~USDVA^" ;**74,Story 1258907 (mko): Changed from USVHA to USDVA
S MPIXML=MPIXML_$G(MPIDUZ("FAMILY"))_"^"_$G(MPIDUZ("GIVEN"))_"</ACTOR>"
S MPIXML=MPIXML_"<DATETIME>"_MPIDT_"</DATETIME><SOURCE>VISTA</SOURCE>"
S MPIXML=MPIXML_"</TRIGGER></IDMHEADER><PROFILE>"
;
; name traits
S MPIXML=MPIXML_"<NAME type="_QUOTE_"L"_QUOTE_">"
D IFADD("FirstName",.MPIARR,.MPIXML,"FIRSTNAME")
D IFADD("MiddleName",.MPIARR,.MPIXML,"MIDDLENAME")
D IFADD("Suffix",.MPIARR,.MPIXML,"SUFFIX")
D IFADD("Surname",.MPIARR,.MPIXML,"LASTNAME")
S MPIXML=MPIXML_"</NAME>"
;
; other traits
I $G(MPIARR("SSN"))'="" D
. S MPIXML=MPIXML_"<IDENTIFIER type="_QUOTE_"SS"_QUOTE_" subtype="
. S MPIXML=MPIXML_QUOTE_"ACTIVE"_QUOTE_"><ID>"_MPIARR("SSN")
. S MPIXML=MPIXML_"</ID></IDENTIFIER>"
I $G(MPIARR("DOB"))'="" D
. S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"DOB"_QUOTE_"><VALUE>"
. S MPIXML=MPIXML_$$FMTHL7^XLFDT(MPIARR("DOB"))_"</VALUE></ATTRIBUTE>"
I $G(MPIARR("Gender"))'="" D
. S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"GENDER"_QUOTE_">"
. S MPIXML=MPIXML_"<VALUE>"_MPIARR("Gender")_"</VALUE></ATTRIBUTE>"
I $G(MPIARR("MMN"))'="" D
. S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"MMN"_QUOTE_">"
. S MPIXML=MPIXML_"<VALUE>"_MPIARR("MMN")_"</VALUE></ATTRIBUTE>"
I $G(MPIARR("MBI"))'="" D
. S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"MULTIBIRTH"_QUOTE_">"
. S MPIXML=MPIXML_"<VALUE>"_MPIARR("MBI")_"</VALUE></ATTRIBUTE>"
;
;POB stuff
S MPIARR("MPIVar")=$$CONV($G(MPIARR("POBCity")))
I MPIARR("MPIVar")'=""!($G(MPIARR("POBState"))'="") D
. S MPIXML=MPIXML_"<ADDRESS type="_QUOTE_"N"_QUOTE_">"
. D IFADD("MPIVar",.MPIARR,.MPIXML,"CITY")
. D IFADD("POBState",.MPIARR,.MPIXML,"STATE")
. S MPIXML=MPIXML_"</ADDRESS>"
;
;address stuff
I $G(MPIARR("ResAddL1"))'=""!($G(MPIARR("ResAddL2"))'="")!($G(MPIARR("ResAddCity"))'="")!($G(MPIARR("ResAddZip4"))'="")!($G(MPIARR("ResAddL3"))'="")!($G(MPIARR("ResAddState"))'="") D
. S MPIXML=MPIXML_"<ADDRESS type="_QUOTE_"P"_QUOTE_">"
. S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResAddL1")))
. D IFADD("MPIVar",.MPIARR,.MPIXML,"STREET1")
. S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResAddL2")))
. D IFADD("MPIVar",.MPIARR,.MPIXML,"STREET2")
. S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResAddL3")))
. D IFADD("MPIVar",.MPIARR,.MPIXML,"STREET3")
. S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResAddCity")))
. D IFADD("MPIVar",.MPIARR,.MPIXML,"CITY")
. D IFADD("ResAddState",.MPIARR,.MPIXML,"STATE")
. D IFADD("ResAddZip4",.MPIARR,.MPIXML,"ZIPCODE")
. D IFADD("ResAddProvince",.MPIARR,.MPIXML,"PROVINCECODE")
. D IFADD("ResAddPCode",.MPIARR,.MPIXML,"POSTALCODE")
. D IFADD("ResAddCountry",.MPIARR,.MPIXML,"COUNTRY")
. S MPIXML=MPIXML_"</ADDRESS>"
;
; phone
I $G(MPIARR("ResPhone"))'=""&($G(MPIARR("ResPhone"))'["""") D
. S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResPhone")))
. I MPIARR("MPIVar")'="" D
.. S MPIXML=MPIXML_"<PHONE type="_QUOTE_"HOME"_QUOTE_"><NUMBER>"
.. S MPIXML=MPIXML_MPIARR("MPIVar")_"</NUMBER></PHONE>"
;
; dod
I $G(MPIARR("DOD"))'="" D
. S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"DOD"_QUOTE_"><VALUE>"
. S MPIXML=MPIXML_$$FMTHL7^XLFDT(MPIARR("DOD"))_"</VALUE></ATTRIBUTE>"
;
; end data
S MPIXML=MPIXML_"</PROFILE></ARGUMENT></ARGUMENTS></IDM_REQUEST>"
K MPIARR("MPIVar")
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
;
PARSE(MPIDATA,MPIXML) ; - parse the data
;
; EN^MXMLPRSE - #4149
;
K ^TMP($J,"MPIFXMLP")
N MPICB,MPIUSE,MPIVAR,MPIPAT,MPIALIAS,MPILOC,MPIIDS,MPIIGNID
S (MPIPAT,MPIIDS)=0
S MPICB("STARTELEMENT")="SE^MPIFXMLP"
S MPICB("CHARACTERS")="VALUE^MPIFXMLP"
S ^TMP($J,"MPIFXMLP",1)=MPIXML
D EN^MXMLPRSE($NA(^TMP($J,"MPIFXMLP")),.MPICB)
K ^TMP($J,"MPIFXMLP")
Q
;
SE(MPIN,MPIA) ; - used for the parser to call back with STARTELEMENT
;
; just to protect the process
S MPIN=$G(MPIN)
S MPIA("type")=$G(MPIA("type"))
S MPIA("subtype")=$G(MPIA("subtype"))
S MPIA("name")=$G(MPIA("name"))
S MPIA("value")=$G(MPIA("value"))
; my variable to protect
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
I MPIN="IDM_RESPONSE"!(MPIN="METADATA")!(MPIN="IDATTR") Q
;**74,Story 1258907 (mko): Don't ignore ISSUER or STATUS elements
I MPIN="RESULT" Q ;!(MPIN="ISSUER")!(MPIN="STATUS") Q
I MPIN="EFFECTIVE"!(MPIN="BADADDRESSCODE")!(MPIN="BADADDRESSTEXT") Q
I MPIN="IDATTR",MPIA("type")="PSEUDO_SSN",MPIA("subtype")="CODE" Q
I MPIN="ASSOC",MPIA("type")="ALIAS_SSN" Q
;
; save some field data
I MPIN="FIELD" S:MPIA("name")]"" MPIDATA(MPIA("name"))=MPIA("value") Q
;
;**74,Story 1258907 (mko): For each PROFILE encountered, also initialize MPIIDS to 0
I MPIN="PROFILE" S MPIPAT=MPIPAT+1,MPIALIAS=0,MPIIDS=0,MPILOC="MPIDATA("_MPIPAT Q
I MPIN="NAME" D Q
. S MPIUSE=MPIA("type")
. S:MPIUSE="A" MPIALIAS=MPIALIAS+1
I MPIUSE="D",MPIN="NAME" S MPIVAR=",""PreferName"")" q
I MPIN="FIRSTNAME",MPIUSE="L" S MPIVAR=",""FirstName"")" Q
I MPIN="LASTNAME",MPIUSE="L" S MPIVAR=",""Surname"")" Q
I MPIN="MIDDLENAME",MPIUSE="L" S MPIVAR=",""MiddleName"")" Q
I MPIN="SUFFIX",MPIUSE="L" S MPIVAR=",""Suffix"")" Q
I MPIN="PREFIX",MPIUSE="L" S MPIVAR=",""Prefix"")" Q
I MPIN="FIRSTNAME",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""FirstName"")" Q
I MPIN="LASTNAME",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""Surname"")" Q
I MPIN="MIDDLENAME",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""MiddleName"")" Q
I MPIN="SUFFIX",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""Suffix"")" Q
I MPIN="PREFIX",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""Prefix"")" Q
I MPIN="IDENTIFIER" D Q
. K MPIIGNID
. I MPIA("type")="SS",MPIA("subtype")="ALIAS" S MPIUSE="ALIASSSN" Q
. I MPIA("type")="SS" S MPIUSE="SSN" Q
. I MPIA("type")="NI",MPIA("subtype")="IDM" S MPIUSE="ICN" Q
. ;**74,Story 1258907 (mko): Add storing PIs in the "IDS" array; also store the type here as "IDTYPE"
. I "^NI^PI^PN^EI^NPI^"[("^"_MPIA("type")_"^"),MPIA("subtype")="" S MPIIDS=MPIIDS+1,MPIUSE="IDS",@(MPILOC_",""IDS"","_MPIIDS_",""IDTYPE"")")=MPIA("type") Q
. ;**74,Story 1258907 (mko): Otherwise, we'll ignore this identifier.
. S MPIIGNID=1,MPIUSE="" K MPIVAR
I MPIN="ID" D Q
. I MPIUSE="ALIASSSN" S MPIVAR=",""ALIAS"","_MPIALIAS_",""SSN"")" Q
. I MPIUSE="SSN" S MPIVAR=",""SSN"")" K MPIUSE Q
. I MPIUSE="ICN" S MPIVAR=",""ICN"")" K MPIUSE Q
. I MPIUSE="EDIPI" S MPIVAR=",""EDIPI"")" K MPIUSE Q
. I MPIUSE="IDS" S MPIVAR=",""IDS"","_MPIIDS_",""ID"")" Q
;**74,Story 1258907 (mko): Ignore SOURCE if we're ignoring this IDENTIFIER
I MPIN="SOURCE",'$G(MPIIGNID) S MPIVAR=",""IDS"","_MPIIDS_",""SOURCE"")" Q
;**74,Story 1258907 (mko): Store the ISSUER and STATUS in the "IDS" array
I MPIN="ISSUER",$G(MPIUSE)="IDS" S MPIVAR=",""IDS"","_MPIIDS_",""ISSUER"")" Q
I MPIN="STATUS",$G(MPIUSE)="IDS" S MPIVAR=",""IDS"","_MPIIDS_",""STATUS"")" Q
I MPIN="ATTRIBUTE" D Q
. I MPIA("type")="SCORE" S MPIUSE="Score" Q
. I MPIA("type")="MMN" S MPIUSE="MMN" Q
. I MPIA("type")="DOB" S MPIUSE="DOB" Q
. I MPIA("type")="GENDER" S MPIUSE="Gender" Q
.;**79 including MBI
.I MPIA("type")="MULTIBIRTH" S MPIUSE="MBI" Q
. ; Story 722746 (elz) need DOD if there is one
. I MPIA("type")="DEATHDATE" S MPIUSE="DOD" Q
I MPIN="VALUE" D K MPIUSE Q
. I $L(MPIUSE) S MPIVAR=","""_MPIUSE_""")"
I MPIN="ADDRESS" D Q
. I MPIA("type")="N" S MPIUSE="POB"
. I MPIA("type")="P" S MPIUSE="ResAdd"
. I MPIA("type")="BA" S MPIUSE="BA"
.;**79 VAMPI-16603 WORK AND CORRESPONDENCE ADDRESS
.I MPIA("type")="C" S MPIUSE="CorAdd"
.I MPIA("type")="W" S MPIUSE="WrkAdd"
I MPIN="CITY" S MPIVAR=","""_MPIUSE_"City"")" Q
I MPIN="STATE" S MPIVAR=","""_MPIUSE_"State"")" Q
I MPIN="PROVINCECODE" S MPIVAR=","""_MPIUSE_"Province"")" Q
I MPIN="COUNTRY" S MPIVAR=","""_MPIUSE_"Country"")" Q
I MPIN="PHONE",MPIA("type")="Home" S MPIUSE="ResPhone" Q
;**79 VAMPI-16603 cell and work phone
I MPIN="PHONE",MPIA("type")="Cell" S MPIUSE="CellPhone" Q
I MPIN="PHONE",MPIA("type")="Work" S MPIUSE="WrkPhone" Q
I MPIN="NUMBER" S MPIVAR=","""_MPIUSE_""")" Q
I MPIN="STREET1" S MPIVAR=","""_MPIUSE_"L1"")" Q
I MPIN="STREET2" S MPIVAR=","""_MPIUSE_"L2"")" Q
I MPIN="STREET3" S MPIVAR=","""_MPIUSE_"L3"")" Q
I MPIN="ZIPCODE" S MPIVAR=","""_MPIUSE_"Zip4"")" Q
I MPIN="POSTALCODE" S MPIVAR=","""_MPIUSE_"PCode"")" Q
;
Q
;
VALUE(MPIT) ; - used by the parser to call back with CHARACTERS
S:$D(MPIVAR) @(MPILOC_MPIVAR)=MPIT K MPIVAR Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFXMLP 12007 printed Dec 13, 2024@02:11:52 Page 2
MPIFXMLP ;OAK/ELZ - MPIF PROBLISTIC SEARCH ;21 May 2020 1:20 PM
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**61,67,74,79**;30 Apr 99;Build 2
+2 ;
+3 ;
PATIENT(RETURN,MPIARR) ; - query for patients based on traits
+1 ; MPIARR("")=""
+2 ;
+3 ;
+4 NEW MPIXML,MPIXMLR,MPID,MPIPAT
+5 KILL RETURN
+6 SET MPIXML=$$XMLBLD(.MPIARR)
+7 DO POST^MPIFHWSC(MPIXML,.MPIXMLR)
+8 IF '$DATA(MPIXMLR)
SET RETURN="-1^Query to Person Search returned nothing."
QUIT
+9 DO PARSE(.RETURN,.MPIXMLR)
+10 ;
+11 ; convert dob to fm format
+12 ; Story 722746 need DOD formatted as well if there is one
+13 SET MPIPAT=0
FOR
SET MPIPAT=$ORDER(RETURN(MPIPAT))
if 'MPIPAT
QUIT
if $DATA(RETURN(MPIPAT,"DOD"))
SET RETURN(MPIPAT,"DOD")=$$HL7TFM^XLFDT(RETURN(MPIPAT,"DOD"))
IF $DATA(RETURN(MPIPAT,"DOB"))
SET RETURN(MPIPAT,"DOB")=$$HL7TFM^XLFDT(RETURN(MPIPAT,"DOB"))
+14 ;
+15 ;
+16 QUIT
+17 ;
XMLBLD(MPIARR) ; setup xml to search
+1 ; MPIARR - Array of traits for seach
+2 ; Returns XML for the search
+3 ;
+4 ; $$SITE^VASITE - #10112
+5 ;
+6 NEW MPIXML,MPISITE,QUOTE,MPITHRES,MPIDT,MPIDUZ,MPIPRID
+7 SET QUOTE=""""
+8 SET MPISITE=$PIECE($$SITE^VASITE,"^",3)
+9 SET MPIPRID=$PIECE($$PARAM^HLCS2,"^",3)
+10 SET MPIDT=$$FMTHL7^XLFDT($$NOW^XLFDT)
+11 SET MPIDUZ=$PIECE(^VA(200,DUZ,0),"^")
DO STDNAME^XLFNAME(.MPIDUZ,"C")
+12 SET MPITHRES=80
+13 ;
+14 ; heading
+15 SET MPIXML="<IDM_REQUEST type="_QUOTE_"SEARCH_PROFILE"_QUOTE_"><METADATA>"
+16 SET MPIXML=MPIXML_"<FIELD name="_QUOTE_"SENDINGFACILITY"_QUOTE_" value="
+17 SET MPIXML=MPIXML_QUOTE_MPISITE_QUOTE_"/><FIELD name="_QUOTE_"matchType"
+18 SET MPIXML=MPIXML_QUOTE_" value="_QUOTE_"VISTA_REG"_QUOTE_"/><FIELD name="
+19 SET MPIXML=MPIXML_QUOTE_"returnMax"_QUOTE_" value="_QUOTE_"100"_QUOTE_"/>"
+20 SET MPIXML=MPIXML_"<FIELD name="_QUOTE_"algorithm"_QUOTE_" value="_QUOTE
+21 SET MPIXML=MPIXML_"PROB"_QUOTE_"/><FIELD name="_QUOTE_"minScore"_QUOTE
+22 SET MPIXML=MPIXML_" value="_QUOTE_MPITHRES_QUOTE_"/><FIELD name="_QUOTE
+23 SET MPIXML=MPIXML_"scopingOrganization"_QUOTE_" value="_QUOTE_"VA_DOD"
+24 SET MPIXML=MPIXML_QUOTE_"/><FIELD name="_QUOTE_"versionCode"_QUOTE
+25 SET MPIXML=MPIXML_" value="_QUOTE_"3.0"_QUOTE_"/><FIELD name="_QUOTE
+26 SET MPIXML=MPIXML_"sendingApplicationName"_QUOTE_" value="_QUOTE
+27 SET MPIXML=MPIXML_"VISTA_REG"_QUOTE_"/><FIELD name="_QUOTE_"PROCESSINGID"
+28 SET MPIXML=MPIXML_QUOTE_" value="_QUOTE_MPIPRID_QUOTE_"/>"
+29 ;**74,Story 1258907 (mko): Add the following to request that the Treating Facilities be returned
+30 SET MPIXML=MPIXML_"<FIELD name=""mviModifyCode"" value=""MVI.COMP1""/></METADATA>"
+31 SET MPIXML=MPIXML_"<ARGUMENTS><ARGUMENT name="_QUOTE
+32 SET MPIXML=MPIXML_"searchProfile"_QUOTE_"><IDMHEADER>"
+33 SET MPIXML=MPIXML_"<SENDING_APP>VISTA_REG</SENDING_APP><MSG_DATE_TIME>"
+34 SET MPIXML=MPIXML_MPIDT_"</MSG_DATE_TIME><MSG_CONTROL_ID>"_$JOB
+35 SET MPIXML=MPIXML_"</MSG_CONTROL_ID><PROCESSING_ID>"_MPIPRID
+36 SET MPIXML=MPIXML_"</PROCESSING_ID><TRIGGER><EVENT>Local Client</EVENT>"
+37 ;**74,Story 1258907 (mko): Changed from USVHA to USDVA
SET MPIXML=MPIXML_"<ACTOR>"_DUZ_"~PN~"_MPISITE_"~USDVA^"
+38 SET MPIXML=MPIXML_$GET(MPIDUZ("FAMILY"))_"^"_$GET(MPIDUZ("GIVEN"))_"</ACTOR>"
+39 SET MPIXML=MPIXML_"<DATETIME>"_MPIDT_"</DATETIME><SOURCE>VISTA</SOURCE>"
+40 SET MPIXML=MPIXML_"</TRIGGER></IDMHEADER><PROFILE>"
+41 ;
+42 ; name traits
+43 SET MPIXML=MPIXML_"<NAME type="_QUOTE_"L"_QUOTE_">"
+44 DO IFADD("FirstName",.MPIARR,.MPIXML,"FIRSTNAME")
+45 DO IFADD("MiddleName",.MPIARR,.MPIXML,"MIDDLENAME")
+46 DO IFADD("Suffix",.MPIARR,.MPIXML,"SUFFIX")
+47 DO IFADD("Surname",.MPIARR,.MPIXML,"LASTNAME")
+48 SET MPIXML=MPIXML_"</NAME>"
+49 ;
+50 ; other traits
+51 IF $GET(MPIARR("SSN"))'=""
Begin DoDot:1
+52 SET MPIXML=MPIXML_"<IDENTIFIER type="_QUOTE_"SS"_QUOTE_" subtype="
+53 SET MPIXML=MPIXML_QUOTE_"ACTIVE"_QUOTE_"><ID>"_MPIARR("SSN")
+54 SET MPIXML=MPIXML_"</ID></IDENTIFIER>"
End DoDot:1
+55 IF $GET(MPIARR("DOB"))'=""
Begin DoDot:1
+56 SET MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"DOB"_QUOTE_"><VALUE>"
+57 SET MPIXML=MPIXML_$$FMTHL7^XLFDT(MPIARR("DOB"))_"</VALUE></ATTRIBUTE>"
End DoDot:1
+58 IF $GET(MPIARR("Gender"))'=""
Begin DoDot:1
+59 SET MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"GENDER"_QUOTE_">"
+60 SET MPIXML=MPIXML_"<VALUE>"_MPIARR("Gender")_"</VALUE></ATTRIBUTE>"
End DoDot:1
+61 IF $GET(MPIARR("MMN"))'=""
Begin DoDot:1
+62 SET MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"MMN"_QUOTE_">"
+63 SET MPIXML=MPIXML_"<VALUE>"_MPIARR("MMN")_"</VALUE></ATTRIBUTE>"
End DoDot:1
+64 IF $GET(MPIARR("MBI"))'=""
Begin DoDot:1
+65 SET MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"MULTIBIRTH"_QUOTE_">"
+66 SET MPIXML=MPIXML_"<VALUE>"_MPIARR("MBI")_"</VALUE></ATTRIBUTE>"
End DoDot:1
+67 ;
+68 ;POB stuff
+69 SET MPIARR("MPIVar")=$$CONV($GET(MPIARR("POBCity")))
+70 IF MPIARR("MPIVar")'=""!($GET(MPIARR("POBState"))'="")
Begin DoDot:1
+71 SET MPIXML=MPIXML_"<ADDRESS type="_QUOTE_"N"_QUOTE_">"
+72 DO IFADD("MPIVar",.MPIARR,.MPIXML,"CITY")
+73 DO IFADD("POBState",.MPIARR,.MPIXML,"STATE")
+74 SET MPIXML=MPIXML_"</ADDRESS>"
End DoDot:1
+75 ;
+76 ;address stuff
+77 IF $GET(MPIARR("ResAddL1"))'=""!($GET(MPIARR("ResAddL2"))'="")!($GET(MPIARR("ResAddCity"))'="")!($GET(MPIARR("ResAddZip4"))'="")!($GET(MPIARR("ResAddL3"))'="")!($GET(MPIARR("ResAddState"))'="")
Begin DoDot:1
+78 SET MPIXML=MPIXML_"<ADDRESS type="_QUOTE_"P"_QUOTE_">"
+79 SET MPIARR("MPIVar")=$$CONV($GET(MPIARR("ResAddL1")))
+80 DO IFADD("MPIVar",.MPIARR,.MPIXML,"STREET1")
+81 SET MPIARR("MPIVar")=$$CONV($GET(MPIARR("ResAddL2")))
+82 DO IFADD("MPIVar",.MPIARR,.MPIXML,"STREET2")
+83 SET MPIARR("MPIVar")=$$CONV($GET(MPIARR("ResAddL3")))
+84 DO IFADD("MPIVar",.MPIARR,.MPIXML,"STREET3")
+85 SET MPIARR("MPIVar")=$$CONV($GET(MPIARR("ResAddCity")))
+86 DO IFADD("MPIVar",.MPIARR,.MPIXML,"CITY")
+87 DO IFADD("ResAddState",.MPIARR,.MPIXML,"STATE")
+88 DO IFADD("ResAddZip4",.MPIARR,.MPIXML,"ZIPCODE")
+89 DO IFADD("ResAddProvince",.MPIARR,.MPIXML,"PROVINCECODE")
+90 DO IFADD("ResAddPCode",.MPIARR,.MPIXML,"POSTALCODE")
+91 DO IFADD("ResAddCountry",.MPIARR,.MPIXML,"COUNTRY")
+92 SET MPIXML=MPIXML_"</ADDRESS>"
End DoDot:1
+93 ;
+94 ; phone
+95 IF $GET(MPIARR("ResPhone"))'=""&($GET(MPIARR("ResPhone"))'["""")
Begin DoDot:1
+96 SET MPIARR("MPIVar")=$$CONV($GET(MPIARR("ResPhone")))
+97 IF MPIARR("MPIVar")'=""
Begin DoDot:2
+98 SET MPIXML=MPIXML_"<PHONE type="_QUOTE_"HOME"_QUOTE_"><NUMBER>"
+99 SET MPIXML=MPIXML_MPIARR("MPIVar")_"</NUMBER></PHONE>"
End DoDot:2
End DoDot:1
+100 ;
+101 ; dod
+102 IF $GET(MPIARR("DOD"))'=""
Begin DoDot:1
+103 SET MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"DOD"_QUOTE_"><VALUE>"
+104 SET MPIXML=MPIXML_$$FMTHL7^XLFDT(MPIARR("DOD"))_"</VALUE></ATTRIBUTE>"
End DoDot:1
+105 ;
+106 ; end data
+107 SET MPIXML=MPIXML_"</PROFILE></ARGUMENT></ARGUMENTS></IDM_REQUEST>"
+108 KILL MPIARR("MPIVar")
+109 QUIT MPIXML
+110 ;
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 ;
PARSE(MPIDATA,MPIXML) ; - parse the data
+1 ;
+2 ; EN^MXMLPRSE - #4149
+3 ;
+4 KILL ^TMP($JOB,"MPIFXMLP")
+5 NEW MPICB,MPIUSE,MPIVAR,MPIPAT,MPIALIAS,MPILOC,MPIIDS,MPIIGNID
+6 SET (MPIPAT,MPIIDS)=0
+7 SET MPICB("STARTELEMENT")="SE^MPIFXMLP"
+8 SET MPICB("CHARACTERS")="VALUE^MPIFXMLP"
+9 SET ^TMP($JOB,"MPIFXMLP",1)=MPIXML
+10 DO EN^MXMLPRSE($NAME(^TMP($JOB,"MPIFXMLP")),.MPICB)
+11 KILL ^TMP($JOB,"MPIFXMLP")
+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 MPIA("type")=$GET(MPIA("type"))
+5 SET MPIA("subtype")=$GET(MPIA("subtype"))
+6 SET MPIA("name")=$GET(MPIA("name"))
+7 SET MPIA("value")=$GET(MPIA("value"))
+8 ; my variable to protect
+9 SET MPIUSE=$GET(MPIUSE)
+10 ;
+11 ; got a business rule error
+12 IF MPIN="RESULT"
IF MPIA("type")="AA"
IF MPIA("subtype")="QE"
SET MPIDATA("Result")="QE"
QUIT
+13 ; don't use these
+14 IF MPIN="IDM_RESPONSE"!(MPIN="METADATA")!(MPIN="IDATTR")
QUIT
+15 ;**74,Story 1258907 (mko): Don't ignore ISSUER or STATUS elements
+16 ;!(MPIN="ISSUER")!(MPIN="STATUS") Q
IF MPIN="RESULT"
QUIT
+17 IF MPIN="EFFECTIVE"!(MPIN="BADADDRESSCODE")!(MPIN="BADADDRESSTEXT")
QUIT
+18 IF MPIN="IDATTR"
IF MPIA("type")="PSEUDO_SSN"
IF MPIA("subtype")="CODE"
QUIT
+19 IF MPIN="ASSOC"
IF MPIA("type")="ALIAS_SSN"
QUIT
+20 ;
+21 ; save some field data
+22 IF MPIN="FIELD"
if MPIA("name")]""
SET MPIDATA(MPIA("name"))=MPIA("value")
QUIT
+23 ;
+24 ;**74,Story 1258907 (mko): For each PROFILE encountered, also initialize MPIIDS to 0
+25 IF MPIN="PROFILE"
SET MPIPAT=MPIPAT+1
SET MPIALIAS=0
SET MPIIDS=0
SET MPILOC="MPIDATA("_MPIPAT
QUIT
+26 IF MPIN="NAME"
Begin DoDot:1
+27 SET MPIUSE=MPIA("type")
+28 if MPIUSE="A"
SET MPIALIAS=MPIALIAS+1
End DoDot:1
QUIT
+29 IF MPIUSE="D"
IF MPIN="NAME"
SET MPIVAR=",""PreferName"")"
QUIT
+30 IF MPIN="FIRSTNAME"
IF MPIUSE="L"
SET MPIVAR=",""FirstName"")"
QUIT
+31 IF MPIN="LASTNAME"
IF MPIUSE="L"
SET MPIVAR=",""Surname"")"
QUIT
+32 IF MPIN="MIDDLENAME"
IF MPIUSE="L"
SET MPIVAR=",""MiddleName"")"
QUIT
+33 IF MPIN="SUFFIX"
IF MPIUSE="L"
SET MPIVAR=",""Suffix"")"
QUIT
+34 IF MPIN="PREFIX"
IF MPIUSE="L"
SET MPIVAR=",""Prefix"")"
QUIT
+35 IF MPIN="FIRSTNAME"
IF MPIUSE="A"
SET MPIVAR=",""ALIAS"","_MPIALIAS_",""FirstName"")"
QUIT
+36 IF MPIN="LASTNAME"
IF MPIUSE="A"
SET MPIVAR=",""ALIAS"","_MPIALIAS_",""Surname"")"
QUIT
+37 IF MPIN="MIDDLENAME"
IF MPIUSE="A"
SET MPIVAR=",""ALIAS"","_MPIALIAS_",""MiddleName"")"
QUIT
+38 IF MPIN="SUFFIX"
IF MPIUSE="A"
SET MPIVAR=",""ALIAS"","_MPIALIAS_",""Suffix"")"
QUIT
+39 IF MPIN="PREFIX"
IF MPIUSE="A"
SET MPIVAR=",""ALIAS"","_MPIALIAS_",""Prefix"")"
QUIT
+40 IF MPIN="IDENTIFIER"
Begin DoDot:1
+41 KILL MPIIGNID
+42 IF MPIA("type")="SS"
IF MPIA("subtype")="ALIAS"
SET MPIUSE="ALIASSSN"
QUIT
+43 IF MPIA("type")="SS"
SET MPIUSE="SSN"
QUIT
+44 IF MPIA("type")="NI"
IF MPIA("subtype")="IDM"
SET MPIUSE="ICN"
QUIT
+45 ;**74,Story 1258907 (mko): Add storing PIs in the "IDS" array; also store the type here as "IDTYPE"
+46 IF "^NI^PI^PN^EI^NPI^"[("^"_MPIA("type")_"^")
IF MPIA("subtype")=""
SET MPIIDS=MPIIDS+1
SET MPIUSE="IDS"
SET @(MPILOC_",""IDS"","_MPIIDS_",""IDTYPE"")")=MPIA("type")
QUIT
+47 ;**74,Story 1258907 (mko): Otherwise, we'll ignore this identifier.
+48 SET MPIIGNID=1
SET MPIUSE=""
KILL MPIVAR
End DoDot:1
QUIT
+49 IF MPIN="ID"
Begin DoDot:1
+50 IF MPIUSE="ALIASSSN"
SET MPIVAR=",""ALIAS"","_MPIALIAS_",""SSN"")"
QUIT
+51 IF MPIUSE="SSN"
SET MPIVAR=",""SSN"")"
KILL MPIUSE
QUIT
+52 IF MPIUSE="ICN"
SET MPIVAR=",""ICN"")"
KILL MPIUSE
QUIT
+53 IF MPIUSE="EDIPI"
SET MPIVAR=",""EDIPI"")"
KILL MPIUSE
QUIT
+54 IF MPIUSE="IDS"
SET MPIVAR=",""IDS"","_MPIIDS_",""ID"")"
QUIT
End DoDot:1
QUIT
+55 ;**74,Story 1258907 (mko): Ignore SOURCE if we're ignoring this IDENTIFIER
+56 IF MPIN="SOURCE"
IF '$GET(MPIIGNID)
SET MPIVAR=",""IDS"","_MPIIDS_",""SOURCE"")"
QUIT
+57 ;**74,Story 1258907 (mko): Store the ISSUER and STATUS in the "IDS" array
+58 IF MPIN="ISSUER"
IF $GET(MPIUSE)="IDS"
SET MPIVAR=",""IDS"","_MPIIDS_",""ISSUER"")"
QUIT
+59 IF MPIN="STATUS"
IF $GET(MPIUSE)="IDS"
SET MPIVAR=",""IDS"","_MPIIDS_",""STATUS"")"
QUIT
+60 IF MPIN="ATTRIBUTE"
Begin DoDot:1
+61 IF MPIA("type")="SCORE"
SET MPIUSE="Score"
QUIT
+62 IF MPIA("type")="MMN"
SET MPIUSE="MMN"
QUIT
+63 IF MPIA("type")="DOB"
SET MPIUSE="DOB"
QUIT
+64 IF MPIA("type")="GENDER"
SET MPIUSE="Gender"
QUIT
+65 ;**79 including MBI
+66 IF MPIA("type")="MULTIBIRTH"
SET MPIUSE="MBI"
QUIT
+67 ; Story 722746 (elz) need DOD if there is one
+68 IF MPIA("type")="DEATHDATE"
SET MPIUSE="DOD"
QUIT
End DoDot:1
QUIT
+69 IF MPIN="VALUE"
Begin DoDot:1
+70 IF $LENGTH(MPIUSE)
SET MPIVAR=","""_MPIUSE_""")"
End DoDot:1
KILL MPIUSE
QUIT
+71 IF MPIN="ADDRESS"
Begin DoDot:1
+72 IF MPIA("type")="N"
SET MPIUSE="POB"
+73 IF MPIA("type")="P"
SET MPIUSE="ResAdd"
+74 IF MPIA("type")="BA"
SET MPIUSE="BA"
+75 ;**79 VAMPI-16603 WORK AND CORRESPONDENCE ADDRESS
+76 IF MPIA("type")="C"
SET MPIUSE="CorAdd"
+77 IF MPIA("type")="W"
SET MPIUSE="WrkAdd"
End DoDot:1
QUIT
+78 IF MPIN="CITY"
SET MPIVAR=","""_MPIUSE_"City"")"
QUIT
+79 IF MPIN="STATE"
SET MPIVAR=","""_MPIUSE_"State"")"
QUIT
+80 IF MPIN="PROVINCECODE"
SET MPIVAR=","""_MPIUSE_"Province"")"
QUIT
+81 IF MPIN="COUNTRY"
SET MPIVAR=","""_MPIUSE_"Country"")"
QUIT
+82 IF MPIN="PHONE"
IF MPIA("type")="Home"
SET MPIUSE="ResPhone"
QUIT
+83 ;**79 VAMPI-16603 cell and work phone
+84 IF MPIN="PHONE"
IF MPIA("type")="Cell"
SET MPIUSE="CellPhone"
QUIT
+85 IF MPIN="PHONE"
IF MPIA("type")="Work"
SET MPIUSE="WrkPhone"
QUIT
+86 IF MPIN="NUMBER"
SET MPIVAR=","""_MPIUSE_""")"
QUIT
+87 IF MPIN="STREET1"
SET MPIVAR=","""_MPIUSE_"L1"")"
QUIT
+88 IF MPIN="STREET2"
SET MPIVAR=","""_MPIUSE_"L2"")"
QUIT
+89 IF MPIN="STREET3"
SET MPIVAR=","""_MPIUSE_"L3"")"
QUIT
+90 IF MPIN="ZIPCODE"
SET MPIVAR=","""_MPIUSE_"Zip4"")"
QUIT
+91 IF MPIN="POSTALCODE"
SET MPIVAR=","""_MPIUSE_"PCode"")"
QUIT
+92 ;
+93 QUIT
+94 ;
VALUE(MPIT) ; - used by the parser to call back with CHARACTERS
+1 if $DATA(MPIVAR)
SET @(MPILOC_MPIVAR)=MPIT
KILL MPIVAR
QUIT
+2 QUIT
