EDPRPT7 ;SLC/MKB - Exposure Report ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;**2**;Feb 24, 2012;Build 23
;;Per VHA Directive 2004-038, this routine should not be modified.
;
EXP(IEN,CSV) ; Get Exposure Report for IEN at EDPSITE
S IEN=+$G(IEN) Q:IEN<1 Q:'$D(^EDP(230,IEN,0))
I $G(CSV) D EXP^EDPRPT7C(IEN) Q ;CSV format instead
N BEG,END,LIST,LOG,IN,OUT,X,X0,Y,RLIST,TREAT,OTHER,MD,RN,RES,I,J,RIN,ROUT
N SHIFT D SETUP^EDPRPT5 ;build SHIFT(#)
I 'SHIFT D ERR^EDPRPT(2300013) Q
S X0=^EDP(230,IEN,0),BEG=$P(X0,U,8),END=$P(X0,U,9)
S:'BEG BEG=$P(X0,U) S:'END END=$$NOW^EDPRPT
D ROOMS(IEN,END)
; put IEN info into XML
D XML^EDPX("<patient>")
D ADD(IEN),STAFF(IEN)
D XML^EDPX("</patient>")
E1 ; look for patients also in ED between BEG and END
D FIND(BEG,END) ;create LIST(#) list of ien's to check
S LOG=0 F S LOG=+$O(LIST(LOG)) Q:'LOG I LOG'=IEN D
. S X0=$G(^EDP(230,LOG,0)),IN=$P(X0,U,8),OUT=$P(X0,U,9)
. D ROOMS(LOG,OUT)
. ; compare treatment rooms
. S I=0 F S I=$O(RLIST(IEN,I)) Q:I<1 D
.. S RIN=$P(RLIST(IEN,I),U,2),ROUT=$P(RLIST(IEN,I),U,3)
.. S J=0 F S J=$O(RLIST(LOG,J)) Q:J<1 I +RLIST(IEN,I)=+RLIST(LOG,J) D
... S X=$P(RLIST(LOG,J),U,2) Q:X>ROUT ;in to room after IEN left
... ;I (RIN<=X)&(X<=ROUT) S TREAT(LOG)="" Q
... S X=$P(RLIST(LOG,J),U,3) Q:X&(X<RIN) ;out of room before IEN came
... ;I (RIN<=X)&(X<=ROUT) S TREAT(LOG)="" Q
... S TREAT(LOG)=""
. I '$D(TREAT(LOG)) S OTHER(LOG)=""
E2 ; return treatment room patients
I $O(TREAT(0)) D
. D XML^EDPX("<treatmentRoom>")
. S LOG=0 F S LOG=$O(TREAT(LOG)) Q:LOG<1 D ADD(LOG),STAFF(LOG)
. D XML^EDPX("</treatmentRoom>")
; return other ED patients
I $O(OTHER(0)) D
. D XML^EDPX("<otherPatients>")
. S LOG=0 F S LOG=$O(OTHER(LOG)) Q:LOG<1 D ADD(LOG),STAFF(LOG)
. D XML^EDPX("</otherPatients>")
E3 ; return staff on duty
D XML^EDPX("<onDutyStaff>")
I $O(MD(0)) D
. D XML^EDPX("<doctors>")
. S I=0 F S I=$O(MD(I)) Q:I<1 D
.. S X="<md name='"_$$ESC^EDPX(MD(I))_"' />"
.. D XML^EDPX(X)
. D XML^EDPX("</doctors>")
I $O(RN(0)) D
. D XML^EDPX("<nurses>")
. S I=0 F S I=$O(RN(I)) Q:I<1 D
.. S X="<rn name='"_$$ESC^EDPX(RN(I))_"' />"
.. D XML^EDPX(X)
. D XML^EDPX("</nurses>")
I $O(RES(0)) D
. D XML^EDPX("<residents>")
. S I=0 F S I=$O(RES(I)) Q:I<1 D
.. S X="<md name='"_$$ESC^EDPX(RES(I))_"' />"
.. D XML^EDPX(X)
. D XML^EDPX("</residents>")
D XML^EDPX("</onDutyStaff>")
Q
;
FIND(IN,OUT) ; create LIST(#) of visits at same time
N TIME,I,X K LIST
S TIME=+$P(IN,".") ;ck today's arrivals
F S TIME=$O(^EDP(230,"ATI",EDPSITE,TIME)) Q:TIME<1!(TIME>OUT) D
. S I=0 F S I=$O(^EDP(230,"ATI",EDPSITE,TIME,I)) Q:I<1 D
.. S X=$P($G(^EDP(230,I,0)),U,9) I X,X<IN Q ;left before IEN arrived
.. S LIST(I)=""
Q
;
ROOMS(LOG,OUT) ; Return RLIST(LOG,n) = room ^ time in ^ time out
N N,D,I,X,LAST S N=0,LAST=""
S D=0 F S D=$O(^EDP(230.1,"ADF",LOG,D)) Q:D<1 S I=+$O(^(D,0)) D
. S X=+$P($G(^EDP(230.1,I,3)),U,4) Q:'X Q:X=LAST ;no location change
. S:N $P(RLIST(LOG,N),U,3)=D ;time in of next room = time out of prev
. S N=N+1,RLIST(LOG,N)=X_U_D,LAST=X ;new room
I N,'$P(RLIST(LOG,N),U,3) S $P(RLIST(LOG,N),U,3)=OUT
Q
;
ADD(LOG) ; Add row to XML for each room used during visit
N EDPI,EDPX,ROW,LABS,XRAY,X,X0
S EDPI=0 F S EDPI=$O(RLIST(LOG,EDPI)) Q:EDPI<1 S EDPX=RLIST(LOG,EDPI) D
. K ROW S ROW("id")=LOG ;only return for EDPI=1 ??
. S ROW("roomName")=$P($G(^EDPB(231.8,+EDPX,0)),U)
. S X=$P(EDPX,U,2)
. S ROW("shiftIn")=$$SHIFT^EDPRPT5(X),ROW("inTS")=X
. S X=$P(EDPX,U,3)
. S ROW("shiftOut")=$$SHIFT^EDPRPT5(X),ROW("outTS")=X
. ;TDP - Patch 2 mod to capture all dispositions
. S X=$P($G(^EDP(230,LOG,1)),U,2),ROW("disposition")=$S($$ECODE^EDPRPT(X)'="":$$ECODE^EDPRPT(X),1:$$DISP^EDPRPT(X))
. S X0=$G(^EDP(230,LOG,0)),X=$P(X0,U,10),ROW("arrival")=$$ENAME^EDPRPT(X)
. ;Begin EDP*2.0*2 changes - drp added icd and icdtype column headers to line below
. S X=$$DXPRI^EDPQPCE(+$P(X0,U,3),LOG),ROW("dx")=$P(X,U,2),ROW("icd")=$P(X,U,1),ROW("icdType")=$P(X,U,3)
. ;End EDP*2.0*2 changes - drp
. S LABS=$D(^EDP(230,LOG,8,"AC","L")),XRAY=$D(^("R")),X=""
. I LABS!XRAY D S X=X_" ordered"
.. I LABS&XRAY S X="Labs and Imaging" Q
.. S:LABS X="Labs" S:XRAY X="Imaging"
. S ROW("notes")=X
. S X=$$XMLA^EDPX("row",.ROW) D XML^EDPX(X)
Q
;
STAFF(LOG) ; save staff involved in patient care
N D,I,X,ACT S 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
. S ACT=$G(^EDP(230.1,I,3))
. S X=+$P(ACT,U,5) S:X MD(X)=$$EPERS^EDPRPT(X)
. S X=+$P(ACT,U,6) S:X RN(X)=$$EPERS^EDPRPT(X)
. S X=+$P(ACT,U,7) S:X RES(X)=$$EPERS^EDPRPT(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPRPT7 4710 printed Apr 09, 2024@20:57:39 Page 2
EDPRPT7 ;SLC/MKB - Exposure Report ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;**2**;Feb 24, 2012;Build 23
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EXP(IEN,CSV) ; Get Exposure Report for IEN at EDPSITE
+1 SET IEN=+$GET(IEN)
if IEN<1
QUIT
if '$DATA(^EDP(230,IEN,0))
QUIT
+2 ;CSV format instead
IF $GET(CSV)
DO EXP^EDPRPT7C(IEN)
QUIT
+3 NEW BEG,END,LIST,LOG,IN,OUT,X,X0,Y,RLIST,TREAT,OTHER,MD,RN,RES,I,J,RIN,ROUT
+4 ;build SHIFT(#)
NEW SHIFT
DO SETUP^EDPRPT5
+5 IF 'SHIFT
DO ERR^EDPRPT(2300013)
QUIT
+6 SET X0=^EDP(230,IEN,0)
SET BEG=$PIECE(X0,U,8)
SET END=$PIECE(X0,U,9)
+7 if 'BEG
SET BEG=$PIECE(X0,U)
if 'END
SET END=$$NOW^EDPRPT
+8 DO ROOMS(IEN,END)
+9 ; put IEN info into XML
+10 DO XML^EDPX("<patient>")
+11 DO ADD(IEN)
DO STAFF(IEN)
+12 DO XML^EDPX("</patient>")
E1 ; look for patients also in ED between BEG and END
+1 ;create LIST(#) list of ien's to check
DO FIND(BEG,END)
+2 SET LOG=0
FOR
SET LOG=+$ORDER(LIST(LOG))
if 'LOG
QUIT
IF LOG'=IEN
Begin DoDot:1
+3 SET X0=$GET(^EDP(230,LOG,0))
SET IN=$PIECE(X0,U,8)
SET OUT=$PIECE(X0,U,9)
+4 DO ROOMS(LOG,OUT)
+5 ; compare treatment rooms
+6 SET I=0
FOR
SET I=$ORDER(RLIST(IEN,I))
if I<1
QUIT
Begin DoDot:2
+7 SET RIN=$PIECE(RLIST(IEN,I),U,2)
SET ROUT=$PIECE(RLIST(IEN,I),U,3)
+8 SET J=0
FOR
SET J=$ORDER(RLIST(LOG,J))
if J<1
QUIT
IF +RLIST(IEN,I)=+RLIST(LOG,J)
Begin DoDot:3
+9 ;in to room after IEN left
SET X=$PIECE(RLIST(LOG,J),U,2)
if X>ROUT
QUIT
+10 ;I (RIN<=X)&(X<=ROUT) S TREAT(LOG)="" Q
+11 ;out of room before IEN came
SET X=$PIECE(RLIST(LOG,J),U,3)
if X&(X<RIN)
QUIT
+12 ;I (RIN<=X)&(X<=ROUT) S TREAT(LOG)="" Q
+13 SET TREAT(LOG)=""
End DoDot:3
End DoDot:2
+14 IF '$DATA(TREAT(LOG))
SET OTHER(LOG)=""
End DoDot:1
E2 ; return treatment room patients
+1 IF $ORDER(TREAT(0))
Begin DoDot:1
+2 DO XML^EDPX("<treatmentRoom>")
+3 SET LOG=0
FOR
SET LOG=$ORDER(TREAT(LOG))
if LOG<1
QUIT
DO ADD(LOG)
DO STAFF(LOG)
+4 DO XML^EDPX("</treatmentRoom>")
End DoDot:1
+5 ; return other ED patients
+6 IF $ORDER(OTHER(0))
Begin DoDot:1
+7 DO XML^EDPX("<otherPatients>")
+8 SET LOG=0
FOR
SET LOG=$ORDER(OTHER(LOG))
if LOG<1
QUIT
DO ADD(LOG)
DO STAFF(LOG)
+9 DO XML^EDPX("</otherPatients>")
End DoDot:1
E3 ; return staff on duty
+1 DO XML^EDPX("<onDutyStaff>")
+2 IF $ORDER(MD(0))
Begin DoDot:1
+3 DO XML^EDPX("<doctors>")
+4 SET I=0
FOR
SET I=$ORDER(MD(I))
if I<1
QUIT
Begin DoDot:2
+5 SET X="<md name='"_$$ESC^EDPX(MD(I))_"' />"
+6 DO XML^EDPX(X)
End DoDot:2
+7 DO XML^EDPX("</doctors>")
End DoDot:1
+8 IF $ORDER(RN(0))
Begin DoDot:1
+9 DO XML^EDPX("<nurses>")
+10 SET I=0
FOR
SET I=$ORDER(RN(I))
if I<1
QUIT
Begin DoDot:2
+11 SET X="<rn name='"_$$ESC^EDPX(RN(I))_"' />"
+12 DO XML^EDPX(X)
End DoDot:2
+13 DO XML^EDPX("</nurses>")
End DoDot:1
+14 IF $ORDER(RES(0))
Begin DoDot:1
+15 DO XML^EDPX("<residents>")
+16 SET I=0
FOR
SET I=$ORDER(RES(I))
if I<1
QUIT
Begin DoDot:2
+17 SET X="<md name='"_$$ESC^EDPX(RES(I))_"' />"
+18 DO XML^EDPX(X)
End DoDot:2
+19 DO XML^EDPX("</residents>")
End DoDot:1
+20 DO XML^EDPX("</onDutyStaff>")
+21 QUIT
+22 ;
FIND(IN,OUT) ; create LIST(#) of visits at same time
+1 NEW TIME,I,X
KILL LIST
+2 ;ck today's arrivals
SET TIME=+$PIECE(IN,".")
+3 FOR
SET TIME=$ORDER(^EDP(230,"ATI",EDPSITE,TIME))
if TIME<1!(TIME>OUT)
QUIT
Begin DoDot:1
+4 SET I=0
FOR
SET I=$ORDER(^EDP(230,"ATI",EDPSITE,TIME,I))
if I<1
QUIT
Begin DoDot:2
+5 ;left before IEN arrived
SET X=$PIECE($GET(^EDP(230,I,0)),U,9)
IF X
IF X<IN
QUIT
+6 SET LIST(I)=""
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
ROOMS(LOG,OUT) ; Return RLIST(LOG,n) = room ^ time in ^ time out
+1 NEW N,D,I,X,LAST
SET N=0
SET LAST=""
+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 ;no location change
SET X=+$PIECE($GET(^EDP(230.1,I,3)),U,4)
if 'X
QUIT
if X=LAST
QUIT
+4 ;time in of next room = time out of prev
if N
SET $PIECE(RLIST(LOG,N),U,3)=D
+5 ;new room
SET N=N+1
SET RLIST(LOG,N)=X_U_D
SET LAST=X
End DoDot:1
+6 IF N
IF '$PIECE(RLIST(LOG,N),U,3)
SET $PIECE(RLIST(LOG,N),U,3)=OUT
+7 QUIT
+8 ;
ADD(LOG) ; Add row to XML for each room used during visit
+1 NEW EDPI,EDPX,ROW,LABS,XRAY,X,X0
+2 SET EDPI=0
FOR
SET EDPI=$ORDER(RLIST(LOG,EDPI))
if EDPI<1
QUIT
SET EDPX=RLIST(LOG,EDPI)
Begin DoDot:1
+3 ;only return for EDPI=1 ??
KILL ROW
SET ROW("id")=LOG
+4 SET ROW("roomName")=$PIECE($GET(^EDPB(231.8,+EDPX,0)),U)
+5 SET X=$PIECE(EDPX,U,2)
+6 SET ROW("shiftIn")=$$SHIFT^EDPRPT5(X)
SET ROW("inTS")=X
+7 SET X=$PIECE(EDPX,U,3)
+8 SET ROW("shiftOut")=$$SHIFT^EDPRPT5(X)
SET ROW("outTS")=X
+9 ;TDP - Patch 2 mod to capture all dispositions
+10 SET X=$PIECE($GET(^EDP(230,LOG,1)),U,2)
SET ROW("disposition")=$SELECT($$ECODE^EDPRPT(X)'="":$$ECODE^EDPRPT(X),1:$$DISP^EDPRPT(X))
+11 SET X0=$GET(^EDP(230,LOG,0))
SET X=$PIECE(X0,U,10)
SET ROW("arrival")=$$ENAME^EDPRPT(X)
+12 ;Begin EDP*2.0*2 changes - drp added icd and icdtype column headers to line below
+13 SET X=$$DXPRI^EDPQPCE(+$PIECE(X0,U,3),LOG)
SET ROW("dx")=$PIECE(X,U,2)
SET ROW("icd")=$PIECE(X,U,1)
SET ROW("icdType")=$PIECE(X,U,3)
+14 ;End EDP*2.0*2 changes - drp
+15 SET LABS=$DATA(^EDP(230,LOG,8,"AC","L"))
SET XRAY=$DATA(^("R"))
SET X=""
+16 IF LABS!XRAY
Begin DoDot:2
+17 IF LABS&XRAY
SET X="Labs and Imaging"
QUIT
+18 if LABS
SET X="Labs"
if XRAY
SET X="Imaging"
End DoDot:2
SET X=X_" ordered"
+19 SET ROW("notes")=X
+20 SET X=$$XMLA^EDPX("row",.ROW)
DO XML^EDPX(X)
End DoDot:1
+21 QUIT
+22 ;
STAFF(LOG) ; save staff involved in patient care
+1 NEW D,I,X,ACT
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 ACT=$GET(^EDP(230.1,I,3))
+4 SET X=+$PIECE(ACT,U,5)
if X
SET MD(X)=$$EPERS^EDPRPT(X)
+5 SET X=+$PIECE(ACT,U,6)
if X
SET RN(X)=$$EPERS^EDPRPT(X)
+6 SET X=+$PIECE(ACT,U,7)
if X
SET RES(X)=$$EPERS^EDPRPT(X)
End DoDot:1
+7 QUIT
