EDPRPT6 ;SLC/MKB - Provider Report ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
PRV(BEG,END,CSV) ; Get Provider Report for EDPSITE by date range
N IN,LOG,X,X0,X1,X3,X4,MD,MDTIME,DISP,S,ACU
N CNT,IN2MD,MD2DS,ROW,SHIFT
S IN=BEG-.000001 D SETUP^EDPRPT5 ;build SHIFT(#)
I 'SHIFT D ERR^EDPRPT(2300013) Q
F S IN=$O(^EDP(230,"ATI",EDPSITE,IN)) Q:'IN Q:IN>END 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 MD=$P(X3,U,5) Q:MD<1 ;no provider
. S DISP=$P(X1,U,3),ACU=$$ACUITY($P(X3,U,3))
. S MDTIME=$$MD^EDPRPT(LOG)
. D:'$D(CNT(MD)) INIT(MD) ;set counters,sums to 0 per provider
D1 . ; all visits
. S S=$$SHIFT^EDPRPT5(MDTIME) Q:S<1
. S CNT(MD)=CNT(MD)+1,CNT(MD,S,ACU)=CNT(MD,S,ACU)+1
. S IN2MD=$$FMDIFF^XLFDT(MDTIME,IN,2)\60
. S IN2MD(MD)=IN2MD(MD)+IN2MD,IN2MD(MD,S,ACU)=IN2MD(MD,S,ACU)+IN2MD
. S MD2DS=$S(DISP:$$FMDIFF^XLFDT(DISP,MDTIME,2)\60,1:0)
. S MD2DS(MD)=MD2DS(MD)+MD2DS,MD2DS(MD,S,ACU)=MD2DS(MD,S,ACU)+MD2DS
D2 ; calculate & return averages as CSV
I $G(CSV) D Q
. N TAB,NM,SFT S TAB=$C(9)
. S X="MD Name"_TAB_"Shift"_TAB_"Acuity"_TAB_"# Patients"_TAB_"Time In to MD Assigned"_TAB_"MD Assign to Dispo"
. D ADD^EDPCSV(X)
. S MD=0 F S MD=$O(CNT(MD)) Q:MD<1 I CNT(MD) D
.. S NM=$$EPERS^EDPRPT(MD) F S=1:1:SHIFT D
... S SFT=S F ACU=0:1:5 I CNT(MD,S,ACU) D
.... S X=NM_TAB_SFT_TAB_ACU_TAB_CNT(MD,S,ACU)
.... S X=X_TAB_$$ETIME^EDPRPT(IN2MD(MD,S,ACU)\CNT(MD,S,ACU))
.... S X=X_TAB_$$ETIME^EDPRPT(MD2DS(MD,S,ACU)\CNT(MD,S,ACU))
.... D ADD^EDPCSV(X) S (NM,SFT)=""
.. S X=" MD TOTALS"_TAB_TAB_TAB_CNT(MD)
.. S X=X_TAB_$$ETIME^EDPRPT(IN2MD(MD)\CNT(MD))
.. S X=X_TAB_$$ETIME^EDPRPT(MD2DS(MD)\CNT(MD))
.. D ADD^EDPCSV(X)
D3 ; or as XML
D XML^EDPX("<providers>")
S MD=0 F S MD=$O(CNT(MD)) Q:MD<1 I CNT(MD) D
. K ROW S ROW("name")=$$EPERS^EDPRPT(MD),ROW("total")=CNT(MD)
. S ROW("timeMD")=$$ETIME^EDPRPT(IN2MD(MD)\CNT(MD))
. S ROW("timeDisp")=$$ETIME^EDPRPT(MD2DS(MD)\CNT(MD))
. S X=$$XMLA^EDPX("md",.ROW),X=$TR(X,"/") D XML^EDPX(X)
. D XML^EDPX("<shifts>")
. F S=1:1:SHIFT D
.. F ACU=0:1:5 I CNT(MD,S,ACU) D
... K ROW S ROW("total")=CNT(MD,S,ACU)
... S ROW("number")=S,ROW("acuity")=ACU
... S ROW("timeMD")=$$ETIME^EDPRPT(IN2MD(MD,S,ACU)\CNT(MD,S,ACU))
... S ROW("timeDisp")=$$ETIME^EDPRPT(MD2DS(MD,S,ACU)\CNT(MD,S,ACU))
... S X=$$XMLA^EDPX("shift",.ROW) D XML^EDPX(X)
. D XML^EDPX("</shifts>"),XML^EDPX("</md>")
D XML^EDPX("</providers>")
Q
;
INIT(DR) ; Initialize counters and sums
N S,A
S (CNT(DR),IN2MD(DR),MD2DS(DR))=0
F S=1:1:SHIFT D
. F A=0:1:5 S (CNT(DR,S,A),IN2MD(DR,S,A),MD2DS(DR,S,A))=0
Q
;
ACUITY(IEN) ; Return external value [0-5] for an Acuity code
N X0,Y S X0=$G(^EDPB(233.1,+IEN,0))
S Y=$P(X0,U,3) S:Y<1 Y=+$P(X0,U,4) ;code or nat'l code
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPRPT6 2888 printed Apr 09, 2024@20:57:48 Page 2
EDPRPT6 ;SLC/MKB - Provider Report ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
PRV(BEG,END,CSV) ; Get Provider Report for EDPSITE by date range
+1 NEW IN,LOG,X,X0,X1,X3,X4,MD,MDTIME,DISP,S,ACU
+2 NEW CNT,IN2MD,MD2DS,ROW,SHIFT
+3 ;build SHIFT(#)
SET IN=BEG-.000001
DO SETUP^EDPRPT5
+4 IF 'SHIFT
DO ERR^EDPRPT(2300013)
QUIT
+5 FOR
SET IN=$ORDER(^EDP(230,"ATI",EDPSITE,IN))
if 'IN
QUIT
if IN>END
QUIT
SET LOG=0
FOR
SET LOG=+$ORDER(^EDP(230,"ATI",EDPSITE,IN,LOG))
if LOG<1
QUIT
Begin DoDot:1
+6 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
SET X3=$GET(^(3))
SET X4=$GET(^(4,1,0))
+7 ;no provider
SET MD=$PIECE(X3,U,5)
if MD<1
QUIT
+8 SET DISP=$PIECE(X1,U,3)
SET ACU=$$ACUITY($PIECE(X3,U,3))
+9 SET MDTIME=$$MD^EDPRPT(LOG)
+10 ;set counters,sums to 0 per provider
if '$DATA(CNT(MD))
DO INIT(MD)
D1 ; all visits
+1 SET S=$$SHIFT^EDPRPT5(MDTIME)
if S<1
QUIT
+2 SET CNT(MD)=CNT(MD)+1
SET CNT(MD,S,ACU)=CNT(MD,S,ACU)+1
+3 SET IN2MD=$$FMDIFF^XLFDT(MDTIME,IN,2)\60
+4 SET IN2MD(MD)=IN2MD(MD)+IN2MD
SET IN2MD(MD,S,ACU)=IN2MD(MD,S,ACU)+IN2MD
+5 SET MD2DS=$SELECT(DISP:$$FMDIFF^XLFDT(DISP,MDTIME,2)\60,1:0)
+6 SET MD2DS(MD)=MD2DS(MD)+MD2DS
SET MD2DS(MD,S,ACU)=MD2DS(MD,S,ACU)+MD2DS
End DoDot:1
D2 ; calculate & return averages as CSV
+1 IF $GET(CSV)
Begin DoDot:1
+2 NEW TAB,NM,SFT
SET TAB=$CHAR(9)
+3 SET X="MD Name"_TAB_"Shift"_TAB_"Acuity"_TAB_"# Patients"_TAB_"Time In to MD Assigned"_TAB_"MD Assign to Dispo"
+4 DO ADD^EDPCSV(X)
+5 SET MD=0
FOR
SET MD=$ORDER(CNT(MD))
if MD<1
QUIT
IF CNT(MD)
Begin DoDot:2
+6 SET NM=$$EPERS^EDPRPT(MD)
FOR S=1:1:SHIFT
Begin DoDot:3
+7 SET SFT=S
FOR ACU=0:1:5
IF CNT(MD,S,ACU)
Begin DoDot:4
+8 SET X=NM_TAB_SFT_TAB_ACU_TAB_CNT(MD,S,ACU)
+9 SET X=X_TAB_$$ETIME^EDPRPT(IN2MD(MD,S,ACU)\CNT(MD,S,ACU))
+10 SET X=X_TAB_$$ETIME^EDPRPT(MD2DS(MD,S,ACU)\CNT(MD,S,ACU))
+11 DO ADD^EDPCSV(X)
SET (NM,SFT)=""
End DoDot:4
End DoDot:3
+12 SET X=" MD TOTALS"_TAB_TAB_TAB_CNT(MD)
+13 SET X=X_TAB_$$ETIME^EDPRPT(IN2MD(MD)\CNT(MD))
+14 SET X=X_TAB_$$ETIME^EDPRPT(MD2DS(MD)\CNT(MD))
+15 DO ADD^EDPCSV(X)
End DoDot:2
End DoDot:1
QUIT
D3 ; or as XML
+1 DO XML^EDPX("<providers>")
+2 SET MD=0
FOR
SET MD=$ORDER(CNT(MD))
if MD<1
QUIT
IF CNT(MD)
Begin DoDot:1
+3 KILL ROW
SET ROW("name")=$$EPERS^EDPRPT(MD)
SET ROW("total")=CNT(MD)
+4 SET ROW("timeMD")=$$ETIME^EDPRPT(IN2MD(MD)\CNT(MD))
+5 SET ROW("timeDisp")=$$ETIME^EDPRPT(MD2DS(MD)\CNT(MD))
+6 SET X=$$XMLA^EDPX("md",.ROW)
SET X=$TRANSLATE(X,"/")
DO XML^EDPX(X)
+7 DO XML^EDPX("<shifts>")
+8 FOR S=1:1:SHIFT
Begin DoDot:2
+9 FOR ACU=0:1:5
IF CNT(MD,S,ACU)
Begin DoDot:3
+10 KILL ROW
SET ROW("total")=CNT(MD,S,ACU)
+11 SET ROW("number")=S
SET ROW("acuity")=ACU
+12 SET ROW("timeMD")=$$ETIME^EDPRPT(IN2MD(MD,S,ACU)\CNT(MD,S,ACU))
+13 SET ROW("timeDisp")=$$ETIME^EDPRPT(MD2DS(MD,S,ACU)\CNT(MD,S,ACU))
+14 SET X=$$XMLA^EDPX("shift",.ROW)
DO XML^EDPX(X)
End DoDot:3
End DoDot:2
+15 DO XML^EDPX("</shifts>")
DO XML^EDPX("</md>")
End DoDot:1
+16 DO XML^EDPX("</providers>")
+17 QUIT
+18 ;
INIT(DR) ; Initialize counters and sums
+1 NEW S,A
+2 SET (CNT(DR),IN2MD(DR),MD2DS(DR))=0
+3 FOR S=1:1:SHIFT
Begin DoDot:1
+4 FOR A=0:1:5
SET (CNT(DR,S,A),IN2MD(DR,S,A),MD2DS(DR,S,A))=0
End DoDot:1
+5 QUIT
+6 ;
ACUITY(IEN) ; Return external value [0-5] for an Acuity code
+1 NEW X0,Y
SET X0=$GET(^EDPB(233.1,+IEN,0))
+2 ;code or nat'l code
SET Y=$PIECE(X0,U,3)
if Y<1
SET Y=+$PIECE(X0,U,4)
+3 QUIT Y
