EDPRPTBV ;SLC/MKB - BVAC Report ;4/25/13 03:15pm
;;2.0;EMERGENCY DEPARTMENT;**6,2**;Feb 24, 2012;Build 23
;
EN(BEG,END,CSV) ; Get Activity Report for EDPSITE by date range
N LOG,X,X0,X1,X3,DX,IN,OUT,ROW,ICD,I
N ELAPSE,TRIAGE,ADMDEC,ADMDEL,CNT,ADM,MIN,AVG
D INIT ;set counters, sums to 0
D:'$G(CSV) XML^EDPX("<logEntries>") I $G(CSV) D ;headers
. N TAB S TAB=$C(9)
. ;Begin EDP*2.0*2 changes
. S X="Patient"_TAB_"Time In"_TAB_"Time Out"_TAB_"Complaint"_TAB_"MD"_TAB_"Acuity"_TAB_"Elapsed"_TAB_"Triage"_TAB_"Dispo"_TAB_"Admit Dec"_TAB_"Admit Delay"_TAB_"Diagnosis"_TAB_"ICD"_TAB_"ICD Type"
. ;End EDP*2.0*2 Changes
. ;***pij 4/19/2013 removed Unemploy
. ;S X=X_TAB_"Viet Vet"_TAB_"Agent Orange"_TAB_"OEF/OIF"_TAB_"Pers Gulf"_TAB_"VA Pension"_TAB_"POW"_TAB_"Serv Conn %"_TAB_"Purp Hrt"_TAB_"Unemploy"_TAB_"Combat End"
. S X=X_TAB_"Viet Vet"_TAB_"Agent Orange"_TAB_"OEF/OIF"_TAB_"Pers Gulf"_TAB_"VA Pension"_TAB_"POW"_TAB_"Serv Conn %"_TAB_"Purp Hrt"_TAB_"Combat End"
. ;***
. 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))
. S DX=$$BVAC(+$P(X0,U,3),LOG) Q:DX="" ;no codes in range
. S CNT=CNT+1,OUT=$P(X0,U,9) ;S:OUT="" OUT=NOW
. S ELAPSE=$S(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0)
. S MIN("elapsed")=MIN("elapsed")+ELAPSE
. S X=$$ACUITY^EDPRPT(LOG),TRIAGE=0 ;S:X<1 X=OUT
. S:X TRIAGE=($$FMDIFF^XLFDT(X,IN,2)\60)
. S MIN("triage")=MIN("triage")+TRIAGE
. S (ADMDEC,ADMDEL)=""
. S X=$$ADMIT^EDPRPT(LOG) I X S ADM=ADM+1 D ;decision to admit
.. S ADMDEC=($$FMDIFF^XLFDT(X,IN,2)\60)
.. S ADMDEL=$S(OUT:($$FMDIFF^XLFDT(OUT,X,2)\60),1:0)
.. S MIN("admDec")=MIN("admDec")+ADMDEC
.. S MIN("admDel")=MIN("admDel")+ADMDEL
. ;
BV1 . ; add row to report
. ;S ICD=$P($G(^ICD9(+$P(X4,U,2),0)),U) Q:ICD<290 Q:ICD>316
. K ROW S ROW("patient")=$P(X0,U,4)
. S ROW("inTS")=$S($G(CSV):$$EDATE^EDPRPT(IN),1:IN)
. 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("elapsed")=ELAPSE_$S(ELAPSE>359:" *",1:"")
. S ROW("triage")=TRIAGE
. S ROW("disposition")=$$ECODE^EDPRPT($P(X1,U,2))
. S ROW("admDec")=ADMDEC,ROW("admDel")=ADMDEL
.; S ROW("icd")=$P(DX,U),ROW("dx")=$P(DX,U,2) replaced this line with one below
. S ROW("icd")=$P(DX,U),ROW("dx")=$P(DX,U,2),ROW("icdType")=$P(DX,"^",3)
. ; get other patient attributes from VADPT
. N DFN,VAEL,VASV,VAMB,VAERR
. S DFN=$P(X0,U,6) I DFN D 8^VADPT D
.. S ROW("vietnam")=$S(VASV(1):"Y",1:"N")
.. S ROW("agentOrange")=$S(VASV(2):"Y",1:"N")
.. S ROW("iraq")=$S(VASV(11)!VASV(12)!VASV(13):"Y",1:"N")
.. S ROW("persGulf")=$P($G(^DPT(DFN,.322)),U,10)
.. S ROW("vaPension")=$S(VAMB(4):"Y",1:"N")
.. S ROW("pow")=$S(VASV(4):"Y",1:"N")
.. S ROW("servConnPct")=+$P(VAEL(3),U,2)
.. S ROW("purpleHeart")=$S(VASV(9):"Y",1:"N")
.. ; ROW("unemployable")=$P($G(^DGEN(27.11,DFN,"E")),U,17) ;or VAPD(7)=3^NOT EMPLOYED ??
.. ;***pij 4/19/2013 VASV(10,1)=3011216^DEC 16,2001
.. S ROW("combatEndDT")=$P($G(VASV(10,1)),U)
.. I CSV,ROW("combatEndDT") S ROW("combatEndDT")=$$FMTE^XLFDT(ROW("combatEndDT"),"2D")
.. ;S ROW("combatEndDT")=$P($G(VASV(10,1)),U,2)
.. ;***
BV2 . ;
. I '$G(CSV) S X=$$XMLA^EDPX("log",.ROW) D XML^EDPX(X) Q
. S X=ROW("patient")
. F I="inTS","outTS","complaint","md","acuity","elapsed","triage","disposition","admDec","admDel","dx","icd","icdType" S X=X_$C(9)_$G(ROW(I))
. ;End EDP*2.0*2 Changes
. ;***pij 4/19/2013 deleted unemployable
. ;F I="vietnam","agentOrange","iraq","persGulf","vaPension","pow","servConn%","purpleHeart","unemployable","combatEndDT" S X=X_$C(9)_$G(ROW(I))
. F I="vietnam","agentOrange","iraq","persGulf","vaPension","pow","servConn%","purpleHeart","combatEndDT" S X=X_$C(9)_$G(ROW(I))
. ;***
. D ADD^EDPCSV(X)
D:'$G(CSV) XML^EDPX("</logEntries>")
;
BV3 ; calculate & include averages
Q:CNT<1 ;no visits found
S ELAPSE=$$ETIME^EDPRPT(MIN("elapsed")\CNT),AVG("elapsed")=ELAPSE
S TRIAGE=$$ETIME^EDPRPT(MIN("triage")\CNT),AVG("triage")=TRIAGE
S ADMDEC=$S(ADM:$$ETIME^EDPRPT(MIN("admDec")\ADM),1:"00:00")
S ADMDEL=$S(ADM:$$ETIME^EDPRPT(MIN("admDel")\ADM),1:"00:00")
S AVG("admDec")=ADMDEC,AVG("admDel")=ADMDEL,AVG("total")=CNT
;
I $G(CSV) D Q ;CSV format
. N TAB,D S TAB=$C(9)
. D BLANK^EDPCSV
. ;***pij 4/19/2013 added extra/needed TAB
. ;S X=TAB_"Total Patients"_TAB_CNT_TAB_"Averages Per Patient"_TAB_TAB_TAB_ELAPSE_TAB_TRIAGE_TAB_ADMDEC_TAB_ADMDEL
. S X=TAB_"Total Patients"_TAB_CNT_TAB_"Averages Per Patient"_TAB_TAB_TAB_ELAPSE_TAB_TRIAGE_TAB_TAB_ADMDEC_TAB_ADMDEL
. ;***
. D ADD^EDPCSV(X),BLANK^EDPCSV
D XML^EDPX("<averages>")
S X=$$XMLA^EDPX("average",.AVG) D XML^EDPX(X)
D XML^EDPX("</averages>")
Q
;
INIT ; Initialize counters and sums
N I,X S (CNT,ADM)=0
F I="elapsed","triage","admDec","admDel" S MIN(I)=0
Q
;
ECODE(IEN) ; Return external value for a Code
Q:IEN $P($G(^EDPB(233.1,IEN,0)),U,2) ;name
Q ""
;
BVAC(AREA,LOG) ; -- Return ICD^text of diagnosis in range, else null
N X,Y,I,EDPDX S Y=""
D DXALL^EDPQPCE(AREA,LOG,.EDPDX)
; drp Begin EDP*2.0*2 Changes
S I=0 F S I=$O(EDPDX(I)) Q:I<1 D
. S X=$G(EDPDX(I))
. I 290<=+X,+X<=316 S Y=X
. I $E(X,1)["F",10<=+($E(X,2,8)),+($E(X,2,8))<=99 S Y=X
.Q
; End EDP*2.0*2 Changes
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPRPTBV 5488 printed Nov 22, 2024@17:02:39 Page 2
EDPRPTBV ;SLC/MKB - BVAC Report ;4/25/13 03:15pm
+1 ;;2.0;EMERGENCY DEPARTMENT;**6,2**;Feb 24, 2012;Build 23
+2 ;
EN(BEG,END,CSV) ; Get Activity Report for EDPSITE by date range
+1 NEW LOG,X,X0,X1,X3,DX,IN,OUT,ROW,ICD,I
+2 NEW ELAPSE,TRIAGE,ADMDEC,ADMDEL,CNT,ADM,MIN,AVG
+3 ;set counters, sums 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 ;Begin EDP*2.0*2 changes
+7 SET X="Patient"_TAB_"Time In"_TAB_"Time Out"_TAB_"Complaint"_TAB_"MD"_TAB_"Acuity"_TAB_"Elapsed"_TAB_"Triage"_TAB_"Dispo"_TAB_"Admit Dec"_TAB_"Admit Delay"_TAB_"Diagnosis"_TAB_"ICD"_TAB_"ICD Type"
+8 ;End EDP*2.0*2 Changes
+9 ;***pij 4/19/2013 removed Unemploy
+10 ;S X=X_TAB_"Viet Vet"_TAB_"Agent Orange"_TAB_"OEF/OIF"_TAB_"Pers Gulf"_TAB_"VA Pension"_TAB_"POW"_TAB_"Serv Conn %"_TAB_"Purp Hrt"_TAB_"Unemploy"_TAB_"Combat End"
+11 SET X=X_TAB_"Viet Vet"_TAB_"Agent Orange"_TAB_"OEF/OIF"_TAB_"Pers Gulf"_TAB_"VA Pension"_TAB_"POW"_TAB_"Serv Conn %"_TAB_"Purp Hrt"_TAB_"Combat End"
+12 ;***
+13 DO ADD^EDPCSV(X)
End DoDot:1
+14 SET IN=BEG-.000001
+15 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
+16 SET X0=^EDP(230,LOG,0)
SET X1=$GET(^(1))
SET X3=$GET(^(3))
+17 ;no codes in range
SET DX=$$BVAC(+$PIECE(X0,U,3),LOG)
if DX=""
QUIT
+18 ;S:OUT="" OUT=NOW
SET CNT=CNT+1
SET OUT=$PIECE(X0,U,9)
+19 SET ELAPSE=$SELECT(OUT:($$FMDIFF^XLFDT(OUT,IN,2)\60),1:0)
+20 SET MIN("elapsed")=MIN("elapsed")+ELAPSE
+21 ;S:X<1 X=OUT
SET X=$$ACUITY^EDPRPT(LOG)
SET TRIAGE=0
+22 if X
SET TRIAGE=($$FMDIFF^XLFDT(X,IN,2)\60)
+23 SET MIN("triage")=MIN("triage")+TRIAGE
+24 SET (ADMDEC,ADMDEL)=""
+25 ;decision to admit
SET X=$$ADMIT^EDPRPT(LOG)
IF X
SET ADM=ADM+1
Begin DoDot:2
+26 SET ADMDEC=($$FMDIFF^XLFDT(X,IN,2)\60)
+27 SET ADMDEL=$SELECT(OUT:($$FMDIFF^XLFDT(OUT,X,2)\60),1:0)
+28 SET MIN("admDec")=MIN("admDec")+ADMDEC
+29 SET MIN("admDel")=MIN("admDel")+ADMDEL
End DoDot:2
+30 ;
BV1 ; add row to report
+1 ;S ICD=$P($G(^ICD9(+$P(X4,U,2),0)),U) Q:ICD<290 Q:ICD>316
+2 KILL ROW
SET ROW("patient")=$PIECE(X0,U,4)
+3 SET ROW("inTS")=$SELECT($GET(CSV):$$EDATE^EDPRPT(IN),1:IN)
+4 SET ROW("outTS")=$SELECT($GET(CSV):$$EDATE^EDPRPT(OUT),1:OUT)
+5 SET ROW("complaint")=$PIECE(X1,U)
+6 SET ROW("md")=$$EPERS^EDPRPT($PIECE(X3,U,5))
+7 SET ROW("acuity")=$$ECODE^EDPRPT($PIECE(X3,U,3))
+8 SET ROW("elapsed")=ELAPSE_$SELECT(ELAPSE>359:" *",1:"")
+9 SET ROW("triage")=TRIAGE
+10 SET ROW("disposition")=$$ECODE^EDPRPT($PIECE(X1,U,2))
+11 SET ROW("admDec")=ADMDEC
SET ROW("admDel")=ADMDEL
+12 ; S ROW("icd")=$P(DX,U),ROW("dx")=$P(DX,U,2) replaced this line with one below
+13 SET ROW("icd")=$PIECE(DX,U)
SET ROW("dx")=$PIECE(DX,U,2)
SET ROW("icdType")=$PIECE(DX,"^",3)
+14 ; get other patient attributes from VADPT
+15 NEW DFN,VAEL,VASV,VAMB,VAERR
+16 SET DFN=$PIECE(X0,U,6)
IF DFN
DO 8^VADPT
Begin DoDot:2
+17 SET ROW("vietnam")=$SELECT(VASV(1):"Y",1:"N")
+18 SET ROW("agentOrange")=$SELECT(VASV(2):"Y",1:"N")
+19 SET ROW("iraq")=$SELECT(VASV(11)!VASV(12)!VASV(13):"Y",1:"N")
+20 SET ROW("persGulf")=$PIECE($GET(^DPT(DFN,.322)),U,10)
+21 SET ROW("vaPension")=$SELECT(VAMB(4):"Y",1:"N")
+22 SET ROW("pow")=$SELECT(VASV(4):"Y",1:"N")
+23 SET ROW("servConnPct")=+$PIECE(VAEL(3),U,2)
+24 SET ROW("purpleHeart")=$SELECT(VASV(9):"Y",1:"N")
+25 ; ROW("unemployable")=$P($G(^DGEN(27.11,DFN,"E")),U,17) ;or VAPD(7)=3^NOT EMPLOYED ??
+26 ;***pij 4/19/2013 VASV(10,1)=3011216^DEC 16,2001
+27 SET ROW("combatEndDT")=$PIECE($GET(VASV(10,1)),U)
+28 IF CSV
IF ROW("combatEndDT")
SET ROW("combatEndDT")=$$FMTE^XLFDT(ROW("combatEndDT"),"2D")
+29 ;S ROW("combatEndDT")=$P($G(VASV(10,1)),U,2)
+30 ;***
End DoDot:2
BV2 ;
+1 IF '$GET(CSV)
SET X=$$XMLA^EDPX("log",.ROW)
DO XML^EDPX(X)
QUIT
+2 SET X=ROW("patient")
+3 FOR I="inTS","outTS","complaint","md","acuity","elapsed","triage","disposition","admDec","admDel","dx","icd","icdType"
SET X=X_$CHAR(9)_$GET(ROW(I))
+4 ;End EDP*2.0*2 Changes
+5 ;***pij 4/19/2013 deleted unemployable
+6 ;F I="vietnam","agentOrange","iraq","persGulf","vaPension","pow","servConn%","purpleHeart","unemployable","combatEndDT" S X=X_$C(9)_$G(ROW(I))
+7 FOR I="vietnam","agentOrange","iraq","persGulf","vaPension","pow","servConn%","purpleHeart","combatEndDT"
SET X=X_$CHAR(9)_$GET(ROW(I))
+8 ;***
+9 DO ADD^EDPCSV(X)
End DoDot:1
+10 if '$GET(CSV)
DO XML^EDPX("</logEntries>")
+11 ;
BV3 ; calculate & include averages
+1 ;no visits found
if CNT<1
QUIT
+2 SET ELAPSE=$$ETIME^EDPRPT(MIN("elapsed")\CNT)
SET AVG("elapsed")=ELAPSE
+3 SET TRIAGE=$$ETIME^EDPRPT(MIN("triage")\CNT)
SET AVG("triage")=TRIAGE
+4 SET ADMDEC=$SELECT(ADM:$$ETIME^EDPRPT(MIN("admDec")\ADM),1:"00:00")
+5 SET ADMDEL=$SELECT(ADM:$$ETIME^EDPRPT(MIN("admDel")\ADM),1:"00:00")
+6 SET AVG("admDec")=ADMDEC
SET AVG("admDel")=ADMDEL
SET AVG("total")=CNT
+7 ;
+8 ;CSV format
IF $GET(CSV)
Begin DoDot:1
+9 NEW TAB,D
SET TAB=$CHAR(9)
+10 DO BLANK^EDPCSV
+11 ;***pij 4/19/2013 added extra/needed TAB
+12 ;S X=TAB_"Total Patients"_TAB_CNT_TAB_"Averages Per Patient"_TAB_TAB_TAB_ELAPSE_TAB_TRIAGE_TAB_ADMDEC_TAB_ADMDEL
+13 SET X=TAB_"Total Patients"_TAB_CNT_TAB_"Averages Per Patient"_TAB_TAB_TAB_ELAPSE_TAB_TRIAGE_TAB_TAB_ADMDEC_TAB_ADMDEL
+14 ;***
+15 DO ADD^EDPCSV(X)
DO BLANK^EDPCSV
End DoDot:1
QUIT
+16 DO XML^EDPX("<averages>")
+17 SET X=$$XMLA^EDPX("average",.AVG)
DO XML^EDPX(X)
+18 DO XML^EDPX("</averages>")
+19 QUIT
+20 ;
INIT ; Initialize counters and sums
+1 NEW I,X
SET (CNT,ADM)=0
+2 FOR I="elapsed","triage","admDec","admDel"
SET MIN(I)=0
+3 QUIT
+4 ;
ECODE(IEN) ; Return external value for a Code
+1 ;name
if IEN
QUIT $PIECE($GET(^EDPB(233.1,IEN,0)),U,2)
+2 QUIT ""
+3 ;
BVAC(AREA,LOG) ; -- Return ICD^text of diagnosis in range, else null
+1 NEW X,Y,I,EDPDX
SET Y=""
+2 DO DXALL^EDPQPCE(AREA,LOG,.EDPDX)
+3 ; drp Begin EDP*2.0*2 Changes
+4 SET I=0
FOR
SET I=$ORDER(EDPDX(I))
if I<1
QUIT
Begin DoDot:1
+5 SET X=$GET(EDPDX(I))
+6 IF 290<=+X
IF +X<=316
SET Y=X
+7 IF $EXTRACT(X,1)["F"
IF 10<=+($EXTRACT(X,2,8))
IF +($EXTRACT(X,2,8))<=99
SET Y=X
+8 QUIT
End DoDot:1
+9 ; End EDP*2.0*2 Changes
+10 QUIT Y
