Routine: ACDWTRB

ACDWTRB ;IHS/ADC/EDE/KML - GET TRIBE TO RUN REPORTS FOR 10:14;

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

;;

 ;********************************************************

 ;//^ACDWRQ

 ;User is running CDMIS reports by tribe. A futher breakdown is now

 ;determined. Run ALL or SELECTED or CATEGORY

 ;This routine will return a ACDTRB(array) that holds the

 ;six digit code for area service tribe or "*ALL*"

 ;*********************************************************

EN ;

 K ACDTRB,DIR,DIC

 S DIR(0)="S^1:Print 'ALL' tribes;2:Print 'SELECTED' tribes;3:Print 'CATEGORY' of tribes",DIR("A")="Tribe Print Criteria" D ^DIR G:Y="^" K D @Y,K Q

1 ;All tribes

 S ACDTRB("*ALL*")=""

 S ACDLOC=ACDLOC_" / "_"*ALL TRIBES*"

2 ;On the fly selected tribes

 S ACDLOC=ACDLOC_" / "_"SELECTED TRIBES"

 F  S DIC=9999999.03,DIC(0)="AEQZM" D ^DIC G:Y<0 K S ACDTRB($P(Y(0),U,2))=""

3 ;Category

 S DIC="^ACDTRB(",DIC(0)="AEQM" D ^DIC G:Y<0 K S ACDTRB("C")=$P(Y,U,2)

 S ACDLOC=ACDLOC_" / "_"TRIBE CATEGORY: "_ACDTRB("C")

 I $D(^ACDTRB(+Y,1,0)) F ACDDA=0:0 S ACDDA=$O(^ACDTRB(+Y,1,ACDDA)) Q:'ACDDA  I $D(^(ACDDA,0)) S ACDTRBP=^(0),ACDTRBP=$P(^AUTTTRI(ACDTRBP,0),U,2),ACDTRB(ACDTRBP)=""

K ;

 I '$D(ACDTRB) S ACDQUIT=1

 K DIC,DIR,ACDTRBP,Y

ACDWTRB   ;IHS/ADC/EDE/KML - GET TRIBE TO RUN REPORTS FOR 10:14;

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

 +2       ;;

 +3       ;********************************************************

 +4       ;//^ACDWRQ

 +5       ;User is running CDMIS reports by tribe. A futher breakdown is now

 +6       ;determined. Run ALL or SELECTED or CATEGORY

 +7       ;This routine will return a ACDTRB(array) that holds the

 +8       ;six digit code for area service tribe or "*ALL*"

 +9       ;*********************************************************

 +10      ;

EN        ;

 +1        KILL ACDTRB,DIR,DIC

 +2        SET DIR(0)="S^1:Print 'ALL' tribes;2:Print 'SELECTED' tribes;3:Print 'CATEGORY' of tribes"

           SET DIR("A")="Tribe Print Criteria"

           DO ^DIR

           IF Y="^"

               GOTO K

           DO @Y

           DO K

           QUIT

1         ;All tribes

 +1        SET ACDTRB("*ALL*")=""

 +2        SET ACDLOC=ACDLOC_" / "_"*ALL TRIBES*"

 +3        QUIT

2         ;On the fly selected tribes

 +1        SET ACDLOC=ACDLOC_" / "_"SELECTED TRIBES"

 +2        FOR

               SET DIC=9999999.03

               SET DIC(0)="AEQZM"

               DO ^DIC

               IF Y<0

                   GOTO K

               SET ACDTRB($PIECE(Y(0),U,2))=""

 +3        QUIT

3         ;Category

 +1        SET DIC="^ACDTRB("

           SET DIC(0)="AEQM"

           DO ^DIC

           IF Y<0

               GOTO K

           SET ACDTRB("C")=$PIECE(Y,U,2)

 +2        SET ACDLOC=ACDLOC_" / "_"TRIBE CATEGORY: "_ACDTRB("C")

 +3        IF $DATA(^ACDTRB(+Y,1,0))

               FOR ACDDA=0:0

                   SET ACDDA=$ORDER(^ACDTRB(+Y,1,ACDDA))

                   IF 'ACDDA

                       QUIT

                   IF $DATA(^(ACDDA,0))

                       SET ACDTRBP=^(0)

                       SET ACDTRBP=$PIECE(^AUTTTRI(ACDTRBP,0),U,2)

                       SET ACDTRB(ACDTRBP)=""

 +4        QUIT

K         ;

 +1        IF '$DATA(ACDTRB)

               SET ACDQUIT=1

 +2        KILL DIC,DIR,ACDTRBP,Y

ACDWTRB.m