EDPRPT12 ;SLC/MKB - Orders by Acuity Report ;4/25/13 3:15pm
;;2.0;EMERGENCY DEPARTMENT;**6**;May 2, 2012;Build 200
;
ORD(BEG,END,CSV) ; Get Acuity Report for EDPSITE by date range
; CNT = counters by acuity
N IN,OUT,X,X0,I,SERV,ACU,CNT,ROW,EDLOC
D INIT ;set counters, sums to 0
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 X=$P($G(^EDP(230,LOG,3)),U,3),ACU=$$ECODE(X)
. I '$D(^EDP(230,LOG,8)) D FIND(LOG,ACU) Q ;old/converted visit
. S I=0 F S I=$O(^EDP(230,LOG,8,I)) Q:I<1 S X0=$G(^(I,0)) D
.. S SERV=$$ENAME($P(X0,U,2))
.. S CNT(ACU,SERV)=CNT(ACU,SERV)+1
;
OR1 ; return counts
I $G(CSV) D Q ;as CSV
. N TAB S TAB=$C(9)
. ;S X="Acuity"_TAB_"Labs"_TAB_"Images"_TAB_"Consults"_TAB_"Meds"_TAB_"Other"
. ;***pij 4/19/2013 changed acuity
. S X="Acuity/Display Group_>"_TAB_"Labs"_TAB_"Images"_TAB_"Consults"_TAB_"Meds"_TAB_"Other"
. ;***
. D ADD^EDPCSV(X)
. F ACU=0,1,2,3,4,5 D
.. K ROW S ROW("acuity")=ACU M ROW=CNT(ACU)
.. D ROW(ACU,.ROW)
; or as XML
D XML^EDPX("<statistics>")
F ACU=0,1,2,3,4,5 D
. K ROW S ROW("acuity")=ACU M ROW=CNT(ACU)
. S X=$$XMLA^EDPX("row",.ROW) D XML^EDPX(X)
D XML^EDPX("</statistics>")
Q
;
ROW(NAME,LIST) ; add line
N I S X=NAME
F I="labs","images","consults","meds","other" S X=X_TAB_LIST(I)
D ADD^EDPCSV(X)
Q
;
INIT ; Initialize acuity/service counters
N A,S
F A=0,1,2,3,4,5 D
. F S="meds","labs","images","consults","other" S CNT(A,S)=0
Q
;
ECODE(IEN) ; Return external value for an Acuity code
N X0,X,Y S X0=$G(^EDPB(233.1,+IEN,0))
S X=$P(X0,U,3) S:X<1 X=$P(X0,U,4) ;code or nat'l code
;S Y=$S(X=1:"one",X=2:"two",X=3:"three",X=4:"four",X=5:"five",1:"none")
S Y=+X I (Y<1)!(Y>5) S Y=0
Q Y
;
ENAME(X) ; Return external name for a Service code
I X="L"!($E(X,1,2)="LR") Q "labs"
I X="R"!($E(X,1,2)="RA") Q "images"
I X="C"!(X="GMRC") Q "consults"
I X="M"!($E(X,1,2)="PS") Q "meds"
I X="A" Q "other"
Q "other"
;
FIND(LOG,ACU) ; find/count orders placed during visit LOG
; (for converted data)
N ORLIST,X0,DFN,IN,OUT,ORI,ORIFN,ORL,PKG,SERV
S X0=$G(^EDP(230,LOG,0)),DFN=+$P(X0,U,6) Q:DFN<1
S IN=$P(X0,U,8),OUT=$P(X0,U,9)
D:'$D(EDLOC) GETLST^XPAR(.EDLOC,"ALL","EDPF LOCATION")
K ^TMP("ORR",$J) D EN^ORQ1(DFN_";DPT(",,1,,IN,OUT) S ORI=0
F S ORI=$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 S ORIFN=+$G(^(ORI)) D
. S ORL=$$GET1^DIQ(100,ORIFN_",",6,"I") Q:'$$ED(+ORL)
. S PKG=$$GET1^DIQ(100,ORIFN_",","12:1")
. S SERV=$$ENAME(PKG)
. S CNT(ACU,SERV)=CNT(ACU,SERV)+1
Q
;
ED(LOC) ; -- Return 1 or 0, if LOCation is part of ED
; Expects EDLOC(n) = seq ^ #44 ien
N I,Y S (I,Y)=0
F S I=$O(EDLOC(I)) Q:I<1 I $P(EDLOC(I),U,2)=LOC S Y=1 Q
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPRPT12 2828 printed Apr 09, 2024@20:57:30 Page 2
EDPRPT12 ;SLC/MKB - Orders by Acuity Report ;4/25/13 3:15pm
+1 ;;2.0;EMERGENCY DEPARTMENT;**6**;May 2, 2012;Build 200
+2 ;
ORD(BEG,END,CSV) ; Get Acuity Report for EDPSITE by date range
+1 ; CNT = counters by acuity
+2 NEW IN,OUT,X,X0,I,SERV,ACU,CNT,ROW,EDLOC
+3 ;set counters, sums to 0
DO INIT
+4 SET IN=BEG-.000001
+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 X=$PIECE($GET(^EDP(230,LOG,3)),U,3)
SET ACU=$$ECODE(X)
+7 ;old/converted visit
IF '$DATA(^EDP(230,LOG,8))
DO FIND(LOG,ACU)
QUIT
+8 SET I=0
FOR
SET I=$ORDER(^EDP(230,LOG,8,I))
if I<1
QUIT
SET X0=$GET(^(I,0))
Begin DoDot:2
+9 SET SERV=$$ENAME($PIECE(X0,U,2))
+10 SET CNT(ACU,SERV)=CNT(ACU,SERV)+1
End DoDot:2
End DoDot:1
+11 ;
OR1 ; return counts
+1 ;as CSV
IF $GET(CSV)
Begin DoDot:1
+2 NEW TAB
SET TAB=$CHAR(9)
+3 ;S X="Acuity"_TAB_"Labs"_TAB_"Images"_TAB_"Consults"_TAB_"Meds"_TAB_"Other"
+4 ;***pij 4/19/2013 changed acuity
+5 SET X="Acuity/Display Group_>"_TAB_"Labs"_TAB_"Images"_TAB_"Consults"_TAB_"Meds"_TAB_"Other"
+6 ;***
+7 DO ADD^EDPCSV(X)
+8 FOR ACU=0,1,2,3,4,5
Begin DoDot:2
+9 KILL ROW
SET ROW("acuity")=ACU
MERGE ROW=CNT(ACU)
+10 DO ROW(ACU,.ROW)
End DoDot:2
End DoDot:1
QUIT
+11 ; or as XML
+12 DO XML^EDPX("<statistics>")
+13 FOR ACU=0,1,2,3,4,5
Begin DoDot:1
+14 KILL ROW
SET ROW("acuity")=ACU
MERGE ROW=CNT(ACU)
+15 SET X=$$XMLA^EDPX("row",.ROW)
DO XML^EDPX(X)
End DoDot:1
+16 DO XML^EDPX("</statistics>")
+17 QUIT
+18 ;
ROW(NAME,LIST) ; add line
+1 NEW I
SET X=NAME
+2 FOR I="labs","images","consults","meds","other"
SET X=X_TAB_LIST(I)
+3 DO ADD^EDPCSV(X)
+4 QUIT
+5 ;
INIT ; Initialize acuity/service counters
+1 NEW A,S
+2 FOR A=0,1,2,3,4,5
Begin DoDot:1
+3 FOR S="meds","labs","images","consults","other"
SET CNT(A,S)=0
End DoDot:1
+4 QUIT
+5 ;
ECODE(IEN) ; Return external value for an Acuity code
+1 NEW X0,X,Y
SET X0=$GET(^EDPB(233.1,+IEN,0))
+2 ;code or nat'l code
SET X=$PIECE(X0,U,3)
if X<1
SET X=$PIECE(X0,U,4)
+3 ;S Y=$S(X=1:"one",X=2:"two",X=3:"three",X=4:"four",X=5:"five",1:"none")
+4 SET Y=+X
IF (Y<1)!(Y>5)
SET Y=0
+5 QUIT Y
+6 ;
ENAME(X) ; Return external name for a Service code
+1 IF X="L"!($EXTRACT(X,1,2)="LR")
QUIT "labs"
+2 IF X="R"!($EXTRACT(X,1,2)="RA")
QUIT "images"
+3 IF X="C"!(X="GMRC")
QUIT "consults"
+4 IF X="M"!($EXTRACT(X,1,2)="PS")
QUIT "meds"
+5 IF X="A"
QUIT "other"
+6 QUIT "other"
+7 ;
FIND(LOG,ACU) ; find/count orders placed during visit LOG
+1 ; (for converted data)
+2 NEW ORLIST,X0,DFN,IN,OUT,ORI,ORIFN,ORL,PKG,SERV
+3 SET X0=$GET(^EDP(230,LOG,0))
SET DFN=+$PIECE(X0,U,6)
if DFN<1
QUIT
+4 SET IN=$PIECE(X0,U,8)
SET OUT=$PIECE(X0,U,9)
+5 if '$DATA(EDLOC)
DO GETLST^XPAR(.EDLOC,"ALL","EDPF LOCATION")
+6 KILL ^TMP("ORR",$JOB)
DO EN^ORQ1(DFN_";DPT(",,1,,IN,OUT)
SET ORI=0
+7 FOR
SET ORI=$ORDER(^TMP("ORR",$JOB,ORLIST,ORI))
if ORI<1
QUIT
SET ORIFN=+$GET(^(ORI))
Begin DoDot:1
+8 SET ORL=$$GET1^DIQ(100,ORIFN_",",6,"I")
if '$$ED(+ORL)
QUIT
+9 SET PKG=$$GET1^DIQ(100,ORIFN_",","12:1")
+10 SET SERV=$$ENAME(PKG)
+11 SET CNT(ACU,SERV)=CNT(ACU,SERV)+1
End DoDot:1
+12 QUIT
+13 ;
ED(LOC) ; -- Return 1 or 0, if LOCation is part of ED
+1 ; Expects EDLOC(n) = seq ^ #44 ien
+2 NEW I,Y
SET (I,Y)=0
+3 FOR
SET I=$ORDER(EDLOC(I))
if I<1
QUIT
IF $PIECE(EDLOC(I),U,2)=LOC
SET Y=1
QUIT
+4 QUIT Y
