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 Dec 13, 2024@02:11:53 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
