Routine: EDPRPT10

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

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

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  Feb 18, 2025@23:18:42                                                                                                                                                                                                    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 ""

EDPRPT10.m