- ACDWSU ;IHS/ADC/EDE/KML - GET SERVICE UNIT TO RUN REPORT;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;;
- ;**********************************************************
- ;//^ACDWRQ
- ;User is running reports by service units. A futher breakdown is now
- ;determined. Run ALL or SELECTED or CATEGORY
- ;This routine will return a ACDSU(array) that holds the
- ;four digit code associated with the area survice unit or "*ALL*"
- ;************************************************************
- EN ;
- K ACDSU,DIR
- S DIR(0)="S^1:Print 'ALL' service units;2:Print 'SELECTED' service units;3:Print 'CATEGORY' of service units",DIR("A")="Service Unit Print Criteria" D ^DIR S:X["^" ACDQUIT=1 G:$D(ACDQUIT) K D @Y,K Q
- 1 ;All service units
- S ACDLOC="*ALL SERVICE UNITS*"
- S ACDSU("*ALL*")=""
- Q
- 2 ;On the fly selected service units
- S ACDLOC="SELECTED SERVICE UNITS:"
- F S DIC="^AUTTSU(",DIC(0)="AEQ" D ^DIC G:Y<0 K I $D(^AUTTSU(+Y,0)),$P(^(0),U,4)'="" S ACDSU($P(^(0),U,4))=""
- Q
- 3 ;Category of service units
- S DIC="^ACDSU(",DIC(0)="AEQ" D ^DIC G:Y<0 K S ACDSU("C")=$P(Y,U,2)
- S ACDLOC="SERVICE UNIT CATEGORY: "_ACDSU("C")
- I $D(^ACDSU(+Y,1,0)) F ACDDA=0:0 S ACDDA=$O(^ACDSU(+Y,1,ACDDA)) Q:'ACDDA I $D(^(ACDDA,0)) S ACDSUP=^(0) I $D(^AUTTSU(ACDSUP,0)),$P(^(0),U,4)'="" S ACDSU($P(^(0),U,4))=""
- Q
- K ;
- I '$D(ACDSU) S ACDQUIT=1
- K ACDSUP,DIC,DIR,Y
- ACDWSU ;IHS/ADC/EDE/KML - GET SERVICE UNIT TO RUN REPORT;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;;
- +3 ;**********************************************************
- +4 ;//^ACDWRQ
- +5 ;User is running reports by service units. A futher breakdown is now
- +6 ;determined. Run ALL or SELECTED or CATEGORY
- +7 ;This routine will return a ACDSU(array) that holds the
- +8 ;four digit code associated with the area survice unit or "*ALL*"
- +9 ;************************************************************
- EN ;
- +1 KILL ACDSU,DIR
- +2 SET DIR(0)="S^1:Print 'ALL' service units;2:Print 'SELECTED' service units;3:Print 'CATEGORY' of service units"
- SET DIR("A")="Service Unit Print Criteria"
- DO ^DIR
- IF X["^"
- SET ACDQUIT=1
- IF $DATA(ACDQUIT)
- GOTO K
- DO @Y
- DO K
- QUIT
- 1 ;All service units
- +1 SET ACDLOC="*ALL SERVICE UNITS*"
- +2 SET ACDSU("*ALL*")=""
- +3 QUIT
- 2 ;On the fly selected service units
- +1 SET ACDLOC="SELECTED SERVICE UNITS:"
- +2 FOR
- SET DIC="^AUTTSU("
- SET DIC(0)="AEQ"
- DO ^DIC
- IF Y<0
- GOTO K
- IF $DATA(^AUTTSU(+Y,0))
- IF $PIECE(^(0),U,4)'=""
- SET ACDSU($PIECE(^(0),U,4))=""
- +3 QUIT
- 3 ;Category of service units
- +1 SET DIC="^ACDSU("
- SET DIC(0)="AEQ"
- DO ^DIC
- IF Y<0
- GOTO K
- SET ACDSU("C")=$PIECE(Y,U,2)
- +2 SET ACDLOC="SERVICE UNIT CATEGORY: "_ACDSU("C")
- +3 IF $DATA(^ACDSU(+Y,1,0))
- FOR ACDDA=0:0
- SET ACDDA=$ORDER(^ACDSU(+Y,1,ACDDA))
- IF 'ACDDA
- QUIT
- IF $DATA(^(ACDDA,0))
- SET ACDSUP=^(0)
- IF $DATA(^AUTTSU(ACDSUP,0))
- IF $PIECE(^(0),U,4)'=""
- SET ACDSU($PIECE(^(0),U,4))=""
- +4 QUIT
- K ;
- +1 IF '$DATA(ACDSU)
- SET ACDQUIT=1
- +2 KILL ACDSUP,DIC,DIR,Y
