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

EDPFMON.m

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