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
;
N DVBXML ;1305 HL7v3 XML
N DVBXMLR ;1306 HL7v3 XML
N DVBCNT ;number of results
N DVBPRS ;parsed results
S DVBCNT=0
;
;create the 1305 request message
I (+$G(DVBQUANT)<1)!(+$G(DVBQUANT)>10) S DVBQUANT=10
I +$G(DVBFRMT)'=1 S DVBFRMT=0
S DVBXML=$$CRE81305(DVBDEM,DVBQUANT)
;
;transmit the message to the MVI
D XMIT(DVBXML,.DVBXMLR)
;
;parse the returned 1306 request message
I $D(DVBXMLR) D
. D PARSE(.DVBXMLR,.DVBPRS)
. ;
. ;format the output array
. D OUTPUT(.DVBPRS,.DVBRSLT)
E D
. S 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)
;
N DVBFNAME ;first name
N DVBLNAME ;last name
N DVBMNAME ;middle name or initial
N DVBSSN ;social security #
N DVBDOB ;date of birth
N DVBSKEY ;site key
N DVBPCODE ;HL7 processing code
N MPIXML ;function result
;
S DVBPCODE=$P($$PARAM^HLCS2,"^",3)
S DVBSKEY="200CAPR"
S DVBFNAME=$P(DVBDEM,U,1)
S DVBMNAME=$P(DVBDEM,U,2)
S DVBLNAME=$P(DVBDEM,U,3)
S DVBSSN=$P(DVBDEM,U,4)
S DVBDOB=$P(DVBDEM,U,5)
;
;Header
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=""2.16.840.1.113883.4.349"" "
S MPIXML=MPIXML_"extension=""MCID-12345""/>"
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="""_DVBPCODE_"""/>"
S MPIXML=MPIXML_"<processingModeCode code=""I""/>"
S MPIXML=MPIXML_"<acceptAckCode code=""AL""/>"
;
;<receiver> start
S MPIXML=MPIXML_"<receiver typeCode=""RCV"">"
S MPIXML=MPIXML_"<device classCode=""DEV"" 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> start
S MPIXML=MPIXML_"<sender typeCode=""SND"">"
S MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
S MPIXML=MPIXML_"<id extension="""_DVBSKEY_""" root=""2.16.840.1.113883.4.349""/>"
S MPIXML=MPIXML_"</device></sender>"
;
;<controlActProcess> start
S MPIXML=MPIXML_"<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=""2.16.840.1.113883.3.933""/>"
S MPIXML=MPIXML_"<statusCode code=""new""/>"
S MPIXML=MPIXML_"<initialQuantity value="""_DVBQUANT_"""/>"
S MPIXML=MPIXML_"<parameterList>"
I DVBDOB'="" D
. S MPIXML=MPIXML_"<livingSubjectBirthTime>"
. S MPIXML=MPIXML_"<value value="""_$$FMTHL7^XLFDT(DVBDOB)_"""/>"
. S MPIXML=MPIXML_"<semanticsText>LivingSubject..birthTime</semanticsText>"
. S MPIXML=MPIXML_"</livingSubjectBirthTime>"
S MPIXML=MPIXML_"<livingSubjectId>"
S MPIXML=MPIXML_"<value root=""2.16.840.1.113883.4.1"" extension="""_DVBSSN_"""/>"
S MPIXML=MPIXML_"<semanticsText>SSN</semanticsText>"
S MPIXML=MPIXML_"</livingSubjectId>"
S MPIXML=MPIXML_"<livingSubjectName>"
S MPIXML=MPIXML_"<value use=""L"">"
S MPIXML=MPIXML_"<given>"""_DVBFNAME_"""</given>"
I $G(DVBMNAME)'="" D ;optional middle name or initial
. S MPIXML=MPIXML_"<given>"""_DVBMNAME_"""</given>"
S MPIXML=MPIXML_"<family>"""_DVBLNAME_"""</family>"
S MPIXML=MPIXML_"</value>"
S MPIXML=MPIXML_"<semanticsText>Legal Name</semanticsText>"
S MPIXML=MPIXML_"</livingSubjectName>"
S MPIXML=MPIXML_"</parameterList>"
S MPIXML=MPIXML_"</queryByParameter></controlActProcess>"
S MPIXML=MPIXML_"</PRPA_IN201305UV02>"
Q 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))
S SVC=$$GETPROXY^XOBWLIB("DVB_PSIM_EXECUTE","DVB_MVI_SERVER")
S 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
;
K ^TMP($J,"DVBAMVI1")
N DVBCB ;parser callback array
N DVBVAR ;character values
S DVBVAR=""
S DVBCB("STARTELEMENT")="SE^DVBAMVI1"
S DVBCB("ENDELEMENT")="EE^DVBAMVI1"
S DVBCB("CHARACTERS")="VALUE^DVBAMVI1"
S ^TMP($J,"DVBAMVI1",1)=DVBXML
D EN^MXMLPRSE($NA(^TMP($J,"DVBAMVI1")),.DVBCB)
K ^TMP($J,"DVBAMVI1")
Q
;
SE(DVBNM,DVBATTR) ; - used for the parser to call back with STARTELEMENT
;
; prevent any undefined errors
S DVBNM=$G(DVBNM)
S DVBATTR("extension")=$G(DVBATTR("extension"))
S DVBATTR("code")=$G(DVBATTR("code"))
;
; set patient counter
I DVBNM="patient" S DVBCNT=DVBCNT+1 Q
;
I 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
I DVBNM="id",DVBATTR("extension")["NI^200M^USVHA^P" D Q
. S DVBOUT(DVBCNT,"ICN")=$P(DVBATTR("extension"),U,1,4)
;
;set SSN
I DVBNM="id",DVBATTR("extension")["^SS" D Q
. S DVBOUT(DVBCNT,"SSN")=$P(DVBATTR("extension"),U,1)
;
;set DOB
I DVBNM="birthTime" D Q
. S DVBOUT(DVBCNT,"DOB")=$$FMTE^XLFDT($$HL7TFM^XLFDT($G(DVBATTR("value"))),"5Z")
;
;set Name to start collecting name field data
I DVBNM="name",DVBATTR("use")="L" D
. S DVBVAR="NAME"
. S DVBOUT(DVBCNT,DVBVAR)=""
;
;set Family Name when using Last,First Middle format
I DVBFRMT,DVBNM="family",DVBVAR="NAME" D
. S DVBVAR="FAMILY"
. S DVBOUT(DVBCNT,DVBVAR)=""
;
;response code
I DVBNM="queryResponseCode",$G(DVBOUT(0))="" D Q
. S 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
I DVBNM="acknowledgementDetail" D Q
. S DVBVAR="ACKNOWLEDGEMENTDETAIL"
. S DVBOUT(DVBCNT,DVBVAR)=""
;
Q
;
VALUE(DVBTXT) ; - used by the parser to call back with CHARACTERS
I DVBVAR'="" D
. S 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
S DVBNM=$G(DVBNM)
;
;set back to "NAME" to append any suffix onto given name - only
;used for Last,First Middle Suffix format
I DVBNM="family",DVBVAR="FAMILY" S DVBVAR="NAME" Q
;
;stop reading name fields
I DVBNM="name",DVBVAR="NAME" S DVBVAR="" Q
;
;stop reading acknowledgmentDetail field
I DVBNM="acknowledgementDetail",DVBVAR="ACKNOWLEDGEMENTDETAIL" S DVBVAR="" Q
;
Q
;
OUTPUT(DVBIN,DVBOUT) ;
;This procedure formats the individual record lines and builds
;the results array output for the remote procedure.
;
N DVBCNT ;line count
N DVBTOT ;total lines
S DVBCNT=0
S DVBTOT=0
F S DVBCNT=$O(DVBIN(DVBCNT)) Q:'DVBCNT D
. S DVBTOT=DVBTOT+1
. I DVBFRMT D ;Last,First Middle Suffix
. . S DVBOUT(DVBCNT)=$G(DVBIN(DVBCNT,"FAMILY"))_","_$G(DVBIN(DVBCNT,"NAME"))
. E D ;First Middle Last Suffix
. . S DVBOUT(DVBCNT)=$G(DVBIN(DVBCNT,"NAME"))
. S DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$G(DVBIN(DVBCNT,"SSN"))
. S DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$G(DVBIN(DVBCNT,"DOB"))
. S DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$G(DVBIN(DVBCNT,"ICN"))
I $G(DVBIN(0))="AE" D
. S DVBOUT(0)=DVBTOT_U_"Acknowledgement Error: "_$G(DVBIN(0,"ACKNOWLEDGEMENTDETAIL"))
E D
. S DVBOUT(0)=DVBTOT_U_$G(DVBIN(0))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAMVI1 10392 printed Apr 09, 2024@20:45:17 Page 2
DVBAMVI1 ;ALB/RPM - CAPRI MVI SEARCH 1305/1306 PROCESSING ;6/27/2012
+1 ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38
+2 ;
+3 ;NO DIRECT ENTRY
QUIT
+4 ;
FNDPAT(DVBRSLT,DVBDEM,DVBQUANT,DVBFRMT) ;
+1 ;This procedure supports the DVBA MVI SEARCH PERSON remote procedure.
+2 ;
+3 ; Input:
+4 ; DVBRSLT - RPC results parameter defined as an ARRAY
+5 ; DVBDEM - Patient demographics used for search delimited using "^"
+6 ; FIRSTNAME - piece 1 (required)
+7 ; MIDDLENAME or INITIAL - piece 2 (optional)
+8 ; LASTNAME - piece 3 (required)
+9 ; SSN (9 digits) - piece 4 (required)
+10 ; DATE OF BIRTH (FileMan format) - piece 5 (optional)
+11 ;
+12 ; ex. CAPRI^TEST^PATIENT^999999999^2540101
+13 ; DVBQUANT - optional initialQuantity value passed to web service.
+14 ; Defaults to 10.
+15 ; DVBFRMT - optional name format type.
+16 ; 0 (Default) - Return name in First Middle Last Suffix format
+17 ; 1 - Return name in Last,First Middle Suffix format
+18 ;
+19 ; Output:
+20 ; DVBRSLT - array of matching patient records in caret-delimited
+21 ; format.
+22 ;
+23 ; FULLNAME - piece 1
+24 ; SSN (9 digits) - piece 2
+25 ; DATE OF BIRTH (external format) - piece 3
+26 ; MVI ID - pieces 4-7
+27 ; ID
+28 ; IdType
+29 ; Assigning Location
+30 ; Assigning Issuer
+31 ;
+32 ; Example results:
+33 ; CAPRI TEST PATIENT^999999999^1/1/1980^1062212234V192931^NI^200M^USVHA
+34 ; or
+35 ; PATIENT,CAPRI TEST^999999999^1/1/1980^1062212234V192931^NI^200M^USVHA
+36 ;
+37 ;1305 HL7v3 XML
NEW DVBXML
+38 ;1306 HL7v3 XML
NEW DVBXMLR
+39 ;number of results
NEW DVBCNT
+40 ;parsed results
NEW DVBPRS
+41 SET DVBCNT=0
+42 ;
+43 ;create the 1305 request message
+44 IF (+$GET(DVBQUANT)<1)!(+$GET(DVBQUANT)>10)
SET DVBQUANT=10
+45 IF +$GET(DVBFRMT)'=1
SET DVBFRMT=0
+46 SET DVBXML=$$CRE81305(DVBDEM,DVBQUANT)
+47 ;
+48 ;transmit the message to the MVI
+49 DO XMIT(DVBXML,.DVBXMLR)
+50 ;
+51 ;parse the returned 1306 request message
+52 IF $DATA(DVBXMLR)
Begin DoDot:1
+53 DO PARSE(.DVBXMLR,.DVBPRS)
+54 ;
+55 ;format the output array
+56 DO OUTPUT(.DVBPRS,.DVBRSLT)
End DoDot:1
+57 IF '$TEST
Begin DoDot:1
+58 SET DVBRSLT(0)=0_U_"Communication error occurred"
End DoDot:1
+59 QUIT
+60 ;
CRE81305(DVBDEM,DVBQUANT) ; create 1305 request xml document
+1 ; This function creates the HL7v3 1305 Search Person Request
+2 ; (Match criteria with person trait data) xml document
+3 ;
+4 ; DVBDEM = Patient demographics delimited using "^"
+5 ; DVBFNAME: FIRSTNAME - piece 1
+6 ; DVBMNAME: MIDDLENAME - piece 2
+7 ; DVBLNAME: LASTNAME - piece 3
+8 ; DVBSSN: SSN - piece 4
+9 ; DVBDOB: DATE OF BIRTH - piece 5
+10 ; ex. CAPRI^TEST^PATIENT^999999999^2540101
+11 ;
+12 ; DVBQUANT = initialQuantity value parameter
+13 ;
+14 ; Returns formatted XML for the search
+15 ;
+16 ; $$PARAM^HLCS2 - #3552 (need)
+17 ;
+18 ;first name
NEW DVBFNAME
+19 ;last name
NEW DVBLNAME
+20 ;middle name or initial
NEW DVBMNAME
+21 ;social security #
NEW DVBSSN
+22 ;date of birth
NEW DVBDOB
+23 ;site key
NEW DVBSKEY
+24 ;HL7 processing code
NEW DVBPCODE
+25 ;function result
NEW MPIXML
+26 ;
+27 SET DVBPCODE=$PIECE($$PARAM^HLCS2,"^",3)
+28 SET DVBSKEY="200CAPR"
+29 SET DVBFNAME=$PIECE(DVBDEM,U,1)
+30 SET DVBMNAME=$PIECE(DVBDEM,U,2)
+31 SET DVBLNAME=$PIECE(DVBDEM,U,3)
+32 SET DVBSSN=$PIECE(DVBDEM,U,4)
+33 SET DVBDOB=$PIECE(DVBDEM,U,5)
+34 ;
+35 ;Header
+36 SET MPIXML="<PRPA_IN201305UV02 xmlns=""urn:hl7-org:v3"" "
+37 SET MPIXML=MPIXML_"xmlns:ps=""http://vaww.oed.oit.domain.ext"" "
+38 SET MPIXML=MPIXML_"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"
+39 SET MPIXML=MPIXML_""" xsi:schemaLocation=""urn:hl7-org:v3 ../../schema/"
+40 SET MPIXML=MPIXML_"HL7V3/NE2008/multicacheschemas/PRPA_IN201305UV02.xsd"
+41 SET MPIXML=MPIXML_""" ITSVersion=""XML_1.0"">"
+42 SET MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349"" "
+43 SET MPIXML=MPIXML_"extension=""MCID-12345""/>"
+44 SET MPIXML=MPIXML_"<creationTime value="""_$$FMTHL7^XLFDT($$NOW^XLFDT())_"""/>"
+45 SET MPIXML=MPIXML_"<interactionId root=""2.16.840.1.113883.1.6"" "
+46 SET MPIXML=MPIXML_"extension=""PRPA_IN201305UV02""/>"
+47 SET MPIXML=MPIXML_"<processingCode code="""_DVBPCODE_"""/>"
+48 SET MPIXML=MPIXML_"<processingModeCode code=""I""/>"
+49 SET MPIXML=MPIXML_"<acceptAckCode code=""AL""/>"
+50 ;
+51 ;<receiver> start
+52 SET MPIXML=MPIXML_"<receiver typeCode=""RCV"">"
+53 SET MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
+54 SET MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349""/>"
+55 SET MPIXML=MPIXML_"<telecom value=""http://servicelocation/PDQuery""/>"
+56 SET MPIXML=MPIXML_"</device></receiver>"
+57 ;
+58 ;<sender> start
+59 SET MPIXML=MPIXML_"<sender typeCode=""SND"">"
+60 SET MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
+61 SET MPIXML=MPIXML_"<id extension="""_DVBSKEY_""" root=""2.16.840.1.113883.4.349""/>"
+62 SET MPIXML=MPIXML_"</device></sender>"
+63 ;
+64 ;<controlActProcess> start
+65 SET MPIXML=MPIXML_"<controlActProcess "
+66 SET MPIXML=MPIXML_"classCode=""CACT"" moodCode=""EVN"">"
+67 SET MPIXML=MPIXML_"<code code=""PRPA_TE201305UV02"" "
+68 SET MPIXML=MPIXML_"codeSystem=""2.16.840.1.113883.1.6""/>"
+69 SET MPIXML=MPIXML_"<queryByParameter><queryId extension="""_$JOB_""""
+70 SET MPIXML=MPIXML_" root=""2.16.840.1.113883.3.933""/>"
+71 SET MPIXML=MPIXML_"<statusCode code=""new""/>"
+72 SET MPIXML=MPIXML_"<initialQuantity value="""_DVBQUANT_"""/>"
+73 SET MPIXML=MPIXML_"<parameterList>"
+74 IF DVBDOB'=""
Begin DoDot:1
+75 SET MPIXML=MPIXML_"<livingSubjectBirthTime>"
+76 SET MPIXML=MPIXML_"<value value="""_$$FMTHL7^XLFDT(DVBDOB)_"""/>"
+77 SET MPIXML=MPIXML_"<semanticsText>LivingSubject..birthTime</semanticsText>"
+78 SET MPIXML=MPIXML_"</livingSubjectBirthTime>"
End DoDot:1
+79 SET MPIXML=MPIXML_"<livingSubjectId>"
+80 SET MPIXML=MPIXML_"<value root=""2.16.840.1.113883.4.1"" extension="""_DVBSSN_"""/>"
+81 SET MPIXML=MPIXML_"<semanticsText>SSN</semanticsText>"
+82 SET MPIXML=MPIXML_"</livingSubjectId>"
+83 SET MPIXML=MPIXML_"<livingSubjectName>"
+84 SET MPIXML=MPIXML_"<value use=""L"">"
+85 SET MPIXML=MPIXML_"<given>"""_DVBFNAME_"""</given>"
+86 ;optional middle name or initial
IF $GET(DVBMNAME)'=""
Begin DoDot:1
+87 SET MPIXML=MPIXML_"<given>"""_DVBMNAME_"""</given>"
End DoDot:1
+88 SET MPIXML=MPIXML_"<family>"""_DVBLNAME_"""</family>"
+89 SET MPIXML=MPIXML_"</value>"
+90 SET MPIXML=MPIXML_"<semanticsText>Legal Name</semanticsText>"
+91 SET MPIXML=MPIXML_"</livingSubjectName>"
+92 SET MPIXML=MPIXML_"</parameterList>"
+93 SET MPIXML=MPIXML_"</queryByParameter></controlActProcess>"
+94 SET MPIXML=MPIXML_"</PRPA_IN201305UV02>"
+95 QUIT MPIXML
+96 ;
XMIT(DVBXML,DVBXMLR) ;
+1 ;This procedure transmits the formatted 1305 HL7v3 XML document
+2 ;and returns the 1306 HL7v3 XML results document.
+3 ;
+4 ; $$GETPROXY^XOBWLIB - #5421
+5 ;
+6 NEW $ETRAP,$ESTACK,SVC
+7 ;
+8 ; set error trap
+9 SET $ETRAP="DO ERROR^DVBAHWSC"
+10 ;
+11 ; make the call
+12 ; $$GETPROXY(web_service_name (#18.02), web_server_name (#18.12))
+13 SET SVC=$$GETPROXY^XOBWLIB("DVB_PSIM_EXECUTE","DVB_MVI_SERVER")
+14 SET DVBXMLR=SVC.execute(DVBXML)
+15 ;
+16 QUIT
+17 ;
PARSE(DVBXML,DVBOUT) ;
+1 ;This procedure parses the resulting 1306 HL7v3 XML document and
+2 ;builds an output array subscripted by record count and field item.
+3 ;
+4 ; EN^MXMLPRSE - #4149
+5 ;
+6 KILL ^TMP($JOB,"DVBAMVI1")
+7 ;parser callback array
NEW DVBCB
+8 ;character values
NEW DVBVAR
+9 SET DVBVAR=""
+10 SET DVBCB("STARTELEMENT")="SE^DVBAMVI1"
+11 SET DVBCB("ENDELEMENT")="EE^DVBAMVI1"
+12 SET DVBCB("CHARACTERS")="VALUE^DVBAMVI1"
+13 SET ^TMP($JOB,"DVBAMVI1",1)=DVBXML
+14 DO EN^MXMLPRSE($NAME(^TMP($JOB,"DVBAMVI1")),.DVBCB)
+15 KILL ^TMP($JOB,"DVBAMVI1")
+16 QUIT
+17 ;
SE(DVBNM,DVBATTR) ; - used for the parser to call back with STARTELEMENT
+1 ;
+2 ; prevent any undefined errors
+3 SET DVBNM=$GET(DVBNM)
+4 SET DVBATTR("extension")=$GET(DVBATTR("extension"))
+5 SET DVBATTR("code")=$GET(DVBATTR("code"))
+6 ;
+7 ; set patient counter
+8 IF DVBNM="patient"
SET DVBCNT=DVBCNT+1
QUIT
+9 ;
+10 IF DVBNM="id"
IF $EXTRACT(DVBATTR("extension"),1,4)="MCID"
QUIT
+11 IF DVBNM="id"
IF DVBATTR("extension")?3N.NA
QUIT
+12 IF DVBNM="id"
IF DVBATTR("extension")=""
QUIT
+13 ;
+14 ;set ICN
+15 IF DVBNM="id"
IF DVBATTR("extension")["NI^200M^USVHA^P"
Begin DoDot:1
+16 SET DVBOUT(DVBCNT,"ICN")=$PIECE(DVBATTR("extension"),U,1,4)
End DoDot:1
QUIT
+17 ;
+18 ;set SSN
+19 IF DVBNM="id"
IF DVBATTR("extension")["^SS"
Begin DoDot:1
+20 SET DVBOUT(DVBCNT,"SSN")=$PIECE(DVBATTR("extension"),U,1)
End DoDot:1
QUIT
+21 ;
+22 ;set DOB
+23 IF DVBNM="birthTime"
Begin DoDot:1
+24 SET DVBOUT(DVBCNT,"DOB")=$$FMTE^XLFDT($$HL7TFM^XLFDT($GET(DVBATTR("value"))),"5Z")
End DoDot:1
QUIT
+25 ;
+26 ;set Name to start collecting name field data
+27 IF DVBNM="name"
IF DVBATTR("use")="L"
Begin DoDot:1
+28 SET DVBVAR="NAME"
+29 SET DVBOUT(DVBCNT,DVBVAR)=""
End DoDot:1
+30 ;
+31 ;set Family Name when using Last,First Middle format
+32 IF DVBFRMT
IF DVBNM="family"
IF DVBVAR="NAME"
Begin DoDot:1
+33 SET DVBVAR="FAMILY"
+34 SET DVBOUT(DVBCNT,DVBVAR)=""
End DoDot:1
+35 ;
+36 ;response code
+37 IF DVBNM="queryResponseCode"
IF $GET(DVBOUT(0))=""
Begin DoDot:1
+38 SET DVBOUT(0)=$SELECT(DVBATTR("code")="NF":"No match found for patient",DVBATTR("code")="QE":"More than 10 potential matches found",1:DVBATTR("code"))
End DoDot:1
QUIT
+39 ;
+40 ;set acknowledgementDetail
+41 IF DVBNM="acknowledgementDetail"
Begin DoDot:1
+42 SET DVBVAR="ACKNOWLEDGEMENTDETAIL"
+43 SET DVBOUT(DVBCNT,DVBVAR)=""
End DoDot:1
QUIT
+44 ;
+45 QUIT
+46 ;
VALUE(DVBTXT) ; - used by the parser to call back with CHARACTERS
+1 IF DVBVAR'=""
Begin DoDot:1
+2 SET DVBOUT(DVBCNT,DVBVAR)=DVBOUT(DVBCNT,DVBVAR)_$SELECT($LENGTH(DVBOUT(DVBCNT,DVBVAR)):" ",1:"")_DVBTXT
End DoDot:1
+3 QUIT
+4 ;
EE(DVBNM) ; - used for the the parser to call back with ENDELEMENT
+1 ;
+2 ; prevent any undefined errors
+3 SET DVBNM=$GET(DVBNM)
+4 ;
+5 ;set back to "NAME" to append any suffix onto given name - only
+6 ;used for Last,First Middle Suffix format
+7 IF DVBNM="family"
IF DVBVAR="FAMILY"
SET DVBVAR="NAME"
QUIT
+8 ;
+9 ;stop reading name fields
+10 IF DVBNM="name"
IF DVBVAR="NAME"
SET DVBVAR=""
QUIT
+11 ;
+12 ;stop reading acknowledgmentDetail field
+13 IF DVBNM="acknowledgementDetail"
IF DVBVAR="ACKNOWLEDGEMENTDETAIL"
SET DVBVAR=""
QUIT
+14 ;
+15 QUIT
+16 ;
OUTPUT(DVBIN,DVBOUT) ;
+1 ;This procedure formats the individual record lines and builds
+2 ;the results array output for the remote procedure.
+3 ;
+4 ;line count
NEW DVBCNT
+5 ;total lines
NEW DVBTOT
+6 SET DVBCNT=0
+7 SET DVBTOT=0
+8 FOR
SET DVBCNT=$ORDER(DVBIN(DVBCNT))
if 'DVBCNT
QUIT
Begin DoDot:1
+9 SET DVBTOT=DVBTOT+1
+10 ;Last,First Middle Suffix
IF DVBFRMT
Begin DoDot:2
+11 SET DVBOUT(DVBCNT)=$GET(DVBIN(DVBCNT,"FAMILY"))_","_$GET(DVBIN(DVBCNT,"NAME"))
End DoDot:2
+12 ;First Middle Last Suffix
IF '$TEST
Begin DoDot:2
+13 SET DVBOUT(DVBCNT)=$GET(DVBIN(DVBCNT,"NAME"))
End DoDot:2
+14 SET DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$GET(DVBIN(DVBCNT,"SSN"))
+15 SET DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$GET(DVBIN(DVBCNT,"DOB"))
+16 SET DVBOUT(DVBCNT)=DVBOUT(DVBCNT)_U_$GET(DVBIN(DVBCNT,"ICN"))
End DoDot:1
+17 IF $GET(DVBIN(0))="AE"
Begin DoDot:1
+18 SET DVBOUT(0)=DVBTOT_U_"Acknowledgement Error: "_$GET(DVBIN(0,"ACKNOWLEDGEMENTDETAIL"))
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 SET DVBOUT(0)=DVBTOT_U_$GET(DVBIN(0))
End DoDot:1
+21 QUIT
