EDPRPT3 ;SLC/MKB - Missed Opportunity Report ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
;
MO(BEG,END,CSV) ; Get Missed Opp Report for EDPSITE by date range
; CNT = counters
N IN,OUT,LOG,DISP,X,X0,X1,X3,X4,I,CNT,ROW
D INIT ;set counters to 0
D:'$G(CSV) XML^EDPX("<logEntries>") I $G(CSV) D ;headers
. N TAB S TAB=$C(9)
. S X="ED"_TAB_"Time In"_TAB_"Complaint"_TAB_"MD"_TAB_"Acuity"_TAB_"Elapsed"_TAB_"Triage"_TAB_"Wait"_TAB_"Dispo"_TAB_"Adm Dec"_TAB_"Adm Del"_TAB_"Delay"
. D ADD^EDPCSV(X)
S IN=BEG-.000001
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))
. ;TDP - Patch 2 change to capture Missed Opportunities
. ; without abbreviations
. ;S DISP=$$ECODE^EDPRPT($P(X1,U,2)) Q:'$$MISSEDOP(DISP)
. S DISP=$$ECODE^EDPRPT($P(X1,U,2))
. I DISP="" S DISP=$$DISP^EDPRPT($P(X1,U,2))
. I '$$MISSEDOP(DISP),'$$MISSOP1($P(X1,U,2)) Q
. S OUT=$P(X0,U,9) ;S:OUT="" OUT=NOW
. K ROW S ROW("id")=LOG
. S ROW("inTS")=$S($G(CSV):$$EDATE^EDPRPT(IN),1:IN)
. S ROW("complaint")=$P(X1,U)
. S ROW("acuity")=$$ECODE^EDPRPT($P(X3,U,3))
. S ROW("md")=$$EPERS^EDPRPT($P(X3,U,5))
. S ROW("disposition")=DISP
. S DISP=$$UP^XLFSTR(DISP),CNT(DISP)=CNT(DISP)+1
. ;
. ; calculate times
. S ROW("elapsed")=$S(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0)
. S X=$$ACUITY^EDPRPT(LOG) ;S:X<1 X=OUT
. S ROW("triage")=$S(X:($$FMDIFF^XLFDT(X,IN,2)\60),1:0)
. S X=$$LVWAITRM^EDPRPT(LOG) ;S:X<1 X=IN
. S ROW("wait")=$S(X:($$FMDIFF^XLFDT(X,IN,2)\60),1:0)
. S X=$$ADMIT^EDPRPT(LOG)
. S ROW("admDec")=$S(X:($$FMDIFF^XLFDT(X,IN,2)\60),1:0)
. S ROW("admDel")=$S(X&OUT:($$FMDIFF^XLFDT(OUT,X,2)\60),1:0)
. S ROW("delayReason")=$$ENAME^EDPRPT(+$P(X1,U,5))
. I '$G(CSV) S X=$$XMLA^EDPX("log",.ROW) D XML^EDPX(X) Q
. S X=ROW("id")
. F I="inTS","complaint","md","acuity","elapsed","triage","wait","disposition","admDec","admDel","delayReason" S X=X_$C(9)_$G(ROW(I))
. D ADD^EDPCSV(X)
D:'$G(CSV) XML^EDPX("</logEntries>")
;
; return totals, as XML or CSV
I '$G(CSV) S X=$$XMLA^EDPX("totals",.CNT) D XML^EDPX(X) Q
N TAB S TAB=$C(9)
S I="" F S I=$O(CNT(I)) Q:I="" D
. D BLANK^EDPCSV
. S X=TAB_TAB_TAB_TAB_"Total "_CNT(I,0)_": "_CNT(I)
. D ADD^EDPCSV(X)
Q
;
INIT ; -- initialize counters
N I,X,X2,DA,DISP,Y S CNT=0
S X="" F S X=$O(^EDPB(233.1,"AB","disposition",X)) Q:X="" S I=+$O(^(X,0)) D
. S X2=$P($G(^EDPB(233.1,I,0)),U,2)
. I $$MISSEDOP(X) S CNT(X)=0,CNT(X,0)=X2
;TDP - Patch 2, Added additional disposition inits to prevent undefined
; errors and capture dispositions without abbreviations
S Y=EDPSTA_".disposition"
S X=0 F S X=$O(^EDPB(233.2,"AS",Y,X)) Q:X="" D
. S DA=0 F S DA=$O(^EDPB(233.2,"AS",Y,X,DA)) Q:DA="" D
.. S DISP=$P($G(^EDPB(233.2,"AS",Y,X,DA)),U)
.. I $L(DISP),'$D(CNT(DISP)),(($$MISSEDOP(DISP))!($$MISSOP1(X))) D
... S DISP=$$UP^XLFSTR(DISP)
... S X2=$P($G(^EDPB(233.1,X,0)),U,2)
... S CNT(DISP)=0,CNT(DISP,0)=X2
.. ;I '$L(DISP) S DISP=$E("NONE/"_$P($G(^EDPB(233.2,"AS",Y,X,DA)),U,2),1,30) D
.. I '$L(DISP) S DISP=$E($TR($P($G(^EDPB(233.2,"AS",Y,X,DA)),U,2)," ","_"),1,30) D
... S DISP=$$UP^XLFSTR(DISP)
... I (($D(CNT(DISP)))!(('$$MISSEDOP(DISP))&('$$MISSOP1(X)))) Q
... S X2=$P($G(^EDPB(233.1,X,0)),U,2)
... S CNT(DISP)=0,CNT(DISP,0)=X2
Q
;
MISSEDOP(X) ; -- Return 1 or 0, if disposition indicates a missed opportunity
I $G(X)="" Q 0
N I,Y S X=$$UP^XLFSTR(X)
S I=+$O(^EDPB(233.1,"AB","disposition",X,0))
S Y=$S($P($G(^EDPB(233.1,I,0)),U,5)["M":1,1:0)
Q Y
MISSOP1(X) ; -- Return 1 or 0, if disposition indicates a missed opportunity
;TDP - Patch 2, additional check for missed opportunity not relying on
; an abbreviation existing.
; X = IEN in file 233.1
I +$G(X)=0 Q 0
N Y
S Y=$S($P($G(^EDPB(233.1,X,0)),U,5)["M":1,1:0)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPRPT3 3953 printed Dec 13, 2024@01:52:21 Page 2
EDPRPT3 ;SLC/MKB - Missed Opportunity Report ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
+2 ;
MO(BEG,END,CSV) ; Get Missed Opp Report for EDPSITE by date range
+1 ; CNT = counters
+2 NEW IN,OUT,LOG,DISP,X,X0,X1,X3,X4,I,CNT,ROW
+3 ;set counters to 0
DO INIT
+4 ;headers
if '$GET(CSV)
DO XML^EDPX("<logEntries>")
IF $GET(CSV)
Begin DoDot:1
+5 NEW TAB
SET TAB=$CHAR(9)
+6 SET X="ED"_TAB_"Time In"_TAB_"Complaint"_TAB_"MD"_TAB_"Acuity"_TAB_"Elapsed"_TAB_"Triage"_TAB_"Wait"_TAB_"Dispo"_TAB_"Adm Dec"_TAB_"Adm Del"_TAB_"Delay"
+7 DO ADD^EDPCSV(X)
End DoDot:1
+8 SET IN=BEG-.000001
+9 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
+10 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
SET X3=$GET(^(3))
SET X4=$GET(^(4,1,0))
+11 ;TDP - Patch 2 change to capture Missed Opportunities
+12 ; without abbreviations
+13 ;S DISP=$$ECODE^EDPRPT($P(X1,U,2)) Q:'$$MISSEDOP(DISP)
+14 SET DISP=$$ECODE^EDPRPT($PIECE(X1,U,2))
+15 IF DISP=""
SET DISP=$$DISP^EDPRPT($PIECE(X1,U,2))
+16 IF '$$MISSEDOP(DISP)
IF '$$MISSOP1($PIECE(X1,U,2))
QUIT
+17 ;S:OUT="" OUT=NOW
SET OUT=$PIECE(X0,U,9)
+18 KILL ROW
SET ROW("id")=LOG
+19 SET ROW("inTS")=$SELECT($GET(CSV):$$EDATE^EDPRPT(IN),1:IN)
+20 SET ROW("complaint")=$PIECE(X1,U)
+21 SET ROW("acuity")=$$ECODE^EDPRPT($PIECE(X3,U,3))
+22 SET ROW("md")=$$EPERS^EDPRPT($PIECE(X3,U,5))
+23 SET ROW("disposition")=DISP
+24 SET DISP=$$UP^XLFSTR(DISP)
SET CNT(DISP)=CNT(DISP)+1
+25 ;
+26 ; calculate times
+27 SET ROW("elapsed")=$SELECT(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0)
+28 ;S:X<1 X=OUT
SET X=$$ACUITY^EDPRPT(LOG)
+29 SET ROW("triage")=$SELECT(X:($$FMDIFF^XLFDT(X,IN,2)\60),1:0)
+30 ;S:X<1 X=IN
SET X=$$LVWAITRM^EDPRPT(LOG)
+31 SET ROW("wait")=$SELECT(X:($$FMDIFF^XLFDT(X,IN,2)\60),1:0)
+32 SET X=$$ADMIT^EDPRPT(LOG)
+33 SET ROW("admDec")=$SELECT(X:($$FMDIFF^XLFDT(X,IN,2)\60),1:0)
+34 SET ROW("admDel")=$SELECT(X&OUT:($$FMDIFF^XLFDT(OUT,X,2)\60),1:0)
+35 SET ROW("delayReason")=$$ENAME^EDPRPT(+$PIECE(X1,U,5))
+36 IF '$GET(CSV)
SET X=$$XMLA^EDPX("log",.ROW)
DO XML^EDPX(X)
QUIT
+37 SET X=ROW("id")
+38 FOR I="inTS","complaint","md","acuity","elapsed","triage","wait","disposition","admDec","admDel","delayReason"
SET X=X_$CHAR(9)_$GET(ROW(I))
+39 DO ADD^EDPCSV(X)
End DoDot:1
+40 if '$GET(CSV)
DO XML^EDPX("</logEntries>")
+41 ;
+42 ; return totals, as XML or CSV
+43 IF '$GET(CSV)
SET X=$$XMLA^EDPX("totals",.CNT)
DO XML^EDPX(X)
QUIT
+44 NEW TAB
SET TAB=$CHAR(9)
+45 SET I=""
FOR
SET I=$ORDER(CNT(I))
if I=""
QUIT
Begin DoDot:1
+46 DO BLANK^EDPCSV
+47 SET X=TAB_TAB_TAB_TAB_"Total "_CNT(I,0)_": "_CNT(I)
+48 DO ADD^EDPCSV(X)
End DoDot:1
+49 QUIT
+50 ;
INIT ; -- initialize counters
+1 NEW I,X,X2,DA,DISP,Y
SET CNT=0
+2 SET X=""
FOR
SET X=$ORDER(^EDPB(233.1,"AB","disposition",X))
if X=""
QUIT
SET I=+$ORDER(^(X,0))
Begin DoDot:1
+3 SET X2=$PIECE($GET(^EDPB(233.1,I,0)),U,2)
+4 IF $$MISSEDOP(X)
SET CNT(X)=0
SET CNT(X,0)=X2
End DoDot:1
+5 ;TDP - Patch 2, Added additional disposition inits to prevent undefined
+6 ; errors and capture dispositions without abbreviations
+7 SET Y=EDPSTA_".disposition"
+8 SET X=0
FOR
SET X=$ORDER(^EDPB(233.2,"AS",Y,X))
if X=""
QUIT
Begin DoDot:1
+9 SET DA=0
FOR
SET DA=$ORDER(^EDPB(233.2,"AS",Y,X,DA))
if DA=""
QUIT
Begin DoDot:2
+10 SET DISP=$PIECE($GET(^EDPB(233.2,"AS",Y,X,DA)),U)
+11 IF $LENGTH(DISP)
IF '$DATA(CNT(DISP))
IF (($$MISSEDOP(DISP))!($$MISSOP1(X)))
Begin DoDot:3
+12 SET DISP=$$UP^XLFSTR(DISP)
+13 SET X2=$PIECE($GET(^EDPB(233.1,X,0)),U,2)
+14 SET CNT(DISP)=0
SET CNT(DISP,0)=X2
End DoDot:3
+15 ;I '$L(DISP) S DISP=$E("NONE/"_$P($G(^EDPB(233.2,"AS",Y,X,DA)),U,2),1,30) D
+16 IF '$LENGTH(DISP)
SET DISP=$EXTRACT($TRANSLATE($PIECE($GET(^EDPB(233.2,"AS",Y,X,DA)),U,2)," ","_"),1,30)
Begin DoDot:3
+17 SET DISP=$$UP^XLFSTR(DISP)
+18 IF (($DATA(CNT(DISP)))!(('$$MISSEDOP(DISP))&('$$MISSOP1(X))))
QUIT
+19 SET X2=$PIECE($GET(^EDPB(233.1,X,0)),U,2)
+20 SET CNT(DISP)=0
SET CNT(DISP,0)=X2
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
MISSEDOP(X) ; -- Return 1 or 0, if disposition indicates a missed opportunity
+1 IF $GET(X)=""
QUIT 0
+2 NEW I,Y
SET X=$$UP^XLFSTR(X)
+3 SET I=+$ORDER(^EDPB(233.1,"AB","disposition",X,0))
+4 SET Y=$SELECT($PIECE($GET(^EDPB(233.1,I,0)),U,5)["M":1,1:0)
+5 QUIT Y
MISSOP1(X) ; -- Return 1 or 0, if disposition indicates a missed opportunity
+1 ;TDP - Patch 2, additional check for missed opportunity not relying on
+2 ; an abbreviation existing.
+3 ; X = IEN in file 233.1
+4 IF +$GET(X)=0
QUIT 0
+5 NEW Y
+6 SET Y=$SELECT($PIECE($GET(^EDPB(233.1,X,0)),U,5)["M":1,1:0)
+7 QUIT Y
