Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MPIFXMLS

MPIFXMLS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. PATIENT(RETURN,MPIID) ; - look up and return PV data from fully qualified id
  1. ; such as 1000323423^PI^500^USVHA
  1. ;
  1. ; RETURN is in MPI array format if not found RETURN=-1
  1. ;
  1. ; $$HL7TFM^XLFDT - #10103
  1. ;
  1. N MPIXML,MPIXMLR,MPID
  1. S RETURN=1
  1. S MPIXML=$$XMLS(MPIID)
  1. D POST^MPIFHWSC(MPIXML,.MPIXMLR)
  1. D PARSE(.RETURN,.MPIXMLR)
  1. ;
  1. ; must have name, dob and ssn
  1. I '$L($G(RETURN("Surname","NAME")))!('$L($G(RETURN("DOB"))))!('$L($G(RETURN("SSN")))) K RETURN S RETURN=-1 Q
  1. ;
  1. ; convert dob to fm format
  1. S RETURN("DOB")=$$HL7TFM^XLFDT($G(RETURN("DOB")))
  1. ;
  1. Q
  1. ;
  1. CARDPV(RETURN,MPICARD,EDIPI) ; - look up PV data from a VIC card number
  1. ; pass in the VIC card number or EDIPI in MPICARD,
  1. ; EDIPI if set to 1 to indicate EDIPI lookup
  1. ; this will return the array:
  1. ; RETURN(.01)= patient name
  1. ; RETURN(.02)= patient sex
  1. ; RETURN(.03)= patient dob
  1. ; RETURN(.09)= patient ssn
  1. ; RETURN(.092)= patient place of birth (city)
  1. ; RETURN(.093)= patient place of birth (state)
  1. ; RETURN(.2403)= mother's maiden name
  1. ; RETURN(991.01)= patient icn
  1. ; RETURN(991.02)= patient icn checksum
  1. ; or if not found RETURN=-1
  1. ;
  1. N MPIXML,MPIDATA,MPIXMLR
  1. S MPICARD=MPICARD_$S(EDIPI:"^NI^200DOD^USDOD",1:"^PI^742V1^USVHA")
  1. D PATIENT(.MPIDATA,MPICARD)
  1. S RETURN=MPIDATA I RETURN=-1 Q
  1. D DPTLK(.RETURN,.MPIDATA)
  1. Q
  1. ;
  1. DPTLK(RETURN,MPIDATA) ; - sets up return data for DPTLK needs
  1. N MPISTATE
  1. S MPISTATE=$G(MPIDATA("POBState"))
  1. S:$L(MPISTATE) MPISTATE=$O(^DIC(5,"C",MPISTATE,0))
  1. ;
  1. S RETURN(.01)=$G(MPIDATA("Surname","NAME"))_","_$G(MPIDATA("FirstName","NAME"))
  1. S RETURN(.02)=$G(MPIDATA("Gender"))
  1. S RETURN(.03)=$G(MPIDATA("DOB"))
  1. S RETURN(.09)=$G(MPIDATA("SSN"))
  1. S RETURN(.092)=$G(MPIDATA("POBCity"))
  1. ; setting up state to auto stuff (additional slash) with internal value
  1. S RETURN(.093)=$S(MPISTATE:"/"_MPISTATE,1:"")
  1. S RETURN(.2403)=$G(MPIDATA("Surname","MMN"))
  1. S RETURN(991.01)=$P($G(MPIDATA("MPIID")),"V")
  1. S RETURN(991.02)=$P($P($G(MPIDATA("MPIID")),"^"),"V",2)
  1. ;
  1. Q
  1. ;
  1. XMLS(MPIID) ; setup xml to search
  1. ; MPIID =fully qualified ID to search for a patient delaminated with "^"
  1. ; Returns XML for the search
  1. ;
  1. ; $$SITE^VASITE - #10112
  1. ; $$PARAM^HLCS2 - #3552 (need)
  1. ;
  1. N MPIXML,MPISITE,MPIPCODE
  1. S MPISITE=$P($$SITE^VASITE,"^",3)
  1. S MPIPCODE=$P($$PARAM^HLCS2,"^",3)
  1. S MPIXML="<PRPA_IN201305UV02 xmlns=""urn:hl7-org:v3"" "
  1. S MPIXML=MPIXML_"xmlns:ps=""http://vaww.oed.oit.domain.ext"" "
  1. S MPIXML=MPIXML_"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"
  1. S MPIXML=MPIXML_""" xsi:schemaLocation=""urn:hl7-org:v3 ../../schema/"
  1. S MPIXML=MPIXML_"HL7V3/NE2008/multicacheschemas/PRPA_IN201305UV02.xsd"
  1. S MPIXML=MPIXML_""" ITSVersion=""XML_1.0"">"
  1. S MPIXML=MPIXML_"<id root=""1.2.840.114350.1.13.0.1.7.1.1"" "
  1. S MPIXML=MPIXML_"extension=""MCID-"_$J_"""/>"
  1. S MPIXML=MPIXML_"<creationTime value="""_$$FMTHL7^XLFDT($$NOW^XLFDT)_"""/>"
  1. S MPIXML=MPIXML_"<interactionId root=""2.16.840.1.113883.1.6"" "
  1. S MPIXML=MPIXML_"extension=""PRPA_IN201305UV02""/>"
  1. S MPIXML=MPIXML_"<processingCode code="""_MPIPCODE_"""/>"
  1. S MPIXML=MPIXML_"<processingModeCode code=""T""/>"
  1. S MPIXML=MPIXML_"<acceptAckCode code=""AL""/>"
  1. S MPIXML=MPIXML_"<receiver typeCode=""RCV"">"
  1. S MPIXML=MPIXML_"<device classCode=""DEV"" "
  1. S MPIXML=MPIXML_"determinerCode=""INSTANCE"">"
  1. S MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349""/>"
  1. S MPIXML=MPIXML_"<telecom value=""http://servicelocation/PDQuery""/>"
  1. S MPIXML=MPIXML_"</device></receiver><sender typeCode=""SND"">"
  1. S MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
  1. S MPIXML=MPIXML_"<id extension="""_MPISITE_""""
  1. S MPIXML=MPIXML_" root=""2.16.840.1.113883.4.349""/>"
  1. S MPIXML=MPIXML_"</device></sender><controlActProcess "
  1. S MPIXML=MPIXML_"classCode=""CACT"" moodCode=""EVN"">"
  1. S MPIXML=MPIXML_"<code code=""PRPA_TE201305UV02"" "
  1. S MPIXML=MPIXML_"codeSystem=""2.16.840.1.113883.1.6""/>"
  1. S MPIXML=MPIXML_"<queryByParameter><queryId extension="""_$J_""""
  1. S MPIXML=MPIXML_" root=""1.2.840.114350.1.13.28.1.18.5.999""/>"
  1. S MPIXML=MPIXML_"<statusCode code=""new""/>"
  1. S MPIXML=MPIXML_"<initialQuantity value=""1""/>"
  1. S MPIXML=MPIXML_"<parameterList><id extension="""_MPIID
  1. S MPIXML=MPIXML_""" root=""2.16.840.1.113883.4.349""/></parameterList>"
  1. S MPIXML=MPIXML_"</queryByParameter></controlActProcess>"
  1. S MPIXML=MPIXML_"</PRPA_IN201305UV02>"
  1. Q MPIXML
  1. ;
  1. PARSE(MPIDATA,MPIXML) ; - parse the data
  1. ;
  1. ; EN^MXMLPRSE - #4149
  1. ;
  1. K ^TMP($J,"MPIFXMLS")
  1. N MPICB,MPIUSE,MPIVAR,MPIALIAS
  1. S MPIALIAS=0
  1. S MPICB("STARTELEMENT")="SE^MPIFXMLS"
  1. S MPICB("CHARACTERS")="VALUE^MPIFXMLS"
  1. S ^TMP($J,"MPIFXMLS",1)=MPIXML
  1. D EN^MXMLPRSE($NA(^TMP($J,"MPIFXMLS")),.MPICB)
  1. K ^TMP($J,"MPIFXMLS")
  1. Q
  1. ;
  1. SE(MPIN,MPIA) ; - used for the parser to call back with STARTELEMENT
  1. ;
  1. ; just to protect the process
  1. S MPIN=$G(MPIN)
  1. S MPIA("extension")=$G(MPIA("extension"))
  1. S MPIA("code")=$G(MPIA("code"))
  1. ;
  1. ; now look for the data I need
  1. I MPIN="id",$E(MPIA("extension"),1,4)="MCID" Q
  1. I MPIN="id",MPIA("extension")?3N.NA Q
  1. I MPIN="id",MPIA("extension")="" Q
  1. I MPIN="statusCode",'$D(MPIDATA("SSNStatus")) D Q
  1. . S MPIDATA("SSNStatus")=$G(MPIA("code"))
  1. I MPIN="id",MPIA("extension")["NI^200M^USVHA^P" D Q
  1. . S MPIDATA("MPIID")=MPIA("extension")
  1. I MPIN="id",MPIA("extension")["^SS" D Q
  1. . S MPIDATA("SSN")=$P(MPIA("extension"),"^")
  1. I MPIN="name" D Q
  1. . S MPIUSE=$G(MPIA("use"),0)
  1. . S MPIUSE=$S(MPIUSE="L":"NAME",MPIUSE="C":"MMN",MPIUSE="P":"ALIAS",1:MPIUSE)
  1. . S MPIVAR="MPIDATA(""FirstName"","""_MPIUSE_""")"
  1. . ; P = alias name, need additional subscript
  1. . I MPIUSE="ALIAS" D
  1. .. S MPIALIAS=MPIALIAS+1
  1. .. S MPIVAR="MPIDATA(""FirstName"","""_MPIUSE_","_MPIALIAS_""")"
  1. . S @MPIVAR=""
  1. I MPIN="family" D Q
  1. . S MPIVAR="MPIDATA(""Surname"","""_$G(MPIUSE,0)_$S($G(MPIUSE)="ALIAS":","_MPIALIAS,1:"")_""")"
  1. . S @MPIVAR=""
  1. I MPIN="administrativeGenderCode" S MPIDATA("Gender")=MPIA("code") Q
  1. I MPIN="birthTime" S MPIDATA("DOB")=$G(MPIA("value")) Q
  1. I MPIN="city" S MPIVAR="MPIDATA(""POBCity"")",@MPIVAR="" Q
  1. I MPIN="state" S MPIVAR="MPIDATA(""POBState"")",@MPIVAR="" Q
  1. I MPIN="country" S MPIVAR="MPIDATA(""POBCountry"")",@MPIVAR="" Q
  1. I MPIN="multipleBirthInd" S MPIDATA("MBI")=MPIA("value") Q
  1. Q
  1. ;
  1. VALUE(MPIT) ; - used by the parser to call back with CHARACTERS
  1. S:$D(MPIVAR) @MPIVAR=@MPIVAR_$S($L(@MPIVAR):" ",1:"")_MPIT
  1. Q