ACDWDRV1 ;IHS/ADC/EDE/KML - DRV1 2941117;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
F K ACDQUIT D D I $D(ACDQUIT) D PRHDR^ACD G ^ACDWK
D ;
S ACDWDRV(1)=1
D PRHDR^ACD
;S:'$D(ACD27) $P(ACD27,"*",27)="*"
;W !,ACD27,!,"* INI/INF/FU/REPORTS *",!,ACD27
F I=1:1:15 W !,I," ",$P($T(@I),";",3) I I=15 S DIR(0)="L^1:15^S ACDRPTS=Y",DIR("A")="RUN REPORT # " W ! D ^DIR S:X["^"!($D(DTOUT)) ACDQUIT=1 Q:$D(ACDQUIT)
I $D(ACDQUIT) K ACDWDRV Q
D ^ACDWRQ I $D(ACDQUIT) K ACDQUIT Q
D ^ACDWQ ; call to XBDBQUE
Q
;
L ;EP - FOR TASKMAN
S ACDNW(1)=ACDTO,ACDNW(2)=ACDFR,ACDNW(3)=ACDLOC,ACDNW(4)=ACDRPTS
S ACDTO=ACDNW(1),ACDFR=ACDNW(2),ACDLOC=ACDNW(3)
D ACDV
Q
ACDV ;
K ^TMP("ACD",ACDJOB,ACDBT)
S ACDDO=0
F ACD=ACDFR-.01:0 S ACD=$O(^ACDVIS("B",ACD)) Q:'ACD!(ACD>ACDTO) D
. S ACDV=0 F S ACDV=$O(^ACDVIS("B",ACD,ACDV)) Q:'ACDV D
.. Q:$P(^ACDVIS(ACDV,0),U,4)="" ; prevent subscript error
.. Q:'$D(ACDCRST($P(^ACDVIS(ACDV,0),U,4))) ; type not wanted
.. S ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)=""
.. S ACD1=0 F S ACD1=$O(^ACDIIF("C",ACDV,ACD1)) Q:'ACD1 D
... S ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)=""
... Q
.. Q
. Q
Q
;
P ;EP - PRINT REPORT
K DIRUT
S ACDNW(1)=ACDTO,ACDNW(2)=ACDFR,ACDNW(3)=ACDLOC,ACDNW(4)=ACDRPTS
F ACDNW(0)=1:1:$L(ACDNW(4),",")-1 S ACDTO=ACDNW(1),ACDFR=ACDNW(2),ACDLOC=ACDNW(3),(ACDTG,ACDTGSUB)=$P(ACDNW(4),",",ACDNW(0)) D P2 Q:$D(DIRUT)
Q
;
P2 ;
S ACDV=0
F S ACDV=$O(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)) Q:'ACDV D Q:$D(DIRUT)
. S ACDDA=ACDV D ^ACDWVIS
. S ACD1=0
. F S ACD1=$O(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)) Q:'ACD1 D Q:$D(DIRUT)
.. S ACDDA=ACD1 D ^ACDWIIF
.. I ACDOK,ACDDFNP D @ACDTG
.. Q
. Q
Q:$D(DIRUT)
D HED
Q
;
HED ;
S ACDH(0)=$P($T(@ACDTG),";",3)_U_ACDLOC,ACDWDRV(1)=1 D HV^ACDWUTL
U IO D H S ACDTG="G"_ACDTG D @ACDTG
Q
H ;EP
D H^ACDWDRVA
Q
1 ;;COMPONENT CODE-TYPE/ SEX/ HOURS/ AGE RANGE/ UNIQ CLI/ # VIS (NEW V4)
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL_"/"_ACDCOMT,ACDSEX,ACDOTHRS,ACDAGER,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
2 ;;CT'S BY CONTACT TYPE
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
3 ;;CT'S BY DRUG TYPE
D C^ACDWUTL
S ACDDT="" F S ACDDT=$O(ACDDTA(ACDDT)) Q:ACDDT="" D
.S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDT,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
Q
4 ;;CT'S BY ACTUAL PLACEMENT
S ACDCBO=ACDPLAA_"/"_ACDPLAA1
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
5 ;;CT'S BY RECOMMENDED PLACEMENT
S ACDCBO=ACDPLAR_"/"_ACDPLAR1
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
6 ;;CT'S BY PRIMARY PROBLEM
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
7 ;;CT'S BY OTHER PROBLEM
D C1^ACDWUTL
S ACDPT="" F S ACDPT=$O(ACDPTA(ACDPT)) Q:ACDPT="" D
.S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPT,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
Q
8 ;;CT'S FOR OTHER PROBLEM WITHIN PRIMARY PROBLEM
;D C1^ACDWUTL
S ACDPT="" F S ACDPT=$O(ACDPTA(ACDPT)) Q:ACDPT="" D
.S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDPT,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
Q
9 ;;CT'S FOR AVE DAYS USED DRUGS WITHIN CONTACT TYPE
Q:$G(ACDDUD)=999
S:'ACDDUD ACDDUD=.1 S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUD)) ^(ACDDUD)="" S ^(ACDDUD)=^(ACDDUD)+1
Q
10 ;;CT'S FOR AVE DAYS USED ALCOHOL WITHIN CONTACT TYPE
Q:$G(ACDDUA)=999
S:'ACDDUA ACDDUA=.1 S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUA)) ^(ACDDUA)="" S ^(ACDDUA)=^(ACDDUA)+1
Q
11 ;;CT'S FOR DIFFERENCE REASONS WITHIN CONTACT TYPE
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDIF,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
13 ;;AVE CLIENT STAGE BY COMPONENT
S ACDADD=0,ACDADD=ACDSUS+ACDPS+ACDES+ACDSS+ACDBS+ACDCS Q:'ACDADD
S ACDCBO=ACDCOMCL_"/"_ACDCOMT
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDADD)) ^(ACDADD)="" S ^(ACDADD)=^(ACDADD)+6 Q
14 ;;PLACEMENT DIFFERENCE VOLUME
S ACDCBO=ACDPLAA_"/"_ACDPLAA1,ACDCOMB=ACDPLAR_"/"_ACDPLAR1
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMB,ACDCBO,ACDDIF)) ^(ACDDIF)="" S ^(ACDDIF)=^(ACDDIF)+1 Q
12 ;;DRUG TYPE/ AGE RANGE/ SEX/ ARRESTS / UNIQ CLI (NEW V4) (****)
Q:$G(ACDAAR)=999
S ACDDT="" F S ACDDT=$O(ACDDTA(ACDDT)) Q:ACDDT="" D
. S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDT,ACDAGER,ACDSEX,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+ACDAAR Q
Q
15 ;;CT'S BY HOSPITAL DAYS
Q:$G(ACDDH)=999
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+ACDDH Q
G2 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G3 S ACDC(1)="DRUG TYPE",ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G4 S ACDC(1)=ACDH(10),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G5 S ACDC(1)=ACDH(11),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G6 S ACDC(1)=ACDH(51),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G7 S ACDC(1)=ACDH(52),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G1 S ACDC(1)=ACDH(54),ACDC(2)=ACDH(53),ACDC(3)="HOURS",ACDC(4)=ACDH(21),ACDC(5)=ACDH(59),ACDC(6)=ACDH(7) D ^ACDWRP91 Q
G8 S ACDC(1)=ACDH(51),ACDC(2)=ACDH(52),ACDC(3)=ACDH(6),ACDC(4)=ACDH(7),ACDC(5)=ACDH(8) D ^ACDWRP6 Q
G9 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(12) D ^ACDWRP14 Q
G10 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(13) D ^ACDWRP14 Q
G11 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(14),ACDC(3)=ACDH(6),ACDC(4)=ACDH(7),ACDC(5)=ACDH(8) D ^ACDWRP6 Q
G13 S ACDC(1)=ACDH(55),ACDC(2)=ACDH(56) D ^ACDWRP13 Q
G14 S ACDC(1)=ACDH(11),ACDC(2)=ACDH(10),ACDC(3)=ACDH(14),ACDC(4)=ACDH(6) D ^ACDWRP15 Q
G12 S ACDC(1)="DRUG TYPE",ACDC(2)=ACDH(21),ACDC(3)=ACDH(53),ACDC(4)=ACDH(60),ACDC(5)=ACDH(59) D ^ACDWRP99 Q
G15 S ACDC(1)=ACDH(59),ACDC(2)=ACDH(61),ACDC(3)=ACDH(58) D ^ACDWRP4 Q
;
EOJ ;EP - EOJ FOR XBDBQUE
K ^TMP("ACD",ACDJOB,ACDBT)
LOCK -^TMP("ACD",ACDJOB,ACDBT)
K ACDNW,ACDQ,ACDFAC,ACDAREA,ACDSU,ACDTRB,ACDSTA,ACDCRST
K ACDAGE,ACDBT,ACDFOLL,ACDH,ACDHRS,ACDJOB,ACDOK,ACDOPT,ACDPLAAL,ACDPLARL,ACDPT,ACDSTAT,ACDTG,ACDTGSUB,ACDVET,ACDWDRV
Q
ACDWDRV1 ;IHS/ADC/EDE/KML - DRV1 2941117;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 FOR
KILL ACDQUIT
DO D
IF $DATA(ACDQUIT)
DO PRHDR^ACD
GOTO ^ACDWK
D ;
+1 SET ACDWDRV(1)=1
+2 DO PRHDR^ACD
+3 ;S:'$D(ACD27) $P(ACD27,"*",27)="*"
+4 ;W !,ACD27,!,"* INI/INF/FU/REPORTS *",!,ACD27
+5 FOR I=1:1:15
WRITE !,I," ",$PIECE($TEXT(@I),";",3)
IF I=15
SET DIR(0)="L^1:15^S ACDRPTS=Y"
SET DIR("A")="RUN REPORT # "
WRITE !
DO ^DIR
IF X["^"!($DATA(DTOUT))
SET ACDQUIT=1
IF $DATA(ACDQUIT)
QUIT
+6 IF $DATA(ACDQUIT)
KILL ACDWDRV
QUIT
+7 DO ^ACDWRQ
IF $DATA(ACDQUIT)
KILL ACDQUIT
QUIT
+8 ; call to XBDBQUE
DO ^ACDWQ
+9 QUIT
+10 ;
L ;EP - FOR TASKMAN
+1 SET ACDNW(1)=ACDTO
SET ACDNW(2)=ACDFR
SET ACDNW(3)=ACDLOC
SET ACDNW(4)=ACDRPTS
+2 SET ACDTO=ACDNW(1)
SET ACDFR=ACDNW(2)
SET ACDLOC=ACDNW(3)
+3 DO ACDV
+4 QUIT
ACDV ;
+1 KILL ^TMP("ACD",ACDJOB,ACDBT)
+2 SET ACDDO=0
+3 FOR ACD=ACDFR-.01:0
SET ACD=$ORDER(^ACDVIS("B",ACD))
IF 'ACD!(ACD>ACDTO)
QUIT
Begin DoDot:1
+4 SET ACDV=0
FOR
SET ACDV=$ORDER(^ACDVIS("B",ACD,ACDV))
IF 'ACDV
QUIT
Begin DoDot:2
+5 ; prevent subscript error
IF $PIECE(^ACDVIS(ACDV,0),U,4)=""
QUIT
+6 ; type not wanted
IF '$DATA(ACDCRST($PIECE(^ACDVIS(ACDV,0),U,4)))
QUIT
+7 SET ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)=""
+8 SET ACD1=0
FOR
SET ACD1=$ORDER(^ACDIIF("C",ACDV,ACD1))
IF 'ACD1
QUIT
Begin DoDot:3
+9 SET ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)=""
+10 QUIT
End DoDot:3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
P ;EP - PRINT REPORT
+1 KILL DIRUT
+2 SET ACDNW(1)=ACDTO
SET ACDNW(2)=ACDFR
SET ACDNW(3)=ACDLOC
SET ACDNW(4)=ACDRPTS
+3 FOR ACDNW(0)=1:1:$LENGTH(ACDNW(4),",")-1
SET ACDTO=ACDNW(1)
SET ACDFR=ACDNW(2)
SET ACDLOC=ACDNW(3)
SET (ACDTG,ACDTGSUB)=$PIECE(ACDNW(4),",",ACDNW(0))
DO P2
IF $DATA(DIRUT)
QUIT
+4 QUIT
+5 ;
P2 ;
+1 SET ACDV=0
+2 FOR
SET ACDV=$ORDER(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV))
IF 'ACDV
QUIT
Begin DoDot:1
+3 SET ACDDA=ACDV
DO ^ACDWVIS
+4 SET ACD1=0
+5 FOR
SET ACD1=$ORDER(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1))
IF 'ACD1
QUIT
Begin DoDot:2
+6 SET ACDDA=ACD1
DO ^ACDWIIF
+7 IF ACDOK
IF ACDDFNP
DO @ACDTG
+8 QUIT
End DoDot:2
IF $DATA(DIRUT)
QUIT
+9 QUIT
End DoDot:1
IF $DATA(DIRUT)
QUIT
+10 IF $DATA(DIRUT)
QUIT
+11 DO HED
+12 QUIT
+13 ;
HED ;
+1 SET ACDH(0)=$PIECE($TEXT(@ACDTG),";",3)_U_ACDLOC
SET ACDWDRV(1)=1
DO HV^ACDWUTL
+2 USE IO
DO H
SET ACDTG="G"_ACDTG
DO @ACDTG
+3 QUIT
H ;EP
+1 DO H^ACDWDRVA
+2 QUIT
1 ;;COMPONENT CODE-TYPE/ SEX/ HOURS/ AGE RANGE/ UNIQ CLI/ # VIS (NEW V4)
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL_"/"_ACDCOMT,ACDSEX,ACDOTHRS,ACDAGER,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
2 ;;CT'S BY CONTACT TYPE
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
3 ;;CT'S BY DRUG TYPE
+1 DO C^ACDWUTL
+2 SET ACDDT=""
FOR
SET ACDDT=$ORDER(ACDDTA(ACDDT))
IF ACDDT=""
QUIT
Begin DoDot:1
+3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDT,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
End DoDot:1
+4 QUIT
4 ;;CT'S BY ACTUAL PLACEMENT
+1 SET ACDCBO=ACDPLAA_"/"_ACDPLAA1
+2 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
5 ;;CT'S BY RECOMMENDED PLACEMENT
+1 SET ACDCBO=ACDPLAR_"/"_ACDPLAR1
+2 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
6 ;;CT'S BY PRIMARY PROBLEM
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
7 ;;CT'S BY OTHER PROBLEM
+1 DO C1^ACDWUTL
+2 SET ACDPT=""
FOR
SET ACDPT=$ORDER(ACDPTA(ACDPT))
IF ACDPT=""
QUIT
Begin DoDot:1
+3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPT,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
End DoDot:1
+4 QUIT
8 ;;CT'S FOR OTHER PROBLEM WITHIN PRIMARY PROBLEM
+1 ;D C1^ACDWUTL
+2 SET ACDPT=""
FOR
SET ACDPT=$ORDER(ACDPTA(ACDPT))
IF ACDPT=""
QUIT
Begin DoDot:1
+3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDPT,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
End DoDot:1
+4 QUIT
9 ;;CT'S FOR AVE DAYS USED DRUGS WITHIN CONTACT TYPE
+1 IF $GET(ACDDUD)=999
QUIT
+2 IF 'ACDDUD
SET ACDDUD=.1
IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUD))
SET ^(ACDDUD)=""
SET ^(ACDDUD)=^(ACDDUD)+1
+3 QUIT
10 ;;CT'S FOR AVE DAYS USED ALCOHOL WITHIN CONTACT TYPE
+1 IF $GET(ACDDUA)=999
QUIT
+2 IF 'ACDDUA
SET ACDDUA=.1
IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUA))
SET ^(ACDDUA)=""
SET ^(ACDDUA)=^(ACDDUA)+1
+3 QUIT
11 ;;CT'S FOR DIFFERENCE REASONS WITHIN CONTACT TYPE
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDIF,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
13 ;;AVE CLIENT STAGE BY COMPONENT
+1 SET ACDADD=0
SET ACDADD=ACDSUS+ACDPS+ACDES+ACDSS+ACDBS+ACDCS
IF 'ACDADD
QUIT
+2 SET ACDCBO=ACDCOMCL_"/"_ACDCOMT
+3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDADD))
SET ^(ACDADD)=""
SET ^(ACDADD)=^(ACDADD)+6
QUIT
14 ;;PLACEMENT DIFFERENCE VOLUME
+1 SET ACDCBO=ACDPLAA_"/"_ACDPLAA1
SET ACDCOMB=ACDPLAR_"/"_ACDPLAR1
+2 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMB,ACDCBO,ACDDIF))
SET ^(ACDDIF)=""
SET ^(ACDDIF)=^(ACDDIF)+1
QUIT
12 ;;DRUG TYPE/ AGE RANGE/ SEX/ ARRESTS / UNIQ CLI (NEW V4) (****)
+1 IF $GET(ACDAAR)=999
QUIT
+2 SET ACDDT=""
FOR
SET ACDDT=$ORDER(ACDDTA(ACDDT))
IF ACDDT=""
QUIT
Begin DoDot:1
+3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDT,ACDAGER,ACDSEX,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+ACDAAR
QUIT
End DoDot:1
+4 QUIT
15 ;;CT'S BY HOSPITAL DAYS
+1 IF $GET(ACDDH)=999
QUIT
+2 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+ACDDH
QUIT
G2 SET ACDC(1)=ACDH(9)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G3 SET ACDC(1)="DRUG TYPE"
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G4 SET ACDC(1)=ACDH(10)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G5 SET ACDC(1)=ACDH(11)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G6 SET ACDC(1)=ACDH(51)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G7 SET ACDC(1)=ACDH(52)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G1 SET ACDC(1)=ACDH(54)
SET ACDC(2)=ACDH(53)
SET ACDC(3)="HOURS"
SET ACDC(4)=ACDH(21)
SET ACDC(5)=ACDH(59)
SET ACDC(6)=ACDH(7)
DO ^ACDWRP91
QUIT
G8 SET ACDC(1)=ACDH(51)
SET ACDC(2)=ACDH(52)
SET ACDC(3)=ACDH(6)
SET ACDC(4)=ACDH(7)
SET ACDC(5)=ACDH(8)
DO ^ACDWRP6
QUIT
G9 SET ACDC(1)=ACDH(9)
SET ACDC(2)=ACDH(12)
DO ^ACDWRP14
QUIT
G10 SET ACDC(1)=ACDH(9)
SET ACDC(2)=ACDH(13)
DO ^ACDWRP14
QUIT
G11 SET ACDC(1)=ACDH(9)
SET ACDC(2)=ACDH(14)
SET ACDC(3)=ACDH(6)
SET ACDC(4)=ACDH(7)
SET ACDC(5)=ACDH(8)
DO ^ACDWRP6
QUIT
G13 SET ACDC(1)=ACDH(55)
SET ACDC(2)=ACDH(56)
DO ^ACDWRP13
QUIT
G14 SET ACDC(1)=ACDH(11)
SET ACDC(2)=ACDH(10)
SET ACDC(3)=ACDH(14)
SET ACDC(4)=ACDH(6)
DO ^ACDWRP15
QUIT
G12 SET ACDC(1)="DRUG TYPE"
SET ACDC(2)=ACDH(21)
SET ACDC(3)=ACDH(53)
SET ACDC(4)=ACDH(60)
SET ACDC(5)=ACDH(59)
DO ^ACDWRP99
QUIT
G15 SET ACDC(1)=ACDH(59)
SET ACDC(2)=ACDH(61)
SET ACDC(3)=ACDH(58)
DO ^ACDWRP4
QUIT
+1 ;
EOJ ;EP - EOJ FOR XBDBQUE
+1 KILL ^TMP("ACD",ACDJOB,ACDBT)
+2 LOCK -^TMP("ACD",ACDJOB,ACDBT)
+3 KILL ACDNW,ACDQ,ACDFAC,ACDAREA,ACDSU,ACDTRB,ACDSTA,ACDCRST
+4 KILL ACDAGE,ACDBT,ACDFOLL,ACDH,ACDHRS,ACDJOB,ACDOK,ACDOPT,ACDPLAAL,ACDPLARL,ACDPT,ACDSTAT,ACDTG,ACDTGSUB,ACDVET,ACDWDRV
+5 QUIT
