EDPFMON ;SLC/MKB - ED Monitor at facility ; 3/16/23 1:46pm
;;2.0;EMERGENCY DEPARTMENT;**16,20**;May 2, 2012;Build 7
;External reference ^ORX8 supported by DBIA 871
;
EN(MSG) ; -- main entry point for EDP MONITOR where MSG contains HL7 msg
N EDMSG,PKG,MSH,PID,PV1,ORC,DFN,LOG
S EDMSG=$S($L($G(MSG)):MSG,1:"MSG"),MSH=0 ;MSG="NAME" or MSG(#)
F S MSH=$O(@EDMSG@(MSH)) Q:MSH'>0 Q:$E(@EDMSG@(MSH),1,3)="MSH"
Q:'MSH ;no message/header
S PKG=$$PKG($P(@EDMSG@(MSH),"|",3)) Q:'$L(PKG) ;unknown or not tracked
S DFN=$$PID Q:DFN<1 ;missing patient
S LOG=+$O(^EDP(230,"APA",DFN,0)) Q:LOG<1 ;not in ED now
S ORC=0 F S ORC=$O(@EDMSG@(+ORC)) Q:ORC'>0 I $E(@EDMSG@(ORC),1,3)="ORC" D
. N ORDCNTRL,ORIFN,STS,RTN
. S ORC=ORC_U_@EDMSG@(ORC),ORDCNTRL=$TR($P(ORC,"|",2),"@","P")
. Q:'$L(ORDCNTRL)
. S ORIFN=$P($P(ORC,"|",3),U),STS=$P(ORC,"|",6)
. S RTN=$S("NW^OK^XR"[ORDCNTRL:"NEW",1:"UPD")
. D @RTN
Q
;
ENOR(MSG) ; -- main entry point for EDP OR MONITOR where MSG contains HL7 msg
N EDMSG,PKG,MSH,PID,PV1,ORC,DFN,LOG
S EDMSG=$S($L($G(MSG)):MSG,1:"MSG"),MSH=0 ;MSG="NAME" or MSG(#)
F S MSH=$O(@EDMSG@(MSH)) Q:MSH'>0 Q:$E(@EDMSG@(MSH),1,3)="MSH"
Q:'MSH ;no message/header
S PKG=$$PKG($P(@EDMSG@(MSH),"|",5)) Q:'$L(PKG) ;unknown or not tracked
S DFN=$$PID Q:DFN<1 ;missing patient
S LOG=+$O(^EDP(230,"APA",DFN,0)) Q:LOG<1 ;not in ED now
S ORC=0 F S ORC=$O(@EDMSG@(+ORC)) Q:ORC'>0 I $E(@EDMSG@(ORC),1,3)="ORC" D
. N ORDCNTRL,ORIFN,ORDSTSDTL,ORDACTFLG,ORUPCHUK
. S ORC=ORC_U_@EDMSG@(ORC),ORDCNTRL=$TR($P(ORC,"|",2),"@","P")
. Q:ORDCNTRL'="NA" ;new backdoor ack
. S ORIFN=$P($P(ORC,"|",3),U)
. I $D(^EDP(230,LOG,8,"B",+ORIFN)) Q ;order already exists *16
. D EN^ORX8(+ORIFN)
. S ORDSTSDTL=$P(ORUPCHUK("ORSTS"),U,2)
. I ORDSTSDTL="ACTIVE" S ORDACTFLG=1
. D NEW
Q
;
PKG(NAME) ; -- Returns package code
I NAME="RADIOLOGY"!(NAME="IMAGING") Q "R"
I NAME="LABORATORY" Q "L"
I NAME="PHARMACY" Q "M"
I NAME="CONSULTS" Q "C"
I NAME="PROCEDURES" Q "C"
I NAME="DIETETICS" Q "A"
I NAME="ORDER ENTRY" Q "A"
Q ""
;
PID() ; -- Returns patient DFN from PID segment in current msg
N I,Y,SEG S I=MSH,Y=""
F S I=$O(@EDMSG@(I)) Q:I'>0 S SEG=$E(@EDMSG@(I),1,3) Q:SEG="ORC" I SEG="PID" S Y=+$P(@EDMSG@(I),"|",4) Q
Q Y
;
PV1() ; -- Returns patient location from PV1 segment in current msg
N I,Y,SEG S I=MSH,Y=""
F S I=$O(@EDMSG@(I)) Q:I'>0 S SEG=$E(@EDMSG@(I),1,3) Q:SEG="ORC" I SEG="PV1" S Y=+$P(@EDMSG@(I),"|",4) Q
Q Y
;
NEW ; -- add new order to patient log
Q:'$G(ORIFN) Q:$$START(ORIFN)>DT ;no future orders
N MSG,URG,ORL
S ORL=+$$GET1^DIQ(100,+ORIFN_",",6,"I")
I ORL,'$$ED(ORL) Q ;not ED location
S URG=$$VALUE^ORCSAVE2(+ORIFN,"URGENCY") S:'URG URG=9 ;routine
S MSG(1)="command=newOrder"
S MSG(2)="id="_LOG
S MSG(3)="orifn="_+ORIFN
S MSG(4)="pkg="_PKG
S MSG(5)=$S($G(ORDACTFLG)=1:"sts="_"A",1:"sts="_"N")
S MSG(6)="stat="_(URG<3) ;1=STAT or 2=ASAP
S MSG(7)="release="_$$NOW^XLFDT
D SEND(.MSG)
Q
;
ED(LOC) ; -- Return 1 or 0 if LOCation is part of ED
N EDLOC,I,Y
D GETLST^XPAR(.EDLOC,"ALL","EDPF LOCATION")
S (I,Y)=0 F S I=$O(EDLOC(I)) Q:I<1 I $P(EDLOC(I),U,2)=LOC S Y=1 Q
Q Y
;
START(IFN) ; -- return start date (day only) of order
N X,Y,%DT
S Y=+$$GET1^DIQ(100,+$G(IFN)_",",21,"I") I Y<1 D
. S X=$$VALUE^ORCSAVE2(+IFN,"START")
. I '$L(X) S Y=DT Q ;assume NOW
. S %DT="T" D ^%DT S:Y<1 Y=""
S Y=$P(Y,".")
Q Y
;
UPD ; -- update state of order in log
I ORDCNTRL="RE" D STS("C") Q
I "CA^DC^OC^OD^CR^DR"[ORDCNTRL D DEL Q ;??
I PKG="L",ORDCNTRL="SC" D STS("A") Q
I PKG="R",ORDCNTRL="SC" D STS("A") Q
I PKG="C","SC^XX"[ORDCNTRL D STS("A") Q
I PKG="M" D Q
. I "RO^XX^ZV"[ORDCNTRL D STS("A") Q
. Q:ORDCNTRL'="SC" Q:'$L(STS)
. I "DC^ZE^RP"[STS D STS("C") Q
. D STS("A")
I PKG="A","SC^XX"[ORDCNTRL D Q
. I "DC^ZE"[STS D STS("C") Q
. D STS("A")
Q
;
STS(X) ; -- update status
N MSG
S MSG(1)="command=updateOrder"
S MSG(2)="id="_LOG
S MSG(3)="orifn="_+ORIFN
S MSG(4)="sts="_X
D SEND(.MSG)
Q
;
DEL ; -- remove order
N MSG
S MSG(1)="command=deleteOrder"
S MSG(2)="id="_LOG
S MSG(3)="orifn="_+ORIFN
D SEND(.MSG)
Q
;
VER(ORIFN) ; -- update status when ORIFN verified
N LOG,MSG S ORIFN=+$G(ORIFN)
S LOG=+$O(^EDP(230,"AO",ORIFN,0)) Q:LOG<1 ;not in ED
S MSG(1)="command=verifyOrder"
S MSG(2)="id="_LOG
S MSG(3)="orifn="_ORIFN
D SEND(.MSG)
Q
;
COMP(ORIFN) ; -- update status when ORIFN completed
N LOG,MSG S ORIFN=+$G(ORIFN)
S LOG=+$O(^EDP(230,"AO",ORIFN,0)) Q:LOG<1 ;not in ED
S MSG(1)="command=completeOrder"
S MSG(2)="id="_LOG
S MSG(3)="orifn="_ORIFN
D SEND(.MSG)
Q
;
; -- Monitor SDAM APPOINTMENT EVENTS for patients checking-in to ED
;
SDAM ; -- send bulletin on check-in
N EDPEVENT
S EDPEVENT=$$GET^XPAR("ALL","EDPF SCHEDULING TRIGGER",1,"Q")
S:'EDPEVENT EDPEVENT=4
Q:$G(SDAMEVT)'=EDPEVENT
;
N EDPLST,X,FOUND
D GETLST^XPAR(.EDPLST,"ALL","EDPF LOCATION","I")
S X="",FOUND=0
F S X=$O(EDPLST(X)) Q:X="" I $P(SDATA,U,4)=EDPLST(X) S FOUND=1 Q
I $P(SDATA("AFTER","STATUS"),"^",4)="" Q ; Check-in deleted *20
Q:'FOUND
;
N DFN,DATE,HLOC
S DFN=+$P(SDATA,U,2),DATE=+$P(SDATA,U,3),HLOC=+$P(SDATA,U,4)
; your code goes here :)
N MSG
S MSG(1)="command=patientCheckIn"
S MSG(2)="dfn="_DFN
S MSG(3)="ptNm="_$P(^DPT(DFN,0),U)
S MSG(4)="ssn="_$P(^DPT(DFN,0),U,9)
S MSG(5)="hloc="_HLOC
S MSG(6)="site="_DUZ(2)
S MSG(7)="time="_DATE ; appt date to match PCE
D SEND(.MSG)
Q
;
SEND(MSG) ; Transfer control to message handler
D MSG^EDPMAIL(.MSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPFMON 5835 printed Apr 09, 2024@20:57:36 Page 2
EDPFMON ;SLC/MKB - ED Monitor at facility ; 3/16/23 1:46pm
+1 ;;2.0;EMERGENCY DEPARTMENT;**16,20**;May 2, 2012;Build 7
+2 ;External reference ^ORX8 supported by DBIA 871
+3 ;
EN(MSG) ; -- main entry point for EDP MONITOR where MSG contains HL7 msg
+1 NEW EDMSG,PKG,MSH,PID,PV1,ORC,DFN,LOG
+2 ;MSG="NAME" or MSG(#)
SET EDMSG=$SELECT($LENGTH($GET(MSG)):MSG,1:"MSG")
SET MSH=0
+3 FOR
SET MSH=$ORDER(@EDMSG@(MSH))
if MSH'>0
QUIT
if $EXTRACT(@EDMSG@(MSH),1,3)="MSH"
QUIT
+4 ;no message/header
if 'MSH
QUIT
+5 ;unknown or not tracked
SET PKG=$$PKG($PIECE(@EDMSG@(MSH),"|",3))
if '$LENGTH(PKG)
QUIT
+6 ;missing patient
SET DFN=$$PID
if DFN<1
QUIT
+7 ;not in ED now
SET LOG=+$ORDER(^EDP(230,"APA",DFN,0))
if LOG<1
QUIT
+8 SET ORC=0
FOR
SET ORC=$ORDER(@EDMSG@(+ORC))
if ORC'>0
QUIT
IF $EXTRACT(@EDMSG@(ORC),1,3)="ORC"
Begin DoDot:1
+9 NEW ORDCNTRL,ORIFN,STS,RTN
+10 SET ORC=ORC_U_@EDMSG@(ORC)
SET ORDCNTRL=$TRANSLATE($PIECE(ORC,"|",2),"@","P")
+11 if '$LENGTH(ORDCNTRL)
QUIT
+12 SET ORIFN=$PIECE($PIECE(ORC,"|",3),U)
SET STS=$PIECE(ORC,"|",6)
+13 SET RTN=$SELECT("NW^OK^XR"[ORDCNTRL:"NEW",1:"UPD")
+14 DO @RTN
End DoDot:1
+15 QUIT
+16 ;
ENOR(MSG) ; -- main entry point for EDP OR MONITOR where MSG contains HL7 msg
+1 NEW EDMSG,PKG,MSH,PID,PV1,ORC,DFN,LOG
+2 ;MSG="NAME" or MSG(#)
SET EDMSG=$SELECT($LENGTH($GET(MSG)):MSG,1:"MSG")
SET MSH=0
+3 FOR
SET MSH=$ORDER(@EDMSG@(MSH))
if MSH'>0
QUIT
if $EXTRACT(@EDMSG@(MSH),1,3)="MSH"
QUIT
+4 ;no message/header
if 'MSH
QUIT
+5 ;unknown or not tracked
SET PKG=$$PKG($PIECE(@EDMSG@(MSH),"|",5))
if '$LENGTH(PKG)
QUIT
+6 ;missing patient
SET DFN=$$PID
if DFN<1
QUIT
+7 ;not in ED now
SET LOG=+$ORDER(^EDP(230,"APA",DFN,0))
if LOG<1
QUIT
+8 SET ORC=0
FOR
SET ORC=$ORDER(@EDMSG@(+ORC))
if ORC'>0
QUIT
IF $EXTRACT(@EDMSG@(ORC),1,3)="ORC"
Begin DoDot:1
+9 NEW ORDCNTRL,ORIFN,ORDSTSDTL,ORDACTFLG,ORUPCHUK
+10 SET ORC=ORC_U_@EDMSG@(ORC)
SET ORDCNTRL=$TRANSLATE($PIECE(ORC,"|",2),"@","P")
+11 ;new backdoor ack
if ORDCNTRL'="NA"
QUIT
+12 SET ORIFN=$PIECE($PIECE(ORC,"|",3),U)
+13 ;order already exists *16
IF $DATA(^EDP(230,LOG,8,"B",+ORIFN))
QUIT
+14 DO EN^ORX8(+ORIFN)
+15 SET ORDSTSDTL=$PIECE(ORUPCHUK("ORSTS"),U,2)
+16 IF ORDSTSDTL="ACTIVE"
SET ORDACTFLG=1
+17 DO NEW
End DoDot:1
+18 QUIT
+19 ;
PKG(NAME) ; -- Returns package code
+1 IF NAME="RADIOLOGY"!(NAME="IMAGING")
QUIT "R"
+2 IF NAME="LABORATORY"
QUIT "L"
+3 IF NAME="PHARMACY"
QUIT "M"
+4 IF NAME="CONSULTS"
QUIT "C"
+5 IF NAME="PROCEDURES"
QUIT "C"
+6 IF NAME="DIETETICS"
QUIT "A"
+7 IF NAME="ORDER ENTRY"
QUIT "A"
+8 QUIT ""
+9 ;
PID() ; -- Returns patient DFN from PID segment in current msg
+1 NEW I,Y,SEG
SET I=MSH
SET Y=""
+2 FOR
SET I=$ORDER(@EDMSG@(I))
if I'>0
QUIT
SET SEG=$EXTRACT(@EDMSG@(I),1,3)
if SEG="ORC"
QUIT
IF SEG="PID"
SET Y=+$PIECE(@EDMSG@(I),"|",4)
QUIT
+3 QUIT Y
+4 ;
PV1() ; -- Returns patient location from PV1 segment in current msg
+1 NEW I,Y,SEG
SET I=MSH
SET Y=""
+2 FOR
SET I=$ORDER(@EDMSG@(I))
if I'>0
QUIT
SET SEG=$EXTRACT(@EDMSG@(I),1,3)
if SEG="ORC"
QUIT
IF SEG="PV1"
SET Y=+$PIECE(@EDMSG@(I),"|",4)
QUIT
+3 QUIT Y
+4 ;
NEW ; -- add new order to patient log
+1 ;no future orders
if '$GET(ORIFN)
QUIT
if $$START(ORIFN)>DT
QUIT
+2 NEW MSG,URG,ORL
+3 SET ORL=+$$GET1^DIQ(100,+ORIFN_",",6,"I")
+4 ;not ED location
IF ORL
IF '$$ED(ORL)
QUIT
+5 ;routine
SET URG=$$VALUE^ORCSAVE2(+ORIFN,"URGENCY")
if 'URG
SET URG=9
+6 SET MSG(1)="command=newOrder"
+7 SET MSG(2)="id="_LOG
+8 SET MSG(3)="orifn="_+ORIFN
+9 SET MSG(4)="pkg="_PKG
+10 SET MSG(5)=$SELECT($GET(ORDACTFLG)=1:"sts="_"A",1:"sts="_"N")
+11 ;1=STAT or 2=ASAP
SET MSG(6)="stat="_(URG<3)
+12 SET MSG(7)="release="_$$NOW^XLFDT
+13 DO SEND(.MSG)
+14 QUIT
+15 ;
ED(LOC) ; -- Return 1 or 0 if LOCation is part of ED
+1 NEW EDLOC,I,Y
+2 DO GETLST^XPAR(.EDLOC,"ALL","EDPF LOCATION")
+3 SET (I,Y)=0
FOR
SET I=$ORDER(EDLOC(I))
if I<1
QUIT
IF $PIECE(EDLOC(I),U,2)=LOC
SET Y=1
QUIT
+4 QUIT Y
+5 ;
START(IFN) ; -- return start date (day only) of order
+1 NEW X,Y,%DT
+2 SET Y=+$$GET1^DIQ(100,+$GET(IFN)_",",21,"I")
IF Y<1
Begin DoDot:1
+3 SET X=$$VALUE^ORCSAVE2(+IFN,"START")
+4 ;assume NOW
IF '$LENGTH(X)
SET Y=DT
QUIT
+5 SET %DT="T"
DO ^%DT
if Y<1
SET Y=""
End DoDot:1
+6 SET Y=$PIECE(Y,".")
+7 QUIT Y
+8 ;
UPD ; -- update state of order in log
+1 IF ORDCNTRL="RE"
DO STS("C")
QUIT
+2 ;??
IF "CA^DC^OC^OD^CR^DR"[ORDCNTRL
DO DEL
QUIT
+3 IF PKG="L"
IF ORDCNTRL="SC"
DO STS("A")
QUIT
+4 IF PKG="R"
IF ORDCNTRL="SC"
DO STS("A")
QUIT
+5 IF PKG="C"
IF "SC^XX"[ORDCNTRL
DO STS("A")
QUIT
+6 IF PKG="M"
Begin DoDot:1
+7 IF "RO^XX^ZV"[ORDCNTRL
DO STS("A")
QUIT
+8 if ORDCNTRL'="SC"
QUIT
if '$LENGTH(STS)
QUIT
+9 IF "DC^ZE^RP"[STS
DO STS("C")
QUIT
+10 DO STS("A")
End DoDot:1
QUIT
+11 IF PKG="A"
IF "SC^XX"[ORDCNTRL
Begin DoDot:1
+12 IF "DC^ZE"[STS
DO STS("C")
QUIT
+13 DO STS("A")
End DoDot:1
QUIT
+14 QUIT
+15 ;
STS(X) ; -- update status
+1 NEW MSG
+2 SET MSG(1)="command=updateOrder"
+3 SET MSG(2)="id="_LOG
+4 SET MSG(3)="orifn="_+ORIFN
+5 SET MSG(4)="sts="_X
+6 DO SEND(.MSG)
+7 QUIT
+8 ;
DEL ; -- remove order
+1 NEW MSG
+2 SET MSG(1)="command=deleteOrder"
+3 SET MSG(2)="id="_LOG
+4 SET MSG(3)="orifn="_+ORIFN
+5 DO SEND(.MSG)
+6 QUIT
+7 ;
VER(ORIFN) ; -- update status when ORIFN verified
+1 NEW LOG,MSG
SET ORIFN=+$GET(ORIFN)
+2 ;not in ED
SET LOG=+$ORDER(^EDP(230,"AO",ORIFN,0))
if LOG<1
QUIT
+3 SET MSG(1)="command=verifyOrder"
+4 SET MSG(2)="id="_LOG
+5 SET MSG(3)="orifn="_ORIFN
+6 DO SEND(.MSG)
+7 QUIT
+8 ;
COMP(ORIFN) ; -- update status when ORIFN completed
+1 NEW LOG,MSG
SET ORIFN=+$GET(ORIFN)
+2 ;not in ED
SET LOG=+$ORDER(^EDP(230,"AO",ORIFN,0))
if LOG<1
QUIT
+3 SET MSG(1)="command=completeOrder"
+4 SET MSG(2)="id="_LOG
+5 SET MSG(3)="orifn="_ORIFN
+6 DO SEND(.MSG)
+7 QUIT
+8 ;
+9 ; -- Monitor SDAM APPOINTMENT EVENTS for patients checking-in to ED
+10 ;
SDAM ; -- send bulletin on check-in
+1 NEW EDPEVENT
+2 SET EDPEVENT=$$GET^XPAR("ALL","EDPF SCHEDULING TRIGGER",1,"Q")
+3 if 'EDPEVENT
SET EDPEVENT=4
+4 if $GET(SDAMEVT)'=EDPEVENT
QUIT
+5 ;
+6 NEW EDPLST,X,FOUND
+7 DO GETLST^XPAR(.EDPLST,"ALL","EDPF LOCATION","I")
+8 SET X=""
SET FOUND=0
+9 FOR
SET X=$ORDER(EDPLST(X))
if X=""
QUIT
IF $PIECE(SDATA,U,4)=EDPLST(X)
SET FOUND=1
QUIT
+10 ; Check-in deleted *20
IF $PIECE(SDATA("AFTER","STATUS"),"^",4)=""
QUIT
+11 if 'FOUND
QUIT
+12 ;
+13 NEW DFN,DATE,HLOC
+14 SET DFN=+$PIECE(SDATA,U,2)
SET DATE=+$PIECE(SDATA,U,3)
SET HLOC=+$PIECE(SDATA,U,4)
+15 ; your code goes here :)
+16 NEW MSG
+17 SET MSG(1)="command=patientCheckIn"
+18 SET MSG(2)="dfn="_DFN
+19 SET MSG(3)="ptNm="_$PIECE(^DPT(DFN,0),U)
+20 SET MSG(4)="ssn="_$PIECE(^DPT(DFN,0),U,9)
+21 SET MSG(5)="hloc="_HLOC
+22 SET MSG(6)="site="_DUZ(2)
+23 ; appt date to match PCE
SET MSG(7)="time="_DATE
+24 DO SEND(.MSG)
+25 QUIT
+26 ;
SEND(MSG) ; Transfer control to message handler
+1 DO MSG^EDPMAIL(.MSG)
+2 QUIT
