- MPIFXMLS ;OAK/ELZ - MPIF HEALTHEVET XML BUILDING - SEARCH ID (PATIENT) ;19 APR 2012
- ;;1.0;MASTER PATIENT INDEX VISTA;**56**;30 Apr 99;Build 2
- ;
- PATIENT(RETURN,MPIID) ; - look up and return PV data from fully qualified id
- ; such as 1000323423^PI^500^USVHA
- ;
- ; RETURN is in MPI array format if not found RETURN=-1
- ;
- ; $$HL7TFM^XLFDT - #10103
- ;
- N MPIXML,MPIXMLR,MPID
- S RETURN=1
- S MPIXML=$$XMLS(MPIID)
- D POST^MPIFHWSC(MPIXML,.MPIXMLR)
- D PARSE(.RETURN,.MPIXMLR)
- ;
- ; must have name, dob and ssn
- I '$L($G(RETURN("Surname","NAME")))!('$L($G(RETURN("DOB"))))!('$L($G(RETURN("SSN")))) K RETURN S RETURN=-1 Q
- ;
- ; convert dob to fm format
- S RETURN("DOB")=$$HL7TFM^XLFDT($G(RETURN("DOB")))
- ;
- Q
- ;
- CARDPV(RETURN,MPICARD,EDIPI) ; - look up PV data from a VIC card number
- ; pass in the VIC card number or EDIPI in MPICARD,
- ; EDIPI if set to 1 to indicate EDIPI lookup
- ; this will return the array:
- ; RETURN(.01)= patient name
- ; RETURN(.02)= patient sex
- ; RETURN(.03)= patient dob
- ; RETURN(.09)= patient ssn
- ; RETURN(.092)= patient place of birth (city)
- ; RETURN(.093)= patient place of birth (state)
- ; RETURN(.2403)= mother's maiden name
- ; RETURN(991.01)= patient icn
- ; RETURN(991.02)= patient icn checksum
- ; or if not found RETURN=-1
- ;
- N MPIXML,MPIDATA,MPIXMLR
- S MPICARD=MPICARD_$S(EDIPI:"^NI^200DOD^USDOD",1:"^PI^742V1^USVHA")
- D PATIENT(.MPIDATA,MPICARD)
- S RETURN=MPIDATA I RETURN=-1 Q
- D DPTLK(.RETURN,.MPIDATA)
- Q
- ;
- DPTLK(RETURN,MPIDATA) ; - sets up return data for DPTLK needs
- N MPISTATE
- S MPISTATE=$G(MPIDATA("POBState"))
- S:$L(MPISTATE) MPISTATE=$O(^DIC(5,"C",MPISTATE,0))
- ;
- S RETURN(.01)=$G(MPIDATA("Surname","NAME"))_","_$G(MPIDATA("FirstName","NAME"))
- S RETURN(.02)=$G(MPIDATA("Gender"))
- S RETURN(.03)=$G(MPIDATA("DOB"))
- S RETURN(.09)=$G(MPIDATA("SSN"))
- S RETURN(.092)=$G(MPIDATA("POBCity"))
- ; setting up state to auto stuff (additional slash) with internal value
- S RETURN(.093)=$S(MPISTATE:"/"_MPISTATE,1:"")
- S RETURN(.2403)=$G(MPIDATA("Surname","MMN"))
- S RETURN(991.01)=$P($G(MPIDATA("MPIID")),"V")
- S RETURN(991.02)=$P($P($G(MPIDATA("MPIID")),"^"),"V",2)
- ;
- Q
- ;
- XMLS(MPIID) ; setup xml to search
- ; MPIID =fully qualified ID to search for a patient delaminated with "^"
- ; Returns XML for the search
- ;
- ; $$SITE^VASITE - #10112
- ; $$PARAM^HLCS2 - #3552 (need)
- ;
- N MPIXML,MPISITE,MPIPCODE
- S MPISITE=$P($$SITE^VASITE,"^",3)
- S MPIPCODE=$P($$PARAM^HLCS2,"^",3)
- S MPIXML="<PRPA_IN201305UV02 xmlns=""urn:hl7-org:v3"" "
- S MPIXML=MPIXML_"xmlns:ps=""http://vaww.oed.oit.domain.ext"" "
- S MPIXML=MPIXML_"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"
- S MPIXML=MPIXML_""" xsi:schemaLocation=""urn:hl7-org:v3 ../../schema/"
- S MPIXML=MPIXML_"HL7V3/NE2008/multicacheschemas/PRPA_IN201305UV02.xsd"
- S MPIXML=MPIXML_""" ITSVersion=""XML_1.0"">"
- S MPIXML=MPIXML_"<id root=""1.2.840.114350.1.13.0.1.7.1.1"" "
- S MPIXML=MPIXML_"extension=""MCID-"_$J_"""/>"
- S MPIXML=MPIXML_"<creationTime value="""_$$FMTHL7^XLFDT($$NOW^XLFDT)_"""/>"
- S MPIXML=MPIXML_"<interactionId root=""2.16.840.1.113883.1.6"" "
- S MPIXML=MPIXML_"extension=""PRPA_IN201305UV02""/>"
- S MPIXML=MPIXML_"<processingCode code="""_MPIPCODE_"""/>"
- S MPIXML=MPIXML_"<processingModeCode code=""T""/>"
- S MPIXML=MPIXML_"<acceptAckCode code=""AL""/>"
- S MPIXML=MPIXML_"<receiver typeCode=""RCV"">"
- S MPIXML=MPIXML_"<device classCode=""DEV"" "
- S MPIXML=MPIXML_"determinerCode=""INSTANCE"">"
- S MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349""/>"
- S MPIXML=MPIXML_"<telecom value=""http://servicelocation/PDQuery""/>"
- S MPIXML=MPIXML_"</device></receiver><sender typeCode=""SND"">"
- S MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
- S MPIXML=MPIXML_"<id extension="""_MPISITE_""""
- S MPIXML=MPIXML_" root=""2.16.840.1.113883.4.349""/>"
- S MPIXML=MPIXML_"</device></sender><controlActProcess "
- S MPIXML=MPIXML_"classCode=""CACT"" moodCode=""EVN"">"
- S MPIXML=MPIXML_"<code code=""PRPA_TE201305UV02"" "
- S MPIXML=MPIXML_"codeSystem=""2.16.840.1.113883.1.6""/>"
- S MPIXML=MPIXML_"<queryByParameter><queryId extension="""_$J_""""
- S MPIXML=MPIXML_" root=""1.2.840.114350.1.13.28.1.18.5.999""/>"
- S MPIXML=MPIXML_"<statusCode code=""new""/>"
- S MPIXML=MPIXML_"<initialQuantity value=""1""/>"
- S MPIXML=MPIXML_"<parameterList><id extension="""_MPIID
- S MPIXML=MPIXML_""" root=""2.16.840.1.113883.4.349""/></parameterList>"
- S MPIXML=MPIXML_"</queryByParameter></controlActProcess>"
- S MPIXML=MPIXML_"</PRPA_IN201305UV02>"
- Q MPIXML
- ;
- PARSE(MPIDATA,MPIXML) ; - parse the data
- ;
- ; EN^MXMLPRSE - #4149
- ;
- K ^TMP($J,"MPIFXMLS")
- N MPICB,MPIUSE,MPIVAR,MPIALIAS
- S MPIALIAS=0
- S MPICB("STARTELEMENT")="SE^MPIFXMLS"
- S MPICB("CHARACTERS")="VALUE^MPIFXMLS"
- S ^TMP($J,"MPIFXMLS",1)=MPIXML
- D EN^MXMLPRSE($NA(^TMP($J,"MPIFXMLS")),.MPICB)
- K ^TMP($J,"MPIFXMLS")
- Q
- ;
- SE(MPIN,MPIA) ; - used for the parser to call back with STARTELEMENT
- ;
- ; just to protect the process
- S MPIN=$G(MPIN)
- S MPIA("extension")=$G(MPIA("extension"))
- S MPIA("code")=$G(MPIA("code"))
- ;
- ; now look for the data I need
- I MPIN="id",$E(MPIA("extension"),1,4)="MCID" Q
- I MPIN="id",MPIA("extension")?3N.NA Q
- I MPIN="id",MPIA("extension")="" Q
- I MPIN="statusCode",'$D(MPIDATA("SSNStatus")) D Q
- . S MPIDATA("SSNStatus")=$G(MPIA("code"))
- I MPIN="id",MPIA("extension")["NI^200M^USVHA^P" D Q
- . S MPIDATA("MPIID")=MPIA("extension")
- I MPIN="id",MPIA("extension")["^SS" D Q
- . S MPIDATA("SSN")=$P(MPIA("extension"),"^")
- I MPIN="name" D Q
- . S MPIUSE=$G(MPIA("use"),0)
- . S MPIUSE=$S(MPIUSE="L":"NAME",MPIUSE="C":"MMN",MPIUSE="P":"ALIAS",1:MPIUSE)
- . S MPIVAR="MPIDATA(""FirstName"","""_MPIUSE_""")"
- . ; P = alias name, need additional subscript
- . I MPIUSE="ALIAS" D
- .. S MPIALIAS=MPIALIAS+1
- .. S MPIVAR="MPIDATA(""FirstName"","""_MPIUSE_","_MPIALIAS_""")"
- . S @MPIVAR=""
- I MPIN="family" D Q
- . S MPIVAR="MPIDATA(""Surname"","""_$G(MPIUSE,0)_$S($G(MPIUSE)="ALIAS":","_MPIALIAS,1:"")_""")"
- . S @MPIVAR=""
- I MPIN="administrativeGenderCode" S MPIDATA("Gender")=MPIA("code") Q
- I MPIN="birthTime" S MPIDATA("DOB")=$G(MPIA("value")) Q
- I MPIN="city" S MPIVAR="MPIDATA(""POBCity"")",@MPIVAR="" Q
- I MPIN="state" S MPIVAR="MPIDATA(""POBState"")",@MPIVAR="" Q
- I MPIN="country" S MPIVAR="MPIDATA(""POBCountry"")",@MPIVAR="" Q
- I MPIN="multipleBirthInd" S MPIDATA("MBI")=MPIA("value") Q
- Q
- ;
- VALUE(MPIT) ; - used by the parser to call back with CHARACTERS
- S:$D(MPIVAR) @MPIVAR=@MPIVAR_$S($L(@MPIVAR):" ",1:"")_MPIT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFXMLS 6687 printed Jan 18, 2025@03:12:59 Page 2
- MPIFXMLS ;OAK/ELZ - MPIF HEALTHEVET XML BUILDING - SEARCH ID (PATIENT) ;19 APR 2012
- +1 ;;1.0;MASTER PATIENT INDEX VISTA;**56**;30 Apr 99;Build 2
- +2 ;
- PATIENT(RETURN,MPIID) ; - look up and return PV data from fully qualified id
- +1 ; such as 1000323423^PI^500^USVHA
- +2 ;
- +3 ; RETURN is in MPI array format if not found RETURN=-1
- +4 ;
- +5 ; $$HL7TFM^XLFDT - #10103
- +6 ;
- +7 NEW MPIXML,MPIXMLR,MPID
- +8 SET RETURN=1
- +9 SET MPIXML=$$XMLS(MPIID)
- +10 DO POST^MPIFHWSC(MPIXML,.MPIXMLR)
- +11 DO PARSE(.RETURN,.MPIXMLR)
- +12 ;
- +13 ; must have name, dob and ssn
- +14 IF '$LENGTH($GET(RETURN("Surname","NAME")))!('$LENGTH($GET(RETURN("DOB"))))!('$LENGTH($GET(RETURN("SSN"))))
- KILL RETURN
- SET RETURN=-1
- QUIT
- +15 ;
- +16 ; convert dob to fm format
- +17 SET RETURN("DOB")=$$HL7TFM^XLFDT($GET(RETURN("DOB")))
- +18 ;
- +19 QUIT
- +20 ;
- CARDPV(RETURN,MPICARD,EDIPI) ; - look up PV data from a VIC card number
- +1 ; pass in the VIC card number or EDIPI in MPICARD,
- +2 ; EDIPI if set to 1 to indicate EDIPI lookup
- +3 ; this will return the array:
- +4 ; RETURN(.01)= patient name
- +5 ; RETURN(.02)= patient sex
- +6 ; RETURN(.03)= patient dob
- +7 ; RETURN(.09)= patient ssn
- +8 ; RETURN(.092)= patient place of birth (city)
- +9 ; RETURN(.093)= patient place of birth (state)
- +10 ; RETURN(.2403)= mother's maiden name
- +11 ; RETURN(991.01)= patient icn
- +12 ; RETURN(991.02)= patient icn checksum
- +13 ; or if not found RETURN=-1
- +14 ;
- +15 NEW MPIXML,MPIDATA,MPIXMLR
- +16 SET MPICARD=MPICARD_$SELECT(EDIPI:"^NI^200DOD^USDOD",1:"^PI^742V1^USVHA")
- +17 DO PATIENT(.MPIDATA,MPICARD)
- +18 SET RETURN=MPIDATA
- IF RETURN=-1
- QUIT
- +19 DO DPTLK(.RETURN,.MPIDATA)
- +20 QUIT
- +21 ;
- DPTLK(RETURN,MPIDATA) ; - sets up return data for DPTLK needs
- +1 NEW MPISTATE
- +2 SET MPISTATE=$GET(MPIDATA("POBState"))
- +3 if $LENGTH(MPISTATE)
- SET MPISTATE=$ORDER(^DIC(5,"C",MPISTATE,0))
- +4 ;
- +5 SET RETURN(.01)=$GET(MPIDATA("Surname","NAME"))_","_$GET(MPIDATA("FirstName","NAME"))
- +6 SET RETURN(.02)=$GET(MPIDATA("Gender"))
- +7 SET RETURN(.03)=$GET(MPIDATA("DOB"))
- +8 SET RETURN(.09)=$GET(MPIDATA("SSN"))
- +9 SET RETURN(.092)=$GET(MPIDATA("POBCity"))
- +10 ; setting up state to auto stuff (additional slash) with internal value
- +11 SET RETURN(.093)=$SELECT(MPISTATE:"/"_MPISTATE,1:"")
- +12 SET RETURN(.2403)=$GET(MPIDATA("Surname","MMN"))
- +13 SET RETURN(991.01)=$PIECE($GET(MPIDATA("MPIID")),"V")
- +14 SET RETURN(991.02)=$PIECE($PIECE($GET(MPIDATA("MPIID")),"^"),"V",2)
- +15 ;
- +16 QUIT
- +17 ;
- XMLS(MPIID) ; setup xml to search
- +1 ; MPIID =fully qualified ID to search for a patient delaminated with "^"
- +2 ; Returns XML for the search
- +3 ;
- +4 ; $$SITE^VASITE - #10112
- +5 ; $$PARAM^HLCS2 - #3552 (need)
- +6 ;
- +7 NEW MPIXML,MPISITE,MPIPCODE
- +8 SET MPISITE=$PIECE($$SITE^VASITE,"^",3)
- +9 SET MPIPCODE=$PIECE($$PARAM^HLCS2,"^",3)
- +10 SET MPIXML="<PRPA_IN201305UV02 xmlns=""urn:hl7-org:v3"" "
- +11 SET MPIXML=MPIXML_"xmlns:ps=""http://vaww.oed.oit.domain.ext"" "
- +12 SET MPIXML=MPIXML_"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"
- +13 SET MPIXML=MPIXML_""" xsi:schemaLocation=""urn:hl7-org:v3 ../../schema/"
- +14 SET MPIXML=MPIXML_"HL7V3/NE2008/multicacheschemas/PRPA_IN201305UV02.xsd"
- +15 SET MPIXML=MPIXML_""" ITSVersion=""XML_1.0"">"
- +16 SET MPIXML=MPIXML_"<id root=""1.2.840.114350.1.13.0.1.7.1.1"" "
- +17 SET MPIXML=MPIXML_"extension=""MCID-"_$JOB_"""/>"
- +18 SET MPIXML=MPIXML_"<creationTime value="""_$$FMTHL7^XLFDT($$NOW^XLFDT)_"""/>"
- +19 SET MPIXML=MPIXML_"<interactionId root=""2.16.840.1.113883.1.6"" "
- +20 SET MPIXML=MPIXML_"extension=""PRPA_IN201305UV02""/>"
- +21 SET MPIXML=MPIXML_"<processingCode code="""_MPIPCODE_"""/>"
- +22 SET MPIXML=MPIXML_"<processingModeCode code=""T""/>"
- +23 SET MPIXML=MPIXML_"<acceptAckCode code=""AL""/>"
- +24 SET MPIXML=MPIXML_"<receiver typeCode=""RCV"">"
- +25 SET MPIXML=MPIXML_"<device classCode=""DEV"" "
- +26 SET MPIXML=MPIXML_"determinerCode=""INSTANCE"">"
- +27 SET MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349""/>"
- +28 SET MPIXML=MPIXML_"<telecom value=""http://servicelocation/PDQuery""/>"
- +29 SET MPIXML=MPIXML_"</device></receiver><sender typeCode=""SND"">"
- +30 SET MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
- +31 SET MPIXML=MPIXML_"<id extension="""_MPISITE_""""
- +32 SET MPIXML=MPIXML_" root=""2.16.840.1.113883.4.349""/>"
- +33 SET MPIXML=MPIXML_"</device></sender><controlActProcess "
- +34 SET MPIXML=MPIXML_"classCode=""CACT"" moodCode=""EVN"">"
- +35 SET MPIXML=MPIXML_"<code code=""PRPA_TE201305UV02"" "
- +36 SET MPIXML=MPIXML_"codeSystem=""2.16.840.1.113883.1.6""/>"
- +37 SET MPIXML=MPIXML_"<queryByParameter><queryId extension="""_$JOB_""""
- +38 SET MPIXML=MPIXML_" root=""1.2.840.114350.1.13.28.1.18.5.999""/>"
- +39 SET MPIXML=MPIXML_"<statusCode code=""new""/>"
- +40 SET MPIXML=MPIXML_"<initialQuantity value=""1""/>"
- +41 SET MPIXML=MPIXML_"<parameterList><id extension="""_MPIID
- +42 SET MPIXML=MPIXML_""" root=""2.16.840.1.113883.4.349""/></parameterList>"
- +43 SET MPIXML=MPIXML_"</queryByParameter></controlActProcess>"
- +44 SET MPIXML=MPIXML_"</PRPA_IN201305UV02>"
- +45 QUIT MPIXML
- +46 ;
- PARSE(MPIDATA,MPIXML) ; - parse the data
- +1 ;
- +2 ; EN^MXMLPRSE - #4149
- +3 ;
- +4 KILL ^TMP($JOB,"MPIFXMLS")
- +5 NEW MPICB,MPIUSE,MPIVAR,MPIALIAS
- +6 SET MPIALIAS=0
- +7 SET MPICB("STARTELEMENT")="SE^MPIFXMLS"
- +8 SET MPICB("CHARACTERS")="VALUE^MPIFXMLS"
- +9 SET ^TMP($JOB,"MPIFXMLS",1)=MPIXML
- +10 DO EN^MXMLPRSE($NAME(^TMP($JOB,"MPIFXMLS")),.MPICB)
- +11 KILL ^TMP($JOB,"MPIFXMLS")
- +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("extension")=$GET(MPIA("extension"))
- +5 SET MPIA("code")=$GET(MPIA("code"))
- +6 ;
- +7 ; now look for the data I need
- +8 IF MPIN="id"
- IF $EXTRACT(MPIA("extension"),1,4)="MCID"
- QUIT
- +9 IF MPIN="id"
- IF MPIA("extension")?3N.NA
- QUIT
- +10 IF MPIN="id"
- IF MPIA("extension")=""
- QUIT
- +11 IF MPIN="statusCode"
- IF '$DATA(MPIDATA("SSNStatus"))
- Begin DoDot:1
- +12 SET MPIDATA("SSNStatus")=$GET(MPIA("code"))
- End DoDot:1
- QUIT
- +13 IF MPIN="id"
- IF MPIA("extension")["NI^200M^USVHA^P"
- Begin DoDot:1
- +14 SET MPIDATA("MPIID")=MPIA("extension")
- End DoDot:1
- QUIT
- +15 IF MPIN="id"
- IF MPIA("extension")["^SS"
- Begin DoDot:1
- +16 SET MPIDATA("SSN")=$PIECE(MPIA("extension"),"^")
- End DoDot:1
- QUIT
- +17 IF MPIN="name"
- Begin DoDot:1
- +18 SET MPIUSE=$GET(MPIA("use"),0)
- +19 SET MPIUSE=$SELECT(MPIUSE="L":"NAME",MPIUSE="C":"MMN",MPIUSE="P":"ALIAS",1:MPIUSE)
- +20 SET MPIVAR="MPIDATA(""FirstName"","""_MPIUSE_""")"
- +21 ; P = alias name, need additional subscript
- +22 IF MPIUSE="ALIAS"
- Begin DoDot:2
- +23 SET MPIALIAS=MPIALIAS+1
- +24 SET MPIVAR="MPIDATA(""FirstName"","""_MPIUSE_","_MPIALIAS_""")"
- End DoDot:2
- +25 SET @MPIVAR=""
- End DoDot:1
- QUIT
- +26 IF MPIN="family"
- Begin DoDot:1
- +27 SET MPIVAR="MPIDATA(""Surname"","""_$GET(MPIUSE,0)_$SELECT($GET(MPIUSE)="ALIAS":","_MPIALIAS,1:"")_""")"
- +28 SET @MPIVAR=""
- End DoDot:1
- QUIT
- +29 IF MPIN="administrativeGenderCode"
- SET MPIDATA("Gender")=MPIA("code")
- QUIT
- +30 IF MPIN="birthTime"
- SET MPIDATA("DOB")=$GET(MPIA("value"))
- QUIT
- +31 IF MPIN="city"
- SET MPIVAR="MPIDATA(""POBCity"")"
- SET @MPIVAR=""
- QUIT
- +32 IF MPIN="state"
- SET MPIVAR="MPIDATA(""POBState"")"
- SET @MPIVAR=""
- QUIT
- +33 IF MPIN="country"
- SET MPIVAR="MPIDATA(""POBCountry"")"
- SET @MPIVAR=""
- QUIT
- +34 IF MPIN="multipleBirthInd"
- SET MPIDATA("MBI")=MPIA("value")
- QUIT
- +35 QUIT
- +36 ;
- VALUE(MPIT) ; - used by the parser to call back with CHARACTERS
- +1 if $DATA(MPIVAR)
- SET @MPIVAR=@MPIVAR_$SELECT($LENGTH(@MPIVAR):" ",1:"")_MPIT
- +2 QUIT