EDPRPT5 ;SLC/MKB - Shift Report ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;**7**;May 2, 2012;Build 18
;
;DBIA SECTION
;10103 - $$NOW^XLFDT$$FMADD^XLFDT,$$FMDIFF^XLFDT,$$FMTH^XLFDT
;10104 - $$UP^XLFSTR
;
SFT(DAY,CSV) ; Get Shift Report for EDPSITE on DAY
N BEG,END,IN,OUT,LOG,X,X0,X1,X3,X4,S,SOUT,SHIFT
N CNT,VA,DX,OTH,HR6,TRG,OCB,MO,DIE,UNK,PREV,NEXT,SUB
N ELAPSE,ADMDEC,STS,DISP,COL
D INIT ;set counters to 0, SHIFT(#) = start time in seconds
I 'SHIFT D ERR^EDPRPT(2300013) Q
S BEG=$S(SHIFT(1)>0:$$FMADD^XLFDT(DAY,,,,SHIFT(1)),1:DAY)
S END=$S(SHIFT(1)>0:$$FMADD^XLFDT(DAY,+1,,,SHIFT(1)),1:DAY_".2359")
;S BEG=$S(SHIFT(1)>0:$$FMADD^XLFDT(DAY,-1,,,SHIFT(SHIFT)),1:DAY)
;S END=$S(SHIFT(1)>0:$$FMADD^XLFDT(DAY,,,,SHIFT(SHIFT)),1:DAY_".2359")
S IN=BEG-.000001 F S IN=$O(^EDP(230,"ATI",EDPSITE,IN)) Q:'IN Q:IN>END D
. S LOG=0 F S LOG=+$O(^EDP(230,"ATI",EDPSITE,IN,LOG)) Q:LOG<1 D
.. S X0=^EDP(230,LOG,0),X1=$G(^(1)),X3=$G(^(3)),X4=$G(^(4,1,0))
.. S STS=$$ECODE^EDPRPT($P(X3,U,2))
.. ;TDP - Patch 2 mod to catch all dispositions
.. S DISP=$$ECODE^EDPRPT($P(X1,U,2))
.. I DISP="" S DISP=$$DISP^EDPRPT($P(X1,U,2))
.. S DISP=$$UP^XLFSTR(DISP)
.. S OUT=$P(X0,U,9) ;S:OUT="" OUT=NOW
.. S ELAPSE=$S(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0) ;#min
.. S ADMDEC=$$ADMIT^EDPRPT(LOG)
D1 .. ; all visits
.. S S=$$SHIFT(IN,1),SOUT=$$SHIFT(OUT,1) Q:S']"" ; EPD*2*7 - correct "new adm" count
.. S CNT(S)=CNT(S)+1
.. S:'$P(X3,U,3) TRG(S)=TRG(S)+1
.. S:ELAPSE>359 HR6(S)=HR6(S)+1
.. S:DISP="O"!(DISP="NVA") OTH(S)=OTH(S)+1
.. S:DISP="D" DIE(S)=DIE(S)+1
.. ;TDP - Patch 2, additional checks for Missed Opportunities added
.. ;S:$$MISSEDOP^EDPRPT3(DISP) MO(S)=MO(S)+1
.. I (($$MISSEDOP^EDPRPT3(DISP))!($$MISSOP1^EDPRPT3($P(X1,U,2)))) S MO(S)=MO(S)+1
.. S:DISP="" UNK(S)=UNK(S)+1
.. I $L(STS),$$UP^XLFSTR(STS)'="GONE",S'=SOUT S OCB(S)=OCB(S)+1
D2 S OUT=BEG-.000001 F S OUT=$O(^EDP(230,"ATO",EDPSITE,OUT)) Q:'OUT Q:OUT>END D
. S LOG=0 F S LOG=+$O(^EDP(230,"ATO",EDPSITE,OUT,LOG)) Q:LOG<1 D
.. S X0=^EDP(230,LOG,0),X1=$G(^(1))
.. S SOUT=$$SHIFT(OUT,1),DX(SOUT)=DX(SOUT)+1
.. S IN=$P(X0,U,8) S:IN<BEG PREV=PREV+1
.. S DISP=$$ECODE^EDPRPT($P(X1,U,2))
.. S ADMDEC=$$ADMIT^EDPRPT(LOG)
.. ;TDP - Patch 2, addition checks for VA Admissions added
.. I ADMDEC,ADMDEC>BEG,(($$VADMIT^EDPRPT2(DISP))!($$VADMIT1^EDPRPT2($P(X1,U,2)))) S S=$$SHIFT(ADMDEC,1),VA(S)=VA(S)+1
D3 ; calculate #carried over
S PREV("one")=PREV
F I=1:1:SHIFT D
. S S=SUB(I)
. S NEXT(S)=PREV(S)+CNT(S)-DX(S)
. I I<SHIFT S PREV(SUB(I+1))=NEXT(S)
;S S=SUB(SHIFT),NEXT(S)=PREV+CNT(S)-DX(S)
;S PREV("one")=NEXT(S),PREV(S)=PREV
;F I=1:1:(SHIFT-1) S S=SUB(I),X=SUB($S(I>1:I-1,1:SHIFT)),NEXT(S)=NEXT(X)+CNT(S)-DX(S)
;F I=2:1:(SHIFT-1) S PREV(SUB(I))=NEXT(SUB(I-1))
;S NEXT("three")=PREV+CNT("three")-DX("three")
;S NEXT("one")=NEXT("three")+CNT("one")-DX("one")
;S NEXT("two")=NEXT("one")+CNT("two")-DX("two")
;S PREV("one")=NEXT("three"),PREV("two")=NEXT("one"),PREV("three")=PREV
D4 ; return column info
F I=1:1:SHIFT D ;convert #seconds to HH[:MM]
. N X,Y S X=SHIFT(I),Y=X\60
. ;S Y=X\3600 S:Y=0 Y=12 S:Y>12 Y=Y-12
. S SHIFT(I)=$$ETIME^EDPRPT(Y) ;Y_$S(X#3600:":"_(X#3600)\60,1:"")
F I=1:1:SHIFT D ;build column captions
. S COL(I,"name")=SHIFT(I)_" to "_SHIFT($S(I+1>SHIFT:1,1:I+1))
. S COL(I,"shiftId")=SUB(I)
;S COL(1,"name")="7 to 3",COL(1,"shiftId")="one"
;S COL(2,"name")="3 to 11",COL(2,"shiftId")="two"
;S COL(3,"name")="11 to 7",COL(3,"shiftId")="three"
I $G(CSV) D CSV Q
D XML^EDPX("<columns>")
F S=1:1:SHIFT K X M X=COL(S) S X=$$XMLA^EDPX("column",.X) D XML^EDPX(X)
D XML^EDPX("</columns>")
D5 ; return counts and averages as XML
D XML^EDPX("<categories>")
S X=$$XMLA^EDPX("category",.PREV) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.CNT) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.DX) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.VA) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.OTH) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.HR6) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.TRG) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.OCB) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.MO) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.DIE) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.UNK) D XML^EDPX(X)
S X=$$XMLA^EDPX("category",.NEXT) D XML^EDPX(X)
D XML^EDPX("</categories>")
Q
;
CSV ; Return headers, counts and averages as CSV
N X,TAB S TAB=$C(9)
S X="Category"
F I=1:1:(SHIFT) S X=X_TAB_COL(I,"name")
D ADD^EDPCSV(X) ;headers
D ROW("Carried over at Report Start",.PREV)
D ROW("Number of New Patients",.CNT)
D ROW("Number of Patients Discharged",.DX)
D ROW("Number Dec to Admit to VA",.VA)
D ROW("Number Dec to Admit to Other",.OTH)
D ROW("Number over Six Hours",.HR6)
D ROW("Number Waiting for Triage",.TRG)
D ROW("Number of Occupied Beds",.OCB)
D ROW("Number of Missed Opportunities",.MO)
D ROW("Number Deceased",.DIE)
D ROW("Number With No Disposition",.UNK)
D ROW("Carry over to Next Shift",.NEXT)
Q
;
ROW(NAME,LIST) ; add row
N S,I
S X=NAME
F I=1:1:(SHIFT) S S=SUB(I),X=X_TAB_LIST(S)
D ADD^EDPCSV(X)
Q
;
INIT ; Initialize counters and sums
N I,S
S PREV=0,DAY=$P(DAY,".")
D SETUP F I=1:1:SHIFT D
. S S=$$WORD(I),SUB(I)=S
. S CNT(S)=0,CNT("category")="Number of New Patients"
. S DX(S)=0,DX("category")="Number of Patients Discharged"
. S VA(S)=0,VA("category")="Number Dec to Admit to VA"
. S OTH(S)=0,OTH("category")="Number Dec to Admit to Other"
. S HR6(S)=0,HR6("category")="Number over Six Hours"
. S TRG(S)=0,TRG("category")="Number Waiting for Triage" ;no acuity
. S OCB(S)=0,OCB("category")="Number of Occupied Beds"
. S MO(S)=0,MO("category")="Number of Missed Opportunities"
. S DIE(S)=0,DIE("category")="Number Deceased"
. S UNK(S)=0,UNK("category")="Number With No Disposition"
. S PREV(S)=0,PREV("category")="Carried over at Report Start"
. S NEXT(S)=0,NEXT("category")="Carry over to Next Shift"
Q
;
WORD(X) ; Return name of number X
N Y
S Y=$S(X=1:"one",X=2:"two",X=3:"three",X=4:"four",X=5:"five",X=6:"six",X=7:"seven",X=8:"eight",X=9:"nine",X=10:"ten",X=11:"eleven",X=12:"twelve",1:"none")
I Y="none" S Y=$S(X=13:"thirteen",X=14:"fourteen",X=15:"fifteen",X=16:"sixteen",X=17:"seventeen",X=18:"eighteen",X=19:"nineteen",X=20:"twenty",X=21:"twenty_one",X=22:"twenty_two",X=23:"twenty_three",X=24:"twenty_four",1:"none")
Q Y
;
SETUP ; Create SHIFT(#) list of shift times
N DUR,OVR,STOP,STRT,TA,X1,X
S (STOP,OVR)=0
S TA=+$O(^EDPB(231.9,"C",EDPSITE,0)),X1=$G(^EDPB(231.9,TA,1))
S (STRT,X)=$P(X1,U,6),DUR=$P(X1,U,7)*60 I DUR'>0 S SHIFT=0 Q
S SHIFT=1,(STRT,SHIFT(1))=X*60 ;seconds
F S X=SHIFT(SHIFT)+DUR D Q:+STOP
. I +STRT=0,X>86340 S STOP=1 Q
. ;I +STRT>0,X>86400 S SHIFT=SHIFT+1,SHIFT(SHIFT)=X-(DUR+1) S STOP=1 Q
. I +STRT>0,X>86400 S STOP=1 D
.. S X=X-86400,OVR=1
. I +OVR,+X'<+STRT S STOP=1 Q
. S SHIFT=SHIFT+1,SHIFT(SHIFT)=X
Q
SHIFT(X,TXT) ; Return shift # for time X using SHIFT(#)
I $G(X)="" Q 0
N TM,Y
S Y=0
S TM=$P($$FMTH^XLFDT(X),",",2) ;#seconds since midnight
; bwf 2/15/2012: if there is only 1 shift, then this must be the shift given date range
I +SHIFT=1,TM>SHIFT(1) S Y=1 S:$G(TXT) Y=$$WORD(Y) Q Y
; bwf - end changes
I +SHIFT(1)=0 D
. I TM<SHIFT(1)!(TM'<SHIFT(SHIFT)) S Y=SHIFT
I +SHIFT(1)>0 D
. I +SHIFT(SHIFT)<+SHIFT(1),TM<SHIFT(1),TM>SHIFT(SHIFT) S Y=SHIFT
. I +SHIFT(SHIFT)>+SHIFT(1),((TM<SHIFT(1))!(TM>SHIFT(SHIFT))) S Y=SHIFT
I +Y=0 F I=2:1:SHIFT D Q:+Y>0
. I SHIFT(1)=0,TM<SHIFT(I) S Y=I-1 Q
. I SHIFT(1)>0 D
.. I SHIFT=I S Y=I-1 Q
.. I SHIFT(I)<SHIFT(I-1),TM>SHIFT(I-1) S Y=I-1 Q
.. I SHIFT(I)>SHIFT(I-1),TM<SHIFT(I),TM>SHIFT(I-1) S Y=I-1 Q
S:$G(TXT) Y=$$WORD(Y)
;S Y=$S(TM<25200:"three",TM<54000:"one",TM<82800:"two",1:"three")
Q Y
;
ECODE(IEN) ; Return external value for an Acuity code
N X,Y S X=$P($G(^EDPB(233.1,IEN,0)),U,3) ;code
S Y=$S(X="":"none",'X:X,X=1:"one",X=2:"two",X=3:"three",X=4:"four",X=5:"five",1:"X")
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPRPT5 8053 printed Dec 13, 2024@01:52:23 Page 2
EDPRPT5 ;SLC/MKB - Shift Report ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;**7**;May 2, 2012;Build 18
+2 ;
+3 ;DBIA SECTION
+4 ;10103 - $$NOW^XLFDT$$FMADD^XLFDT,$$FMDIFF^XLFDT,$$FMTH^XLFDT
+5 ;10104 - $$UP^XLFSTR
+6 ;
SFT(DAY,CSV) ; Get Shift Report for EDPSITE on DAY
+1 NEW BEG,END,IN,OUT,LOG,X,X0,X1,X3,X4,S,SOUT,SHIFT
+2 NEW CNT,VA,DX,OTH,HR6,TRG,OCB,MO,DIE,UNK,PREV,NEXT,SUB
+3 NEW ELAPSE,ADMDEC,STS,DISP,COL
+4 ;set counters to 0, SHIFT(#) = start time in seconds
DO INIT
+5 IF 'SHIFT
DO ERR^EDPRPT(2300013)
QUIT
+6 SET BEG=$SELECT(SHIFT(1)>0:$$FMADD^XLFDT(DAY,,,,SHIFT(1)),1:DAY)
+7 SET END=$SELECT(SHIFT(1)>0:$$FMADD^XLFDT(DAY,+1,,,SHIFT(1)),1:DAY_".2359")
+8 ;S BEG=$S(SHIFT(1)>0:$$FMADD^XLFDT(DAY,-1,,,SHIFT(SHIFT)),1:DAY)
+9 ;S END=$S(SHIFT(1)>0:$$FMADD^XLFDT(DAY,,,,SHIFT(SHIFT)),1:DAY_".2359")
+10 SET IN=BEG-.000001
FOR
SET IN=$ORDER(^EDP(230,"ATI",EDPSITE,IN))
if 'IN
QUIT
if IN>END
QUIT
Begin DoDot:1
+11 SET LOG=0
FOR
SET LOG=+$ORDER(^EDP(230,"ATI",EDPSITE,IN,LOG))
if LOG<1
QUIT
Begin DoDot:2
+12 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
SET X3=$GET(^(3))
SET X4=$GET(^(4,1,0))
+13 SET STS=$$ECODE^EDPRPT($PIECE(X3,U,2))
+14 ;TDP - Patch 2 mod to catch all dispositions
+15 SET DISP=$$ECODE^EDPRPT($PIECE(X1,U,2))
+16 IF DISP=""
SET DISP=$$DISP^EDPRPT($PIECE(X1,U,2))
+17 SET DISP=$$UP^XLFSTR(DISP)
+18 ;S:OUT="" OUT=NOW
SET OUT=$PIECE(X0,U,9)
+19 ;#min
SET ELAPSE=$SELECT(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0)
+20 SET ADMDEC=$$ADMIT^EDPRPT(LOG)
D1 ; all visits
+1 ; EPD*2*7 - correct "new adm" count
SET S=$$SHIFT(IN,1)
SET SOUT=$$SHIFT(OUT,1)
if S']""
QUIT
+2 SET CNT(S)=CNT(S)+1
+3 if '$PIECE(X3,U,3)
SET TRG(S)=TRG(S)+1
+4 if ELAPSE>359
SET HR6(S)=HR6(S)+1
+5 if DISP="O"!(DISP="NVA")
SET OTH(S)=OTH(S)+1
+6 if DISP="D"
SET DIE(S)=DIE(S)+1
+7 ;TDP - Patch 2, additional checks for Missed Opportunities added
+8 ;S:$$MISSEDOP^EDPRPT3(DISP) MO(S)=MO(S)+1
+9 IF (($$MISSEDOP^EDPRPT3(DISP))!($$MISSOP1^EDPRPT3($PIECE(X1,U,2))))
SET MO(S)=MO(S)+1
+10 if DISP=""
SET UNK(S)=UNK(S)+1
+11 IF $LENGTH(STS)
IF $$UP^XLFSTR(STS)'="GONE"
IF S'=SOUT
SET OCB(S)=OCB(S)+1
End DoDot:2
End DoDot:1
D2 SET OUT=BEG-.000001
FOR
SET OUT=$ORDER(^EDP(230,"ATO",EDPSITE,OUT))
if 'OUT
QUIT
if OUT>END
QUIT
Begin DoDot:1
+1 SET LOG=0
FOR
SET LOG=+$ORDER(^EDP(230,"ATO",EDPSITE,OUT,LOG))
if LOG<1
QUIT
Begin DoDot:2
+2 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
+3 SET SOUT=$$SHIFT(OUT,1)
SET DX(SOUT)=DX(SOUT)+1
+4 SET IN=$PIECE(X0,U,8)
if IN<BEG
SET PREV=PREV+1
+5 SET DISP=$$ECODE^EDPRPT($PIECE(X1,U,2))
+6 SET ADMDEC=$$ADMIT^EDPRPT(LOG)
+7 ;TDP - Patch 2, addition checks for VA Admissions added
+8 IF ADMDEC
IF ADMDEC>BEG
IF (($$VADMIT^EDPRPT2(DISP))!($$VADMIT1^EDPRPT2($PIECE(X1,U,2))))
SET S=$$SHIFT(ADMDEC,1)
SET VA(S)=VA(S)+1
End DoDot:2
End DoDot:1
D3 ; calculate #carried over
+1 SET PREV("one")=PREV
+2 FOR I=1:1:SHIFT
Begin DoDot:1
+3 SET S=SUB(I)
+4 SET NEXT(S)=PREV(S)+CNT(S)-DX(S)
+5 IF I<SHIFT
SET PREV(SUB(I+1))=NEXT(S)
End DoDot:1
+6 ;S S=SUB(SHIFT),NEXT(S)=PREV+CNT(S)-DX(S)
+7 ;S PREV("one")=NEXT(S),PREV(S)=PREV
+8 ;F I=1:1:(SHIFT-1) S S=SUB(I),X=SUB($S(I>1:I-1,1:SHIFT)),NEXT(S)=NEXT(X)+CNT(S)-DX(S)
+9 ;F I=2:1:(SHIFT-1) S PREV(SUB(I))=NEXT(SUB(I-1))
+10 ;S NEXT("three")=PREV+CNT("three")-DX("three")
+11 ;S NEXT("one")=NEXT("three")+CNT("one")-DX("one")
+12 ;S NEXT("two")=NEXT("one")+CNT("two")-DX("two")
+13 ;S PREV("one")=NEXT("three"),PREV("two")=NEXT("one"),PREV("three")=PREV
D4 ; return column info
+1 ;convert #seconds to HH[:MM]
FOR I=1:1:SHIFT
Begin DoDot:1
+2 NEW X,Y
SET X=SHIFT(I)
SET Y=X\60
+3 ;S Y=X\3600 S:Y=0 Y=12 S:Y>12 Y=Y-12
+4 ;Y_$S(X#3600:":"_(X#3600)\60,1:"")
SET SHIFT(I)=$$ETIME^EDPRPT(Y)
End DoDot:1
+5 ;build column captions
FOR I=1:1:SHIFT
Begin DoDot:1
+6 SET COL(I,"name")=SHIFT(I)_" to "_SHIFT($SELECT(I+1>SHIFT:1,1:I+1))
+7 SET COL(I,"shiftId")=SUB(I)
End DoDot:1
+8 ;S COL(1,"name")="7 to 3",COL(1,"shiftId")="one"
+9 ;S COL(2,"name")="3 to 11",COL(2,"shiftId")="two"
+10 ;S COL(3,"name")="11 to 7",COL(3,"shiftId")="three"
+11 IF $GET(CSV)
DO CSV
QUIT
+12 DO XML^EDPX("<columns>")
+13 FOR S=1:1:SHIFT
KILL X
MERGE X=COL(S)
SET X=$$XMLA^EDPX("column",.X)
DO XML^EDPX(X)
+14 DO XML^EDPX("</columns>")
D5 ; return counts and averages as XML
+1 DO XML^EDPX("<categories>")
+2 SET X=$$XMLA^EDPX("category",.PREV)
DO XML^EDPX(X)
+3 SET X=$$XMLA^EDPX("category",.CNT)
DO XML^EDPX(X)
+4 SET X=$$XMLA^EDPX("category",.DX)
DO XML^EDPX(X)
+5 SET X=$$XMLA^EDPX("category",.VA)
DO XML^EDPX(X)
+6 SET X=$$XMLA^EDPX("category",.OTH)
DO XML^EDPX(X)
+7 SET X=$$XMLA^EDPX("category",.HR6)
DO XML^EDPX(X)
+8 SET X=$$XMLA^EDPX("category",.TRG)
DO XML^EDPX(X)
+9 SET X=$$XMLA^EDPX("category",.OCB)
DO XML^EDPX(X)
+10 SET X=$$XMLA^EDPX("category",.MO)
DO XML^EDPX(X)
+11 SET X=$$XMLA^EDPX("category",.DIE)
DO XML^EDPX(X)
+12 SET X=$$XMLA^EDPX("category",.UNK)
DO XML^EDPX(X)
+13 SET X=$$XMLA^EDPX("category",.NEXT)
DO XML^EDPX(X)
+14 DO XML^EDPX("</categories>")
+15 QUIT
+16 ;
CSV ; Return headers, counts and averages as CSV
+1 NEW X,TAB
SET TAB=$CHAR(9)
+2 SET X="Category"
+3 FOR I=1:1:(SHIFT)
SET X=X_TAB_COL(I,"name")
+4 ;headers
DO ADD^EDPCSV(X)
+5 DO ROW("Carried over at Report Start",.PREV)
+6 DO ROW("Number of New Patients",.CNT)
+7 DO ROW("Number of Patients Discharged",.DX)
+8 DO ROW("Number Dec to Admit to VA",.VA)
+9 DO ROW("Number Dec to Admit to Other",.OTH)
+10 DO ROW("Number over Six Hours",.HR6)
+11 DO ROW("Number Waiting for Triage",.TRG)
+12 DO ROW("Number of Occupied Beds",.OCB)
+13 DO ROW("Number of Missed Opportunities",.MO)
+14 DO ROW("Number Deceased",.DIE)
+15 DO ROW("Number With No Disposition",.UNK)
+16 DO ROW("Carry over to Next Shift",.NEXT)
+17 QUIT
+18 ;
ROW(NAME,LIST) ; add row
+1 NEW S,I
+2 SET X=NAME
+3 FOR I=1:1:(SHIFT)
SET S=SUB(I)
SET X=X_TAB_LIST(S)
+4 DO ADD^EDPCSV(X)
+5 QUIT
+6 ;
INIT ; Initialize counters and sums
+1 NEW I,S
+2 SET PREV=0
SET DAY=$PIECE(DAY,".")
+3 DO SETUP
FOR I=1:1:SHIFT
Begin DoDot:1
+4 SET S=$$WORD(I)
SET SUB(I)=S
+5 SET CNT(S)=0
SET CNT("category")="Number of New Patients"
+6 SET DX(S)=0
SET DX("category")="Number of Patients Discharged"
+7 SET VA(S)=0
SET VA("category")="Number Dec to Admit to VA"
+8 SET OTH(S)=0
SET OTH("category")="Number Dec to Admit to Other"
+9 SET HR6(S)=0
SET HR6("category")="Number over Six Hours"
+10 ;no acuity
SET TRG(S)=0
SET TRG("category")="Number Waiting for Triage"
+11 SET OCB(S)=0
SET OCB("category")="Number of Occupied Beds"
+12 SET MO(S)=0
SET MO("category")="Number of Missed Opportunities"
+13 SET DIE(S)=0
SET DIE("category")="Number Deceased"
+14 SET UNK(S)=0
SET UNK("category")="Number With No Disposition"
+15 SET PREV(S)=0
SET PREV("category")="Carried over at Report Start"
+16 SET NEXT(S)=0
SET NEXT("category")="Carry over to Next Shift"
End DoDot:1
+17 QUIT
+18 ;
WORD(X) ; Return name of number X
+1 NEW Y
+2 SET Y=$SELECT(X=1:"one",X=2:"two",X=3:"three",X=4:"four",X=5:"five",X=6:"six",X=7:"seven",X=8:"eight",X=9:"nine",X=10:"ten",X=11:"eleven",X=12:"twelve",1:"none")
+3 IF Y="none"
SET Y=$SELECT(X=13:"thirteen",X=14:"fourteen",X=15:"fifteen",X=16:"sixteen",X=17:"seventeen",X=18:"eighteen",X=19:"nineteen",X=20:"twenty",X=21:"twenty_one",X=22:"twenty_two",X=23:"twenty_three",X=24:"twenty_four",1:"none")
+4 QUIT Y
+5 ;
SETUP ; Create SHIFT(#) list of shift times
+1 NEW DUR,OVR,STOP,STRT,TA,X1,X
+2 SET (STOP,OVR)=0
+3 SET TA=+$ORDER(^EDPB(231.9,"C",EDPSITE,0))
SET X1=$GET(^EDPB(231.9,TA,1))
+4 SET (STRT,X)=$PIECE(X1,U,6)
SET DUR=$PIECE(X1,U,7)*60
IF DUR'>0
SET SHIFT=0
QUIT
+5 ;seconds
SET SHIFT=1
SET (STRT,SHIFT(1))=X*60
+6 FOR
SET X=SHIFT(SHIFT)+DUR
Begin DoDot:1
+7 IF +STRT=0
IF X>86340
SET STOP=1
QUIT
+8 ;I +STRT>0,X>86400 S SHIFT=SHIFT+1,SHIFT(SHIFT)=X-(DUR+1) S STOP=1 Q
+9 IF +STRT>0
IF X>86400
SET STOP=1
Begin DoDot:2
+10 SET X=X-86400
SET OVR=1
End DoDot:2
+11 IF +OVR
IF +X'<+STRT
SET STOP=1
QUIT
+12 SET SHIFT=SHIFT+1
SET SHIFT(SHIFT)=X
End DoDot:1
if +STOP
QUIT
+13 QUIT
SHIFT(X,TXT) ; Return shift # for time X using SHIFT(#)
+1 IF $GET(X)=""
QUIT 0
+2 NEW TM,Y
+3 SET Y=0
+4 ;#seconds since midnight
SET TM=$PIECE($$FMTH^XLFDT(X),",",2)
+5 ; bwf 2/15/2012: if there is only 1 shift, then this must be the shift given date range
+6 IF +SHIFT=1
IF TM>SHIFT(1)
SET Y=1
if $GET(TXT)
SET Y=$$WORD(Y)
QUIT Y
+7 ; bwf - end changes
+8 IF +SHIFT(1)=0
Begin DoDot:1
+9 IF TM<SHIFT(1)!(TM'<SHIFT(SHIFT))
SET Y=SHIFT
End DoDot:1
+10 IF +SHIFT(1)>0
Begin DoDot:1
+11 IF +SHIFT(SHIFT)<+SHIFT(1)
IF TM<SHIFT(1)
IF TM>SHIFT(SHIFT)
SET Y=SHIFT
+12 IF +SHIFT(SHIFT)>+SHIFT(1)
IF ((TM<SHIFT(1))!(TM>SHIFT(SHIFT)))
SET Y=SHIFT
End DoDot:1
+13 IF +Y=0
FOR I=2:1:SHIFT
Begin DoDot:1
+14 IF SHIFT(1)=0
IF TM<SHIFT(I)
SET Y=I-1
QUIT
+15 IF SHIFT(1)>0
Begin DoDot:2
+16 IF SHIFT=I
SET Y=I-1
QUIT
+17 IF SHIFT(I)<SHIFT(I-1)
IF TM>SHIFT(I-1)
SET Y=I-1
QUIT
+18 IF SHIFT(I)>SHIFT(I-1)
IF TM<SHIFT(I)
IF TM>SHIFT(I-1)
SET Y=I-1
QUIT
End DoDot:2
End DoDot:1
if +Y>0
QUIT
+19 if $GET(TXT)
SET Y=$$WORD(Y)
+20 ;S Y=$S(TM<25200:"three",TM<54000:"one",TM<82800:"two",1:"three")
+21 QUIT Y
+22 ;
ECODE(IEN) ; Return external value for an Acuity code
+1 ;code
NEW X,Y
SET X=$PIECE($GET(^EDPB(233.1,IEN,0)),U,3)
+2 SET Y=$SELECT(X="":"none",'X:X,X=1:"one",X=2:"two",X=3:"three",X=4:"four",X=5:"five",1:"X")
+3 QUIT Y
