BEDDUTW1 ;GDIT/HS/BEE-BEDD Utility Routine 2 - Cache Calls ; 08 Nov 2011 12:00 PM
;;2.0;IHS EMERGENCY DEPT DASHBOARD;**1**;Apr 02, 2014
;
;This routine is included in the BEDD XML 2.0 install and is not in the KIDS
;GDIT/HS/BEE - This routine is included in the BEDD 2.0 Patch 3 XML
;
Q
;
;GDIT/HS/BEE 05/10/2018;CR#10213 Get DUZ(2) from browser session var
SDUZ(DUZ) ; EP - Set up DUZ array
;
NEW X,EXEC
;
;Make sure initial variables are set
S X="S:$G(U)="""" U=""^""" X X
S X="S:$G(DT)="""" DT=$$DT^XLFDT" X X
;
;Set up DUZ
S EXEC="S DUZ(2)=$G(%session.Data(""SITE""))" X EXEC
D DUZ^XUP(DUZ)
;
Q
;
CHKLK(BEDDID,DUZ,TIMEOUT) ; EP - Check and Possibly Unlock
;
; Input:
; BEDDID - Record ID
; DUZ - User DUZ
; TIMEOUT - The site timeout value
;
; Output:
; None
;
;Error Trap
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDUTW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
I $G(BEDDID)="" Q
I $G(DUZ)="" Q
;
;BEDD*2.0*1;CR#8726;Establish variable unlocking timeout
S TIMEOUT=+$G(TIMEOUT) S:TIMEOUT=0 TIMEOUT=300
;
NEW EDVST,LDT,TIM,SAVE,LUSITE
;
S EDVST=##CLASS(BEDD.EDVISIT).%OpenId(BEDDID)
;
;Check if already unlocked
I EDVST.RecLock=0 Q
;
;Unlock if same user
I DUZ=EDVST.RecLockUser D Q
. S EDVST.RecLock=0,EDVST.RecLockDT="",EDVST.RecLockUser="",EDVST.RecLockSite=""
. S SAVE=EDVST.%Save()
;
;Pull timeout of locked user's site, if available
S LUSITE=EDVST.RecLockSite
I +LUSITE D
. NEW SINFO,SIEN
. S SIEN=$O(^BEDD.EDSYSTEMI("SiteIdx"," "_+LUSITE,"")) Q:'SIEN
. S SINFO=##class(BEDD.EDSYSTEM).%OpenId(SIEN)
. S TIMEOUT=+SINFO.TimeOut S:TIMEOUT=0 TIMEOUT=300
;
;Unlock any record after 30 seconds after timeout value
S LDT=EDVST.RecLockDT
S TIM=$$SECWTG^BEDDUTIL($P(LDT,","),$P(LDT,",",2))
I TIM>(TIMEOUT+30) D Q
. S EDVST.RecLock=0,EDVST.RecLockDT="",EDVST.RecLockUser="",EDVST.RecLockSite=""
. S SAVE=EDVST.%Save()
Q
;
LKLST(BEDDLK,SITE,DUZ) ; EP - Assemble list of locked records dashboard
;
; Input:
; SITE - Site variable
; DUZ - User DUZ
;
; Output:
; BEDDLK array
;
;Error Trap
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDUTW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW BEDD,OBJ,TYP,TRM,BEDDSYS
;
S SITE=$G(SITE)
S DUZ=$G(DUZ)
;
;Get system variables
Do LOADSYS^BEDDUTW(.BEDDSYS,SITE,DUZ)
;
;Get dashboard entries
D BEDDLST^BEDDUTIL(.BEDD,SITE)
;
;Check-In/Awaiting Doc
F TYP=1,8 S OBJ="" F S OBJ=$O(BEDD(TYP,OBJ)) Q:OBJ="" D
. Do CHKLK^BEDDUTW(OBJ,DUZ,$G(BEDDSYS("TimeOut"))) ;Check Lock
. NEW EDVST
. S EDVST=##CLASS(BEDD.EDVISIT).%OpenId(OBJ)
. I EDVST.RecLock'=0 S BEDDLK(OBJ)=""
;
;Triage/Room
F TYP=2,3 S TRM="" F S TRM=$O(BEDD(TYP,TRM)) Q:TRM="" S OBJ="" F S OBJ=$O(BEDD(TYP,TRM,OBJ)) Q:OBJ="" D
. Do CHKLK^BEDDUTW(OBJ,DUZ,$G(BEDDSYS("TimeOut"))) ;Check Lock
. NEW EDVST
. S EDVST=##CLASS(BEDD.EDVISIT).%OpenId(OBJ)
. I EDVST.RecLock'=0 S BEDDLK(OBJ)=""
;
Q
;
CHKDATA(OBJID) ; EP - Save Primary Prov and Assigned Prov
;
; Input:
; OBJID
;
; Output:
; None
;
;Error Trap
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDUTW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW EDREF,VIEN,PPR,PPRN,ESTAT
S EDREF=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
S VIEN=EDREF.VIEN
S (PPR,PPRN)="" S PPR=$$PPR^BEDDUTIL(VIEN)
I PPR'="" S EDREF.PrimPrv=PPR
I EDREF.AsgPrv="" s EDREF.AsgPrv=PPR
S ESTAT=EDREF.%Save()
S EDREF=""
K EDREF
Q
;
UPPRV(OBJID,PPR) ; EP - Save Primary Prov
;
; INPUT:
; OBJID - OBJECT
; PPR - Primary Provider IEN
;
; OUTPUT:
; None
;
;Error Trap
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDUTW D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW EDOBJ,STAT
;
I $G(OBJID)="" Q
I $G(PPR)="" Q
;
S EDOBJ=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
I EDOBJ.PrimPrv="" S EDOBJ.PrimPrv=PPR S STAT=EDOBJ.%Save()
S EDOBJ=""
K EDOBJ,STAT
Q
;
BLDTRG(MYTRG) ;EP - Build Acuity MYTRG array
;
; Input:
; None
;
; Output:
; MYTRG array of ^AMER(3) TRIAGE CATEGORY entries
;
;Error Trap
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDUTIL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
NEW TIEN,TIEN1,AC
K MYTRG
S TIEN=$O(^AMER(2,"B","TRIAGE CATEGORY","")) Q:TIEN=""
S TIEN1="" F S TIEN1=$O(^AMER(3,"AC",TIEN,TIEN1)) Q:'TIEN1 D
. NEW ANM,CNM
. S AC=$$GET1^DIQ(9009083,TIEN1_",",5,"E") Q:AC=""
. S CNM=$$GET1^DIQ(9009083,TIEN1_",",.01,"E")
. S ANM=$S(AC=1:"RESUSCITATION",AC=2:"EMERGENT",AC=4:"LESS URGENT",AC=5:"ROUTINE",1:CNM)
. S MYTRG(AC)=TIEN1_"^"_CNM_"^"_AC_"^"_ANM
Q
BEDDUTW1 ;GDIT/HS/BEE-BEDD Utility Routine 2 - Cache Calls ; 08 Nov 2011 12:00 PM
+1 ;;2.0;IHS EMERGENCY DEPT DASHBOARD;**1**;Apr 02, 2014
+2 ;
+3 ;This routine is included in the BEDD XML 2.0 install and is not in the KIDS
+4 ;GDIT/HS/BEE - This routine is included in the BEDD 2.0 Patch 3 XML
+5 ;
+6 QUIT
+7 ;
+8 ;GDIT/HS/BEE 05/10/2018;CR#10213 Get DUZ(2) from browser session var
SDUZ(DUZ) ; EP - Set up DUZ array
+1 ;
+2 NEW X,EXEC
+3 ;
+4 ;Make sure initial variables are set
+5 SET X="S:$G(U)="""" U=""^"""
XECUTE X
+6 SET X="S:$G(DT)="""" DT=$$DT^XLFDT"
XECUTE X
+7 ;
+8 ;Set up DUZ
+9 SET EXEC="S DUZ(2)=$G(%session.Data(""SITE""))"
XECUTE EXEC
+10 DO DUZ^XUP(DUZ)
+11 ;
+12 QUIT
+13 ;
CHKLK(BEDDID,DUZ,TIMEOUT) ; EP - Check and Possibly Unlock
+1 ;
+2 ; Input:
+3 ; BEDDID - Record ID
+4 ; DUZ - User DUZ
+5 ; TIMEOUT - The site timeout value
+6 ;
+7 ; Output:
+8 ; None
+9 ;
+10 ;Error Trap
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BEDDUTW D UNWIND^%ZTER"
+12 ;
+13 IF $GET(BEDDID)=""
QUIT
+14 IF $GET(DUZ)=""
QUIT
+15 ;
+16 ;BEDD*2.0*1;CR#8726;Establish variable unlocking timeout
+17 SET TIMEOUT=+$GET(TIMEOUT)
IF TIMEOUT=0
SET TIMEOUT=300
+18 ;
+19 NEW EDVST,LDT,TIM,SAVE,LUSITE
+20 ;
+21 SET EDVST=##CLASS(BEDD.EDVISIT).%OpenId(BEDDID)
+22 ;
+23 ;Check if already unlocked
+24 IF EDVST.RecLock=0
QUIT
+25 ;
+26 ;Unlock if same user
+27 IF DUZ=EDVST.RecLockUser
Begin DoDot:1
+28 SET EDVST.RecLock=0
SET EDVST.RecLockDT=""
SET EDVST.RecLockUser=""
SET EDVST.RecLockSite=""
+29 SET SAVE=EDVST.%Save()
End DoDot:1
QUIT
+30 ;
+31 ;Pull timeout of locked user's site, if available
+32 SET LUSITE=EDVST.RecLockSite
+33 IF +LUSITE
Begin DoDot:1
+34 NEW SINFO,SIEN
+35 SET SIEN=$ORDER(^BEDD.EDSYSTEMI("SiteIdx"," "_+LUSITE,""))
IF 'SIEN
QUIT
+36 SET SINFO=##class(BEDD.EDSYSTEM).%OpenId(SIEN)
+37 SET TIMEOUT=+SINFO.TimeOut
IF TIMEOUT=0
SET TIMEOUT=300
End DoDot:1
+38 ;
+39 ;Unlock any record after 30 seconds after timeout value
+40 SET LDT=EDVST.RecLockDT
+41 SET TIM=$$SECWTG^BEDDUTIL($PIECE(LDT,","),$PIECE(LDT,",",2))
+42 IF TIM>(TIMEOUT+30)
Begin DoDot:1
+43 SET EDVST.RecLock=0
SET EDVST.RecLockDT=""
SET EDVST.RecLockUser=""
SET EDVST.RecLockSite=""
+44 SET SAVE=EDVST.%Save()
End DoDot:1
QUIT
+45 QUIT
+46 ;
LKLST(BEDDLK,SITE,DUZ) ; EP - Assemble list of locked records dashboard
+1 ;
+2 ; Input:
+3 ; SITE - Site variable
+4 ; DUZ - User DUZ
+5 ;
+6 ; Output:
+7 ; BEDDLK array
+8 ;
+9 ;Error Trap
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BEDDUTW D UNWIND^%ZTER"
+11 ;
+12 NEW BEDD,OBJ,TYP,TRM,BEDDSYS
+13 ;
+14 SET SITE=$GET(SITE)
+15 SET DUZ=$GET(DUZ)
+16 ;
+17 ;Get system variables
+18 DO LOADSYS^BEDDUTW(.BEDDSYS,SITE,DUZ)
+19 ;
+20 ;Get dashboard entries
+21 DO BEDDLST^BEDDUTIL(.BEDD,SITE)
+22 ;
+23 ;Check-In/Awaiting Doc
+24 FOR TYP=1,8
SET OBJ=""
FOR
SET OBJ=$ORDER(BEDD(TYP,OBJ))
IF OBJ=""
QUIT
Begin DoDot:1
+25 ;Check Lock
DO CHKLK^BEDDUTW(OBJ,DUZ,$GET(BEDDSYS("TimeOut")))
+26 NEW EDVST
+27 SET EDVST=##CLASS(BEDD.EDVISIT).%OpenId(OBJ)
+28 IF EDVST.RecLock'=0
SET BEDDLK(OBJ)=""
End DoDot:1
+29 ;
+30 ;Triage/Room
+31 FOR TYP=2,3
SET TRM=""
FOR
SET TRM=$ORDER(BEDD(TYP,TRM))
IF TRM=""
QUIT
SET OBJ=""
FOR
SET OBJ=$ORDER(BEDD(TYP,TRM,OBJ))
IF OBJ=""
QUIT
Begin DoDot:1
+32 ;Check Lock
DO CHKLK^BEDDUTW(OBJ,DUZ,$GET(BEDDSYS("TimeOut")))
+33 NEW EDVST
+34 SET EDVST=##CLASS(BEDD.EDVISIT).%OpenId(OBJ)
+35 IF EDVST.RecLock'=0
SET BEDDLK(OBJ)=""
End DoDot:1
+36 ;
+37 QUIT
+38 ;
CHKDATA(OBJID) ; EP - Save Primary Prov and Assigned Prov
+1 ;
+2 ; Input:
+3 ; OBJID
+4 ;
+5 ; Output:
+6 ; None
+7 ;
+8 ;Error Trap
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BEDDUTW D UNWIND^%ZTER"
+10 ;
+11 NEW EDREF,VIEN,PPR,PPRN,ESTAT
+12 SET EDREF=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
+13 SET VIEN=EDREF.VIEN
+14 SET (PPR,PPRN)=""
SET PPR=$$PPR^BEDDUTIL(VIEN)
+15 IF PPR'=""
SET EDREF.PrimPrv=PPR
+16 IF EDREF.AsgPrv=""
SET EDREF.AsgPrv=PPR
+17 SET ESTAT=EDREF.%Save()
+18 SET EDREF=""
+19 KILL EDREF
+20 QUIT
+21 ;
UPPRV(OBJID,PPR) ; EP - Save Primary Prov
+1 ;
+2 ; INPUT:
+3 ; OBJID - OBJECT
+4 ; PPR - Primary Provider IEN
+5 ;
+6 ; OUTPUT:
+7 ; None
+8 ;
+9 ;Error Trap
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BEDDUTW D UNWIND^%ZTER"
+11 ;
+12 NEW EDOBJ,STAT
+13 ;
+14 IF $GET(OBJID)=""
QUIT
+15 IF $GET(PPR)=""
QUIT
+16 ;
+17 SET EDOBJ=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)
+18 IF EDOBJ.PrimPrv=""
SET EDOBJ.PrimPrv=PPR
SET STAT=EDOBJ.%Save()
+19 SET EDOBJ=""
+20 KILL EDOBJ,STAT
+21 QUIT
+22 ;
BLDTRG(MYTRG) ;EP - Build Acuity MYTRG array
+1 ;
+2 ; Input:
+3 ; None
+4 ;
+5 ; Output:
+6 ; MYTRG array of ^AMER(3) TRIAGE CATEGORY entries
+7 ;
+8 ;Error Trap
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BEDDUTIL D UNWIND^%ZTER"
+10 ;
+11 NEW TIEN,TIEN1,AC
+12 KILL MYTRG
+13 SET TIEN=$ORDER(^AMER(2,"B","TRIAGE CATEGORY",""))
IF TIEN=""
QUIT
+14 SET TIEN1=""
FOR
SET TIEN1=$ORDER(^AMER(3,"AC",TIEN,TIEN1))
IF 'TIEN1
QUIT
Begin DoDot:1
+15 NEW ANM,CNM
+16 SET AC=$$GET1^DIQ(9009083,TIEN1_",",5,"E")
IF AC=""
QUIT
+17 SET CNM=$$GET1^DIQ(9009083,TIEN1_",",.01,"E")
+18 SET ANM=$SELECT(AC=1:"RESUSCITATION",AC=2:"EMERGENT",AC=4:"LESS URGENT",AC=5:"ROUTINE",1:CNM)
+19 SET MYTRG(AC)=TIEN1_"^"_CNM_"^"_AC_"^"_ANM
End DoDot:1
+20 QUIT
