EDPRPT ;SLC/MKB - Reports ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
EN(BEG,END,RPT,ID,CSV,TASK) ; Get RPT data for EDPSITE by date range
;
I $G(TASK) D Q ;return text from task
. I '$D(^XTMP("EDIS-"_TASK)) D XML^EDPX("<task id='"_TASK_"' />") Q
. M EDPXML=^XTMP("EDIS-"_TASK)
. K EDPXML(0),^XTMP("EDIS-"_TASK)
;
N NOW,ZTSAVE,ZTRTN,ZTDESC
S NOW=$$NOW I BEG,END D ;check
. N X I END<BEG S X=BEG,BEG=END,END=X ;switch
. S:$L(END,".")<2 END=END_".2359"
S RPT=$$UP^XLFSTR($G(RPT))
S CSV=$G(CSV,"")
; switch on report type
I RPT="EXPOSURE" D EXP^EDPRPT7(ID,CSV) G CONT
I BEG<1 D ERR(2300012) G CONT
I RPT="SHIFT" D SFT^EDPRPT5(BEG,CSV) G CONT
I END<1 D ERR(2300012) G CONT
I RPT="ACTIVITY" D ACT^EDPRPT1(BEG,END,CSV) G CONT
I RPT["DELAY" D DEL^EDPRPT2(BEG,END,CSV) G CONT
I RPT="SUMMARY" D SUM^EDPRPT4(BEG,END,CSV) G CONT
I RPT="MISSEDOP" D MO^EDPRPT3(BEG,END,CSV) G CONT
I RPT="PROVIDER" D PRV^EDPRPT6(BEG,END,CSV) G CONT
I RPT="ACUITY" D ACU^EDPRPT8(BEG,END,CSV) G CONT
I RPT="PATIENT" D XRF^EDPRPT9(BEG,END,CSV) G CONT
I RPT="ADMISSIONS" D ADM^EDPRPT10(BEG,END,CSV) G CONT
I RPT="INTAKE" D CNT^EDPRPT11(BEG,END,CSV) G CONT
I RPT="ORDERS" D ORD^EDPRPT12(BEG,END,CSV) G CONT
I RPT="BVAC" D EN^EDPRPTBV(BEG,END,CSV) G CONT
; 10-18-2011 bwf: New report for patients removed in error
I RPT="REMOVED" D EN^EDPRPT13(BEG,END,CSV) G CONT
; else
D ERR(2300011)
CONT ; end switch
Q
;
ERR(MSG) ; -- return error MSG
N X S X=$$MSG^EDPX(MSG)
I $G(CSV) D ADD^EDPCSV(X) Q
D XML^EDPX("<error msg='"_X_"' />")
Q
;
NOW() ; -- Return local value of NOW, based on EDPSITE
Q $$NOW^XLFDT
;
TASK ; -- task report: expects ZTSAVE,ZTRTN,ZTDESC
N ZTDTH,ZTIO,ZTSK,I
S ZTDTH=$H,ZTIO=""
F I="NOW","EDPSTA","EDPSITE","EDPXML","EDPXML(" S ZTSAVE(I)=""
I $G(CSV) S ZTSAVE("CSV")="",ZTSAVE("EDPCSV(")=""
D ^%ZTLOAD I '$G(ZTSK) D ERR(2300017) Q
K EDPXML
D XML^EDPX("<task id='"_ZTSK_"' />")
Q
;
PROV(MD) ; add list of assigned providers to XML
N I,X0,X
D XML^EDPX("<providers>")
S I=0 F S I=$O(MD(I)) Q:I<1 D
. S X0=$G(^VA(200,I,0)),X="<md id='"_I_"' name='"_$$ESC^EDPX($P(X0,U))_"' initials='"_$$ESC^EDPX($P(X0,U,2))_"'/>"
. D XML^EDPX(X)
D XML^EDPX("</providers>")
Q
;
ECODE(IEN) ; Return external value for a Code
;Q:$G(IEN) $P($G(^EDPB(233.1,+IEN,0)),U,3) ;code
N X0,LIST,DA,Y S IEN=+$G(IEN)
S X0=$G(^EDPB(233.1,IEN,0)),LIST=EDPSTA_"."_$P($P(X0,U),".",2)
S DA=+$O(^EDPB(233.2,"AS",LIST,IEN,0)),Y=""
I DA S Y=$P($G(^EDPB(233.2,"AS",LIST,IEN,DA)),U)
I Y="" S Y=$P(X0,U,3) ;use nat'l value if no local
Q Y
;
ENAME(IEN) ; Return external value for a code Name
N X0,LIST,DA,Y S IEN=+$G(IEN)
S X0=$G(^EDPB(233.1,IEN,0)),LIST=EDPSTA_"."_$P($P(X0,U),".",2)
S DA=$O(^EDPB(233.2,"AS",LIST,IEN,0)),Y=""
I DA S Y=$P($G(^EDPB(233.2,"AS",LIST,IEN,DA)),U,2)
I Y="" S Y=$P(X0,U,2) ;use nat'l value if no local
Q Y
;
EPERS(IEN) ; Return external value for a Person (file 200)
Q:$G(IEN) $P($G(^VA(200,+IEN,0)),U)
Q ""
;
EDATE(FMDT) ; Return external value for a Date/Time
Q:$G(FMDT) $TR($$FMTE^XLFDT(FMDT,"2M"),"@"," ") ;MM/DD/YY HH:MM
Q ""
;
ETIME(MINS) ; Return #minutes as HH:MM
N H,M,Y S MINS=+$G(MINS)
S H=MINS\60,M=MINS#60
S Y=H_":"_$S($L(M)=1:"0"_M,1:M)
Q Y
;
MD(LOG) ; Return time physician was first assigned
N IDX,ROOT,D,X,Y S Y="",LOG=+$G(LOG)
S IDX=$NA(^EDP(230.1,"ADF",LOG)),ROOT=$TR(IDX,")")
F S IDX=$Q(@IDX) Q:$P(IDX,",",1,3)'=ROOT D Q:Y
. S D=+$P(IDX,",",4),X=$P($G(^EDP(230.1,+$P(IDX,",",5),3)),U,5)
. I X'="" S Y=D
Q Y
;
ACUITY(LOG) ; Return time acuity was first assigned
N IDX,ROOT,D,X,Y S Y="",LOG=+$G(LOG)
S IDX=$NA(^EDP(230.1,"ADF",LOG)),ROOT=$TR(IDX,")")
F S IDX=$Q(@IDX) Q:$P(IDX,",",1,3)'=ROOT D Q:Y
. S D=+$P(IDX,",",4),X=$P($G(^EDP(230.1,+$P(IDX,",",5),3)),U,3)
. S:X Y=D
Q Y
;
LVWAITRM(LOG) ; Return time patient left waiting room
N IDX,ROOT,D,D1,X,ROOM S Y="",LOG=+$G(LOG)
; get list of room changes in ROOM(time)= 231.8 ien
S IDX=$NA(^EDP(230.1,"ADF",LOG)),ROOT=$TR(IDX,")")
F S IDX=$Q(@IDX) Q:$P(IDX,",",1,3)'=ROOT D
. S D=+$P(IDX,",",4),X=+$P($G(^EDP(230.1,+$P(IDX,",",5),3)),U,4)
. I X,D S ROOM(D)=X
; look for movement in and out of waiting room
S D=0 F S D=$O(ROOM(D)) Q:D<1 S D1=$O(ROOM(D)) D Q:Y
. N RM,NXT S RM=ROOM(D),NXT=$S(D1:ROOM(D1),1:0)
. I NXT,NXT'=RM,$$WAIT(RM),'$$WAIT(NXT) S Y=D1 ;$S(D1:D1,1:OUT)
Q Y
;
WAIT(X) ; Return 1 or 0, if X is a waiting room
Q $P($G(^EDPB(231.8,+$G(X),0)),U,9)=2
;
ADMIT(LOG) ; Return 1st time admitting disposition was assigned
N D,I,X0,X,Y,OUT S Y="",LOG=+$G(LOG)
S D=0 F S D=$O(^EDP(230.1,"ADF",LOG,D)) Q:D<1 S I=+$O(^(D,0)) D Q:Y
. S X0=$G(^EDP(230.1,I,0))
. I $P(X0,U,11),$P($G(^EDPB(233.1,+$P(X0,U,11),0)),U,5)["A" S Y=D
I Y="" D ;ck old format
. N X1 S X1=$G(^EDP(230,LOG,1))
. I $P(X1,U,2),$P($G(^EDPB(233.1,+$P(X1,U,2),0)),U,5)["A" S Y=$P(X1,U,3)
I Y S OUT=$P($G(^EDP(230,LOG,0)),U,9) S:OUT&(OUT<Y) Y=OUT ;use Time Out if earlier
Q Y
DISP(X) ;Return disposition abbreviation or display name from file 233.2
;X = IEN of disposition entry in file 233.1
I +X=0 Q ""
N DA,DISP,Y
S Y=EDPSTA_".disposition"
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)
Q DISP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPRPT 5548 printed Oct 16, 2024@17:53:04 Page 2
EDPRPT ;SLC/MKB - Reports ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
EN(BEG,END,RPT,ID,CSV,TASK) ; Get RPT data for EDPSITE by date range
+1 ;
+2 ;return text from task
IF $GET(TASK)
Begin DoDot:1
+3 IF '$DATA(^XTMP("EDIS-"_TASK))
DO XML^EDPX("<task id='"_TASK_"' />")
QUIT
+4 MERGE EDPXML=^XTMP("EDIS-"_TASK)
+5 KILL EDPXML(0),^XTMP("EDIS-"_TASK)
End DoDot:1
QUIT
+6 ;
+7 NEW NOW,ZTSAVE,ZTRTN,ZTDESC
+8 ;check
SET NOW=$$NOW
IF BEG
IF END
Begin DoDot:1
+9 ;switch
NEW X
IF END<BEG
SET X=BEG
SET BEG=END
SET END=X
+10 if $LENGTH(END,".")<2
SET END=END_".2359"
End DoDot:1
+11 SET RPT=$$UP^XLFSTR($GET(RPT))
+12 SET CSV=$GET(CSV,"")
+13 ; switch on report type
+14 IF RPT="EXPOSURE"
DO EXP^EDPRPT7(ID,CSV)
GOTO CONT
+15 IF BEG<1
DO ERR(2300012)
GOTO CONT
+16 IF RPT="SHIFT"
DO SFT^EDPRPT5(BEG,CSV)
GOTO CONT
+17 IF END<1
DO ERR(2300012)
GOTO CONT
+18 IF RPT="ACTIVITY"
DO ACT^EDPRPT1(BEG,END,CSV)
GOTO CONT
+19 IF RPT["DELAY"
DO DEL^EDPRPT2(BEG,END,CSV)
GOTO CONT
+20 IF RPT="SUMMARY"
DO SUM^EDPRPT4(BEG,END,CSV)
GOTO CONT
+21 IF RPT="MISSEDOP"
DO MO^EDPRPT3(BEG,END,CSV)
GOTO CONT
+22 IF RPT="PROVIDER"
DO PRV^EDPRPT6(BEG,END,CSV)
GOTO CONT
+23 IF RPT="ACUITY"
DO ACU^EDPRPT8(BEG,END,CSV)
GOTO CONT
+24 IF RPT="PATIENT"
DO XRF^EDPRPT9(BEG,END,CSV)
GOTO CONT
+25 IF RPT="ADMISSIONS"
DO ADM^EDPRPT10(BEG,END,CSV)
GOTO CONT
+26 IF RPT="INTAKE"
DO CNT^EDPRPT11(BEG,END,CSV)
GOTO CONT
+27 IF RPT="ORDERS"
DO ORD^EDPRPT12(BEG,END,CSV)
GOTO CONT
+28 IF RPT="BVAC"
DO EN^EDPRPTBV(BEG,END,CSV)
GOTO CONT
+29 ; 10-18-2011 bwf: New report for patients removed in error
+30 IF RPT="REMOVED"
DO EN^EDPRPT13(BEG,END,CSV)
GOTO CONT
+31 ; else
+32 DO ERR(2300011)
CONT ; end switch
+1 QUIT
+2 ;
ERR(MSG) ; -- return error MSG
+1 NEW X
SET X=$$MSG^EDPX(MSG)
+2 IF $GET(CSV)
DO ADD^EDPCSV(X)
QUIT
+3 DO XML^EDPX("<error msg='"_X_"' />")
+4 QUIT
+5 ;
NOW() ; -- Return local value of NOW, based on EDPSITE
+1 QUIT $$NOW^XLFDT
+2 ;
TASK ; -- task report: expects ZTSAVE,ZTRTN,ZTDESC
+1 NEW ZTDTH,ZTIO,ZTSK,I
+2 SET ZTDTH=$HOROLOG
SET ZTIO=""
+3 FOR I="NOW","EDPSTA","EDPSITE","EDPXML","EDPXML("
SET ZTSAVE(I)=""
+4 IF $GET(CSV)
SET ZTSAVE("CSV")=""
SET ZTSAVE("EDPCSV(")=""
+5 DO ^%ZTLOAD
IF '$GET(ZTSK)
DO ERR(2300017)
QUIT
+6 KILL EDPXML
+7 DO XML^EDPX("<task id='"_ZTSK_"' />")
+8 QUIT
+9 ;
PROV(MD) ; add list of assigned providers to XML
+1 NEW I,X0,X
+2 DO XML^EDPX("<providers>")
+3 SET I=0
FOR
SET I=$ORDER(MD(I))
if I<1
QUIT
Begin DoDot:1
+4 SET X0=$GET(^VA(200,I,0))
SET X="<md id='"_I_"' name='"_$$ESC^EDPX($PIECE(X0,U))_"' initials='"_$$ESC^EDPX($PIECE(X0,U,2))_"'/>"
+5 DO XML^EDPX(X)
End DoDot:1
+6 DO XML^EDPX("</providers>")
+7 QUIT
+8 ;
ECODE(IEN) ; Return external value for a Code
+1 ;Q:$G(IEN) $P($G(^EDPB(233.1,+IEN,0)),U,3) ;code
+2 NEW X0,LIST,DA,Y
SET IEN=+$GET(IEN)
+3 SET X0=$GET(^EDPB(233.1,IEN,0))
SET LIST=EDPSTA_"."_$PIECE($PIECE(X0,U),".",2)
+4 SET DA=+$ORDER(^EDPB(233.2,"AS",LIST,IEN,0))
SET Y=""
+5 IF DA
SET Y=$PIECE($GET(^EDPB(233.2,"AS",LIST,IEN,DA)),U)
+6 ;use nat'l value if no local
IF Y=""
SET Y=$PIECE(X0,U,3)
+7 QUIT Y
+8 ;
ENAME(IEN) ; Return external value for a code Name
+1 NEW X0,LIST,DA,Y
SET IEN=+$GET(IEN)
+2 SET X0=$GET(^EDPB(233.1,IEN,0))
SET LIST=EDPSTA_"."_$PIECE($PIECE(X0,U),".",2)
+3 SET DA=$ORDER(^EDPB(233.2,"AS",LIST,IEN,0))
SET Y=""
+4 IF DA
SET Y=$PIECE($GET(^EDPB(233.2,"AS",LIST,IEN,DA)),U,2)
+5 ;use nat'l value if no local
IF Y=""
SET Y=$PIECE(X0,U,2)
+6 QUIT Y
+7 ;
EPERS(IEN) ; Return external value for a Person (file 200)
+1 if $GET(IEN)
QUIT $PIECE($GET(^VA(200,+IEN,0)),U)
+2 QUIT ""
+3 ;
EDATE(FMDT) ; Return external value for a Date/Time
+1 ;MM/DD/YY HH:MM
if $GET(FMDT)
QUIT $TRANSLATE($$FMTE^XLFDT(FMDT,"2M"),"@"," ")
+2 QUIT ""
+3 ;
ETIME(MINS) ; Return #minutes as HH:MM
+1 NEW H,M,Y
SET MINS=+$GET(MINS)
+2 SET H=MINS\60
SET M=MINS#60
+3 SET Y=H_":"_$SELECT($LENGTH(M)=1:"0"_M,1:M)
+4 QUIT Y
+5 ;
MD(LOG) ; Return time physician was first assigned
+1 NEW IDX,ROOT,D,X,Y
SET Y=""
SET LOG=+$GET(LOG)
+2 SET IDX=$NAME(^EDP(230.1,"ADF",LOG))
SET ROOT=$TRANSLATE(IDX,")")
+3 FOR
SET IDX=$QUERY(@IDX)
if $PIECE(IDX,",",1,3)'=ROOT
QUIT
Begin DoDot:1
+4 SET D=+$PIECE(IDX,",",4)
SET X=$PIECE($GET(^EDP(230.1,+$PIECE(IDX,",",5),3)),U,5)
+5 IF X'=""
SET Y=D
End DoDot:1
if Y
QUIT
+6 QUIT Y
+7 ;
ACUITY(LOG) ; Return time acuity was first assigned
+1 NEW IDX,ROOT,D,X,Y
SET Y=""
SET LOG=+$GET(LOG)
+2 SET IDX=$NAME(^EDP(230.1,"ADF",LOG))
SET ROOT=$TRANSLATE(IDX,")")
+3 FOR
SET IDX=$QUERY(@IDX)
if $PIECE(IDX,",",1,3)'=ROOT
QUIT
Begin DoDot:1
+4 SET D=+$PIECE(IDX,",",4)
SET X=$PIECE($GET(^EDP(230.1,+$PIECE(IDX,",",5),3)),U,3)
+5 if X
SET Y=D
End DoDot:1
if Y
QUIT
+6 QUIT Y
+7 ;
LVWAITRM(LOG) ; Return time patient left waiting room
+1 NEW IDX,ROOT,D,D1,X,ROOM
SET Y=""
SET LOG=+$GET(LOG)
+2 ; get list of room changes in ROOM(time)= 231.8 ien
+3 SET IDX=$NAME(^EDP(230.1,"ADF",LOG))
SET ROOT=$TRANSLATE(IDX,")")
+4 FOR
SET IDX=$QUERY(@IDX)
if $PIECE(IDX,",",1,3)'=ROOT
QUIT
Begin DoDot:1
+5 SET D=+$PIECE(IDX,",",4)
SET X=+$PIECE($GET(^EDP(230.1,+$PIECE(IDX,",",5),3)),U,4)
+6 IF X
IF D
SET ROOM(D)=X
End DoDot:1
+7 ; look for movement in and out of waiting room
+8 SET D=0
FOR
SET D=$ORDER(ROOM(D))
if D<1
QUIT
SET D1=$ORDER(ROOM(D))
Begin DoDot:1
+9 NEW RM,NXT
SET RM=ROOM(D)
SET NXT=$SELECT(D1:ROOM(D1),1:0)
+10 ;$S(D1:D1,1:OUT)
IF NXT
IF NXT'=RM
IF $$WAIT(RM)
IF '$$WAIT(NXT)
SET Y=D1
End DoDot:1
if Y
QUIT
+11 QUIT Y
+12 ;
WAIT(X) ; Return 1 or 0, if X is a waiting room
+1 QUIT $PIECE($GET(^EDPB(231.8,+$GET(X),0)),U,9)=2
+2 ;
ADMIT(LOG) ; Return 1st time admitting disposition was assigned
+1 NEW D,I,X0,X,Y,OUT
SET Y=""
SET LOG=+$GET(LOG)
+2 SET D=0
FOR
SET D=$ORDER(^EDP(230.1,"ADF",LOG,D))
if D<1
QUIT
SET I=+$ORDER(^(D,0))
Begin DoDot:1
+3 SET X0=$GET(^EDP(230.1,I,0))
+4 IF $PIECE(X0,U,11)
IF $PIECE($GET(^EDPB(233.1,+$PIECE(X0,U,11),0)),U,5)["A"
SET Y=D
End DoDot:1
if Y
QUIT
+5 ;ck old format
IF Y=""
Begin DoDot:1
+6 NEW X1
SET X1=$GET(^EDP(230,LOG,1))
+7 IF $PIECE(X1,U,2)
IF $PIECE($GET(^EDPB(233.1,+$PIECE(X1,U,2),0)),U,5)["A"
SET Y=$PIECE(X1,U,3)
End DoDot:1
+8 ;use Time Out if earlier
IF Y
SET OUT=$PIECE($GET(^EDP(230,LOG,0)),U,9)
if OUT&(OUT<Y)
SET Y=OUT
+9 QUIT Y
DISP(X) ;Return disposition abbreviation or display name from file 233.2
+1 ;X = IEN of disposition entry in file 233.1
+2 IF +X=0
QUIT ""
+3 NEW DA,DISP,Y
+4 SET Y=EDPSTA_".disposition"
+5 SET DA=0
FOR
SET DA=$ORDER(^EDPB(233.2,"AS",Y,+X,DA))
if DA=""
QUIT
Begin DoDot:1
+6 SET DISP=$PIECE($GET(^EDPB(233.2,"AS",Y,+X,DA)),U)
+7 IF '$LENGTH(DISP)
SET DISP=$EXTRACT($TRANSLATE($PIECE($GET(^EDPB(233.2,"AS",Y,+X,DA)),U,2)," ","_"),1,30)
End DoDot:1
+8 QUIT DISP
