MPIFXMLI ;ALB/CKN - MPIF IMPLICIT/EXPLICIT ADD ; 9/6/19 5:05pm
;;1.0;MASTER PATIENT INDEX VISTA;**61,71,73,77**;30 Apr 99;Build 1
;
;**73, STORY 1218906 (dlr) - Add Preferred Facility Type Logic
; to Support VistA-Side creation of
; patients. (VAR - "ADDPREFTF")
Q
GETICN(MPIDATA,MPIARR) ; Explicit add for user traits - ICN is returned
N MPIXML,MPIXMLR
K MPIDATA
S MPIXML=$$XMLBLD(.MPIARR)
D POST^MPIFHWSC(MPIXML,.MPIXMLR)
I '$D(MPIXMLR) S MPIDATA("ICN")=-1,MPIDATA("ERRTXT")="No results returned" Q
D PARSE(.MPIDATA,.MPIXMLR)
Q
;
XMLBLD(MPIARR) ; setup xml for explicit Add
; MPIARR - Array contains traits for ADD
; Returns XML for explicit ADD
N MPIXML,MPISITE,QUOTE,MPITHRES,MPIDT,MPIDUZ,MPIPRID,ADDTYPE,PATARR
I MPIARR("AddType")="" S MPIARR("AddType")=MPIARR(1,"AddType")
S QUOTE="""",ADDTYPE=$S(MPIARR("AddType")="Explicit":"ADD ICN OVERRIDE",MPIARR("AddType")="ADDPREFTF":"ADDPREFTF",MPIARR("AddType")="ProxyAddPatientToCerner":"ADDPREFTF",1:"ADD ICN") ;Setting add type on implicit or explicit flag
;**77 ADDING NEW ADDTYPE VAMPI-10064
M PATARR=MPIARR(1)
;**77 adding additional check VAMPI-10064
I $G(PATARR("AddType"))="ADDPREFTF"!($G(PATARR("AddType"))="ProxyAddPatientToCerner") S PATARR("DFN")="PROXY_VISTA"
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
;**77 IF HAVE NEW PROXY ADD PATIENT TO CERNER ADD ANOTHER FIELD to xml VAMPI-10064
I ADDTYPE="ADDPREFTF" D
.S MPIXML="<IDM_REQUEST type="_QUOTE_"ADDPREFTF"_QUOTE_"><METADATA>"
.I $G(PATARR("AddType"))="ProxyAddPatientToCerner" S MPIXML=MPIXML_"<FIELD name='isOnlyProxyCerner' value='TRUE'/>"
I ADDTYPE'="ADDPREFTF" S MPIXML="<IDM_REQUEST type="_QUOTE_"ADD_PROFILE"_QUOTE_"><METADATA>"
S MPIXML=MPIXML_"<FIELD name="_QUOTE_"PROCESSINGID"_QUOTE_" value="
S MPIXML=MPIXML_QUOTE_MPIPRID_QUOTE_"/><FIELD name="_QUOTE_"SENDINGFACILITY"
S MPIXML=MPIXML_QUOTE_" value="_QUOTE_MPISITE_QUOTE_"/><FIELD name="_QUOTE
S MPIXML=MPIXML_"SENDINGAPPLICATIONNAME"_QUOTE_" value="_QUOTE_"VistAEnterpriseReg"_QUOTE
I $G(MPIARR("mcid"))'="" D
.S MPIXML=MPIXML_"/><FIELD name="_QUOTE_"attentionLine"_QUOTE
.S MPIXML=MPIXML_" value="_QUOTE_MPIARR("mcid")_QUOTE ;search token
;**71 - Story 841885 (ckn)
S MPIXML=MPIXML_"/><FIELD name="_QUOTE_"selectedIdentifier"_QUOTE
S MPIXML=MPIXML_" value="_QUOTE_$G(MPIARR("SelIdentifier"))_QUOTE
S MPIXML=MPIXML_"/></METADATA><IDMHEADER><SENDING_FACILITY>"_MPISITE
S MPIXML=MPIXML_"</SENDING_FACILITY><PROCESSING_ID>"_MPIPRID_"</PROCESSING_ID>"
S MPIXML=MPIXML_"<TRIGGER><ACTOR>"
S MPIXML=MPIXML_"<IDENTIFIER type='PN'><ID>"_DUZ_"</ID><SOURCE>"_MPISITE_"</SOURCE>"
S MPIXML=MPIXML_"<ISSUER>USVHA</ISSUER></IDENTIFIER><NAME type='U'>"
S MPIXML=MPIXML_"<LASTNAME>"_$G(MPIDUZ("FAMILY"))_"</LASTNAME>"
S MPIXML=MPIXML_"<FIRSTNAME>"_$G(MPIDUZ("GIVEN"))_"</FIRSTNAME>"
S MPIXML=MPIXML_"</NAME></ACTOR></TRIGGER></IDMHEADER><ARGUMENTS>"
I ADDTYPE'="ADDPREFTF" S MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"ACTIVEPROFILE"_QUOTE_"><PROFILE>"
I ADDTYPE="ADDPREFTF" S MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"PROFILE"_QUOTE_"><PROFILE>" S MPIXML=MPIXML_"<IDENTIFIER type='NI'><ID>"_$G(PATARR("ICN"))_"</ID></IDENTIFIER>"
;Name Traits
S MPIXML=MPIXML_"<NAME type="_QUOTE_"L"_QUOTE_">"
D IFADD("FirstName",.PATARR,.MPIXML,"FIRSTNAME")
D IFADD("MiddleName",.PATARR,.MPIXML,"MIDDLENAME")
D IFADD("Suffix",.PATARR,.MPIXML,"SUFFIX")
D IFADD("Surname",.PATARR,.MPIXML,"LASTNAME")
S MPIXML=MPIXML_"</NAME>"
;Source ID
S MPIXML=MPIXML_"<IDENTIFIER type='PI'><ID>"_$G(PATARR("DFN"))_"</ID>"
I ADDTYPE="ADDPREFTF" S MPIXML=MPIXML_"<SOURCE>"_PATARR("preferredFacilityNumber")_"</SOURCE><ISSUER>USVHA</ISSUER></IDENTIFIER>"
I ADDTYPE'="ADDPREFTF" S MPIXML=MPIXML_"<SOURCE>"_MPISITE_"</SOURCE><ISSUER>USVHA</ISSUER></IDENTIFIER>"
I $G(PATARR("SSN"))'="" D
.S MPIXML=MPIXML_"<IDENTIFIER type='SS' subtype='ACTIVE'>"
.S MPIXML=MPIXML_"<ID>"_PATARR("SSN")_"</ID>"
.S MPIXML=MPIXML_"<ISSUER>USSSA</ISSUER></IDENTIFIER>"
I $G(PATARR("DOB"))'="" D
.S MPIXML=MPIXML_"<ATTRIBUTE type='DOB'><VALUE>"_$$FMTHL7^XLFDT(PATARR("DOB"))
.S MPIXML=MPIXML_"</VALUE></ATTRIBUTE>"
I $G(PATARR("Gender"))'="" D
.S MPIXML=MPIXML_"<ATTRIBUTE type='GENDER'><VALUE>"
.S MPIXML=MPIXML_PATARR("Gender")_"</VALUE></ATTRIBUTE>"
I $G(PATARR("MMN"))'="" D
. S MPIXML=MPIXML_"<ATTRIBUTE type='MMN'>"
. S MPIXML=MPIXML_"<VALUE>"_PATARR("MMN")_"</VALUE></ATTRIBUTE>"
I $G(PATARR("MBI"))'="" D
. S MPIXML=MPIXML_"<ATTRIBUTE type='MULTIBIRTH'>"
. S MPIXML=MPIXML_"<VALUE>"_PATARR("MBI")_"</VALUE></ATTRIBUTE>"
;POB stuff
S PATARR("MPIVar")=$$CONV($G(PATARR("POBCity")))
I PATARR("MPIVar")'=""!($G(PATARR("POBState"))'="") D
. S MPIXML=MPIXML_"<ADDRESS type='N'>"
. D IFADD("MPIVar",.PATARR,.MPIXML,"CITY")
. D IFADD("POBState",.PATARR,.MPIXML,"STATE")
. S MPIXML=MPIXML_"</ADDRESS>"
;address stuff
N PROVINCE,PCODE
S PROVINCE=$G(PATARR("ResAddProvince")),PCODE=$G(PATARR("ResAddPCode"))
I $G(PATARR("ResAddL1"))'=""!($G(PATARR("ResAddL2"))'="")!($G(PATARR("ResAddCity"))'="")!($G(PATARR("ResAddZip4"))'="")!($G(PATARR("ResAddL3"))'="")!($G(PATARR("ResAddState"))'="")!(PROVINCE'="")!(PCODE'="") D
. S MPIXML=MPIXML_"<ADDRESS type='P'>"
. S PATARR("MPIVar")=$$CONV($G(PATARR("ResAddL1")))
. D IFADD("MPIVar",.PATARR,.MPIXML,"STREET1")
. S PATARR("MPIVar")=$$CONV($G(PATARR("ResAddL2")))
. D IFADD("MPIVar",.PATARR,.MPIXML,"STREET2")
. S PATARR("MPIVar")=$$CONV($G(PATARR("ResAddL3")))
. D IFADD("MPIVar",.PATARR,.MPIXML,"STREET3")
. S PATARR("MPIVar")=$$CONV($G(PATARR("ResAddCity")))
. D IFADD("MPIVar",.PATARR,.MPIXML,"CITY")
. D IFADD("ResAddState",.PATARR,.MPIXML,"STATE")
. D IFADD("ResAddZip4",.PATARR,.MPIXML,"ZIPCODE")
. D IFADD("ResAddProvince",.PATARR,.MPIXML,"PROVINCECODE")
. D IFADD("ResAddPCode",.PATARR,.MPIXML,"POSTALCODE")
. D IFADD("ResAddCountry",.PATARR,.MPIXML,"COUNTRY")
. S MPIXML=MPIXML_"</ADDRESS>"
; phone
I $G(PATARR("ResPhone"))'=""&($G(PATARR("ResPhone"))'["""") D
. S PATARR("MPIVar")=$$CONV($G(PATARR("ResPhone")))
. I PATARR("MPIVar")'="" D
.. S MPIXML=MPIXML_"<PHONE type='HOME'><NUMBER>"
.. S MPIXML=MPIXML_PATARR("MPIVar")_"</NUMBER></PHONE>"
; date of death
I $G(PATARR("DOD"))'="" D
. S MPIXML=MPIXML_"<ATTRIBUTE type='DOD'><VALUE>"
. S MPIXML=MPIXML_$$FMTHL7^XLFDT(PATARR("DOD"))_"</VALUE></ATTRIBUTE>"
S MPIXML=MPIXML_"</PROFILE></ARGUMENT>"
S MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"ADDTYPE"_QUOTE_">"
S MPIXML=MPIXML_"<VALUE>"_ADDTYPE_"</VALUE></ARGUMENT>"
I ADDTYPE="ADDPREFTF" D
.S MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"preferredFacilityNumber"_QUOTE_"><VALUE>"_PATARR("preferredFacilityNumber")_"</VALUE></ARGUMENT>"
.S MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"patientVeteran"_QUOTE_"><VALUE>"_PATARR("patientVeteran")_"</VALUE></ARGUMENT>"
.S MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"patientServiceConnected"_QUOTE_"><VALUE>"_PATARR("patientServiceConnected")_"</VALUE></ARGUMENT>"
.S MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"patientType"_QUOTE_"><VALUE>"_PATARR("patientType")_"</VALUE></ARGUMENT>"
S MPIXML=MPIXML_"</ARGUMENTS></IDM_REQUEST>"
Q MPIXML
;
IFADD(MPIVAR,PATARR,MPIXML,MPIXMLN) ;check if there, if so add it to the XML
; MPIVAR is the PATARR variable name
; MPIXMLN is the name of the XML to encase
; modifies MPIXML to add if it is there
I $G(PATARR(MPIVAR))'="" D
. S MPIXML=MPIXML_"<"_MPIXMLN_">"_PATARR(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 XML for results
;
; EN^MXMLPRSE - #4149
;
K ^TMP($J,"MPIFXMLI")
N MPICB,MPIUSE,MPIVAR,MPIIDN,MPILOC
S MPICB("STARTELEMENT")="SE^MPIFXMLI"
S MPICB("CHARACTERS")="VALUE^MPIFXMLI"
S ^TMP($J,"MPIFXMLI",1)=MPIXML
D EN^MXMLPRSE($NA(^TMP($J,"MPIFXMLI")),.MPICB)
K ^TMP($J,"MPIFXMLI")
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"))
;No need for these tags
I MPIN="IDM_RESPONSE"!(MPIN="RESULT")!(MPIN="ERROR") Q
S MPILOC="MPIDATA("
I MPIN="TEXT" D Q
. S MPIVAR="""ERRTXT"")",MPIDATA("ICN")=-1
I MPIN="ID" S MPIVAR="""ICN"")" 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[HMPIFXMLI 8808 printed Sep 02, 2024@18:57:06 Page 2
MPIFXMLI ;ALB/CKN - MPIF IMPLICIT/EXPLICIT ADD ; 9/6/19 5:05pm
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**61,71,73,77**;30 Apr 99;Build 1
+2 ;
+3 ;**73, STORY 1218906 (dlr) - Add Preferred Facility Type Logic
+4 ; to Support VistA-Side creation of
+5 ; patients. (VAR - "ADDPREFTF")
+6 QUIT
GETICN(MPIDATA,MPIARR) ; Explicit add for user traits - ICN is returned
+1 NEW MPIXML,MPIXMLR
+2 KILL MPIDATA
+3 SET MPIXML=$$XMLBLD(.MPIARR)
+4 DO POST^MPIFHWSC(MPIXML,.MPIXMLR)
+5 IF '$DATA(MPIXMLR)
SET MPIDATA("ICN")=-1
SET MPIDATA("ERRTXT")="No results returned"
QUIT
+6 DO PARSE(.MPIDATA,.MPIXMLR)
+7 QUIT
+8 ;
XMLBLD(MPIARR) ; setup xml for explicit Add
+1 ; MPIARR - Array contains traits for ADD
+2 ; Returns XML for explicit ADD
+3 NEW MPIXML,MPISITE,QUOTE,MPITHRES,MPIDT,MPIDUZ,MPIPRID,ADDTYPE,PATARR
+4 IF MPIARR("AddType")=""
SET MPIARR("AddType")=MPIARR(1,"AddType")
+5 ;Setting add type on implicit or explicit flag
SET QUOTE=""""
SET ADDTYPE=$SELECT(MPIARR("AddType")="Explicit":"ADD ICN OVERRIDE",MPIARR("AddType")="ADDPREFTF":"ADDPREFTF",MPIARR("AddType")="ProxyAddPatientToCerner":"ADDPREFTF",1:"ADD ICN")
+6 ;**77 ADDING NEW ADDTYPE VAMPI-10064
+7 MERGE PATARR=MPIARR(1)
+8 ;**77 adding additional check VAMPI-10064
+9 IF $GET(PATARR("AddType"))="ADDPREFTF"!($GET(PATARR("AddType"))="ProxyAddPatientToCerner")
SET PATARR("DFN")="PROXY_VISTA"
+10 SET MPISITE=$PIECE($$SITE^VASITE,"^",3)
+11 SET MPIPRID=$PIECE($$PARAM^HLCS2,"^",3)
+12 SET MPIDT=$$FMTHL7^XLFDT($$NOW^XLFDT)
+13 SET MPIDUZ=$PIECE(^VA(200,DUZ,0),"^")
DO STDNAME^XLFNAME(.MPIDUZ,"C")
+14 SET MPITHRES=80
+15 ;**77 IF HAVE NEW PROXY ADD PATIENT TO CERNER ADD ANOTHER FIELD to xml VAMPI-10064
+16 IF ADDTYPE="ADDPREFTF"
Begin DoDot:1
+17 SET MPIXML="<IDM_REQUEST type="_QUOTE_"ADDPREFTF"_QUOTE_"><METADATA>"
+18 IF $GET(PATARR("AddType"))="ProxyAddPatientToCerner"
SET MPIXML=MPIXML_"<FIELD name='isOnlyProxyCerner' value='TRUE'/>"
End DoDot:1
+19 IF ADDTYPE'="ADDPREFTF"
SET MPIXML="<IDM_REQUEST type="_QUOTE_"ADD_PROFILE"_QUOTE_"><METADATA>"
+20 SET MPIXML=MPIXML_"<FIELD name="_QUOTE_"PROCESSINGID"_QUOTE_" value="
+21 SET MPIXML=MPIXML_QUOTE_MPIPRID_QUOTE_"/><FIELD name="_QUOTE_"SENDINGFACILITY"
+22 SET MPIXML=MPIXML_QUOTE_" value="_QUOTE_MPISITE_QUOTE_"/><FIELD name="_QUOTE
+23 SET MPIXML=MPIXML_"SENDINGAPPLICATIONNAME"_QUOTE_" value="_QUOTE_"VistAEnterpriseReg"_QUOTE
+24 IF $GET(MPIARR("mcid"))'=""
Begin DoDot:1
+25 SET MPIXML=MPIXML_"/><FIELD name="_QUOTE_"attentionLine"_QUOTE
+26 ;search token
SET MPIXML=MPIXML_" value="_QUOTE_MPIARR("mcid")_QUOTE
End DoDot:1
+27 ;**71 - Story 841885 (ckn)
+28 SET MPIXML=MPIXML_"/><FIELD name="_QUOTE_"selectedIdentifier"_QUOTE
+29 SET MPIXML=MPIXML_" value="_QUOTE_$GET(MPIARR("SelIdentifier"))_QUOTE
+30 SET MPIXML=MPIXML_"/></METADATA><IDMHEADER><SENDING_FACILITY>"_MPISITE
+31 SET MPIXML=MPIXML_"</SENDING_FACILITY><PROCESSING_ID>"_MPIPRID_"</PROCESSING_ID>"
+32 SET MPIXML=MPIXML_"<TRIGGER><ACTOR>"
+33 SET MPIXML=MPIXML_"<IDENTIFIER type='PN'><ID>"_DUZ_"</ID><SOURCE>"_MPISITE_"</SOURCE>"
+34 SET MPIXML=MPIXML_"<ISSUER>USVHA</ISSUER></IDENTIFIER><NAME type='U'>"
+35 SET MPIXML=MPIXML_"<LASTNAME>"_$GET(MPIDUZ("FAMILY"))_"</LASTNAME>"
+36 SET MPIXML=MPIXML_"<FIRSTNAME>"_$GET(MPIDUZ("GIVEN"))_"</FIRSTNAME>"
+37 SET MPIXML=MPIXML_"</NAME></ACTOR></TRIGGER></IDMHEADER><ARGUMENTS>"
+38 IF ADDTYPE'="ADDPREFTF"
SET MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"ACTIVEPROFILE"_QUOTE_"><PROFILE>"
+39 IF ADDTYPE="ADDPREFTF"
SET MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"PROFILE"_QUOTE_"><PROFILE>"
SET MPIXML=MPIXML_"<IDENTIFIER type='NI'><ID>"_$GET(PATARR("ICN"))_"</ID></IDENTIFIER>"
+40 ;Name Traits
+41 SET MPIXML=MPIXML_"<NAME type="_QUOTE_"L"_QUOTE_">"
+42 DO IFADD("FirstName",.PATARR,.MPIXML,"FIRSTNAME")
+43 DO IFADD("MiddleName",.PATARR,.MPIXML,"MIDDLENAME")
+44 DO IFADD("Suffix",.PATARR,.MPIXML,"SUFFIX")
+45 DO IFADD("Surname",.PATARR,.MPIXML,"LASTNAME")
+46 SET MPIXML=MPIXML_"</NAME>"
+47 ;Source ID
+48 SET MPIXML=MPIXML_"<IDENTIFIER type='PI'><ID>"_$GET(PATARR("DFN"))_"</ID>"
+49 IF ADDTYPE="ADDPREFTF"
SET MPIXML=MPIXML_"<SOURCE>"_PATARR("preferredFacilityNumber")_"</SOURCE><ISSUER>USVHA</ISSUER></IDENTIFIER>"
+50 IF ADDTYPE'="ADDPREFTF"
SET MPIXML=MPIXML_"<SOURCE>"_MPISITE_"</SOURCE><ISSUER>USVHA</ISSUER></IDENTIFIER>"
+51 IF $GET(PATARR("SSN"))'=""
Begin DoDot:1
+52 SET MPIXML=MPIXML_"<IDENTIFIER type='SS' subtype='ACTIVE'>"
+53 SET MPIXML=MPIXML_"<ID>"_PATARR("SSN")_"</ID>"
+54 SET MPIXML=MPIXML_"<ISSUER>USSSA</ISSUER></IDENTIFIER>"
End DoDot:1
+55 IF $GET(PATARR("DOB"))'=""
Begin DoDot:1
+56 SET MPIXML=MPIXML_"<ATTRIBUTE type='DOB'><VALUE>"_$$FMTHL7^XLFDT(PATARR("DOB"))
+57 SET MPIXML=MPIXML_"</VALUE></ATTRIBUTE>"
End DoDot:1
+58 IF $GET(PATARR("Gender"))'=""
Begin DoDot:1
+59 SET MPIXML=MPIXML_"<ATTRIBUTE type='GENDER'><VALUE>"
+60 SET MPIXML=MPIXML_PATARR("Gender")_"</VALUE></ATTRIBUTE>"
End DoDot:1
+61 IF $GET(PATARR("MMN"))'=""
Begin DoDot:1
+62 SET MPIXML=MPIXML_"<ATTRIBUTE type='MMN'>"
+63 SET MPIXML=MPIXML_"<VALUE>"_PATARR("MMN")_"</VALUE></ATTRIBUTE>"
End DoDot:1
+64 IF $GET(PATARR("MBI"))'=""
Begin DoDot:1
+65 SET MPIXML=MPIXML_"<ATTRIBUTE type='MULTIBIRTH'>"
+66 SET MPIXML=MPIXML_"<VALUE>"_PATARR("MBI")_"</VALUE></ATTRIBUTE>"
End DoDot:1
+67 ;POB stuff
+68 SET PATARR("MPIVar")=$$CONV($GET(PATARR("POBCity")))
+69 IF PATARR("MPIVar")'=""!($GET(PATARR("POBState"))'="")
Begin DoDot:1
+70 SET MPIXML=MPIXML_"<ADDRESS type='N'>"
+71 DO IFADD("MPIVar",.PATARR,.MPIXML,"CITY")
+72 DO IFADD("POBState",.PATARR,.MPIXML,"STATE")
+73 SET MPIXML=MPIXML_"</ADDRESS>"
End DoDot:1
+74 ;address stuff
+75 NEW PROVINCE,PCODE
+76 SET PROVINCE=$GET(PATARR("ResAddProvince"))
SET PCODE=$GET(PATARR("ResAddPCode"))
+77 IF $GET(PATARR("ResAddL1"))'=""!($GET(PATARR("ResAddL2"))'="")!($GET(PATARR("ResAddCity"))'="")!($GET(PATARR("ResAddZip4"))'="")!($GET(PATARR("ResAddL3"))'="")!($GET(PATARR("ResAddState"))'="")!(PROVINCE'="")!(PCODE'="")
Begin DoDot:1
+78 SET MPIXML=MPIXML_"<ADDRESS type='P'>"
+79 SET PATARR("MPIVar")=$$CONV($GET(PATARR("ResAddL1")))
+80 DO IFADD("MPIVar",.PATARR,.MPIXML,"STREET1")
+81 SET PATARR("MPIVar")=$$CONV($GET(PATARR("ResAddL2")))
+82 DO IFADD("MPIVar",.PATARR,.MPIXML,"STREET2")
+83 SET PATARR("MPIVar")=$$CONV($GET(PATARR("ResAddL3")))
+84 DO IFADD("MPIVar",.PATARR,.MPIXML,"STREET3")
+85 SET PATARR("MPIVar")=$$CONV($GET(PATARR("ResAddCity")))
+86 DO IFADD("MPIVar",.PATARR,.MPIXML,"CITY")
+87 DO IFADD("ResAddState",.PATARR,.MPIXML,"STATE")
+88 DO IFADD("ResAddZip4",.PATARR,.MPIXML,"ZIPCODE")
+89 DO IFADD("ResAddProvince",.PATARR,.MPIXML,"PROVINCECODE")
+90 DO IFADD("ResAddPCode",.PATARR,.MPIXML,"POSTALCODE")
+91 DO IFADD("ResAddCountry",.PATARR,.MPIXML,"COUNTRY")
+92 SET MPIXML=MPIXML_"</ADDRESS>"
End DoDot:1
+93 ; phone
+94 IF $GET(PATARR("ResPhone"))'=""&($GET(PATARR("ResPhone"))'["""")
Begin DoDot:1
+95 SET PATARR("MPIVar")=$$CONV($GET(PATARR("ResPhone")))
+96 IF PATARR("MPIVar")'=""
Begin DoDot:2
+97 SET MPIXML=MPIXML_"<PHONE type='HOME'><NUMBER>"
+98 SET MPIXML=MPIXML_PATARR("MPIVar")_"</NUMBER></PHONE>"
End DoDot:2
End DoDot:1
+99 ; date of death
+100 IF $GET(PATARR("DOD"))'=""
Begin DoDot:1
+101 SET MPIXML=MPIXML_"<ATTRIBUTE type='DOD'><VALUE>"
+102 SET MPIXML=MPIXML_$$FMTHL7^XLFDT(PATARR("DOD"))_"</VALUE></ATTRIBUTE>"
End DoDot:1
+103 SET MPIXML=MPIXML_"</PROFILE></ARGUMENT>"
+104 SET MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"ADDTYPE"_QUOTE_">"
+105 SET MPIXML=MPIXML_"<VALUE>"_ADDTYPE_"</VALUE></ARGUMENT>"
+106 IF ADDTYPE="ADDPREFTF"
Begin DoDot:1
+107 SET MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"preferredFacilityNumber"_QUOTE_"><VALUE>"_PATARR("preferredFacilityNumber")_"</VALUE></ARGUMENT>"
+108 SET MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"patientVeteran"_QUOTE_"><VALUE>"_PATARR("patientVeteran")_"</VALUE></ARGUMENT>"
+109 SET MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"patientServiceConnected"_QUOTE_"><VALUE>"_PATARR("patientServiceConnected")_"</VALUE></ARGUMENT>"
+110 SET MPIXML=MPIXML_"<ARGUMENT name="_QUOTE_"patientType"_QUOTE_"><VALUE>"_PATARR("patientType")_"</VALUE></ARGUMENT>"
End DoDot:1
+111 SET MPIXML=MPIXML_"</ARGUMENTS></IDM_REQUEST>"
+112 QUIT MPIXML
+113 ;
IFADD(MPIVAR,PATARR,MPIXML,MPIXMLN) ;check if there, if so add it to the XML
+1 ; MPIVAR is the PATARR variable name
+2 ; MPIXMLN is the name of the XML to encase
+3 ; modifies MPIXML to add if it is there
+4 IF $GET(PATARR(MPIVAR))'=""
Begin DoDot:1
+5 SET MPIXML=MPIXML_"<"_MPIXMLN_">"_PATARR(MPIVAR)_"</"_MPIXMLN_">"
End DoDot:1
+6 QUIT
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
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
PARSE(MPIDATA,MPIXML) ;Parse XML for results
+1 ;
+2 ; EN^MXMLPRSE - #4149
+3 ;
+4 KILL ^TMP($JOB,"MPIFXMLI")
+5 NEW MPICB,MPIUSE,MPIVAR,MPIIDN,MPILOC
+6 SET MPICB("STARTELEMENT")="SE^MPIFXMLI"
+7 SET MPICB("CHARACTERS")="VALUE^MPIFXMLI"
+8 SET ^TMP($JOB,"MPIFXMLI",1)=MPIXML
+9 DO EN^MXMLPRSE($NAME(^TMP($JOB,"MPIFXMLI")),.MPICB)
+10 KILL ^TMP($JOB,"MPIFXMLI")
+11 QUIT
SE(MPIN,MPIA) ; - used for the parser to call back with STARTELEMENT
+1 ; just to protect the process
+2 SET MPIN=$GET(MPIN)
+3 SET MPIA("type")=$GET(MPIA("type"))
+4 ;No need for these tags
+5 IF MPIN="IDM_RESPONSE"!(MPIN="RESULT")!(MPIN="ERROR")
QUIT
+6 SET MPILOC="MPIDATA("
+7 IF MPIN="TEXT"
Begin DoDot:1
+8 SET MPIVAR="""ERRTXT"")"
SET MPIDATA("ICN")=-1
End DoDot:1
QUIT
+9 IF MPIN="ID"
SET MPIVAR="""ICN"")"
QUIT
+10 QUIT
+11 ;
VALUE(MPIT) ;used by the parser to call back with CHARACTERS
+1 if $DATA(MPIVAR)
SET @(MPILOC_MPIVAR)=MPIT
KILL MPIVAR
QUIT
+2 QUIT
