EDPRPT12.m

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 ---EDPRPT12   2828     printed  Feb 18, 2025@23:18:44                                                                                                                                                                                                    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