EDPRPT10 ;SLC/MKB - Admissions Report ;4/25/13 3:15pm
;;2.0;EMERGENCY DEPARTMENT;**6,2**;Feb 24, 2012;Build 23
;
ADM(BEG,END,CSV) ; Get Admissions Report for EDPSITE by date range
N IN,OUT,LOG,X,X0,X1,X3,DX,DISP,ROW,TAB
N ELAPSE,TRIAGE,WAIT,ADMDEC,ADMDEL
D INIT ;set counters, sums to 0
D:'$G(CSV) XML^EDPX("<logEntries>") I $G(CSV) D ;headers
. S TAB=$C(9)
. ;***pij 4/19/2013 changed ED to IEN
. ;S X="ED"_TAB_"Time Out"_TAB_"Complaint"_TAB_"MD"_TAB_"Acuity"_TAB_"Dispo"_TAB_"Adm Dec"_TAB_"Adm Delay"_TAB_"Diagnosis"_TAB_"ICD9" ;_TAB_"ER Spec Visit"
. ;Begin EDP*2.0*2 changes - drp
. S X="IEN"_TAB_"Time Out"_TAB_"Complaint"_TAB_"MD"_TAB_"Acuity"_TAB_"Dispo"_TAB_"Adm Dec"_TAB_"Adm Delay"_TAB_"Diagnosis"_TAB_"ICD"_TAB_"ICD Type" ;_TAB_"ER Spec Visit"
. ;end EDP*2.0*2 changes
. ;***
. 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))
. Q:'+$P(X1,U,2)
. S DISP=$$ECODE^EDPRPT($P(X1,U,2)),OUT=$P(X0,U,9)
. ;TDP - Patch 2 change to capture entries without abbreviations
. ;Q:DISP="" Q:'$D(CNT($$UP^XLFSTR(DISP))) ;visits w/admit disp
. ;S:DISP="" DISP="NONE"
. I DISP="" S DISP=$$DISP^EDPRPT($P(X1,U,2))
. ;Q:'$D(CNT($$UP^XLFSTR(DISP))) ;visits w/admit disp
. ;TDP - Patch 2, added VADMIT1 call for additional VA Admit check
. I '$D(CNT($$UP^XLFSTR(DISP))),'$$VADMIT1^EDPRPT2($P(X1,U,2)) Q ;visits w/admit disp
. S DX=$$DXPRI^EDPQPCE(+$P(X0,U,3),LOG)
. K ROW S ROW("id")=LOG
. S ROW("outTS")=$S($G(CSV):$$EDATE^EDPRPT(OUT),1:OUT)
. S ROW("complaint")=$P(X1,U)
. S ROW("md")=$$EPERS^EDPRPT($P(X3,U,5))
. S ROW("acuity")=$$ECODE^EDPRPT($P(X3,U,3))
. S ROW("disposition")=DISP,DISP=$$UP^XLFSTR(DISP)
. ;Begin EDP*2.0*2 changes - drp
. S ROW("icd")=$P(DX,U),ROW("dx")=$P(DX,U,2),ROW("icdType")=$P(DX,U,3)
. ; ER Special Visit ?? -- ck ^DPT dispositions
. S CNT("ALL")=CNT("ALL")+1,CNT(DISP)=CNT(DISP)+1
. ;
A1 . ; calculate times
. ; S:OUT="" OUT=NOW
. S ELAPSE=$S(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0)
. F I="ALL",DISP S MIN(I,"elapsed")=MIN(I,"elapsed")+ELAPSE
. ;
. S X=$$ACUITY^EDPRPT(LOG),TRIAGE=0 ;S:X<1 X=OUT
. S:X TRIAGE=($$FMDIFF^XLFDT(X,IN,2)\60)
. F I="ALL",DISP S MIN(I,"triage")=MIN(I,"triage")+TRIAGE
. ;
. S X=$$LVWAITRM^EDPRPT(LOG),WAIT=0 ;leave waiting room
. S:X WAIT=($$FMDIFF^XLFDT(X,IN,2)\60)
. F I="ALL",DISP S MIN(I,"wait")=MIN(I,"wait")+WAIT
. ;
. S X=$$ADMIT^EDPRPT(LOG) ;decision to admit
. S ADMDEC=$S(X:($$FMDIFF^XLFDT(X,IN,2)\60),1:0)
. F I="ALL",DISP S MIN(I,"admDec")=MIN(I,"admDec")+ADMDEC
. S ROW("admDec")=ADMDEC
. ;
. S ADMDEL=$S(X:($$FMDIFF^XLFDT(OUT,X,2)\60),1:0)
. F I="ALL",DISP S MIN(I,"admDel")=MIN(I,"admDel")+ADMDEL
. S ROW("admDel")=ADMDEL
. ;
. I '$G(CSV) S X=$$XMLA^EDPX("log",.ROW) D XML^EDPX(X) Q
. S X=ROW("id")
. F I="outTS","complaint","md","acuity","disposition","admDec","admDel","dx","icd","icdType" S X=X_$C(9)_$G(ROW(I))
. ;End EDP*2.0*2 changes - drp
. D ADD^EDPCSV(X)
D:'$G(CSV) XML^EDPX("</logEntries>")
;
A2 ; calculate & include averages
Q:CNT("ALL")<1 ;no visits found
I $G(CSV) D Q ;return as CSV
. ;***pij 4/19/2013 changed field to Elapsed from Visit
. ;S X=TAB_TAB_TAB_" Activity Summary"_TAB_"Total"_TAB_"Visit"_TAB_"Triage"_TAB_"Wait"_TAB_"Adm Dec"_TAB_"Adm Delay"
. S X=TAB_TAB_TAB_" Activity Summary"_TAB_"Total"_TAB_"Elapsed"_TAB_"Triage"_TAB_"Wait"_TAB_"Adm Dec"_TAB_"Adm Delay"
. ;***
. D BLANK^EDPCSV,ADD^EDPCSV(X),BLANK^EDPCSV
. S X=TAB_TAB_TAB_"Total Patients VA Admitted"_TAB_CNT("ALL")
. F I="elapsed","triage","wait","admDec","admDel" D
.. S Y=MIN("ALL",I)\CNT("ALL"),X=X_TAB_$S(Y:$$ETIME^EDPRPT(Y),1:"0:00")
. D ADD^EDPCSV(X),BLANK^EDPCSV
. S X=TAB_TAB_TAB_" Disposition" D ADD^EDPCSV(X)
. S DISP="" F S DISP=$O(CNT(DISP)) Q:DISP="" I DISP'="ALL",CNT(DISP) D
.. S X=TAB_TAB_TAB_DISP_TAB_CNT(DISP)
.. F I="elapsed","triage","wait","admDec","admDel" D
... S Y=MIN(DISP,I)\CNT(DISP),X=X_TAB_$S(Y:$$ETIME^EDPRPT(Y),1:"0:00")
.. D ADD^EDPCSV(X)
; or as XML
D XML^EDPX("<averages>")
S DISP="" F S DISP=$O(CNT(DISP)) Q:DISP="" I CNT(DISP) D
. S MIN(DISP,"type")=$S(DISP="ALL":"Total Patients VA Admitted",1:DISP)
. S MIN(DISP,"total")=CNT(DISP)
. F I="elapsed","triage","wait","admDec","admDel" D
.. S X=MIN(DISP,I)\CNT(DISP)
.. S MIN(DISP,I)=$S(X:$$ETIME^EDPRPT(X),1:"0:00")
. K ROW M ROW=MIN(DISP)
. S X=$$XMLA^EDPX("average",.ROW) D XML^EDPX(X)
D XML^EDPX("</averages>")
K CNT,MIN
Q
;
INIT ; Initialize counters and sums
N I,DISP,DA,X,Y
;F D="VA","T","ICU","OBS","ALL" D
S DISP="" F S DISP=$O(^EDPB(233.1,"AB","disposition",DISP)) Q:DISP="" D
. Q:'$$VADMIT^EDPRPT2(DISP)
. S CNT(DISP)=0
. F I="elapsed","triage","wait","admDec","admDel" S MIN(DISP,I)=0
;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) S DISP=$E($TR($P($G(^EDPB(233.2,"AS",Y,+X,DA)),U,2)," ","_"),1,30)
.. I $L(DISP),'$D(CNT(DISP)),(($$VADMIT^EDPRPT2(DISP))!($$VADMIT1^EDPRPT2(X))) D
... S DISP=$$UP^XLFSTR(DISP)
... S CNT(DISP)=0
... F I="elapsed","triage","wait","admDec","admDel" S MIN(DISP,I)=0
;S CNT("NONE")=0 F I="elapsed","triage","wait","admDec","admDel" S MIN("NONE",I)=0
S CNT("ALL")=0
F I="elapsed","triage","wait","admDec","admDel" S MIN("ALL",I)=0
Q
;
ECODE(IEN) ; Return external value for a Code
Q:IEN $P($G(^EDPB(233.1,IEN,0)),U,2) ;name
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPRPT10 5801 printed Apr 09, 2024@20:56:39 Page 2
EDPRPT10 ;SLC/MKB - Admissions Report ;4/25/13 3:15pm
+1 ;;2.0;EMERGENCY DEPARTMENT;**6,2**;Feb 24, 2012;Build 23
+2 ;
ADM(BEG,END,CSV) ; Get Admissions Report for EDPSITE by date range
+1 NEW IN,OUT,LOG,X,X0,X1,X3,DX,DISP,ROW,TAB
+2 NEW ELAPSE,TRIAGE,WAIT,ADMDEC,ADMDEL
+3 ;set counters, sums to 0
DO INIT
+4 ;headers
if '$GET(CSV)
DO XML^EDPX("<logEntries>")
IF $GET(CSV)
Begin DoDot:1
+5 SET TAB=$CHAR(9)
+6 ;***pij 4/19/2013 changed ED to IEN
+7 ;S X="ED"_TAB_"Time Out"_TAB_"Complaint"_TAB_"MD"_TAB_"Acuity"_TAB_"Dispo"_TAB_"Adm Dec"_TAB_"Adm Delay"_TAB_"Diagnosis"_TAB_"ICD9" ;_TAB_"ER Spec Visit"
+8 ;Begin EDP*2.0*2 changes - drp
+9 ;_TAB_"ER Spec Visit"
SET X="IEN"_TAB_"Time Out"_TAB_"Complaint"_TAB_"MD"_TAB_"Acuity"_TAB_"Dispo"_TAB_"Adm Dec"_TAB_"Adm Delay"_TAB_"Diagnosis"_TAB_"ICD"_TAB_"ICD Type"
+10 ;end EDP*2.0*2 changes
+11 ;***
+12 DO ADD^EDPCSV(X)
End DoDot:1
+13 SET IN=BEG-.000001
+14 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
+15 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
SET X3=$GET(^(3))
+16 if '+$PIECE(X1,U,2)
QUIT
+17 SET DISP=$$ECODE^EDPRPT($PIECE(X1,U,2))
SET OUT=$PIECE(X0,U,9)
+18 ;TDP - Patch 2 change to capture entries without abbreviations
+19 ;Q:DISP="" Q:'$D(CNT($$UP^XLFSTR(DISP))) ;visits w/admit disp
+20 ;S:DISP="" DISP="NONE"
+21 IF DISP=""
SET DISP=$$DISP^EDPRPT($PIECE(X1,U,2))
+22 ;Q:'$D(CNT($$UP^XLFSTR(DISP))) ;visits w/admit disp
+23 ;TDP - Patch 2, added VADMIT1 call for additional VA Admit check
+24 ;visits w/admit disp
IF '$DATA(CNT($$UP^XLFSTR(DISP)))
IF '$$VADMIT1^EDPRPT2($PIECE(X1,U,2))
QUIT
+25 SET DX=$$DXPRI^EDPQPCE(+$PIECE(X0,U,3),LOG)
+26 KILL ROW
SET ROW("id")=LOG
+27 SET ROW("outTS")=$SELECT($GET(CSV):$$EDATE^EDPRPT(OUT),1:OUT)
+28 SET ROW("complaint")=$PIECE(X1,U)
+29 SET ROW("md")=$$EPERS^EDPRPT($PIECE(X3,U,5))
+30 SET ROW("acuity")=$$ECODE^EDPRPT($PIECE(X3,U,3))
+31 SET ROW("disposition")=DISP
SET DISP=$$UP^XLFSTR(DISP)
+32 ;Begin EDP*2.0*2 changes - drp
+33 SET ROW("icd")=$PIECE(DX,U)
SET ROW("dx")=$PIECE(DX,U,2)
SET ROW("icdType")=$PIECE(DX,U,3)
+34 ; ER Special Visit ?? -- ck ^DPT dispositions
+35 SET CNT("ALL")=CNT("ALL")+1
SET CNT(DISP)=CNT(DISP)+1
+36 ;
A1 ; calculate times
+1 ; S:OUT="" OUT=NOW
+2 SET ELAPSE=$SELECT(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0)
+3 FOR I="ALL",DISP
SET MIN(I,"elapsed")=MIN(I,"elapsed")+ELAPSE
+4 ;
+5 ;S:X<1 X=OUT
SET X=$$ACUITY^EDPRPT(LOG)
SET TRIAGE=0
+6 if X
SET TRIAGE=($$FMDIFF^XLFDT(X,IN,2)\60)
+7 FOR I="ALL",DISP
SET MIN(I,"triage")=MIN(I,"triage")+TRIAGE
+8 ;
+9 ;leave waiting room
SET X=$$LVWAITRM^EDPRPT(LOG)
SET WAIT=0
+10 if X
SET WAIT=($$FMDIFF^XLFDT(X,IN,2)\60)
+11 FOR I="ALL",DISP
SET MIN(I,"wait")=MIN(I,"wait")+WAIT
+12 ;
+13 ;decision to admit
SET X=$$ADMIT^EDPRPT(LOG)
+14 SET ADMDEC=$SELECT(X:($$FMDIFF^XLFDT(X,IN,2)\60),1:0)
+15 FOR I="ALL",DISP
SET MIN(I,"admDec")=MIN(I,"admDec")+ADMDEC
+16 SET ROW("admDec")=ADMDEC
+17 ;
+18 SET ADMDEL=$SELECT(X:($$FMDIFF^XLFDT(OUT,X,2)\60),1:0)
+19 FOR I="ALL",DISP
SET MIN(I,"admDel")=MIN(I,"admDel")+ADMDEL
+20 SET ROW("admDel")=ADMDEL
+21 ;
+22 IF '$GET(CSV)
SET X=$$XMLA^EDPX("log",.ROW)
DO XML^EDPX(X)
QUIT
+23 SET X=ROW("id")
+24 FOR I="outTS","complaint","md","acuity","disposition","admDec","admDel","dx","icd","icdType"
SET X=X_$CHAR(9)_$GET(ROW(I))
+25 ;End EDP*2.0*2 changes - drp
+26 DO ADD^EDPCSV(X)
End DoDot:1
+27 if '$GET(CSV)
DO XML^EDPX("</logEntries>")
+28 ;
A2 ; calculate & include averages
+1 ;no visits found
if CNT("ALL")<1
QUIT
+2 ;return as CSV
IF $GET(CSV)
Begin DoDot:1
+3 ;***pij 4/19/2013 changed field to Elapsed from Visit
+4 ;S X=TAB_TAB_TAB_" Activity Summary"_TAB_"Total"_TAB_"Visit"_TAB_"Triage"_TAB_"Wait"_TAB_"Adm Dec"_TAB_"Adm Delay"
+5 SET X=TAB_TAB_TAB_" Activity Summary"_TAB_"Total"_TAB_"Elapsed"_TAB_"Triage"_TAB_"Wait"_TAB_"Adm Dec"_TAB_"Adm Delay"
+6 ;***
+7 DO BLANK^EDPCSV
DO ADD^EDPCSV(X)
DO BLANK^EDPCSV
+8 SET X=TAB_TAB_TAB_"Total Patients VA Admitted"_TAB_CNT("ALL")
+9 FOR I="elapsed","triage","wait","admDec","admDel"
Begin DoDot:2
+10 SET Y=MIN("ALL",I)\CNT("ALL")
SET X=X_TAB_$SELECT(Y:$$ETIME^EDPRPT(Y),1:"0:00")
End DoDot:2
+11 DO ADD^EDPCSV(X)
DO BLANK^EDPCSV
+12 SET X=TAB_TAB_TAB_" Disposition"
DO ADD^EDPCSV(X)
+13 SET DISP=""
FOR
SET DISP=$ORDER(CNT(DISP))
if DISP=""
QUIT
IF DISP'="ALL"
IF CNT(DISP)
Begin DoDot:2
+14 SET X=TAB_TAB_TAB_DISP_TAB_CNT(DISP)
+15 FOR I="elapsed","triage","wait","admDec","admDel"
Begin DoDot:3
+16 SET Y=MIN(DISP,I)\CNT(DISP)
SET X=X_TAB_$SELECT(Y:$$ETIME^EDPRPT(Y),1:"0:00")
End DoDot:3
+17 DO ADD^EDPCSV(X)
End DoDot:2
End DoDot:1
QUIT
+18 ; or as XML
+19 DO XML^EDPX("<averages>")
+20 SET DISP=""
FOR
SET DISP=$ORDER(CNT(DISP))
if DISP=""
QUIT
IF CNT(DISP)
Begin DoDot:1
+21 SET MIN(DISP,"type")=$SELECT(DISP="ALL":"Total Patients VA Admitted",1:DISP)
+22 SET MIN(DISP,"total")=CNT(DISP)
+23 FOR I="elapsed","triage","wait","admDec","admDel"
Begin DoDot:2
+24 SET X=MIN(DISP,I)\CNT(DISP)
+25 SET MIN(DISP,I)=$SELECT(X:$$ETIME^EDPRPT(X),1:"0:00")
End DoDot:2
+26 KILL ROW
MERGE ROW=MIN(DISP)
+27 SET X=$$XMLA^EDPX("average",.ROW)
DO XML^EDPX(X)
End DoDot:1
+28 DO XML^EDPX("</averages>")
+29 KILL CNT,MIN
+30 QUIT
+31 ;
INIT ; Initialize counters and sums
+1 NEW I,DISP,DA,X,Y
+2 ;F D="VA","T","ICU","OBS","ALL" D
+3 SET DISP=""
FOR
SET DISP=$ORDER(^EDPB(233.1,"AB","disposition",DISP))
if DISP=""
QUIT
Begin DoDot:1
+4 if '$$VADMIT^EDPRPT2(DISP)
QUIT
+5 SET CNT(DISP)=0
+6 FOR I="elapsed","triage","wait","admDec","admDel"
SET MIN(DISP,I)=0
End DoDot:1
+7 ;TDP - Patch 2, Added additional disposition inits to prevent undefined
+8 ; errors and capture dispositions without abbreviations
+9 SET Y=EDPSTA_".disposition"
+10 SET X=0
FOR
SET X=$ORDER(^EDPB(233.2,"AS",Y,X))
if X=""
QUIT
Begin DoDot:1
+11 SET DA=0
FOR
SET DA=$ORDER(^EDPB(233.2,"AS",Y,X,DA))
if DA=""
QUIT
Begin DoDot:2
+12 SET DISP=$PIECE($GET(^EDPB(233.2,"AS",Y,X,DA)),U)
+13 IF '$LENGTH(DISP)
SET DISP=$EXTRACT($TRANSLATE($PIECE($GET(^EDPB(233.2,"AS",Y,+X,DA)),U,2)," ","_"),1,30)
+14 IF $LENGTH(DISP)
IF '$DATA(CNT(DISP))
IF (($$VADMIT^EDPRPT2(DISP))!($$VADMIT1^EDPRPT2(X)))
Begin DoDot:3
+15 SET DISP=$$UP^XLFSTR(DISP)
+16 SET CNT(DISP)=0
+17 FOR I="elapsed","triage","wait","admDec","admDel"
SET MIN(DISP,I)=0
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;S CNT("NONE")=0 F I="elapsed","triage","wait","admDec","admDel" S MIN("NONE",I)=0
+19 SET CNT("ALL")=0
+20 FOR I="elapsed","triage","wait","admDec","admDel"
SET MIN("ALL",I)=0
+21 QUIT
+22 ;
ECODE(IEN) ; Return external value for a Code
+1 ;name
if IEN
QUIT $PIECE($GET(^EDPB(233.1,IEN,0)),U,2)
+2 QUIT ""
