- 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 Jan 18, 2025@03:12:58 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