MDCPVDEF ;HINES OIFO/BJ/TJ - CP Outbound message record maintenance routine.;30 Jul 2007
;;1.0;CLINICAL PROCEDURES;**16,12,23**;Apr 01, 2004;Build 281
;Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine uses the following IAs:
; #10061 - IN5^VADPT Registration (supported)
; # 2817 - access "AD" x-ref per ^DG(40.8, Registration (controlled subscription)
; # 1373 - access ^ORD(101 Kernel (controlled subscription)
; #10039 - access ^DIC(42 Registration (supported)
; # 1181 - access DGPM* event variables Registration (controlled subscription)
;
; only call via line tags.
Q
;
EN ;
; Parses outbound message from PIMS to send to 3rd party devices via ADT/A?? message.
;
; Parameters -
; Covert (Preset local variables) -
; DFN - The internal entry number of the patient in file 2.
; DGPMDA - The movement internal entry number of the entry in the PATIENT_MOVEMENT
; file.
; DGPMA - Zero node of entry DGPMDA after the movement has been changed in the
; PATIENT MOVEMENT file.
; DGPMP - Zero node of entry DGPMDA before the movement has been changed in the
; PATIENT MOVEMENT file.
;
; Returns -
; None
;
Q:'$D(DGPMA)&'$D(DGPMP)
N MDNODE,MDDIV,MDWARD,MDBED,MDEVNT,MDTYPE,MDDFN,MDMVMT,MDQUIT,MDDA,MDEDIT,VAIP
S MDNODE=$S(DGPMA]"":DGPMA,1:DGPMP)
S MDEDIT=(DGPMA]"")&(DGPMP]"")
S MDMVMT=DGPMDA
S MDDFN=$P(MDNODE,U,3)
S MDTYPE=+$P(MDNODE,U,2) Q:(MDTYPE'=MDTYPE\1)!(MDTYPE>3)!(MDTYPE<1)
S MDWARD=$P(MDNODE,U,6) I MDWARD="" D LASTLOC(MDDFN,"WARD")
S MDBED=$P(MDNODE,U,7) I MDBED="" D:MDTYPE'=1 LASTLOC(MDDFN,"BED")
I ($G(MDWARD)="")!($G(MDBED)="") Q ;Q NOT inpatient activity
;
; It appears that DIV might be empty if this is a single division facility. So, we have to
; get a division of our own.
;
S MDDIV=$P(^DIC(42,MDWARD,0),U,11)
I MDDIV="" S MDDIV=DUZ(2),MDDIV=$O(^DG(40.8,"AD",MDDIV,0))
; Future inclusion: MD*1*23
;I $G(^MDC(704.005,"APIMS",MDMVMT,MDDFN,MDWARD),0)&MDEDIT D RESEND^MDCPHL7C(MDDFN,MDDIV,MDWARD,MDBED,MDEDIT) Q ; We've already seen this movement - Future A08
;
; Movement | DGPMP | DGPMA
; ---------------------------------------------
; Admit | Absent | Present
; Cancel Admit | Present | Absent
; Transfer | Absent | Present
; Cancel Xfer | Present | Absent
; Discharge | Absent | Present
; Cancel Discharge | Present | Absent
; Update | Present old | Present new
;
S MDEVNT=$S(DGPMA]"":"A0",1:"A1")
S MDEVNT=MDEVNT_MDTYPE
W !,"Executing HL7 ADT Messaging (MD CP Flowsheets)",!
I '$$SENDMSG(MDDIV,MDWARD,"ADT",MDEVNT) W !,"No CP Flowsheets subscriber(s) for the movement location.",! Q
D ADD(MDDFN,MDDIV,MDWARD,$G(MDBED),"ADT",MDEVNT,MDMVMT)
Q
;
ADD(MDCPDFN,MDCPDIV,MDCPWARD,MDCPBED,MDCPMSG,MDCPEVNT,MDCPMVMT,MDCPROT) ;
;
; Adds information to CP_PATIENT_MOVEMENT file (704.005), and generates HL7 message.
;
; Parameters -
; Covert (Preset local variables) -
; None
;
; Overt -
; MDCPDFN - The IFN of the patient in the PATIENT file.
; MDCPDIV - A pointer to the division of the ward for which the message was sent
; MDCPWARD - A pointer to the ward for which the movement was sent
; MDCPBED - A pointer to the bed for which the movement was sent
; MDCPMSG - The HL7 message type (at this point, this should ALWAYS be ADT).
; MDCPEVNT - The HL7 event type for the message (A01, A02, A03, etc.)
; MDCPMVMT - PATIENT MOVEMENT IEN (Stored as PIMS_EVENT_ID, not a pointer)
; MDCPROT - Pointer to 704.006 (optional)
;
; Returns -
; None
;
; The first thing we want to do is see if this is a cancellation. If it is, we need
; to look back at the most recent previous movement in our system. If the most recent
; previous movement does NOT refer to the same division, ward, and bed, then we ignore
; the event.
;
; $ESTACK, UNWIND^%ZTER, and ^%ZTER appear courtesy of IA 1621 (Supported)
;
N MDCPDTTM
D NOW^%DTC S MDCPDTTM=%
N MDCPFLG S MDCPFLG=0
I MDCPEVNT?1"A1"1N D
.; The concept here is that, if this is a cancel movement, we need to take a look at
.; the most recent movement and cancellation of that movement type. If there was another
.; cancel between the last movement and this cancel, we don't want to resend the message.
.N MDCPPREV,MDCPOLD,MDCPPOLD
.S MDCPOLD=$S(MDCPEVNT="A11":"A01",MDCPEVNT="A12":"A02",MDCPEVNT="A13":"A03",1:"")
.S MDCPPREV=$O(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPOLD,""),-1)
.S MDCPPOLD=$O(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPEVNT,""),-1)
.S MDCPFLG=$S(MDCPPREV="":"0",+MDCPPOLD'<+MDCPPREV:"1",1:"0")
;
Q:MDCPFLG
N MDCFDA,MDCPIEN,MDCPPAIR
S MDCFDA(704.005,"+1,",.01)=MDCPDFN
S MDCFDA(704.005,"+1,",.02)=MDCPDTTM
S MDCFDA(704.005,"+1,",.03)=$G(MDCPDIV)
S MDCFDA(704.005,"+1,",.04)=$G(MDCPWARD)
S MDCFDA(704.005,"+1,",.05)=$G(MDCPBED)
S MDCFDA(704.005,"+1,",.06)=MDCPMSG
S MDCFDA(704.005,"+1,",.07)=MDCPEVNT
S MDCFDA(704.005,"+1,",.08)=$G(MDCPMVMT)
S MDCFDA(704.005,"+1,",.21)=$G(MDCPROT)
D UPDATE^DIE("","MDCFDA","MDCPIEN") Q:$G(MDCPIEN(1))<1
;
I MDCPEVNT?1"A1"1N D
.S MDCPOLD=$S(MDCPEVNT="A11":"A01",MDCPEVNT="A12":"A02",MDCPEVNT="A13":"A03",1:"")
.N MDIFN,MDCPPREV
.S MDCPPREV=$O(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPOLD,""),-1)
.I MDCPPREV]"" D
..S MDIFN=$O(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPOLD,MDCPPREV,""))
..D DEL(MDIFN)
;
N RETRN
K MDCFDA
S MDCFDA(704.005,MDCPIEN(1)_",",.09)=$$QUE^MDCPMESQ(MDCPIEN(1),MDCPEVNT,.RETRN) ; Queue message
S MDCFDA(704.005,MDCPIEN(1)_",",.1)=$G(RETRN,"No return message.")
D UPDATE^DIE("","MDCFDA")
Q
;
DEL(MDCPIFN) ;
;
; Removes entry from CP_PATIENT_MOVEMENT file (704.005).
;
; Parameters -
; Covert (Preset local variables) -
; None
;
; Overt -
; MDCPIFN - IFN of entry in 704.005 to delete.
;
; Returns -
; None
;
N MDCFDA
S MDCFDA(704.005,MDCPIFN_",",.01)="@"
D FILE^DIE("K","MDCFDA")
Q
;
GENDESTS ;
; Filters outbound messages. See HL*1.6*56/66 Site Manager and Developer Manual
; p. 11-7 to 11-11 (inc).
;
; IA's -
; 1373 (provisional: subscription requested 3 Aug 2007)
;
; Parameters -
; Covert (Preset local variables) -
; HLNEXT - Executable code to retrieve the next line of an outbound HL7 message.
; HL("ECH") - Encoding characters for this HL7 message.
; HL("FS") - The Field Separator for this HL7 message.
; NAMEVAL - Local array passed from VDEF to HL7. Must not be newed or killed.
;
;
; Returns -
; None overt. HLL("LINKS",n) will be read by HLO upon return.
;
N MDCPV1,MDHLFS,MDHLECH,MDDIV,MDDIVI,MDWARD,MDWARDI,MDBED,MDCPSUB,MDCPROT,I,IEN
S IEN=MDCIEN
S MDHLFS=HL("FS")
S MDHLECH=$E(HL("ECH"),1,1)
F X HLNEXT D Q:HLQUIT'>0
.S:$P($G(HLNODE),MDHLFS)="PV1" MDCPV1=HLNODE
; Division is PV1(3)(1), Room is PV1(3)(2), Bed is PV1(3)(3)
S MDDIV=$P(MDCPV1,MDHLFS,4)
S MDWARD=$P(MDDIV,MDHLECH,2)
S MDBED=$P(MDDIV,MDHLECH,3)
S MDDIVI=$P(^MDC(704.005,IEN,0),U,3)
S MDWARDI=$P(^MDC(704.005,IEN,0),U,4)
D ARRYDEST(MDDIVI,MDWARDI,$G(HL("MTN")),$G(HL("ETN")))
;
Q
;
GETSUBS ;
; Get subscriber protocols
;
; IA's -
; 1373 (provisional, see above)
;
; Parameters -
; None
;
; Returns -
; Overt - None
;
N Y S Y=0
F S Y=$O(^ORD(101,Y)) Q:'Y S:$P(^ORD(101,Y,0),U,4)="S"&($P(^(0),U,1)?1"MD".E) @MDROOT@(Y)=""
Q
;
GENDEST2(IEN) ; Filters outbound messages. Unlike GENDESTS, this is set to filter
; assuming that we have not yet queued the outbound message.
;
;
; Parameters
; IEN: The IEN of the entry in the CLIO_HL7_LOG file that will be used to generate
; this message.
;
; Returns -
; None overt. HLL("LINKS",n) will be read by HLO upon return.
;
N MDCPDIV,MDCPMSGT,MDCPEVNT
N MDCPMSG
D GETS^DIQ(704.005,IEN_",","*","I","MDCPMSG")
S MDCPDIV=$G(MDCPMSG("704.005",IEN_",",".03","I"))
S MDCPMSGT=$G(MDCPMSG("704.005",IEN_",",".06","I"))
S MDCPEVNT=$G(MDCPMSG("704.005",IEN_",",".07","I"))
S MDCPWARD=$G(MDCPMSG("704.005",IEN_",",".04","I"))
D ARRYDEST(MDCPDIV,MDCPWARD,MDCPMSGT,MDCPEVNT)
Q
;
ARRYDEST(DIVISION,WARD,MSGTYPE,EVNTTYPE) ;
;
; DIVISION: IEN of division in file 40.8.
; WARD: IEN of ward in file 42.
;
N MDCPSUB,I,MDCPROT,MDCPWARD
S MDCPSUB=0,I=0
F S MDCPSUB=$O(^MDC(704.006,"LOCDEV",DIVISION,MDCPSUB)) Q:'MDCPSUB D
.Q:MSGTYPE'=$P(^MDC(704.006,MDCPSUB,0),U,4)
.Q:EVNTTYPE'=$P(^MDC(704.006,MDCPSUB,0),U,5)
.S MDCPWARD=$P(^MDC(704.006,MDCPSUB,0),U,3)
.Q:(MDCPWARD'="")&(MDCPWARD'=WARD)
.S MDCPROT=$P(^MDC(704.006,MDCPSUB,0),U)
.S I=I+1
.S HLL("LINKS",I)=$P(^ORD(101,MDCPROT,0),U)_U_$$EXTERNAL^DILFD(101,770.7,"",$P(^ORD(101,MDCPROT,770),U,7))
Q
;
SENDMSG(DIVISION,WARD,MSGTYPE,EVNTTYPE) ;
;
; Determines whether or not we should continue to build or save this message. On a basis
; of division, ward, message type, and event type, will return 1 or 0 based on whether or
; not there is an entry in 704.006 to send the message to a specific device.
;
; Parameters
; DIVISION - Division (internal)
; WARD - Ward (internal)
; MSGTYPE - HL7 message type eg. "ADT"
; EVNTTYPE - HL7 event type eg. "A01"
;
; Returns
; 1 if message should be sent
; 0 if not
;
N USE
I $G(WARD)'="" D
.S USE=$O(^MDC(704.006,"AMSGDIVWARD",MSGTYPE,EVNTTYPE,$G(DIVISION),$G(WARD),0))
I $G(WARD)="" D
.N WD S WD=0 S USE=0
.F S WD=$O(^MDC(704.006,"AMSGDIV",MSGTYPE,EVNTTYPE,$G(DIVISION),WD)) Q:+WD=0 D
..I $P(^MDC(704.006,WD,0),U,3)="" S USE=1 Q
Q:+$G(USE) 1
Q 0
;
LASTLOC(MDCPDFN,MDCPLOC) ;
;
; Retrieve inpatient's location via LAST known LOCation per CP - if neccessary ....
;
; Parameters
; MDCPDFN - Patient's IEN
; MDCPLOC - "WARD" or "BED" (seeking ward or bed data)
;
; Returns
; 1 if found location patient
; 0 if NOT found location of patient or NOT INPATIENT
;
N LASTLOC S LASTLOC=""
A02 ;Look into transfers (A02)
G:'$D(^MDC(704.005,"LAST",MDCPDFN,"ADT","A02")) A01
N MDCDAT S MDCDAT=$O(^MDC(704.005,"LAST",MDCPDFN,"ADT","A02",""),-1)
S LASTLOC=$O(^MDC(704.005,"LAST",MDCPDFN,"ADT","A02",MDCDAT,LASTLOC))
I LASTLOC]"" D Q
.I MDCPLOC="WARD" S MDWARD=$P(^MDC(704.005,LASTLOC,0),U,4)
.I MDCPLOC="BED" S MDBED=$P(^MDC(704.005,LASTLOC,0),U,5)
A01 ;Look into admissions (A01)
;
G:'$D(^MDC(704.005,"LAST",MDCPDFN,"ADT","A01")) VADATA
N MDCDAT S MDCDAT=$O(^MDC(704.005,"LAST",MDCPDFN,"ADT","A01",""),-1)
S LASTLOC=$O(^MDC(704.005,"LAST",MDCPDFN,"ADT","A01",MDCDAT,LASTLOC))
I LASTLOC]"" D Q
.I MDCPLOC="WARD" S MDWARD=$P(^MDC(704.005,LASTLOC,0),U,4)
.I MDCPLOC="BED" S MDBED=$P(^MDC(704.005,LASTLOC,0),U,5)
VADATA ;Look into VADPT
N DFN S DFN=MDCPDFN
S:MDTYPE=3 VAIP("D")=$P(MDNODE,".")
D IN5^VADPT
I MDCPLOC="WARD" S MDWARD=$P(VAIP(5),U)
I MDCPLOC="BED" S MDBED=$P(VAIP(6),U)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCPVDEF 11226 printed Dec 13, 2024@01:42:35 Page 2
MDCPVDEF ;HINES OIFO/BJ/TJ - CP Outbound message record maintenance routine.;30 Jul 2007
+1 ;;1.0;CLINICAL PROCEDURES;**16,12,23**;Apr 01, 2004;Build 281
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; This routine uses the following IAs:
+5 ; #10061 - IN5^VADPT Registration (supported)
+6 ; # 2817 - access "AD" x-ref per ^DG(40.8, Registration (controlled subscription)
+7 ; # 1373 - access ^ORD(101 Kernel (controlled subscription)
+8 ; #10039 - access ^DIC(42 Registration (supported)
+9 ; # 1181 - access DGPM* event variables Registration (controlled subscription)
+10 ;
+11 ; only call via line tags.
+12 QUIT
+13 ;
EN ;
+1 ; Parses outbound message from PIMS to send to 3rd party devices via ADT/A?? message.
+2 ;
+3 ; Parameters -
+4 ; Covert (Preset local variables) -
+5 ; DFN - The internal entry number of the patient in file 2.
+6 ; DGPMDA - The movement internal entry number of the entry in the PATIENT_MOVEMENT
+7 ; file.
+8 ; DGPMA - Zero node of entry DGPMDA after the movement has been changed in the
+9 ; PATIENT MOVEMENT file.
+10 ; DGPMP - Zero node of entry DGPMDA before the movement has been changed in the
+11 ; PATIENT MOVEMENT file.
+12 ;
+13 ; Returns -
+14 ; None
+15 ;
+16 if '$DATA(DGPMA)&'$DATA(DGPMP)
QUIT
+17 NEW MDNODE,MDDIV,MDWARD,MDBED,MDEVNT,MDTYPE,MDDFN,MDMVMT,MDQUIT,MDDA,MDEDIT,VAIP
+18 SET MDNODE=$SELECT(DGPMA]"":DGPMA,1:DGPMP)
+19 SET MDEDIT=(DGPMA]"")&(DGPMP]"")
+20 SET MDMVMT=DGPMDA
+21 SET MDDFN=$PIECE(MDNODE,U,3)
+22 SET MDTYPE=+$PIECE(MDNODE,U,2)
if (MDTYPE'=MDTYPE\1)!(MDTYPE>3)!(MDTYPE<1)
QUIT
+23 SET MDWARD=$PIECE(MDNODE,U,6)
IF MDWARD=""
DO LASTLOC(MDDFN,"WARD")
+24 SET MDBED=$PIECE(MDNODE,U,7)
IF MDBED=""
if MDTYPE'=1
DO LASTLOC(MDDFN,"BED")
+25 ;Q NOT inpatient activity
IF ($GET(MDWARD)="")!($GET(MDBED)="")
QUIT
+26 ;
+27 ; It appears that DIV might be empty if this is a single division facility. So, we have to
+28 ; get a division of our own.
+29 ;
+30 SET MDDIV=$PIECE(^DIC(42,MDWARD,0),U,11)
+31 IF MDDIV=""
SET MDDIV=DUZ(2)
SET MDDIV=$ORDER(^DG(40.8,"AD",MDDIV,0))
+32 ; Future inclusion: MD*1*23
+33 ;I $G(^MDC(704.005,"APIMS",MDMVMT,MDDFN,MDWARD),0)&MDEDIT D RESEND^MDCPHL7C(MDDFN,MDDIV,MDWARD,MDBED,MDEDIT) Q ; We've already seen this movement - Future A08
+34 ;
+35 ; Movement | DGPMP | DGPMA
+36 ; ---------------------------------------------
+37 ; Admit | Absent | Present
+38 ; Cancel Admit | Present | Absent
+39 ; Transfer | Absent | Present
+40 ; Cancel Xfer | Present | Absent
+41 ; Discharge | Absent | Present
+42 ; Cancel Discharge | Present | Absent
+43 ; Update | Present old | Present new
+44 ;
+45 SET MDEVNT=$SELECT(DGPMA]"":"A0",1:"A1")
+46 SET MDEVNT=MDEVNT_MDTYPE
+47 WRITE !,"Executing HL7 ADT Messaging (MD CP Flowsheets)",!
+48 IF '$$SENDMSG(MDDIV,MDWARD,"ADT",MDEVNT)
WRITE !,"No CP Flowsheets subscriber(s) for the movement location.",!
QUIT
+49 DO ADD(MDDFN,MDDIV,MDWARD,$GET(MDBED),"ADT",MDEVNT,MDMVMT)
+50 QUIT
+51 ;
ADD(MDCPDFN,MDCPDIV,MDCPWARD,MDCPBED,MDCPMSG,MDCPEVNT,MDCPMVMT,MDCPROT) ;
+1 ;
+2 ; Adds information to CP_PATIENT_MOVEMENT file (704.005), and generates HL7 message.
+3 ;
+4 ; Parameters -
+5 ; Covert (Preset local variables) -
+6 ; None
+7 ;
+8 ; Overt -
+9 ; MDCPDFN - The IFN of the patient in the PATIENT file.
+10 ; MDCPDIV - A pointer to the division of the ward for which the message was sent
+11 ; MDCPWARD - A pointer to the ward for which the movement was sent
+12 ; MDCPBED - A pointer to the bed for which the movement was sent
+13 ; MDCPMSG - The HL7 message type (at this point, this should ALWAYS be ADT).
+14 ; MDCPEVNT - The HL7 event type for the message (A01, A02, A03, etc.)
+15 ; MDCPMVMT - PATIENT MOVEMENT IEN (Stored as PIMS_EVENT_ID, not a pointer)
+16 ; MDCPROT - Pointer to 704.006 (optional)
+17 ;
+18 ; Returns -
+19 ; None
+20 ;
+21 ; The first thing we want to do is see if this is a cancellation. If it is, we need
+22 ; to look back at the most recent previous movement in our system. If the most recent
+23 ; previous movement does NOT refer to the same division, ward, and bed, then we ignore
+24 ; the event.
+25 ;
+26 ; $ESTACK, UNWIND^%ZTER, and ^%ZTER appear courtesy of IA 1621 (Supported)
+27 ;
+28 NEW MDCPDTTM
+29 DO NOW^%DTC
SET MDCPDTTM=%
+30 NEW MDCPFLG
SET MDCPFLG=0
+31 IF MDCPEVNT?1"A1"1N
Begin DoDot:1
+32 ; The concept here is that, if this is a cancel movement, we need to take a look at
+33 ; the most recent movement and cancellation of that movement type. If there was another
+34 ; cancel between the last movement and this cancel, we don't want to resend the message.
+35 NEW MDCPPREV,MDCPOLD,MDCPPOLD
+36 SET MDCPOLD=$SELECT(MDCPEVNT="A11":"A01",MDCPEVNT="A12":"A02",MDCPEVNT="A13":"A03",1:"")
+37 SET MDCPPREV=$ORDER(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPOLD,""),-1)
+38 SET MDCPPOLD=$ORDER(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPEVNT,""),-1)
+39 SET MDCPFLG=$SELECT(MDCPPREV="":"0",+MDCPPOLD'<+MDCPPREV:"1",1:"0")
End DoDot:1
+40 ;
+41 if MDCPFLG
QUIT
+42 NEW MDCFDA,MDCPIEN,MDCPPAIR
+43 SET MDCFDA(704.005,"+1,",.01)=MDCPDFN
+44 SET MDCFDA(704.005,"+1,",.02)=MDCPDTTM
+45 SET MDCFDA(704.005,"+1,",.03)=$GET(MDCPDIV)
+46 SET MDCFDA(704.005,"+1,",.04)=$GET(MDCPWARD)
+47 SET MDCFDA(704.005,"+1,",.05)=$GET(MDCPBED)
+48 SET MDCFDA(704.005,"+1,",.06)=MDCPMSG
+49 SET MDCFDA(704.005,"+1,",.07)=MDCPEVNT
+50 SET MDCFDA(704.005,"+1,",.08)=$GET(MDCPMVMT)
+51 SET MDCFDA(704.005,"+1,",.21)=$GET(MDCPROT)
+52 DO UPDATE^DIE("","MDCFDA","MDCPIEN")
if $GET(MDCPIEN(1))<1
QUIT
+53 ;
+54 IF MDCPEVNT?1"A1"1N
Begin DoDot:1
+55 SET MDCPOLD=$SELECT(MDCPEVNT="A11":"A01",MDCPEVNT="A12":"A02",MDCPEVNT="A13":"A03",1:"")
+56 NEW MDIFN,MDCPPREV
+57 SET MDCPPREV=$ORDER(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPOLD,""),-1)
+58 IF MDCPPREV]""
Begin DoDot:2
+59 SET MDIFN=$ORDER(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPOLD,MDCPPREV,""))
+60 DO DEL(MDIFN)
End DoDot:2
End DoDot:1
+61 ;
+62 NEW RETRN
+63 KILL MDCFDA
+64 ; Queue message
SET MDCFDA(704.005,MDCPIEN(1)_",",.09)=$$QUE^MDCPMESQ(MDCPIEN(1),MDCPEVNT,.RETRN)
+65 SET MDCFDA(704.005,MDCPIEN(1)_",",.1)=$GET(RETRN,"No return message.")
+66 DO UPDATE^DIE("","MDCFDA")
+67 QUIT
+68 ;
DEL(MDCPIFN) ;
+1 ;
+2 ; Removes entry from CP_PATIENT_MOVEMENT file (704.005).
+3 ;
+4 ; Parameters -
+5 ; Covert (Preset local variables) -
+6 ; None
+7 ;
+8 ; Overt -
+9 ; MDCPIFN - IFN of entry in 704.005 to delete.
+10 ;
+11 ; Returns -
+12 ; None
+13 ;
+14 NEW MDCFDA
+15 SET MDCFDA(704.005,MDCPIFN_",",.01)="@"
+16 DO FILE^DIE("K","MDCFDA")
+17 QUIT
+18 ;
GENDESTS ;
+1 ; Filters outbound messages. See HL*1.6*56/66 Site Manager and Developer Manual
+2 ; p. 11-7 to 11-11 (inc).
+3 ;
+4 ; IA's -
+5 ; 1373 (provisional: subscription requested 3 Aug 2007)
+6 ;
+7 ; Parameters -
+8 ; Covert (Preset local variables) -
+9 ; HLNEXT - Executable code to retrieve the next line of an outbound HL7 message.
+10 ; HL("ECH") - Encoding characters for this HL7 message.
+11 ; HL("FS") - The Field Separator for this HL7 message.
+12 ; NAMEVAL - Local array passed from VDEF to HL7. Must not be newed or killed.
+13 ;
+14 ;
+15 ; Returns -
+16 ; None overt. HLL("LINKS",n) will be read by HLO upon return.
+17 ;
+18 NEW MDCPV1,MDHLFS,MDHLECH,MDDIV,MDDIVI,MDWARD,MDWARDI,MDBED,MDCPSUB,MDCPROT,I,IEN
+19 SET IEN=MDCIEN
+20 SET MDHLFS=HL("FS")
+21 SET MDHLECH=$EXTRACT(HL("ECH"),1,1)
+22 FOR
XECUTE HLNEXT
Begin DoDot:1
+23 if $PIECE($GET(HLNODE),MDHLFS)="PV1"
SET MDCPV1=HLNODE
End DoDot:1
if HLQUIT'>0
QUIT
+24 ; Division is PV1(3)(1), Room is PV1(3)(2), Bed is PV1(3)(3)
+25 SET MDDIV=$PIECE(MDCPV1,MDHLFS,4)
+26 SET MDWARD=$PIECE(MDDIV,MDHLECH,2)
+27 SET MDBED=$PIECE(MDDIV,MDHLECH,3)
+28 SET MDDIVI=$PIECE(^MDC(704.005,IEN,0),U,3)
+29 SET MDWARDI=$PIECE(^MDC(704.005,IEN,0),U,4)
+30 DO ARRYDEST(MDDIVI,MDWARDI,$GET(HL("MTN")),$GET(HL("ETN")))
+31 ;
+32 QUIT
+33 ;
GETSUBS ;
+1 ; Get subscriber protocols
+2 ;
+3 ; IA's -
+4 ; 1373 (provisional, see above)
+5 ;
+6 ; Parameters -
+7 ; None
+8 ;
+9 ; Returns -
+10 ; Overt - None
+11 ;
+12 NEW Y
SET Y=0
+13 FOR
SET Y=$ORDER(^ORD(101,Y))
if 'Y
QUIT
if $PIECE(^ORD(101,Y,0),U,4)="S"&($PIECE(^(0),U,1)?1"MD".E)
SET @MDROOT@(Y)=""
+14 QUIT
+15 ;
GENDEST2(IEN) ; Filters outbound messages. Unlike GENDESTS, this is set to filter
+1 ; assuming that we have not yet queued the outbound message.
+2 ;
+3 ;
+4 ; Parameters
+5 ; IEN: The IEN of the entry in the CLIO_HL7_LOG file that will be used to generate
+6 ; this message.
+7 ;
+8 ; Returns -
+9 ; None overt. HLL("LINKS",n) will be read by HLO upon return.
+10 ;
+11 NEW MDCPDIV,MDCPMSGT,MDCPEVNT
+12 NEW MDCPMSG
+13 DO GETS^DIQ(704.005,IEN_",","*","I","MDCPMSG")
+14 SET MDCPDIV=$GET(MDCPMSG("704.005",IEN_",",".03","I"))
+15 SET MDCPMSGT=$GET(MDCPMSG("704.005",IEN_",",".06","I"))
+16 SET MDCPEVNT=$GET(MDCPMSG("704.005",IEN_",",".07","I"))
+17 SET MDCPWARD=$GET(MDCPMSG("704.005",IEN_",",".04","I"))
+18 DO ARRYDEST(MDCPDIV,MDCPWARD,MDCPMSGT,MDCPEVNT)
+19 QUIT
+20 ;
ARRYDEST(DIVISION,WARD,MSGTYPE,EVNTTYPE) ;
+1 ;
+2 ; DIVISION: IEN of division in file 40.8.
+3 ; WARD: IEN of ward in file 42.
+4 ;
+5 NEW MDCPSUB,I,MDCPROT,MDCPWARD
+6 SET MDCPSUB=0
SET I=0
+7 FOR
SET MDCPSUB=$ORDER(^MDC(704.006,"LOCDEV",DIVISION,MDCPSUB))
if 'MDCPSUB
QUIT
Begin DoDot:1
+8 if MSGTYPE'=$PIECE(^MDC(704.006,MDCPSUB,0),U,4)
QUIT
+9 if EVNTTYPE'=$PIECE(^MDC(704.006,MDCPSUB,0),U,5)
QUIT
+10 SET MDCPWARD=$PIECE(^MDC(704.006,MDCPSUB,0),U,3)
+11 if (MDCPWARD'="")&(MDCPWARD'=WARD)
QUIT
+12 SET MDCPROT=$PIECE(^MDC(704.006,MDCPSUB,0),U)
+13 SET I=I+1
+14 SET HLL("LINKS",I)=$PIECE(^ORD(101,MDCPROT,0),U)_U_$$EXTERNAL^DILFD(101,770.7,"",$PIECE(^ORD(101,MDCPROT,770),U,7))
End DoDot:1
+15 QUIT
+16 ;
SENDMSG(DIVISION,WARD,MSGTYPE,EVNTTYPE) ;
+1 ;
+2 ; Determines whether or not we should continue to build or save this message. On a basis
+3 ; of division, ward, message type, and event type, will return 1 or 0 based on whether or
+4 ; not there is an entry in 704.006 to send the message to a specific device.
+5 ;
+6 ; Parameters
+7 ; DIVISION - Division (internal)
+8 ; WARD - Ward (internal)
+9 ; MSGTYPE - HL7 message type eg. "ADT"
+10 ; EVNTTYPE - HL7 event type eg. "A01"
+11 ;
+12 ; Returns
+13 ; 1 if message should be sent
+14 ; 0 if not
+15 ;
+16 NEW USE
+17 IF $GET(WARD)'=""
Begin DoDot:1
+18 SET USE=$ORDER(^MDC(704.006,"AMSGDIVWARD",MSGTYPE,EVNTTYPE,$GET(DIVISION),$GET(WARD),0))
End DoDot:1
+19 IF $GET(WARD)=""
Begin DoDot:1
+20 NEW WD
SET WD=0
SET USE=0
+21 FOR
SET WD=$ORDER(^MDC(704.006,"AMSGDIV",MSGTYPE,EVNTTYPE,$GET(DIVISION),WD))
if +WD=0
QUIT
Begin DoDot:2
+22 IF $PIECE(^MDC(704.006,WD,0),U,3)=""
SET USE=1
QUIT
End DoDot:2
End DoDot:1
+23 if +$GET(USE)
QUIT 1
+24 QUIT 0
+25 ;
LASTLOC(MDCPDFN,MDCPLOC) ;
+1 ;
+2 ; Retrieve inpatient's location via LAST known LOCation per CP - if neccessary ....
+3 ;
+4 ; Parameters
+5 ; MDCPDFN - Patient's IEN
+6 ; MDCPLOC - "WARD" or "BED" (seeking ward or bed data)
+7 ;
+8 ; Returns
+9 ; 1 if found location patient
+10 ; 0 if NOT found location of patient or NOT INPATIENT
+11 ;
+12 NEW LASTLOC
SET LASTLOC=""
A02 ;Look into transfers (A02)
+1 if '$DATA(^MDC(704.005,"LAST",MDCPDFN,"ADT","A02"))
GOTO A01
+2 NEW MDCDAT
SET MDCDAT=$ORDER(^MDC(704.005,"LAST",MDCPDFN,"ADT","A02",""),-1)
+3 SET LASTLOC=$ORDER(^MDC(704.005,"LAST",MDCPDFN,"ADT","A02",MDCDAT,LASTLOC))
+4 IF LASTLOC]""
Begin DoDot:1
+5 IF MDCPLOC="WARD"
SET MDWARD=$PIECE(^MDC(704.005,LASTLOC,0),U,4)
+6 IF MDCPLOC="BED"
SET MDBED=$PIECE(^MDC(704.005,LASTLOC,0),U,5)
End DoDot:1
QUIT
A01 ;Look into admissions (A01)
+1 ;
+2 if '$DATA(^MDC(704.005,"LAST",MDCPDFN,"ADT","A01"))
GOTO VADATA
+3 NEW MDCDAT
SET MDCDAT=$ORDER(^MDC(704.005,"LAST",MDCPDFN,"ADT","A01",""),-1)
+4 SET LASTLOC=$ORDER(^MDC(704.005,"LAST",MDCPDFN,"ADT","A01",MDCDAT,LASTLOC))
+5 IF LASTLOC]""
Begin DoDot:1
+6 IF MDCPLOC="WARD"
SET MDWARD=$PIECE(^MDC(704.005,LASTLOC,0),U,4)
+7 IF MDCPLOC="BED"
SET MDBED=$PIECE(^MDC(704.005,LASTLOC,0),U,5)
End DoDot:1
QUIT
VADATA ;Look into VADPT
+1 NEW DFN
SET DFN=MDCPDFN
+2 if MDTYPE=3
SET VAIP("D")=$PIECE(MDNODE,".")
+3 DO IN5^VADPT
+4 IF MDCPLOC="WARD"
SET MDWARD=$PIECE(VAIP(5),U)
+5 IF MDCPLOC="BED"
SET MDBED=$PIECE(VAIP(6),U)
+6 QUIT
