- ACDWAREA ;IHS/ADC/EDE/KML - GET AREA TO RUN REPORTS FOR 11/17/93;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;;
- ;************************************************************
- ;//^ACDWRQ
- ;User is running CDMIS reports by area. A futher breakdown is now
- ;determined. Run ALL or SELECTED or CATEGORY
- ;This routine will return a ACDAREA(array) that holds the
- ;2 digit code for the area's or "*ALL*"
- ;*************************************************************
- EN ;
- K ACDAREA,DIR
- S DIR(0)="S^1:Print 'ALL' areas;2:Print 'SELECTED' areas;3:Print a 'CATEGORY' of areas",DIR("A")="Area Print Criteria" D ^DIR S:X["^" ACDQUIT=1 G:$D(ACDQUIT) K D @Y,K Q
- 1 ;All areas
- S ACDLOC="*ALL AREAS*"
- S ACDAREA("*ALL*")=""
- Q
- 2 ;On the fly selected area's
- S ACDLOC="SELECTED AREAS:"
- F S DIC="^AUTTAREA(",DIC(0)="AEQ" D ^DIC G:Y<0 K I $D(^AUTTAREA(+Y,0)),$P(^(0),U,2)'="" S ACDAREA($P(^(0),U,2))=""
- Q
- 3 ;Category
- S DIC="^ACDAREA(",DIC(0)="AEQ" D ^DIC G:Y<0 K S ACDAREA("C")=$P(Y,U,2)
- S ACDLOC="AREA CATEGORY: "_ACDAREA("C")
- I $D(^ACDAREA(+Y,1,0)) F ACDDA=0:0 S ACDDA=$O(^ACDAREA(+Y,1,ACDDA)) Q:'ACDDA I $D(^(ACDDA,0)) S ACDAREAP=^(0) I $D(^AUTTAREA(ACDAREAP,0)),$P(^(0),U,2)'="" S ACDAREA($P(^(0),U,2))=""
- Q
- K ;
- I '$D(ACDAREA) S ACDQUIT=1
- K ACDAREAP,DIC,Y,DIR
- ACDWAREA ;IHS/ADC/EDE/KML - GET AREA TO RUN REPORTS FOR 11/17/93;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;;
- +3 ;************************************************************
- +4 ;//^ACDWRQ
- +5 ;User is running CDMIS reports by area. A futher breakdown is now
- +6 ;determined. Run ALL or SELECTED or CATEGORY
- +7 ;This routine will return a ACDAREA(array) that holds the
- +8 ;2 digit code for the area's or "*ALL*"
- +9 ;*************************************************************
- EN ;
- +1 KILL ACDAREA,DIR
- +2 SET DIR(0)="S^1:Print 'ALL' areas;2:Print 'SELECTED' areas;3:Print a 'CATEGORY' of areas"
- SET DIR("A")="Area Print Criteria"
- DO ^DIR
- IF X["^"
- SET ACDQUIT=1
- IF $DATA(ACDQUIT)
- GOTO K
- DO @Y
- DO K
- QUIT
- 1 ;All areas
- +1 SET ACDLOC="*ALL AREAS*"
- +2 SET ACDAREA("*ALL*")=""
- +3 QUIT
- 2 ;On the fly selected area's
- +1 SET ACDLOC="SELECTED AREAS:"
- +2 FOR
- SET DIC="^AUTTAREA("
- SET DIC(0)="AEQ"
- DO ^DIC
- IF Y<0
- GOTO K
- IF $DATA(^AUTTAREA(+Y,0))
- IF $PIECE(^(0),U,2)'=""
- SET ACDAREA($PIECE(^(0),U,2))=""
- +3 QUIT
- 3 ;Category
- +1 SET DIC="^ACDAREA("
- SET DIC(0)="AEQ"
- DO ^DIC
- IF Y<0
- GOTO K
- SET ACDAREA("C")=$PIECE(Y,U,2)
- +2 SET ACDLOC="AREA CATEGORY: "_ACDAREA("C")
- +3 IF $DATA(^ACDAREA(+Y,1,0))
- FOR ACDDA=0:0
- SET ACDDA=$ORDER(^ACDAREA(+Y,1,ACDDA))
- IF 'ACDDA
- QUIT
- IF $DATA(^(ACDDA,0))
- SET ACDAREAP=^(0)
- IF $DATA(^AUTTAREA(ACDAREAP,0))
- IF $PIECE(^(0),U,2)'=""
- SET ACDAREA($PIECE(^(0),U,2))=""
- +4 QUIT
- K ;
- +1 IF '$DATA(ACDAREA)
- SET ACDQUIT=1
- +2 KILL ACDAREAP,DIC,Y,DIR