ACDWFAC.m

ACDWFAC ;IHS/ADC/EDE/KML - GET FACILITY TO RUN REPORTS;

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

 ;;

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

 ;//^ACDWRQ

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

 ;determined. Run ALL or SELECTED or CATEGORY

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

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

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

 ;

EN ;

 K ACDFAC,DIR

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

1 ;All facilities

 S ACDFAC("*ALL*")=""

 S ACDLOC="*ALL FACILITIES*"

 Q

2 ;On the fly selected facilities

 S ACDLOC="SELECTED FACILITIES"

 F  S DIC=4,DIC(0)="AEQ" D ^DIC G:Y<0 K I $D(^AUTTLOC(+Y,0)),$P(^(0),U,10)'="" S ACDFAC($P(^(0),U,10))=""

 Q

3 ;Category

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

 S ACDLOC="FACILITY CATEGORY: "_ACDFAC("C")

 I $D(^ACDFAC(+Y,1,0)) F ACDDA=0:0 S ACDDA=$O(^ACDFAC(+Y,1,ACDDA)) Q:'ACDDA  I $D(^(ACDDA,0)) S ACDFACP=^(0) I $D(^AUTTLOC(ACDFACP,0)),$P(^(0),U,10)'="" S ACDFAC($P(^(0),U,10))=""

 Q

K ;

 I '$D(ACDFAC) S ACDQUIT=1

 K DIC,DIR,ACDFACP,Y

ACDWFAC   ;IHS/ADC/EDE/KML - GET FACILITY TO RUN REPORTS;

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

 +2       ;;

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

 +4       ;//^ACDWRQ

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

 +6       ;determined. Run ALL or SELECTED or CATEGORY

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

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

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

 +10      ;

EN        ;

 +1        KILL ACDFAC,DIR

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

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

           DO ^DIR

           IF Y="^"

               GOTO K

           DO @Y

           DO K

           QUIT 

1         ;All facilities

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

 +2        SET ACDLOC="*ALL FACILITIES*"

 +3        QUIT 

2         ;On the fly selected facilities

 +1        SET ACDLOC="SELECTED FACILITIES"

 +2        FOR 

               SET DIC=4

               SET DIC(0)="AEQ"

               DO ^DIC

               IF Y<0

                   GOTO K

               IF $DATA(^AUTTLOC(+Y,0))

                   IF $PIECE(^(0),U,10)'=""

                       SET ACDFAC($PIECE(^(0),U,10))=""

 +3        QUIT 

3         ;Category

 +1        SET DIC="^ACDFAC("

           SET DIC(0)="AEQ"

           DO ^DIC

           IF Y<0

               GOTO K

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

 +2        SET ACDLOC="FACILITY CATEGORY: "_ACDFAC("C")

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

               FOR ACDDA=0:0

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

                   IF 'ACDDA

                       QUIT 

                   IF $DATA(^(ACDDA,0))

                       SET ACDFACP=^(0)

                       IF $DATA(^AUTTLOC(ACDFACP,0))

                           IF $PIECE(^(0),U,10)'=""

                               SET ACDFAC($PIECE(^(0),U,10))=""

 +4        QUIT 

K         ;

 +1        IF '$DATA(ACDFAC)

               SET ACDQUIT=1

 +2        KILL DIC,DIR,ACDFACP,Y