DVBAMVI1 ;ALB/RPM - CAPRI MVI SEARCH 1305/1306 PROCESSING ;6/27/2012
 ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38
 ;
 
Q  ;NO DIRECT ENTRY
 ;
FNDPAT(DVBRSLT,DVBDEM,DVBQUANT,DVBFRMT) ;
 ;This procedure supports the DVBA MVI SEARCH PERSON remote procedure.
 ;
 ;  Input:
 ;    DVBRSLT - RPC results parameter defined as an ARRAY
 ;    DVBDEM  - Patient demographics used for search delimited using "^"
 ;         FIRSTNAME                      - piece 1 (required)
 ;         MIDDLENAME or INITIAL          - piece 2 (optional)
 ;         LASTNAME                       - piece 3 (required)
 ;         SSN (9 digits)                 - piece 4 (required)
 ;         DATE OF BIRTH (FileMan format) - piece 5 (optional)
 ;
 ;         ex.  CAPRI^TEST^PATIENT^999999999^2540101
 ;    DVBQUANT - optional initialQuantity value passed to web service.
 ;               Defaults to 10.
 ;    DVBFRMT - optional name format type.
 ;       0 (Default) - Return name in First Middle Last Suffix format
 ;       1           - Return name in Last,First Middle Suffix format
 ;
 ; Output:
 ;   DVBRSLT - array of matching patient records in caret-delimited
 ;             format.
 ;
 ;      FULLNAME                        - piece 1
 ;      SSN  (9 digits)                 - piece 2
 ;      DATE OF BIRTH (external format) - piece 3          
 ;      MVI ID                          - pieces 4-7
 ;        ID
 ;        IdType
 ;        Assigning Location
 ;        Assigning Issuer
 ;
 ; Example results:
 ;  CAPRI TEST PATIENT^999999999^1/1/1980^1062212234V192931^NI^200M^USVHA
 ;   or
 ;  PATIENT,CAPRI TEST^999999999^1/1/1980^1062212234V192931^NI^200M^USVHA
 ;
 
DVBXML   ;1305 HL7v3 XML
 
DVBXMLR  ;1306 HL7v3 XML
 
DVBCNT  ;number of results
 
DVBPRS  ;parsed results
 
DVBCNT=0
 
;
 ;create the 1305 request message
 
(+$G(DVBQUANT)<1)!(+$G(DVBQUANT)>10) DVBQUANT=10
 
+$G(DVBFRMT)'=1 DVBFRMT=0
 
DVBXML=$$CRE81305(DVBDEM,DVBQUANT)
 
;
 ;transmit the message to the MVI
 
XMIT(DVBXML,.DVBXMLR)
 
;
 ;parse the returned 1306 request message
 
I $D(DVBXMLRD
 
PARSE(.DVBXMLR,.DVBPRS)
 . 
;
 
;format the output array
 
OUTPUT(.DVBPRS,.DVBRSLT)
 
E  D
 
DVBRSLT(0)=0_U_"Communication error occurred"
 
Q
 
;
CRE81305(DVBDEM,DVBQUANT) ; create 1305 request xml document
 ; This function creates the HL7v3 1305 Search Person Request
 ; (Match criteria with person trait data) xml document
 ;
 ; DVBDEM = Patient demographics delimited using "^"
 ;         DVBFNAME: FIRSTNAME  - piece 1
 ;         DVBMNAME: MIDDLENAME - piece 2
 ;         DVBLNAME: LASTNAME   - piece 3
 ;         DVBSSN:   SSN        - piece 4
 ;         DVBDOB:   DATE OF BIRTH - piece 5
 ;         ex.  CAPRI^TEST^PATIENT^999999999^2540101
 ;
 ; DVBQUANT = initialQuantity value parameter
 ;
 ;    Returns formatted XML for the search
 ;
 ; $$PARAM^HLCS2 - #3552 (need)
 ;
 
DVBFNAME  ;first name
 
DVBLNAME  ;last name
 
DVBMNAME  ;middle name or initial
 
DVBSSN    ;social security #
 
DVBDOB    ;date of birth
 
DVBSKEY   ;site key
 
DVBPCODE  ;HL7 processing code
 
MPIXML    ;function result
 ;
 
DVBPCODE=$P($$PARAM^HLCS2,"^",3)
 
DVBSKEY="200CAPR"
 
DVBFNAME=$P(DVBDEM,U,1)
 
DVBMNAME=$P(DVBDEM,U,2)
 
DVBLNAME=$P(DVBDEM,U,3)
 
DVBSSN=$P(DVBDEM,U,4)
 
DVBDOB=$P(DVBDEM,U,5)
 
;
 ;Header
 
MPIXML="<PRPA_IN201305UV02 xmlns=""urn:hl7-org:v3"" "
 
MPIXML=MPIXML_"xmlns:ps=""http://vaww.oed.oit.domain.ext"" "
 
MPIXML=MPIXML_"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"
 
MPIXML=MPIXML_""" xsi:schemaLocation=""urn:hl7-org:v3 ../../schema/"
 
MPIXML=MPIXML_"HL7V3/NE2008/multicacheschemas/PRPA_IN201305UV02.xsd"
 
MPIXML=MPIXML_""" ITSVersion=""XML_1.0"">"
 
MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349"" "
 
MPIXML=MPIXML_"extension=""MCID-12345""/>"
 
MPIXML=MPIXML_"<creationTime value="""_$$FMTHL7^XLFDT($$NOW^XLFDT())_"""/>"
 
MPIXML=MPIXML_"<interactionId root=""2.16.840.1.113883.1.6"" "
 
MPIXML=MPIXML_"extension=""PRPA_IN201305UV02""/>"
 
MPIXML=MPIXML_"<processingCode code="""_DVBPCODE_"""/>"
 
MPIXML=MPIXML_"<processingModeCode code=""I""/>"
 
MPIXML=MPIXML_"<acceptAckCode code=""AL""/>"
 ;
 ;<receiver> start
 
MPIXML=MPIXML_"<receiver typeCode=""RCV"">"
 
MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
 
MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349""/>"
 
MPIXML=MPIXML_"<telecom value=""http://servicelocation/PDQuery""/>"
 
MPIXML=MPIXML_"</device></receiver>"
 ;
 ;<sender> start
 
MPIXML=MPIXML_"<sender typeCode=""SND"">"
 
MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
 
MPIXML=MPIXML_"<id extension="""_DVBSKEY_""" root=""2.16.840.1.113883.4.349""/>"
 
MPIXML=MPIXML_"</device></sender>"
 ;
 ;<controlActProcess> start
 
MPIXML=MPIXML_"<controlActProcess "
 
MPIXML=MPIXML_"classCode=""CACT"" moodCode=""EVN"">"
 
MPIXML=MPIXML_"<code code=""PRPA_TE201305UV02"" "
 
MPIXML=MPIXML_"codeSystem=""2.16.840.1.113883.1.6""/>"
 
MPIXML=MPIXML_"<queryByParameter><queryId extension="""_$J_""""
 
MPIXML=MPIXML_" root=""2.16.840.1.113883.3.933""/>"
 
MPIXML=MPIXML_"<statusCode code=""new""/>"
 
MPIXML=MPIXML_"<initialQuantity value="""_DVBQUANT_"""/>"
 
MPIXML=MPIXML_"<parameterList>"
 
DVBDOB'="" D
 
MPIXML=MPIXML_"<livingSubjectBirthTime>"
 
MPIXML=MPIXML_"<value value="""_$$FMTHL7^XLFDT(DVBDOB)_"""/>"
 
MPIXML=MPIXML_"<semanticsText>LivingSubject..birthTime</semanticsText>"
 
MPIXML=MPIXML_"</livingSubjectBirthTime>"
 
MPIXML=MPIXML_"<livingSubjectId>"
 
MPIXML=MPIXML_"<value root=""2.16.840.1.113883.4.1"" extension="""_DVBSSN_"""/>"
 
MPIXML=MPIXML_"<semanticsText>SSN</semanticsText>"
 
MPIXML=MPIXML_"</livingSubjectId>"
 
MPIXML=MPIXML_"<livingSubjectName>"
 
MPIXML=MPIXML_"<value use=""L"">"
 
MPIXML=MPIXML_"<given>"""_DVBFNAME_"""</given>"
 
I $G(DVBMNAME)'="" D  ;optional middle name or initial
 
MPIXML=MPIXML_"<given>"""_DVBMNAME_"""</given>"
 
MPIXML=MPIXML_"<family>"""_DVBLNAME_"""</family>"
 
MPIXML=MPIXML_"</value>"
 
MPIXML=MPIXML_"<semanticsText>Legal Name</semanticsText>"
 
MPIXML=MPIXML_"</livingSubjectName>"
 
MPIXML=MPIXML_"</parameterList>"
 
MPIXML=MPIXML_"</queryByParameter></controlActProcess>"
 
MPIXML=MPIXML_"</PRPA_IN201305UV02>"
 
MPIXML
 
;
XMIT(DVBXML,DVBXMLR) ;
 ;This procedure transmits the formatted 1305 HL7v3 XML document
 ;and returns the 1306 HL7v3 XML results document.
 ;
 ; $$GETPROXY^XOBWLIB - #5421
 ;
 
N $ETRAP,$ESTACK,SVC
 
;
 ; set error trap
 
S $ETRAP="DO ERROR^DVBAHWSC"
 ;
 ; make the call
 ;  $$GETPROXY(web_service_name (#18.02), web_server_name (#18.12))
 
SVC=$$GETPROXY^XOBWLIB("DVB_PSIM_EXECUTE","DVB_MVI_SERVER")
 
DVBXMLR=SVC.execute(DVBXML)
 
;
 
Q
 
;
PARSE(DVBXML,DVBOUT) ;
 ;This procedure parses the resulting 1306 HL7v3 XML document and
 ;builds an output array subscripted by record count and field item.
 ;
 ; EN^MXMLPRSE - #4149
 ;
 
^TMP($J,"DVBAMVI1")
 
DVBCB     ;parser callback array
 
DVBVAR    ;character values
 
DVBVAR=""
 
DVBCB("STARTELEMENT")="SE^DVBAMVI1"
 
DVBCB("ENDELEMENT")="EE^DVBAMVI1"
 
DVBCB("CHARACTERS")="VALUE^DVBAMVI1"
 
^TMP($J,"DVBAMVI1",1)=DVBXML
 
EN^MXMLPRSE($NA(^TMP($J,"DVBAMVI1")),.DVBCB)
 
^TMP($J,"DVBAMVI1")
 
Q
 
;
SE(DVBNM,DVBATTR) ; - used for the parser to call back with STARTELEMENT
 ;
 ; prevent any undefined errors
 
DVBNM=$G(DVBNM)
 
DVBATTR("extension")=$G(DVBATTR("extension"))
 
DVBATTR("code")=$G(DVBATTR("code"))
 
;
 ; set patient counter
 
DVBNM="patient" DVBCNT=DVBCNT+1 Q
 
;
 
DVBNM="id",$E(DVBATTR("extension"),1,4)="MCID" Q
 I 
DVBNM="id",DVBATTR("extension")?3N.NA Q
 I 
DVBNM="id",DVBATTR("extension")="" Q
 
;
 ;set ICN
 
DVBNM="id",DVBATTR("extension")["NI^200M^USVHA^P" D  Q
 
DVBOUT(DVBCNT,"ICN")=$P(DVBATTR("extension"),U,1,4)
 
;
 ;set SSN
 
DVBNM="id",DVBATTR("extension")["^SS" D  Q
 
DVBOUT(DVBCNT,"SSN")=$P(DVBATTR("extension"),U,1)
 
;
 ;set DOB
 
DVBNM="birthTime" D  Q
 
DVBOUT(DVBCNT,"DOB")=$$FMTE^XLFDT($$HL7TFM^XLFDT($G(DVBATTR("value"))),"5Z")
 
;
 ;set Name to start collecting name field data
 
DVBNM="name",DVBATTR("use")="L" D
 
DVBVAR="NAME"
 
DVBOUT(DVBCNT,DVBVAR)=""
 ;
 ;set Family Name when using Last,First Middle format
 
DVBFRMT,DVBNM="family",DVBVAR="NAME" D
 
DVBVAR="FAMILY"
 
DVBOUT(DVBCNT,DVBVAR)=""
 ;
 ;response code
 
DVBNM="queryResponseCode",$G(DVBOUT(0))="" D  Q
 
DVBOUT(0)=$S(DVBATTR("code")="NF":"No match found for patient",DVBATTR("code")="QE":"More than 10 potential matches found",1:DVBATTR("code"))
 
;
 ;set acknowledgementDetail
 
DVBNM="acknowledgementDetail" D  Q
 
DVBVAR="ACKNOWLEDGEMENTDETAIL"
 
DVBOUT(DVBCNT,DVBVAR)=""
 ;
 
Q
 
;
VALUE(DVBTXT) ; - used by the parser to call back with CHARACTERS
 
DVBVAR'="" D
 
DVBOUT(DVBCNT,DVBVAR)=DVBOUT(DVBCNT,DVBVAR)_$S($L(DVBOUT(DVBCNT,DVBVAR)):" ",1:"")_DVBTXT
 
Q
 
;
EE(DVBNM) ; - used for the the parser to call back with ENDELEMENT
 ;
 ; prevent any undefined errors
 
DVBNM=$G(DVBNM)
 
;
 ;set back to "NAME" to append any suffix onto given name - only
 ;used for Last,First Middle Suffix format
 
DVBNM="family",DVBVAR="FAMILY" DVBVAR="NAME" Q
 
;
 ;stop reading name fields
 
DVBNM="name",DVBVAR="NAME" DVBVAR="" Q
 
;
 ;stop reading acknowledgmentDetail field
 
DVBNM="acknowledgementDetail",DVBVAR="ACKNOWLEDGEMENTDETAIL" DVBVAR="" Q
 
;
 
Q
 
;
OUTPUT(DVBIN,DVBOUT) ;
 ;This procedure formats the individual record lines and builds
 ;the results array output for the remote procedure.
 ;
 
DVBCNT  ;line count
 
DVBTOT  ;total lines
 
DVBCNT=0
 
DVBTOT=0
 
F  S DVBCNT=$O(DVBIN(DVBCNT)) Q:'DVBCNT  D
 
DVBTOT=DVBTOT+1
 . 
DVBFRMT D  ;Last,First Middle Suffix
 
. . DVBOUT(DVBCNT)=$G(DVBIN(DVBCNT,"FAMILY"))_","_$G(DVBIN(DVBCNT,"NAME"))
 . 
E  D  ;First Middle Last Suffix
 
. . DVBOUT(DVBCNT)=$G(DVBIN(DVBCNT,"NAME"))
 . 
DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$G(DVBIN(DVBCNT,"SSN"))
 . 
DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$G(DVBIN(DVBCNT,"DOB"))
 . 
DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$G(DVBIN(DVBCNT,"ICN"))
 
I $G(DVBIN(0))="AE" D
 
DVBOUT(0)=DVBTOT_U_"Acknowledgement Error: "_$G(DVBIN(0,"ACKNOWLEDGEMENTDETAIL"))
 
E  D
 
DVBOUT(0)=DVBTOT_U_$G(DVBIN(0))
 
Q