Routine: EDPRPT7

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>")

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)=""

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

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)

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPRPT7   4710     printed  Feb 18, 2025@23:18:50                                                                                                                                                                                                     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

EDPRPT7.m