ACDRR1PC.m

ACDRR1PC ;IHS/ADC/EDE/KML - BROKE UP ACDRR1PB;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

TRIBE ; EP-tribe

 D F Q:ACDQ

 W !!,?50,"SEX",?68,"AGE",!

 W "PATIENT COUNT BY TRIBE",?48,"M",?55,"F",?62,"<13",?67,"13-20",?75,"21+",!!

 F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN",%)

 F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN","AGE",%)

 W ?2,$$LJRF^ACD("TOTAL SEEN",28,".")," ",X,?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!

 ; seen by tribe

 S ACDTRIBE=""

 F  S ACDTRIBE=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE)) Q:ACDTRIBE=""  D  Q:ACDQ

 .  D F Q:ACDQ

 .  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE)

 .  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE,%)

 .  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE,"AGE",%)

 .  W ?2,$$LJRF^ACD(ACDTRIBE,28,".")," ",Y W ?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!

 .  Q

 Q

 ;

LOS ; EP-length of stay by component code/type

 D F Q:ACDQ

 W !,"AVERAGE LENGTH OF STAY IN DAYS BY COMPONENT CODE/TYPE",!

 W ?30,"COUNT",?40,"AVERAGE LOS",!

 S ACDTC=""

 F  S ACDTC=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",ACDTC)) Q:ACDTC=""  D  Q:ACDQ

 .  D F Q:ACDQ

 .  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",ACDTC,"COUNT")

 .  S Z=^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",ACDTC,"AVG")

 .  W ?2,$$LJRF^ACD(ACDTC,28,".")," ",Y,?44,$J(Z,5,0),!

 .  Q

 Q

 ;

F ;Form feed

 NEW V,W,X,Y,Z

 I $Y+4>IOSL D

 . I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST,1,2)'="P-" D PAUSE^ACDDEU S:$D(DIRUT) ACDQ=1

 . W @IOF

 . W !

 . Q

 Q

ACDRR1PC  ;IHS/ADC/EDE/KML - BROKE UP ACDRR1PB;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

TRIBE     ; EP-tribe

 +1        DO F

           IF ACDQ

               QUIT 

 +2        WRITE !!,?50,"SEX",?68,"AGE",!

 +3        WRITE "PATIENT COUNT BY TRIBE",?48,"M",?55,"F",?62,"<13",?67,"13-20",?75,"21+",!!

 +4        FOR %="M","F"

               SET @%=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN",%)

 +5        FOR %=1:1:3

               SET %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN","AGE",%)

 +6        WRITE ?2,$$LJRF^ACD("TOTAL SEEN",28,".")," ",X,?44,$JUSTIFY(M,5),?51,$JUSTIFY(F,5),?60,$JUSTIFY(%(1),5),?67,$JUSTIFY(%(2),5),?73,$JUSTIFY(%(3),5),!

 +7       ; seen by tribe

 +8        SET ACDTRIBE=""

 +9        FOR 

               SET ACDTRIBE=$ORDER(^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE))

               IF ACDTRIBE=""

                   QUIT 

               Begin DoDot:1

 +10               DO F

                   IF ACDQ

                       QUIT 

 +11               SET Y=^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE)

 +12               FOR %="M","F"

                       SET @%=^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE,%)

 +13               FOR %=1:1:3

                       SET %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE,"AGE",%)

 +14               WRITE ?2,$$LJRF^ACD(ACDTRIBE,28,".")," ",Y

                   WRITE ?37,$JUSTIFY((Y/X*100),3,0),"%",?44,$JUSTIFY(M,5),?51,$JUSTIFY(F,5),?60,$JUSTIFY(%(1),5),?67,$JUSTIFY(%(2),5),?73,$JUSTIFY(%(3),5),!

 +15               QUIT 

               End DoDot:1

               IF ACDQ

                   QUIT 

 +16       QUIT 

 +17      ;

LOS       ; EP-length of stay by component code/type

 +1        DO F

           IF ACDQ

               QUIT 

 +2        WRITE !,"AVERAGE LENGTH OF STAY IN DAYS BY COMPONENT CODE/TYPE",!

 +3        WRITE ?30,"COUNT",?40,"AVERAGE LOS",!

 +4        SET ACDTC=""

 +5        FOR 

               SET ACDTC=$ORDER(^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",ACDTC))

               IF ACDTC=""

                   QUIT 

               Begin DoDot:1

 +6                DO F

                   IF ACDQ

                       QUIT 

 +7                SET Y=^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",ACDTC,"COUNT")

 +8                SET Z=^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",ACDTC,"AVG")

 +9                WRITE ?2,$$LJRF^ACD(ACDTC,28,".")," ",Y,?44,$JUSTIFY(Z,5,0),!

 +10               QUIT 

               End DoDot:1

               IF ACDQ

                   QUIT 

 +11       QUIT 

 +12      ;

F         ;Form feed

 +1        NEW V,W,X,Y,Z

 +2        IF $Y+4>IOSL

               Begin DoDot:1

 +3                IF '$DATA(ZTQUEUED)

                       IF '$DATA(IO("S"))

                           IF $EXTRACT(IOST,1,2)'="P-"

                               DO PAUSE^ACDDEU

                               IF $DATA(DIRUT)

                                   SET ACDQ=1

 +4                WRITE @IOF

 +5                WRITE !

 +6                QUIT 

               End DoDot:1

 +7        QUIT