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

MPIFXMLP.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. PATIENT(RETURN,MPIARR) ; - query for patients based on traits
  1. ; MPIARR("")=""
  1. ;
  1. ;
  1. N MPIXML,MPIXMLR,MPID,MPIPAT
  1. K RETURN
  1. S MPIXML=$$XMLBLD(.MPIARR)
  1. D POST^MPIFHWSC(MPIXML,.MPIXMLR)
  1. I '$D(MPIXMLR) S RETURN="-1^Query to Person Search returned nothing." Q
  1. D PARSE(.RETURN,.MPIXMLR)
  1. ;
  1. ; convert dob to fm format
  1. ; Story 722746 need DOD formatted as well if there is one
  1. 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"))
  1. ;
  1. ;
  1. Q
  1. ;
  1. XMLBLD(MPIARR) ; setup xml to search
  1. ; MPIARR - Array of traits for seach
  1. ; Returns XML for the search
  1. ;
  1. ; $$SITE^VASITE - #10112
  1. ;
  1. N MPIXML,MPISITE,QUOTE,MPITHRES,MPIDT,MPIDUZ,MPIPRID
  1. S QUOTE=""""
  1. S MPISITE=$P($$SITE^VASITE,"^",3)
  1. S MPIPRID=$P($$PARAM^HLCS2,"^",3)
  1. S MPIDT=$$FMTHL7^XLFDT($$NOW^XLFDT)
  1. S MPIDUZ=$P(^VA(200,DUZ,0),"^") D STDNAME^XLFNAME(.MPIDUZ,"C")
  1. S MPITHRES=80
  1. ;
  1. ; heading
  1. S MPIXML="<IDM_REQUEST type="_QUOTE_"SEARCH_PROFILE"_QUOTE_"><METADATA>"
  1. S MPIXML=MPIXML_"<FIELD name="_QUOTE_"SENDINGFACILITY"_QUOTE_" value="
  1. S MPIXML=MPIXML_QUOTE_MPISITE_QUOTE_"/><FIELD name="_QUOTE_"matchType"
  1. S MPIXML=MPIXML_QUOTE_" value="_QUOTE_"VISTA_REG"_QUOTE_"/><FIELD name="
  1. S MPIXML=MPIXML_QUOTE_"returnMax"_QUOTE_" value="_QUOTE_"100"_QUOTE_"/>"
  1. S MPIXML=MPIXML_"<FIELD name="_QUOTE_"algorithm"_QUOTE_" value="_QUOTE
  1. S MPIXML=MPIXML_"PROB"_QUOTE_"/><FIELD name="_QUOTE_"minScore"_QUOTE
  1. S MPIXML=MPIXML_" value="_QUOTE_MPITHRES_QUOTE_"/><FIELD name="_QUOTE
  1. S MPIXML=MPIXML_"scopingOrganization"_QUOTE_" value="_QUOTE_"VA_DOD"
  1. S MPIXML=MPIXML_QUOTE_"/><FIELD name="_QUOTE_"versionCode"_QUOTE
  1. S MPIXML=MPIXML_" value="_QUOTE_"3.0"_QUOTE_"/><FIELD name="_QUOTE
  1. S MPIXML=MPIXML_"sendingApplicationName"_QUOTE_" value="_QUOTE
  1. S MPIXML=MPIXML_"VISTA_REG"_QUOTE_"/><FIELD name="_QUOTE_"PROCESSINGID"
  1. S MPIXML=MPIXML_QUOTE_" value="_QUOTE_MPIPRID_QUOTE_"/>"
  1. ;**74,Story 1258907 (mko): Add the following to request that the Treating Facilities be returned
  1. S MPIXML=MPIXML_"<FIELD name=""mviModifyCode"" value=""MVI.COMP1""/></METADATA>"
  1. S MPIXML=MPIXML_"<ARGUMENTS><ARGUMENT name="_QUOTE
  1. S MPIXML=MPIXML_"searchProfile"_QUOTE_"><IDMHEADER>"
  1. S MPIXML=MPIXML_"<SENDING_APP>VISTA_REG</SENDING_APP><MSG_DATE_TIME>"
  1. S MPIXML=MPIXML_MPIDT_"</MSG_DATE_TIME><MSG_CONTROL_ID>"_$J
  1. S MPIXML=MPIXML_"</MSG_CONTROL_ID><PROCESSING_ID>"_MPIPRID
  1. S MPIXML=MPIXML_"</PROCESSING_ID><TRIGGER><EVENT>Local Client</EVENT>"
  1. S MPIXML=MPIXML_"<ACTOR>"_DUZ_"~PN~"_MPISITE_"~USDVA^" ;**74,Story 1258907 (mko): Changed from USVHA to USDVA
  1. S MPIXML=MPIXML_$G(MPIDUZ("FAMILY"))_"^"_$G(MPIDUZ("GIVEN"))_"</ACTOR>"
  1. S MPIXML=MPIXML_"<DATETIME>"_MPIDT_"</DATETIME><SOURCE>VISTA</SOURCE>"
  1. S MPIXML=MPIXML_"</TRIGGER></IDMHEADER><PROFILE>"
  1. ;
  1. ; name traits
  1. S MPIXML=MPIXML_"<NAME type="_QUOTE_"L"_QUOTE_">"
  1. D IFADD("FirstName",.MPIARR,.MPIXML,"FIRSTNAME")
  1. D IFADD("MiddleName",.MPIARR,.MPIXML,"MIDDLENAME")
  1. D IFADD("Suffix",.MPIARR,.MPIXML,"SUFFIX")
  1. D IFADD("Surname",.MPIARR,.MPIXML,"LASTNAME")
  1. S MPIXML=MPIXML_"</NAME>"
  1. ;
  1. ; other traits
  1. I $G(MPIARR("SSN"))'="" D
  1. . S MPIXML=MPIXML_"<IDENTIFIER type="_QUOTE_"SS"_QUOTE_" subtype="
  1. . S MPIXML=MPIXML_QUOTE_"ACTIVE"_QUOTE_"><ID>"_MPIARR("SSN")
  1. . S MPIXML=MPIXML_"</ID></IDENTIFIER>"
  1. I $G(MPIARR("DOB"))'="" D
  1. . S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"DOB"_QUOTE_"><VALUE>"
  1. . S MPIXML=MPIXML_$$FMTHL7^XLFDT(MPIARR("DOB"))_"</VALUE></ATTRIBUTE>"
  1. I $G(MPIARR("Gender"))'="" D
  1. . S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"GENDER"_QUOTE_">"
  1. . S MPIXML=MPIXML_"<VALUE>"_MPIARR("Gender")_"</VALUE></ATTRIBUTE>"
  1. I $G(MPIARR("MMN"))'="" D
  1. . S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"MMN"_QUOTE_">"
  1. . S MPIXML=MPIXML_"<VALUE>"_MPIARR("MMN")_"</VALUE></ATTRIBUTE>"
  1. I $G(MPIARR("MBI"))'="" D
  1. . S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"MULTIBIRTH"_QUOTE_">"
  1. . S MPIXML=MPIXML_"<VALUE>"_MPIARR("MBI")_"</VALUE></ATTRIBUTE>"
  1. ;
  1. ;POB stuff
  1. S MPIARR("MPIVar")=$$CONV($G(MPIARR("POBCity")))
  1. I MPIARR("MPIVar")'=""!($G(MPIARR("POBState"))'="") D
  1. . S MPIXML=MPIXML_"<ADDRESS type="_QUOTE_"N"_QUOTE_">"
  1. . D IFADD("MPIVar",.MPIARR,.MPIXML,"CITY")
  1. . D IFADD("POBState",.MPIARR,.MPIXML,"STATE")
  1. . S MPIXML=MPIXML_"</ADDRESS>"
  1. ;
  1. ;address stuff
  1. I $G(MPIARR("ResAddL1"))'=""!($G(MPIARR("ResAddL2"))'="")!($G(MPIARR("ResAddCity"))'="")!($G(MPIARR("ResAddZip4"))'="")!($G(MPIARR("ResAddL3"))'="")!($G(MPIARR("ResAddState"))'="") D
  1. . S MPIXML=MPIXML_"<ADDRESS type="_QUOTE_"P"_QUOTE_">"
  1. . S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResAddL1")))
  1. . D IFADD("MPIVar",.MPIARR,.MPIXML,"STREET1")
  1. . S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResAddL2")))
  1. . D IFADD("MPIVar",.MPIARR,.MPIXML,"STREET2")
  1. . S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResAddL3")))
  1. . D IFADD("MPIVar",.MPIARR,.MPIXML,"STREET3")
  1. . S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResAddCity")))
  1. . D IFADD("MPIVar",.MPIARR,.MPIXML,"CITY")
  1. . D IFADD("ResAddState",.MPIARR,.MPIXML,"STATE")
  1. . D IFADD("ResAddZip4",.MPIARR,.MPIXML,"ZIPCODE")
  1. . D IFADD("ResAddProvince",.MPIARR,.MPIXML,"PROVINCECODE")
  1. . D IFADD("ResAddPCode",.MPIARR,.MPIXML,"POSTALCODE")
  1. . D IFADD("ResAddCountry",.MPIARR,.MPIXML,"COUNTRY")
  1. . S MPIXML=MPIXML_"</ADDRESS>"
  1. ;
  1. ; phone
  1. I $G(MPIARR("ResPhone"))'=""&($G(MPIARR("ResPhone"))'["""") D
  1. . S MPIARR("MPIVar")=$$CONV($G(MPIARR("ResPhone")))
  1. . I MPIARR("MPIVar")'="" D
  1. .. S MPIXML=MPIXML_"<PHONE type="_QUOTE_"HOME"_QUOTE_"><NUMBER>"
  1. .. S MPIXML=MPIXML_MPIARR("MPIVar")_"</NUMBER></PHONE>"
  1. ;
  1. ; dod
  1. I $G(MPIARR("DOD"))'="" D
  1. . S MPIXML=MPIXML_"<ATTRIBUTE type="_QUOTE_"DOD"_QUOTE_"><VALUE>"
  1. . S MPIXML=MPIXML_$$FMTHL7^XLFDT(MPIARR("DOD"))_"</VALUE></ATTRIBUTE>"
  1. ;
  1. ; end data
  1. S MPIXML=MPIXML_"</PROFILE></ARGUMENT></ARGUMENTS></IDM_REQUEST>"
  1. K MPIARR("MPIVar")
  1. Q MPIXML
  1. ;
  1. IFADD(MPIVAR,MPIARR,MPIXML,MPIXMLN) ;check if there, if so add it to the XML
  1. ; MPIVAR is the MPIARR variable name
  1. ; MPIXMLN is the name of the XML to encase
  1. ; modifies MPIXML to add if it is there
  1. I $G(MPIARR(MPIVAR))'="" D
  1. . S MPIXML=MPIXML_"<"_MPIXMLN_">"_MPIARR(MPIVAR)_"</"_MPIXMLN_">"
  1. Q
  1. ;
  1. CONV(FIELD) ;check for &, ', > and <
  1. I FIELD["&" S FIELD=$P(FIELD,"&")_"&"_$P(FIELD,"&",2)
  1. I FIELD["'" S FIELD=$P(FIELD,"'")_"'"_$P(FIELD,"'",2)
  1. S:(FIELD["<") FIELD=$$CONVA(FIELD,"<")
  1. S:(FIELD[">") FIELD=$$CONVA(FIELD,">")
  1. Q FIELD
  1. ;
  1. CONVA(FIELD,ENCHAR) ;handle <<pob city>>
  1. N I,X,VAL
  1. S VAL="",I=$L(FIELD,ENCHAR) F X=1:1:I S VAL=VAL_$P(FIELD,ENCHAR,X)
  1. Q VAL
  1. ;
  1. PARSE(MPIDATA,MPIXML) ; - parse the data
  1. ;
  1. ; EN^MXMLPRSE - #4149
  1. ;
  1. K ^TMP($J,"MPIFXMLP")
  1. N MPICB,MPIUSE,MPIVAR,MPIPAT,MPIALIAS,MPILOC,MPIIDS,MPIIGNID
  1. S (MPIPAT,MPIIDS)=0
  1. S MPICB("STARTELEMENT")="SE^MPIFXMLP"
  1. S MPICB("CHARACTERS")="VALUE^MPIFXMLP"
  1. S ^TMP($J,"MPIFXMLP",1)=MPIXML
  1. D EN^MXMLPRSE($NA(^TMP($J,"MPIFXMLP")),.MPICB)
  1. K ^TMP($J,"MPIFXMLP")
  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("type")=$G(MPIA("type"))
  1. S MPIA("subtype")=$G(MPIA("subtype"))
  1. S MPIA("name")=$G(MPIA("name"))
  1. S MPIA("value")=$G(MPIA("value"))
  1. ; my variable to protect
  1. S MPIUSE=$G(MPIUSE)
  1. ;
  1. ; got a business rule error
  1. I MPIN="RESULT",MPIA("type")="AA",MPIA("subtype")="QE" S MPIDATA("Result")="QE" Q
  1. ; don't use these
  1. I MPIN="IDM_RESPONSE"!(MPIN="METADATA")!(MPIN="IDATTR") Q
  1. ;**74,Story 1258907 (mko): Don't ignore ISSUER or STATUS elements
  1. I MPIN="RESULT" Q ;!(MPIN="ISSUER")!(MPIN="STATUS") Q
  1. I MPIN="EFFECTIVE"!(MPIN="BADADDRESSCODE")!(MPIN="BADADDRESSTEXT") Q
  1. I MPIN="IDATTR",MPIA("type")="PSEUDO_SSN",MPIA("subtype")="CODE" Q
  1. I MPIN="ASSOC",MPIA("type")="ALIAS_SSN" Q
  1. ;
  1. ; save some field data
  1. I MPIN="FIELD" S:MPIA("name")]"" MPIDATA(MPIA("name"))=MPIA("value") Q
  1. ;
  1. ;**74,Story 1258907 (mko): For each PROFILE encountered, also initialize MPIIDS to 0
  1. I MPIN="PROFILE" S MPIPAT=MPIPAT+1,MPIALIAS=0,MPIIDS=0,MPILOC="MPIDATA("_MPIPAT Q
  1. I MPIN="NAME" D Q
  1. . S MPIUSE=MPIA("type")
  1. . S:MPIUSE="A" MPIALIAS=MPIALIAS+1
  1. I MPIUSE="D",MPIN="NAME" S MPIVAR=",""PreferName"")" q
  1. I MPIN="FIRSTNAME",MPIUSE="L" S MPIVAR=",""FirstName"")" Q
  1. I MPIN="LASTNAME",MPIUSE="L" S MPIVAR=",""Surname"")" Q
  1. I MPIN="MIDDLENAME",MPIUSE="L" S MPIVAR=",""MiddleName"")" Q
  1. I MPIN="SUFFIX",MPIUSE="L" S MPIVAR=",""Suffix"")" Q
  1. I MPIN="PREFIX",MPIUSE="L" S MPIVAR=",""Prefix"")" Q
  1. I MPIN="FIRSTNAME",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""FirstName"")" Q
  1. I MPIN="LASTNAME",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""Surname"")" Q
  1. I MPIN="MIDDLENAME",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""MiddleName"")" Q
  1. I MPIN="SUFFIX",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""Suffix"")" Q
  1. I MPIN="PREFIX",MPIUSE="A" S MPIVAR=",""ALIAS"","_MPIALIAS_",""Prefix"")" Q
  1. I MPIN="IDENTIFIER" D Q
  1. . K MPIIGNID
  1. . I MPIA("type")="SS",MPIA("subtype")="ALIAS" S MPIUSE="ALIASSSN" Q
  1. . I MPIA("type")="SS" S MPIUSE="SSN" Q
  1. . I MPIA("type")="NI",MPIA("subtype")="IDM" S MPIUSE="ICN" Q
  1. . ;**74,Story 1258907 (mko): Add storing PIs in the "IDS" array; also store the type here as "IDTYPE"
  1. . I "^NI^PI^PN^EI^NPI^"[("^"_MPIA("type")_"^"),MPIA("subtype")="" S MPIIDS=MPIIDS+1,MPIUSE="IDS",@(MPILOC_",""IDS"","_MPIIDS_",""IDTYPE"")")=MPIA("type") Q
  1. . ;**74,Story 1258907 (mko): Otherwise, we'll ignore this identifier.
  1. . S MPIIGNID=1,MPIUSE="" K MPIVAR
  1. I MPIN="ID" D Q
  1. . I MPIUSE="ALIASSSN" S MPIVAR=",""ALIAS"","_MPIALIAS_",""SSN"")" Q
  1. . I MPIUSE="SSN" S MPIVAR=",""SSN"")" K MPIUSE Q
  1. . I MPIUSE="ICN" S MPIVAR=",""ICN"")" K MPIUSE Q
  1. . I MPIUSE="EDIPI" S MPIVAR=",""EDIPI"")" K MPIUSE Q
  1. . I MPIUSE="IDS" S MPIVAR=",""IDS"","_MPIIDS_",""ID"")" Q
  1. ;**74,Story 1258907 (mko): Ignore SOURCE if we're ignoring this IDENTIFIER
  1. I MPIN="SOURCE",'$G(MPIIGNID) S MPIVAR=",""IDS"","_MPIIDS_",""SOURCE"")" Q
  1. ;**74,Story 1258907 (mko): Store the ISSUER and STATUS in the "IDS" array
  1. I MPIN="ISSUER",$G(MPIUSE)="IDS" S MPIVAR=",""IDS"","_MPIIDS_",""ISSUER"")" Q
  1. I MPIN="STATUS",$G(MPIUSE)="IDS" S MPIVAR=",""IDS"","_MPIIDS_",""STATUS"")" Q
  1. I MPIN="ATTRIBUTE" D Q
  1. . I MPIA("type")="SCORE" S MPIUSE="Score" Q
  1. . I MPIA("type")="MMN" S MPIUSE="MMN" Q
  1. . I MPIA("type")="DOB" S MPIUSE="DOB" Q
  1. . I MPIA("type")="GENDER" S MPIUSE="Gender" Q
  1. .;**79 including MBI
  1. .I MPIA("type")="MULTIBIRTH" S MPIUSE="MBI" Q
  1. . ; Story 722746 (elz) need DOD if there is one
  1. . I MPIA("type")="DEATHDATE" S MPIUSE="DOD" Q
  1. I MPIN="VALUE" D K MPIUSE Q
  1. . I $L(MPIUSE) S MPIVAR=","""_MPIUSE_""")"
  1. I MPIN="ADDRESS" D Q
  1. . I MPIA("type")="N" S MPIUSE="POB"
  1. . I MPIA("type")="P" S MPIUSE="ResAdd"
  1. . I MPIA("type")="BA" S MPIUSE="BA"
  1. .;**79 VAMPI-16603 WORK AND CORRESPONDENCE ADDRESS
  1. .I MPIA("type")="C" S MPIUSE="CorAdd"
  1. .I MPIA("type")="W" S MPIUSE="WrkAdd"
  1. I MPIN="CITY" S MPIVAR=","""_MPIUSE_"City"")" Q
  1. I MPIN="STATE" S MPIVAR=","""_MPIUSE_"State"")" Q
  1. I MPIN="PROVINCECODE" S MPIVAR=","""_MPIUSE_"Province"")" Q
  1. I MPIN="COUNTRY" S MPIVAR=","""_MPIUSE_"Country"")" Q
  1. I MPIN="PHONE",MPIA("type")="Home" S MPIUSE="ResPhone" Q
  1. ;**79 VAMPI-16603 cell and work phone
  1. I MPIN="PHONE",MPIA("type")="Cell" S MPIUSE="CellPhone" Q
  1. I MPIN="PHONE",MPIA("type")="Work" S MPIUSE="WrkPhone" Q
  1. I MPIN="NUMBER" S MPIVAR=","""_MPIUSE_""")" Q
  1. I MPIN="STREET1" S MPIVAR=","""_MPIUSE_"L1"")" Q
  1. I MPIN="STREET2" S MPIVAR=","""_MPIUSE_"L2"")" Q
  1. I MPIN="STREET3" S MPIVAR=","""_MPIUSE_"L3"")" Q
  1. I MPIN="ZIPCODE" S MPIVAR=","""_MPIUSE_"Zip4"")" Q
  1. I MPIN="POSTALCODE" S MPIVAR=","""_MPIUSE_"PCode"")" Q
  1. ;
  1. Q
  1. ;
  1. VALUE(MPIT) ; - used by the parser to call back with CHARACTERS
  1. S:$D(MPIVAR) @(MPILOC_MPIVAR)=MPIT K MPIVAR Q
  1. Q