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

MDHL7BH.m

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