MDHL7BH ; HOIFO/WAA,WOIFO/PMK -Bi-directional interface (HL7) routine ;15 Jun 2018 12:46 PM
;;1.0;CLINICAL PROCEDURES;**11,21,20,60**;Apr 01, 2004;Build 1
;
; This routine will build the HL7 Message and store that message.
; After the message has been created then it will call the
; The actual HL7package to start the processing of the message
;
; Reference DBIA #2056 [Supported] reference $$GET1^DIQ function call
; Reference DBIA #2161 [Supported] call to INIT^HLFCN2
; Reference DBIA #2164 [Supported] call to GENERATE^HLMA
; Reference DBIA #6932 [Private] call to CLINPROC^MAGDHLWP
; Reference DBIA #10061 [Supported] call to ADD^VADPT
; Reference DBIA #10103 [Supported] calls to $$NOW^XLFDT
; Reference DBIA #3062 [Supported] calls to $$HLNAME^XLFNAME
; Reference DBIA #2263 [Supported] calls to $$GET^XPAR
; Reference DBIA #3067 [Private] Read Consult Data with FM call.
; Reference DBIA #10035[Supported] Patient File Access
; Reference DBIA #10040[Supported] Access ^SC
; Reference DBIA #10056[Supported] Direct read STATE (5)
Q
EN1 ;Main Entry point.
N MDMSG,MD101,CNT,HLA,LINE,MDHL,DFN,MDLINK
Q:RESULT<1 ; This tells the study is not a BDi
S MDLINK=$$GET1^DIQ(702.09,DEVIEN,.18,"E")
I MDLINK="" S RESULT=-1,MSG="No HL Logical Link has been defined." Q ; No link has been defined
S MDERROR="0"
D INIT^HLFNC2("MCAR ORM SERVER",.MDMSG)
I +$G(MDMSG)>0 S RESULT=-1,MSG="Unable to produce a message." Q ; something is wrong and no MSH was created
S DFN=$$GET1^DIQ(702,MDD702,.01,"I")
S DEVNAME=$$GET1^DIQ(702.09,DEVIEN,.16,"I")
S CNT=0
D PID S CNT=CNT+1,HLA("HLS",CNT)=LINE
D PV1 S CNT=CNT+1,HLA("HLS",CNT)=LINE
D ORC S CNT=CNT+1,HLA("HLS",CNT)=LINE
D OBR I LINE'="" S CNT=CNT+1,HLA("HLS",CNT)=LINE
S HLP("SUBSCRIBER")="^^VISTA^^"_DEVNAME_"^M"
S HLL("LINKS",1)="MCAR ORM CLIENT"_"^"_MDLINK
;
; MD*1.0*60 - 16 April 2018 - Peter Kuzmak, VistA Imaging
; VistA Imaging code to generate CPRS Consult Request Tracking
; HL7 message for the DICOM Text Gateway to put the CP study
; on the DICOM Modality Worklist. This usually happens when
; the study is ordered, but is deferred for CP to check-in time.
;
; This considerably improves interoperability between Clinical Procedure
; and VistA Imaging CPRS Consult Request Tracking DICOM.
;
; If the CP - DICOM INTEROPERABILITY (field #.19) of the CP Instrument
; file (#702.09) is set to 2, then the VistA Imaging HL7 will replace
; the just-created CP HL7 in HLA("HLS"). The benefit for this is the
; VistA Imaging HL7 has much more data than does the CP HL7. The VistA
; Imaging HL7 would be transmitted to the instrument identically the same
; as the CP HL7, using the 1.6 HL7 package software (i.e., not HLO).
;
I $T(CLINPROC^MAGDHOWP)'="" D CLINPROC^MAGDHOWP(MDD702,MDORFLG) ; invoke VistA Imaging to generate HL7
;
D GENERATE^HLMA("MCAR ORM SERVER","LM",1,.MDHL,,.HLP)
I $P(MDHL,U,2) S MDERROR=MDHL
Q
OBR ; Send the procedure to the correct device
S LINE="OBR|"
S DEVIEN=$$GET1^DIQ(702,MDD702,.11,"I")
S USC=$$GET1^DIQ(702.09,DEVIEN,.17,"I")
I USC="" S LINE="" Q
E S USC=$TR(USC,"=","^")
S $P(LINE,"|",5)=USC_"|"
Q
PID ;get the patient information and build the PID
;PID|||SSN||Last^First||DOB|SEX|||||||||||SSN
N MDSSN,NAME,DOB,ADDR,TMP,MDADD,VAPA,VAERR,VAROOT,MDPCOD
S LINE="PID|",$P(LINE,"|",21)=""
S MDSSN=$$GET1^DIQ(702,MDD702,.011) ; Get the ssn for the patient
S NAME=$$GET1^DIQ(702,MDD702,.01,"E") ; get the patient name
S NAME=$$HLNAME^XLFNAME($P(NAME,"^"),"",$E(HLECH,1))
I $P(NAME,$E(HLECH,1),7)'="L" S $P(NAME,$E(HLECH,1),7)="L"
S DOB=$$GET1^DIQ(2,DFN,.03,"I") S DOB=$$FTOHL7^MDHL7U2(DOB)
S VAROOT="MDADD" D ADD^VADPT
S ADDR=$G(MDADD(1))_"^" ; Address 1
S TMP=$G(MDADD(2)) I TMP'="" S ADDR=ADDR_TMP ; Add 2
S TMP=$G(MDADD(3)) I TMP'="" S ADDR=ADDR_" "_TMP ; Add 3
S ADDR=ADDR_"^"_$G(MDADD(4)) ; City
S MDPCOD=$P($G(MDADD(5)),"^",1) I MDPCOD'="" S MDPCOD=$P($G(^DIC(5,MDPCOD,0)),"^",2)
; ^^^^^^ Setting MDPCODE to Postal code Via direct supported lookup.
S ADDR=ADDR_"^"_MDPCOD ; State Postal Code
S ADDR=ADDR_"^"_$G(MDADD(6)) ; Zip
K MDADD
S $P(LINE,"|",2)="1"
S $P(LINE,"|",4)=MDSSN
S $P(LINE,"|",6)=NAME
S $P(LINE,"|",8)=DOB
S $P(LINE,"|",9)=$$GET1^DIQ(2,DFN,.02,"I")
S $P(LINE,"|",12)=ADDR
S $P(LINE,"|",20)=MDSSN
Q
PV1 ;Get the ward location for PV1
;PV1||In or out|Ward location
N CWARD,WARD,INOUT,CONSULT,REF,NREF,WARD1,WARD2,MDPR1,MDPNAM,MDSV
S WARD=$$GET1^DIQ(2,DFN,.1,"E"),(WARD1,WARD2)=""
S INOUT=$S(WARD'="":"I",1:"O")
S:WARD'="" WARD=WARD_U_WARD
S CONSULT=$$GET123^MDHL7U2(MDD702)
S CWARD=$P($G(^MDD(702,+MDD702,0)),U,7),CWARD=$P(CWARD,";",3)
S:+CWARD WARD2=$$GET1^DIQ(44,+CWARD_",",.01,"E")
S MDPR1=$$GET1^DIQ(702,+MDD702_",",.04,"I")
S:+MDPR1 WARD1=$$GET1^DIQ(702.01,+MDPR1_",",.05,"E")
S MDPNAM=$$GET1^DIQ(702.09,DEVIEN,.06,"I")
I INOUT="O" D
.;S WARD=WARD1 S:WARD="" WARD=WARD2
.S WARD=WARD2 S:WARD="" WARD=WARD1
.I WARD="" S WARD=$$GET1^DIQ(123,CONSULT_",",.04,"E"),MDSV="A;"_$$NOW^XLFDT()_";"_$$GET1^DIQ(123,CONSULT_",",.04,"I"),$P(^MDD(702,+MDD702,0),U,7)=MDSV
.I MDPNAM["Olympus" D
..S WARD1=$O(^SC("B",WARD,0)),CWARD=$P($G(^SC(+WARD1,0)),U,2)
..S WARD=$S(+$$GET^XPAR("SYS","MD OLYMPUS 7",1)>0:$E(WARD,1,7),1:$E(WARD,1,4))_"^"_CWARD
I INOUT="I" D
.S:WARD="" WARD=WARD2 S:WARD="" WARD=WARD1
.S:WARD="" WARD=$$GET1^DIQ(123,CONSULT_",",.04,"E")
.S WARD=WARD_"^"_$S($G(^DPT(2,.101))'="":$G(^DPT(2,.101)),1:"") Q
;V--- NEW CODE THis code is
I $P($P(^MDD(702,+MDD702,0),U,7),";",3)="" D
. I +MDPR1 Q:+$$GET1^DIQ(702.01,+MDPR1_",",.05,"I")
. S MDSV="A;"_$$NOW^XLFDT()_";"_$$GET1^DIQ(123,CONSULT_",",.04,"I"),$P(^MDD(702,+MDD702,0),U,7)=MDSV
. Q
;^--- NEW CODE
S LINE="PV1||"_INOUT_"|"_WARD
Q:CONSULT<1
S NREF=$$GETREF^MDHL7U2(CONSULT) Q:NREF="-1"
S $P(LINE,"|",9)=NREF
Q
ORC ;get ORC onformation
;ORC|NA|Order Number|||||||date/time ordered
N DATE,SDATE
S DATE=$$GET1^DIQ(702,MDD702,.02,"I")
S DATE=$$FTOHL7^MDHL7U2(DATE)
S SDATE=$$GET1^DIQ(702,MDD702,.07,"I")
I SDATE[";" S SDATE=$P(SDATE,";",2)
I SDATE="" D NOW^%DTC S SDATE=% S $P(^MDD(702,MDD702,0),"^",7)=SDATE
I SDATE<DT D NOW^%DTC S SDATE=%
S SDATE=$$FTOHL7^MDHL7U2(SDATE)
S LINE="ORC|"_$S(MDORFLG=1:"NW",MDORFLG=0:"CA",1:"")_"|"_MDIORD
S $P(LINE,"|",6)=$S(MDORFLG=1:"NW",MDORFLG=0:"CA",1:"")
S $P(LINE,"|",10)=DATE,$P(LINE,"|",16)=SDATE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDHL7BH 6465 printed Apr 09, 2024@20:48:01 Page 2
MDHL7BH ; HOIFO/WAA,WOIFO/PMK -Bi-directional interface (HL7) routine ;15 Jun 2018 12:46 PM
+1 ;;1.0;CLINICAL PROCEDURES;**11,21,20,60**;Apr 01, 2004;Build 1
+2 ;
+3 ; This routine will build the HL7 Message and store that message.
+4 ; After the message has been created then it will call the
+5 ; The actual HL7package to start the processing of the message
+6 ;
+7 ; Reference DBIA #2056 [Supported] reference $$GET1^DIQ function call
+8 ; Reference DBIA #2161 [Supported] call to INIT^HLFCN2
+9 ; Reference DBIA #2164 [Supported] call to GENERATE^HLMA
+10 ; Reference DBIA #6932 [Private] call to CLINPROC^MAGDHLWP
+11 ; Reference DBIA #10061 [Supported] call to ADD^VADPT
+12 ; Reference DBIA #10103 [Supported] calls to $$NOW^XLFDT
+13 ; Reference DBIA #3062 [Supported] calls to $$HLNAME^XLFNAME
+14 ; Reference DBIA #2263 [Supported] calls to $$GET^XPAR
+15 ; Reference DBIA #3067 [Private] Read Consult Data with FM call.
+16 ; Reference DBIA #10035[Supported] Patient File Access
+17 ; Reference DBIA #10040[Supported] Access ^SC
+18 ; Reference DBIA #10056[Supported] Direct read STATE (5)
+19 QUIT
EN1 ;Main Entry point.
+1 NEW MDMSG,MD101,CNT,HLA,LINE,MDHL,DFN,MDLINK
+2 ; This tells the study is not a BDi
if RESULT<1
QUIT
+3 SET MDLINK=$$GET1^DIQ(702.09,DEVIEN,.18,"E")
+4 ; No link has been defined
IF MDLINK=""
SET RESULT=-1
SET MSG="No HL Logical Link has been defined."
QUIT
+5 SET MDERROR="0"
+6 DO INIT^HLFNC2("MCAR ORM SERVER",.MDMSG)
+7 ; something is wrong and no MSH was created
IF +$GET(MDMSG)>0
SET RESULT=-1
SET MSG="Unable to produce a message."
QUIT
+8 SET DFN=$$GET1^DIQ(702,MDD702,.01,"I")
+9 SET DEVNAME=$$GET1^DIQ(702.09,DEVIEN,.16,"I")
+10 SET CNT=0
+11 DO PID
SET CNT=CNT+1
SET HLA("HLS",CNT)=LINE
+12 DO PV1
SET CNT=CNT+1
SET HLA("HLS",CNT)=LINE
+13 DO ORC
SET CNT=CNT+1
SET HLA("HLS",CNT)=LINE
+14 DO OBR
IF LINE'=""
SET CNT=CNT+1
SET HLA("HLS",CNT)=LINE
+15 SET HLP("SUBSCRIBER")="^^VISTA^^"_DEVNAME_"^M"
+16 SET HLL("LINKS",1)="MCAR ORM CLIENT"_"^"_MDLINK
+17 ;
+18 ; MD*1.0*60 - 16 April 2018 - Peter Kuzmak, VistA Imaging
+19 ; VistA Imaging code to generate CPRS Consult Request Tracking
+20 ; HL7 message for the DICOM Text Gateway to put the CP study
+21 ; on the DICOM Modality Worklist. This usually happens when
+22 ; the study is ordered, but is deferred for CP to check-in time.
+23 ;
+24 ; This considerably improves interoperability between Clinical Procedure
+25 ; and VistA Imaging CPRS Consult Request Tracking DICOM.
+26 ;
+27 ; If the CP - DICOM INTEROPERABILITY (field #.19) of the CP Instrument
+28 ; file (#702.09) is set to 2, then the VistA Imaging HL7 will replace
+29 ; the just-created CP HL7 in HLA("HLS"). The benefit for this is the
+30 ; VistA Imaging HL7 has much more data than does the CP HL7. The VistA
+31 ; Imaging HL7 would be transmitted to the instrument identically the same
+32 ; as the CP HL7, using the 1.6 HL7 package software (i.e., not HLO).
+33 ;
+34 ; invoke VistA Imaging to generate HL7
IF $TEXT(CLINPROC^MAGDHOWP)'=""
DO CLINPROC^MAGDHOWP(MDD702,MDORFLG)
+35 ;
+36 DO GENERATE^HLMA("MCAR ORM SERVER","LM",1,.MDHL,,.HLP)
+37 IF $PIECE(MDHL,U,2)
SET MDERROR=MDHL
+38 QUIT
OBR ; Send the procedure to the correct device
+1 SET LINE="OBR|"
+2 SET DEVIEN=$$GET1^DIQ(702,MDD702,.11,"I")
+3 SET USC=$$GET1^DIQ(702.09,DEVIEN,.17,"I")
+4 IF USC=""
SET LINE=""
QUIT
+5 IF '$TEST
SET USC=$TRANSLATE(USC,"=","^")
+6 SET $PIECE(LINE,"|",5)=USC_"|"
+7 QUIT
PID ;get the patient information and build the PID
+1 ;PID|||SSN||Last^First||DOB|SEX|||||||||||SSN
+2 NEW MDSSN,NAME,DOB,ADDR,TMP,MDADD,VAPA,VAERR,VAROOT,MDPCOD
+3 SET LINE="PID|"
SET $PIECE(LINE,"|",21)=""
+4 ; Get the ssn for the patient
SET MDSSN=$$GET1^DIQ(702,MDD702,.011)
+5 ; get the patient name
SET NAME=$$GET1^DIQ(702,MDD702,.01,"E")
+6 SET NAME=$$HLNAME^XLFNAME($PIECE(NAME,"^"),"",$EXTRACT(HLECH,1))
+7 IF $PIECE(NAME,$EXTRACT(HLECH,1),7)'="L"
SET $PIECE(NAME,$EXTRACT(HLECH,1),7)="L"
+8 SET DOB=$$GET1^DIQ(2,DFN,.03,"I")
SET DOB=$$FTOHL7^MDHL7U2(DOB)
+9 SET VAROOT="MDADD"
DO ADD^VADPT
+10 ; Address 1
SET ADDR=$GET(MDADD(1))_"^"
+11 ; Add 2
SET TMP=$GET(MDADD(2))
IF TMP'=""
SET ADDR=ADDR_TMP
+12 ; Add 3
SET TMP=$GET(MDADD(3))
IF TMP'=""
SET ADDR=ADDR_" "_TMP
+13 ; City
SET ADDR=ADDR_"^"_$GET(MDADD(4))
+14 SET MDPCOD=$PIECE($GET(MDADD(5)),"^",1)
IF MDPCOD'=""
SET MDPCOD=$PIECE($GET(^DIC(5,MDPCOD,0)),"^",2)
+15 ; ^^^^^^ Setting MDPCODE to Postal code Via direct supported lookup.
+16 ; State Postal Code
SET ADDR=ADDR_"^"_MDPCOD
+17 ; Zip
SET ADDR=ADDR_"^"_$GET(MDADD(6))
+18 KILL MDADD
+19 SET $PIECE(LINE,"|",2)="1"
+20 SET $PIECE(LINE,"|",4)=MDSSN
+21 SET $PIECE(LINE,"|",6)=NAME
+22 SET $PIECE(LINE,"|",8)=DOB
+23 SET $PIECE(LINE,"|",9)=$$GET1^DIQ(2,DFN,.02,"I")
+24 SET $PIECE(LINE,"|",12)=ADDR
+25 SET $PIECE(LINE,"|",20)=MDSSN
+26 QUIT
PV1 ;Get the ward location for PV1
+1 ;PV1||In or out|Ward location
+2 NEW CWARD,WARD,INOUT,CONSULT,REF,NREF,WARD1,WARD2,MDPR1,MDPNAM,MDSV
+3 SET WARD=$$GET1^DIQ(2,DFN,.1,"E")
SET (WARD1,WARD2)=""
+4 SET INOUT=$SELECT(WARD'="":"I",1:"O")
+5 if WARD'=""
SET WARD=WARD_U_WARD
+6 SET CONSULT=$$GET123^MDHL7U2(MDD702)
+7 SET CWARD=$PIECE($GET(^MDD(702,+MDD702,0)),U,7)
SET CWARD=$PIECE(CWARD,";",3)
+8 if +CWARD
SET WARD2=$$GET1^DIQ(44,+CWARD_",",.01,"E")
+9 SET MDPR1=$$GET1^DIQ(702,+MDD702_",",.04,"I")
+10 if +MDPR1
SET WARD1=$$GET1^DIQ(702.01,+MDPR1_",",.05,"E")
+11 SET MDPNAM=$$GET1^DIQ(702.09,DEVIEN,.06,"I")
+12 IF INOUT="O"
Begin DoDot:1
+13 ;S WARD=WARD1 S:WARD="" WARD=WARD2
+14 SET WARD=WARD2
if WARD=""
SET WARD=WARD1
+15 IF WARD=""
SET WARD=$$GET1^DIQ(123,CONSULT_",",.04,"E")
SET MDSV="A;"_$$NOW^XLFDT()_";"_$$GET1^DIQ(123,CONSULT_",",.04,"I")
SET $PIECE(^MDD(702,+MDD702,0),U,7)=MDSV
+16 IF MDPNAM["Olympus"
Begin DoDot:2
+17 SET WARD1=$ORDER(^SC("B",WARD,0))
SET CWARD=$PIECE($GET(^SC(+WARD1,0)),U,2)
+18 SET WARD=$SELECT(+$$GET^XPAR("SYS","MD OLYMPUS 7",1)>0:$EXTRACT(WARD,1,7),1:$EXTRACT(WARD,1,4))_"^"_CWARD
End DoDot:2
End DoDot:1
+19 IF INOUT="I"
Begin DoDot:1
+20 if WARD=""
SET WARD=WARD2
if WARD=""
SET WARD=WARD1
+21 if WARD=""
SET WARD=$$GET1^DIQ(123,CONSULT_",",.04,"E")
+22 SET WARD=WARD_"^"_$SELECT($GET(^DPT(2,.101))'="":$GET(^DPT(2,.101)),1:"")
QUIT
End DoDot:1
+23 ;V--- NEW CODE THis code is
+24 IF $PIECE($PIECE(^MDD(702,+MDD702,0),U,7),";",3)=""
Begin DoDot:1
+25 IF +MDPR1
if +$$GET1^DIQ(702.01,+MDPR1_",",.05,"I")
QUIT
+26 SET MDSV="A;"_$$NOW^XLFDT()_";"_$$GET1^DIQ(123,CONSULT_",",.04,"I")
SET $PIECE(^MDD(702,+MDD702,0),U,7)=MDSV
+27 QUIT
End DoDot:1
+28 ;^--- NEW CODE
+29 SET LINE="PV1||"_INOUT_"|"_WARD
+30 if CONSULT<1
QUIT
+31 SET NREF=$$GETREF^MDHL7U2(CONSULT)
if NREF="-1"
QUIT
+32 SET $PIECE(LINE,"|",9)=NREF
+33 QUIT
ORC ;get ORC onformation
+1 ;ORC|NA|Order Number|||||||date/time ordered
+2 NEW DATE,SDATE
+3 SET DATE=$$GET1^DIQ(702,MDD702,.02,"I")
+4 SET DATE=$$FTOHL7^MDHL7U2(DATE)
+5 SET SDATE=$$GET1^DIQ(702,MDD702,.07,"I")
+6 IF SDATE[";"
SET SDATE=$PIECE(SDATE,";",2)
+7 IF SDATE=""
DO NOW^%DTC
SET SDATE=%
SET $PIECE(^MDD(702,MDD702,0),"^",7)=SDATE
+8 IF SDATE<DT
DO NOW^%DTC
SET SDATE=%
+9 SET SDATE=$$FTOHL7^MDHL7U2(SDATE)
+10 SET LINE="ORC|"_$SELECT(MDORFLG=1:"NW",MDORFLG=0:"CA",1:"")_"|"_MDIORD
+11 SET $PIECE(LINE,"|",6)=$SELECT(MDORFLG=1:"NW",MDORFLG=0:"CA",1:"")
+12 SET $PIECE(LINE,"|",10)=DATE
SET $PIECE(LINE,"|",16)=SDATE
+13 QUIT
