DVBAMVI2 ;ALB/RPM - CAPRI MVI GET CORRESPONDING IDS ;8/6/2012
;;2.7;AMIE;**181,223**;Apr 10, 1995;Build 15
; SAC EXEMPTION 20201020-01 : Xindex error, use of HWSC Object
;
; Get Corresponding Ids is a function of the MVI service,
; used to retrieve all known MVI Identifiers as they relate
; to a source identifier. The transaction grouping for this
; interaction is a 1309 Request and 1310 Response.
;
Q ;NO DIRECT ENTRY
;
GETIDS(DVBRSLT,DVBIID) ;
;This procedure supports the DVBA MVI GET CORRESPONDING IDS remote
;procedure. An MVI patient identifier string is passed to the procedure.
;The procedure generates a 1309 Get Corresponding IDs HL7v3 request
;message and transmits it to the MVI. A list of station numbers is
;returned in a 1310 HL7v3 message to represent the treating facility list.
;The INSTITUTION (#4) file IEN, station name, and station number is
;returned for each treating facility.
;
; Input:
; DVBRSLT - RPC results parameter defined as an ARRAY
; DVBIID = Patient identifier delimited using "^"
; Piece 1: Id
; Piece 2: IdType
; Piece 3: Assigning location
; Piece 4: Assigning issuer
;
; Example: 1008523099V750710^NI^200M^USVHA
;
; Output:
; DVBRSLT - array of lines each containing station IEN, name ,
; and station number delimited by a caret ("^"). The
; first array node contains the total number of stations
; returned and the query response.
;
; Format: instutionIEN^stationName^stationNumber
;
; Example: DVBOUT(0)=2^OK
; DVBOUT(1)="516^BAY PINES VA HCS^516"
; DVBOUT(2)="523^BOSTON HCS VAMC^523"
;
N DVBPRS ;parsed results array
N DVBXML ;1309 HL7v3 XML request
N DVBXMLR ;1310 HL7v3 XML results
;
;create the 1309 request message
S DVBXML=$$CRE81309(DVBIID)
;
;transmit the message to the MVI
D XMIT(DVBXML,.DVBXMLR)
;
;parse the returned 1310 result 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
;
CRE81309(DVBIID) ; create 1309 request xml document
; This function creates the HL7v3 1309 Get Corresponding IDs
; Request xml document.
;
; DVBIID = Patient identifier delimited using "^"
; Piece 1: Id
; Piece 2: IdType
; Piece 3: Assigning location
; Piece 4: Assigning issuer
;
; ex. 1008523099V750710^NI^200M^USVHA
;
; Returns formatted XML for the search
;
; $$PARAM^HLCS2 - #3552 (need)
;
N DVBSKEY ;site key
N DVBPCODE ;HL7 processing code
N MPIXML ;function result
;
S DVBPCODE=$P($$PARAM^HLCS2,"^",3)
S DVBSKEY="200CAPR"
;
;Header
S MPIXML="<PRPA_IN201309UV02 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_IN201309UV02.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_IN201309UV02""/>"
S MPIXML=MPIXML_"<processingCode code="""_DVBPCODE_"""/>"
S MPIXML=MPIXML_"<processingModeCode code=""T""/>"
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_TE201309UV02"" "
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.4.349""/>"
S MPIXML=MPIXML_"<statusCode code=""new""/>"
S MPIXML=MPIXML_"<responsePriorityCode code=""I"" />"
S MPIXML=MPIXML_"<parameterList>"
S MPIXML=MPIXML_"<patientIdentifier>"
S MPIXML=MPIXML_"<value root=""2.16.840.1.113883.4.349"" extension="""_DVBIID_"""/>"
S MPIXML=MPIXML_"<semanticsText>Patient.Id</semanticsText>"
S MPIXML=MPIXML_"</patientIdentifier>"
S MPIXML=MPIXML_"</parameterList>"
S MPIXML=MPIXML_"</queryByParameter></controlActProcess>"
S MPIXML=MPIXML_"</PRPA_IN201309UV02>"
Q MPIXML
;
XMIT(DVBXML,DVBXMLR) ;
;
; $$GETPROXY^XOBWLIB - #5421
;
N $ETRAP,$ESTACK,SVC
;
; set error trap
S $ETRAP="DO ERROR^DVBAHWSC"
;
; make the call
S SVC=$$GETPROXY^XOBWLIB("DVB_PSIM_EXECUTE","DVB_MVI_SERVER")
S DVBXMLR=SVC.execute(DVBXML)
;
Q
;
PARSE(DVBXML,DVBOUT) ;
;
; EN^MXMLPRSE - #4149
;
K ^TMP($J,"DVBAMVI2")
N DVBCB ;parser callback array
N DVBCNT ;record counter
S DVBCNT=0
S DVBCB("STARTELEMENT")="SE^DVBAMVI2"
S ^TMP($J,"DVBAMVI2",1)=DVBXML
D EN^MXMLPRSE($NA(^TMP($J,"DVBAMVI2")),.DVBCB)
K ^TMP($J,"DVBAMVI2")
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"))
;
;
I DVBNM="id",$E(DVBATTR("extension"),1,4)="MCID" Q
I DVBNM="id",DVBATTR("extension")?3N.NA Q
I DVBNM="id",DVBATTR("extension")="" Q
I DVBNM="id",DVBATTR("extension")["NI^200M^USVHA^P" Q
;
;response code
I DVBNM="queryResponseCode",$G(DVBOUT(0))="" D Q
. S DVBOUT(0)=$S(DVBATTR("code")="NF":"No match found for "_DVBIID,1:DVBATTR("code"))
;
;set station numbers
;pattern match DFN_"^PI^"_stationNumber_"^USVHA^"_alpha
I DVBNM="id",DVBATTR("extension")?1.N1"^PI^"2N.NA1"^USVHA^".A D Q
. S DVBOUT($P(DVBATTR("extension"),U,3))=""
Q
;
OUTPUT(DVBIN,DVBOUT) ;
;This procedure formats the individual record lines and builds
;the results array output for the remote procedure.
;
; Input:
; DVBIN - array of station numbers
;
; Output:
; DVBOUT - array of lines each containing station IEN, name ,
; and station number delimited by a caret ("^"). The
; first array node contains the returned station count
; and the query response.
;
; Example: DVBOUT(0)=2^OK
; DVBOUT(1)="516^BAY PINES VA HCS^516"
; DVBOUT(2)="523^BOSTON HCS VAMC^523"
;
N DVBSTA ;station number
N DVBCNT ;results counter
N DVBIEN ;INSTITUTION (#4) file IEN
S DVBSTA=""
S DVBCNT=0
F S DVBSTA=$O(DVBIN(DVBSTA)) Q:(DVBSTA="") D
. S DVBIEN=+$$IEN^XUAF4(DVBSTA)
. I DVBIEN D
. . S DVBCNT=DVBCNT+1
. . S DVBOUT(DVBCNT)=DVBIEN_U_$$NS^XUAF4(DVBIEN)
S DVBOUT(0)=DVBCNT_U_$G(DVBIN(0))
Q
GETACC(DVBOUT,DVBICN) ;get Active Cerner Correlations from mpi via hl7 direct rpc
;
; DVBOUT - return 0 (no) or 1 (yes) cerner active correlations or -1 (error)
; DVBICN - patient identifier (icn)
;
; DIRECT^XWB2HL7 supported by subscription to ICR #3144
;
Q:$G(DVBICN)=""
N DVBARRAY,DVBERROR
D DIRECT^XWB2HL7(.DVBARRAY,"200M","MPI GETCORRESPONDINGIDS","",DVBICN)
;check for errors when connecting to mpi
S DVBERROR="An error has occurred that prevents CAPRI from determining if Cerner treatment records exist. Please try again. If this error persists after several attempts, please open a trouble ticket requesting IT support."
I $P($G(DVBARRAY(0)),"^")=""!($P($G(DVBARRAY(1)),"^")=-1) S DVBOUT="-1^"_DVBERROR_"^"_$G(DVBARRAY(1)) Q
D CHKACC(.DVBARRAY,.DVBOUT) ;pass by reference to set dvbout
Q
;
CHKACC(DVBARRAY,DVBOUT) ;check for Active Correlations with '200CRNR'
;
; DVBARRAY - array of patient's active correlations from mpi
; DVBOUT - return 0 (no) or 1 (yes) cerner active correlation
;
N DVBRECN,DVBCRN,DVBERROR
S (DVBOUT,DVBCRN)=0
I $D(DVBARRAY) S DVBRECN="" F S DVBRECN=$O(DVBARRAY(DVBRECN)) Q:DVBRECN="" D Q:DVBOUT=1
.I $P(DVBARRAY(DVBRECN),"^",2)="200CRNR" S DVBCRN=1 D ; check if active correlation contains '200CRNR'
..; check date last treated (piece 3) not null, id type (piece 4) is pi, and status of icn or correlation (piece 6) is active
..I $P(DVBARRAY(DVBRECN),"^",3)'="",$P(DVBARRAY(DVBRECN),"^",4)="PI" D
...I (($P(DVBARRAY(DVBRECN),"^",6)="A")!($P(DVBARRAY(DVBRECN),"^",6)="")) S DVBOUT=1
I DVBCRN=0 D ; if no active correlations contain '200CRNR'
.S DVBERROR="An error has occurred that prevents CAPRI from determining if Cerner treatment records exist. Please try again. If this error persists after several attempts, please open a trouble ticket requesting IT support."
.S DVBOUT="-1^"_DVBERROR_"^-1^'200CRNR' not found at MPI"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAMVI2 9390 printed Apr 09, 2024@20:56:28 Page 2
DVBAMVI2 ;ALB/RPM - CAPRI MVI GET CORRESPONDING IDS ;8/6/2012
+1 ;;2.7;AMIE;**181,223**;Apr 10, 1995;Build 15
+2 ; SAC EXEMPTION 20201020-01 : Xindex error, use of HWSC Object
+3 ;
+4 ; Get Corresponding Ids is a function of the MVI service,
+5 ; used to retrieve all known MVI Identifiers as they relate
+6 ; to a source identifier. The transaction grouping for this
+7 ; interaction is a 1309 Request and 1310 Response.
+8 ;
+9 ;NO DIRECT ENTRY
QUIT
+10 ;
GETIDS(DVBRSLT,DVBIID) ;
+1 ;This procedure supports the DVBA MVI GET CORRESPONDING IDS remote
+2 ;procedure. An MVI patient identifier string is passed to the procedure.
+3 ;The procedure generates a 1309 Get Corresponding IDs HL7v3 request
+4 ;message and transmits it to the MVI. A list of station numbers is
+5 ;returned in a 1310 HL7v3 message to represent the treating facility list.
+6 ;The INSTITUTION (#4) file IEN, station name, and station number is
+7 ;returned for each treating facility.
+8 ;
+9 ; Input:
+10 ; DVBRSLT - RPC results parameter defined as an ARRAY
+11 ; DVBIID = Patient identifier delimited using "^"
+12 ; Piece 1: Id
+13 ; Piece 2: IdType
+14 ; Piece 3: Assigning location
+15 ; Piece 4: Assigning issuer
+16 ;
+17 ; Example: 1008523099V750710^NI^200M^USVHA
+18 ;
+19 ; Output:
+20 ; DVBRSLT - array of lines each containing station IEN, name ,
+21 ; and station number delimited by a caret ("^"). The
+22 ; first array node contains the total number of stations
+23 ; returned and the query response.
+24 ;
+25 ; Format: instutionIEN^stationName^stationNumber
+26 ;
+27 ; Example: DVBOUT(0)=2^OK
+28 ; DVBOUT(1)="516^BAY PINES VA HCS^516"
+29 ; DVBOUT(2)="523^BOSTON HCS VAMC^523"
+30 ;
+31 ;parsed results array
NEW DVBPRS
+32 ;1309 HL7v3 XML request
NEW DVBXML
+33 ;1310 HL7v3 XML results
NEW DVBXMLR
+34 ;
+35 ;create the 1309 request message
+36 SET DVBXML=$$CRE81309(DVBIID)
+37 ;
+38 ;transmit the message to the MVI
+39 DO XMIT(DVBXML,.DVBXMLR)
+40 ;
+41 ;parse the returned 1310 result message
+42 IF $DATA(DVBXMLR)
Begin DoDot:1
+43 DO PARSE(.DVBXMLR,.DVBPRS)
+44 ;
+45 ;format the output array
+46 DO OUTPUT(.DVBPRS,.DVBRSLT)
End DoDot:1
+47 IF '$TEST
Begin DoDot:1
+48 SET DVBRSLT(0)=0_U_"Communication error occurred"
End DoDot:1
+49 QUIT
+50 ;
CRE81309(DVBIID) ; create 1309 request xml document
+1 ; This function creates the HL7v3 1309 Get Corresponding IDs
+2 ; Request xml document.
+3 ;
+4 ; DVBIID = Patient identifier delimited using "^"
+5 ; Piece 1: Id
+6 ; Piece 2: IdType
+7 ; Piece 3: Assigning location
+8 ; Piece 4: Assigning issuer
+9 ;
+10 ; ex. 1008523099V750710^NI^200M^USVHA
+11 ;
+12 ; Returns formatted XML for the search
+13 ;
+14 ; $$PARAM^HLCS2 - #3552 (need)
+15 ;
+16 ;site key
NEW DVBSKEY
+17 ;HL7 processing code
NEW DVBPCODE
+18 ;function result
NEW MPIXML
+19 ;
+20 SET DVBPCODE=$PIECE($$PARAM^HLCS2,"^",3)
+21 SET DVBSKEY="200CAPR"
+22 ;
+23 ;Header
+24 SET MPIXML="<PRPA_IN201309UV02 xmlns=""urn:hl7-org:v3"" "
+25 SET MPIXML=MPIXML_"xmlns:ps=""http://vaww.oed.oit.domain.ext"" "
+26 SET MPIXML=MPIXML_"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"
+27 SET MPIXML=MPIXML_""" xsi:schemaLocation=""urn:hl7-org:v3 ../../schema/"
+28 SET MPIXML=MPIXML_"HL7V3/NE2008/multicacheschemas/PRPA_IN201309UV02.xsd"
+29 SET MPIXML=MPIXML_""" ITSVersion=""XML_1.0"">"
+30 SET MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349"" "
+31 SET MPIXML=MPIXML_"extension=""MCID-12345""/>"
+32 SET MPIXML=MPIXML_"<creationTime value="""_$$FMTHL7^XLFDT($$NOW^XLFDT())_"""/>"
+33 SET MPIXML=MPIXML_"<interactionId root=""2.16.840.1.113883.1.6"" "
+34 SET MPIXML=MPIXML_"extension=""PRPA_IN201309UV02""/>"
+35 SET MPIXML=MPIXML_"<processingCode code="""_DVBPCODE_"""/>"
+36 SET MPIXML=MPIXML_"<processingModeCode code=""T""/>"
+37 SET MPIXML=MPIXML_"<acceptAckCode code=""AL""/>"
+38 ;
+39 ;<receiver> start
+40 SET MPIXML=MPIXML_"<receiver typeCode=""RCV"">"
+41 SET MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
+42 SET MPIXML=MPIXML_"<id root=""2.16.840.1.113883.4.349""/>"
+43 SET MPIXML=MPIXML_"<telecom value=""http://servicelocation/PDQuery""/>"
+44 SET MPIXML=MPIXML_"</device></receiver>"
+45 ;
+46 ;<sender> start
+47 SET MPIXML=MPIXML_"<sender typeCode=""SND"">"
+48 SET MPIXML=MPIXML_"<device classCode=""DEV"" determinerCode=""INSTANCE"">"
+49 SET MPIXML=MPIXML_"<id extension="""_DVBSKEY_""" root=""2.16.840.1.113883.4.349""/>"
+50 SET MPIXML=MPIXML_"</device></sender>"
+51 ;
+52 ;<controlActProcess> start
+53 SET MPIXML=MPIXML_"<controlActProcess "
+54 SET MPIXML=MPIXML_"classCode=""CACT"" moodCode=""EVN"">"
+55 SET MPIXML=MPIXML_"<code code=""PRPA_TE201309UV02"" "
+56 SET MPIXML=MPIXML_"codeSystem=""2.16.840.1.113883.1.6""/>"
+57 SET MPIXML=MPIXML_"<queryByParameter><queryId extension="""_$JOB_""""
+58 SET MPIXML=MPIXML_" root=""2.16.840.1.113883.4.349""/>"
+59 SET MPIXML=MPIXML_"<statusCode code=""new""/>"
+60 SET MPIXML=MPIXML_"<responsePriorityCode code=""I"" />"
+61 SET MPIXML=MPIXML_"<parameterList>"
+62 SET MPIXML=MPIXML_"<patientIdentifier>"
+63 SET MPIXML=MPIXML_"<value root=""2.16.840.1.113883.4.349"" extension="""_DVBIID_"""/>"
+64 SET MPIXML=MPIXML_"<semanticsText>Patient.Id</semanticsText>"
+65 SET MPIXML=MPIXML_"</patientIdentifier>"
+66 SET MPIXML=MPIXML_"</parameterList>"
+67 SET MPIXML=MPIXML_"</queryByParameter></controlActProcess>"
+68 SET MPIXML=MPIXML_"</PRPA_IN201309UV02>"
+69 QUIT MPIXML
+70 ;
XMIT(DVBXML,DVBXMLR) ;
+1 ;
+2 ; $$GETPROXY^XOBWLIB - #5421
+3 ;
+4 NEW $ETRAP,$ESTACK,SVC
+5 ;
+6 ; set error trap
+7 SET $ETRAP="DO ERROR^DVBAHWSC"
+8 ;
+9 ; make the call
+10 SET SVC=$$GETPROXY^XOBWLIB("DVB_PSIM_EXECUTE","DVB_MVI_SERVER")
+11 SET DVBXMLR=SVC.execute(DVBXML)
+12 ;
+13 QUIT
+14 ;
PARSE(DVBXML,DVBOUT) ;
+1 ;
+2 ; EN^MXMLPRSE - #4149
+3 ;
+4 KILL ^TMP($JOB,"DVBAMVI2")
+5 ;parser callback array
NEW DVBCB
+6 ;record counter
NEW DVBCNT
+7 SET DVBCNT=0
+8 SET DVBCB("STARTELEMENT")="SE^DVBAMVI2"
+9 SET ^TMP($JOB,"DVBAMVI2",1)=DVBXML
+10 DO EN^MXMLPRSE($NAME(^TMP($JOB,"DVBAMVI2")),.DVBCB)
+11 KILL ^TMP($JOB,"DVBAMVI2")
+12 QUIT
+13 ;
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 ;
+6 ;
+7 IF DVBNM="id"
IF $EXTRACT(DVBATTR("extension"),1,4)="MCID"
QUIT
+8 IF DVBNM="id"
IF DVBATTR("extension")?3N.NA
QUIT
+9 IF DVBNM="id"
IF DVBATTR("extension")=""
QUIT
+10 IF DVBNM="id"
IF DVBATTR("extension")["NI^200M^USVHA^P"
QUIT
+11 ;
+12 ;response code
+13 IF DVBNM="queryResponseCode"
IF $GET(DVBOUT(0))=""
Begin DoDot:1
+14 SET DVBOUT(0)=$SELECT(DVBATTR("code")="NF":"No match found for "_DVBIID,1:DVBATTR("code"))
End DoDot:1
QUIT
+15 ;
+16 ;set station numbers
+17 ;pattern match DFN_"^PI^"_stationNumber_"^USVHA^"_alpha
+18 IF DVBNM="id"
IF DVBATTR("extension")?1.N1"^PI^"2N.NA1"^USVHA^".A
Begin DoDot:1
+19 SET DVBOUT($PIECE(DVBATTR("extension"),U,3))=""
End DoDot:1
QUIT
+20 QUIT
+21 ;
OUTPUT(DVBIN,DVBOUT) ;
+1 ;This procedure formats the individual record lines and builds
+2 ;the results array output for the remote procedure.
+3 ;
+4 ; Input:
+5 ; DVBIN - array of station numbers
+6 ;
+7 ; Output:
+8 ; DVBOUT - array of lines each containing station IEN, name ,
+9 ; and station number delimited by a caret ("^"). The
+10 ; first array node contains the returned station count
+11 ; and the query response.
+12 ;
+13 ; Example: DVBOUT(0)=2^OK
+14 ; DVBOUT(1)="516^BAY PINES VA HCS^516"
+15 ; DVBOUT(2)="523^BOSTON HCS VAMC^523"
+16 ;
+17 ;station number
NEW DVBSTA
+18 ;results counter
NEW DVBCNT
+19 ;INSTITUTION (#4) file IEN
NEW DVBIEN
+20 SET DVBSTA=""
+21 SET DVBCNT=0
+22 FOR
SET DVBSTA=$ORDER(DVBIN(DVBSTA))
if (DVBSTA="")
QUIT
Begin DoDot:1
+23 SET DVBIEN=+$$IEN^XUAF4(DVBSTA)
+24 IF DVBIEN
Begin DoDot:2
+25 SET DVBCNT=DVBCNT+1
+26 SET DVBOUT(DVBCNT)=DVBIEN_U_$$NS^XUAF4(DVBIEN)
End DoDot:2
End DoDot:1
+27 SET DVBOUT(0)=DVBCNT_U_$GET(DVBIN(0))
+28 QUIT
GETACC(DVBOUT,DVBICN) ;get Active Cerner Correlations from mpi via hl7 direct rpc
+1 ;
+2 ; DVBOUT - return 0 (no) or 1 (yes) cerner active correlations or -1 (error)
+3 ; DVBICN - patient identifier (icn)
+4 ;
+5 ; DIRECT^XWB2HL7 supported by subscription to ICR #3144
+6 ;
+7 if $GET(DVBICN)=""
QUIT
+8 NEW DVBARRAY,DVBERROR
+9 DO DIRECT^XWB2HL7(.DVBARRAY,"200M","MPI GETCORRESPONDINGIDS","",DVBICN)
+10 ;check for errors when connecting to mpi
+11 SET DVBERROR="An error has occurred that prevents CAPRI from determining if Cerner treatment records exist. Please try again. If this error persists after several attempts, please open a trouble ticket requesting IT support."
+12 IF $PIECE($GET(DVBARRAY(0)),"^")=""!($PIECE($GET(DVBARRAY(1)),"^")=-1)
SET DVBOUT="-1^"_DVBERROR_"^"_$GET(DVBARRAY(1))
QUIT
+13 ;pass by reference to set dvbout
DO CHKACC(.DVBARRAY,.DVBOUT)
+14 QUIT
+15 ;
CHKACC(DVBARRAY,DVBOUT) ;check for Active Correlations with '200CRNR'
+1 ;
+2 ; DVBARRAY - array of patient's active correlations from mpi
+3 ; DVBOUT - return 0 (no) or 1 (yes) cerner active correlation
+4 ;
+5 NEW DVBRECN,DVBCRN,DVBERROR
+6 SET (DVBOUT,DVBCRN)=0
+7 IF $DATA(DVBARRAY)
SET DVBRECN=""
FOR
SET DVBRECN=$ORDER(DVBARRAY(DVBRECN))
if DVBRECN=""
QUIT
Begin DoDot:1
+8 ; check if active correlation contains '200CRNR'
IF $PIECE(DVBARRAY(DVBRECN),"^",2)="200CRNR"
SET DVBCRN=1
Begin DoDot:2
+9 ; check date last treated (piece 3) not null, id type (piece 4) is pi, and status of icn or correlation (piece 6) is active
+10 IF $PIECE(DVBARRAY(DVBRECN),"^",3)'=""
IF $PIECE(DVBARRAY(DVBRECN),"^",4)="PI"
Begin DoDot:3
+11 IF (($PIECE(DVBARRAY(DVBRECN),"^",6)="A")!($PIECE(DVBARRAY(DVBRECN),"^",6)=""))
SET DVBOUT=1
End DoDot:3
End DoDot:2
End DoDot:1
if DVBOUT=1
QUIT
+12 ; if no active correlations contain '200CRNR'
IF DVBCRN=0
Begin DoDot:1
+13 SET DVBERROR="An error has occurred that prevents CAPRI from determining if Cerner treatment records exist. Please try again. If this error persists after several attempts, please open a trouble ticket requesting IT support."
+14 SET DVBOUT="-1^"_DVBERROR_"^-1^'200CRNR' not found at MPI"
End DoDot:1
+15 QUIT
