ACDWDRV2 ; IHS/ADC/EDE/KML - DRV 2 FOR RPTS FROM ^ACDTDC 10:14 NOV 17,1993 ;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;//[ACDR3MENU]
;//[ACDR3MENU]
F K ACDQUIT D DIR I $D(ACDQUIT) D PRHDR^ACD G ^ACDWK
DIR ;Menu
S ACDWDRV(2)=2
D PRHDR^ACD
;S:'$D(ACD20) $P(ACD20,"*",20)="*"
;W !,ACD20,!,"* T/ D/ C/ REPORTS *",!,ACD20
F I=50:1:65 W !,I," ",$P($T(@I),";",3) I I=65 S DIR(0)="L^50:65^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 TM entry
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 ;Visit
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
.. S ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)=""
.. S ACD1=0
.. F S ACD1=$O(^ACDTDC("C",ACDV,ACD1)) Q:'ACD1 S ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)=""
.. 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 ^ACDWTDC
.. I ACDOK,ACDDFNP D @ACDTG
.. Q
. Q
Q:$D(DIRUT)
D HED
Q
;
HED ;H-vars
S ACDH(0)=$P($T(@ACDTG),";",3)_U_ACDLOC,ACDWDRV(2)=2 D HV^ACDWUTL
U IO D H S ACDTG="G"_ACDTG D @ACDTG Q
H ;EP
W @IOF,!,"CDMIS T/ D/ C REPORT # "_$S(ACDTG:ACDTG,1:$E(ACDTG,2,6)),!,$P(ACDH(0),U) S ACDH(3)=ACDH(3)+1 W ?68,"PG ",ACDH(3),!,ACDH(50),$P(ACDH(0),U,2) D ASF^ACDWUTL W !,"DATA CAPTURED FOR: ",ACDH(2),!,ACDH(4),!
Q
50 ;;CT'S WITH A DISCHARGE/AFTERCARE PLAN
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDAP,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
51 ;;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
52 ;;CT'S BY T/ D/ C/ REASON
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDTDCR,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
53 ;;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
54 ;;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
55 ;;CT'S BY DIFFERENCE REASON
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDIF,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
56 ;;CT'S BY GOAL TREATMENT STATUS
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDGA,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
57 ;;CT'S FOR AVE DAYS USED DRUGS WITHIN CONTACT
S:'ACDDUD ACDDUD=.1 S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUD)) ^(ACDDUD)="" S ^(ACDDUD)=^(ACDDUD)+1 Q
58 ;;CT'S FOR AVE DAYS USED ALCOHOL WITHIN CONTACT
S:'ACDDUA ACDDUA=.1 S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUA)) ^(ACDDUA)="" S ^(ACDDUA)=^(ACDDUA)+1 Q
59 ;;CT'S BY ALCOHOL/DRUG RELATED ARRESTS
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+ACDAAR Q
60 ;;AVE CLIENT STAGE BY COMPONENT
S ACDCBO=ACDCOMCL_"/"_ACDCOMT
S ACDADD=0 S ACDADD=ACDSUS+ACDPS+ACDES+ACDSS+ACDCS+ACDBS Q:'ACDADD
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDADD)) ^(ACDADD)="" S ^(ACDADD)=^(ACDADD)+6 Q
61 ;;CT'S BY HOSPITAL DAYS
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+ACDDH Q
62 ;;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
63 ;;CT'S BY PRIMARY PROBLEM
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
64 ;;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
;
65 ;;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
;
G50 S ACDC(1)="DISCHARGE PLAN",ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G51 S ACDC(1)="DRUG TYPE",ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G52 S ACDC(1)="T/ D/ C/ REASON",ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G53 S ACDC(1)=ACDH(10),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G54 S ACDC(1)=ACDH(11),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G55 S ACDC(1)=ACDH(14),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G56 S ACDC(1)="GOAL TREATMENT STATUS",ACDC(3)=ACDH(7),ACDC(4)=ACDH(8),ACDC(2)=ACDH(6) D ^ACDWRP5 Q
G57 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(12) D ^ACDWRP14 Q
G58 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(13) D ^ACDWRP14 Q
G59 S ACDC(1)=ACDH(59),ACDC(2)=ACDH(60),ACDC(3)=ACDH(57) D ^ACDWRP4 Q
G60 S ACDC(1)=ACDH(55),ACDC(2)=ACDH(56) D ^ACDWRP13 Q
G61 S ACDC(1)=ACDH(59),ACDC(2)=ACDH(61),ACDC(3)=ACDH(58) D ^ACDWRP4 Q
G62 S ACDC(1)=ACDH(11),ACDC(2)=ACDH(10),ACDC(3)=ACDH(14),ACDC(4)=ACDH(6) D ^ACDWRP15 Q
G63 S ACDC(1)=ACDH(51),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G64 S ACDC(1)=ACDH(52),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
G65 S ACDC(1)=ACDH(51),ACDC(2)=ACDH(52),ACDC(3)=ACDH(6),ACDC(4)=ACDH(7),ACDC(5)=ACDH(8) D ^ACDWRP6 Q
;
EOJ ;EP - EOJ FOR XBDBQUE
K ^TMP("ACD",ACDJOB,ACDBT)
LOCK -^TMP("ACD",ACDJOB,ACDBT)
K ACDNW,ACDQ,ACDFAC,ACDAREA,ACDSU,ACDTRB,ACDSTA
K ACDAGE,ACDBT,ACDFOLL,ACDH,ACDHRS,ACDJOB,ACDOK,ACDOPT,ACDPLAAL,ACDPLARL,ACDPT,ACDSTAT,ACDTG,ACDTGSUB,ACDVET,ACDWDRV
Q
ACDWDRV2 ; IHS/ADC/EDE/KML - DRV 2 FOR RPTS FROM ^ACDTDC 10:14 NOV 17,1993 ;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;//[ACDR3MENU]
+3 ;//[ACDR3MENU]
+4 FOR
KILL ACDQUIT
DO DIR
IF $DATA(ACDQUIT)
DO PRHDR^ACD
GOTO ^ACDWK
DIR ;Menu
+1 SET ACDWDRV(2)=2
+2 DO PRHDR^ACD
+3 ;S:'$D(ACD20) $P(ACD20,"*",20)="*"
+4 ;W !,ACD20,!,"* T/ D/ C/ REPORTS *",!,ACD20
+5 FOR I=50:1:65
WRITE !,I," ",$PIECE($TEXT(@I),";",3)
IF I=65
SET DIR(0)="L^50:65^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 TM entry
+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
+5 ;
ACDV ;Visit
+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
+5 FOR
SET ACDV=$ORDER(^ACDVIS("B",ACD,ACDV))
IF 'ACDV
QUIT
Begin DoDot:2
+6 SET ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)=""
+7 SET ACD1=0
+8 FOR
SET ACD1=$ORDER(^ACDTDC("C",ACDV,ACD1))
IF 'ACD1
QUIT
SET ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)=""
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
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 ^ACDWTDC
+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 ;H-vars
+1 SET ACDH(0)=$PIECE($TEXT(@ACDTG),";",3)_U_ACDLOC
SET ACDWDRV(2)=2
DO HV^ACDWUTL
+2 USE IO
DO H
SET ACDTG="G"_ACDTG
DO @ACDTG
QUIT
H ;EP
+1 WRITE @IOF,!,"CDMIS T/ D/ C REPORT # "_$SELECT(ACDTG:ACDTG,1:$EXTRACT(ACDTG,2,6)),!,$PIECE(ACDH(0),U)
SET ACDH(3)=ACDH(3)+1
WRITE ?68,"PG ",ACDH(3),!,ACDH(50),$PIECE(ACDH(0),U,2)
DO ASF^ACDWUTL
WRITE !,"DATA CAPTURED FOR: ",ACDH(2),!,ACDH(4),!
+2 QUIT
50 ;;CT'S WITH A DISCHARGE/AFTERCARE PLAN
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDAP,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
51 ;;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
52 ;;CT'S BY T/ D/ C/ REASON
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDTDCR,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
53 ;;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
54 ;;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
55 ;;CT'S BY DIFFERENCE REASON
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDIF,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
56 ;;CT'S BY GOAL TREATMENT STATUS
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDGA,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
57 ;;CT'S FOR AVE DAYS USED DRUGS WITHIN CONTACT
+1 IF 'ACDDUD
SET ACDDUD=.1
IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUD))
SET ^(ACDDUD)=""
SET ^(ACDDUD)=^(ACDDUD)+1
QUIT
58 ;;CT'S FOR AVE DAYS USED ALCOHOL WITHIN CONTACT
+1 IF 'ACDDUA
SET ACDDUA=.1
IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUA))
SET ^(ACDDUA)=""
SET ^(ACDDUA)=^(ACDDUA)+1
QUIT
59 ;;CT'S BY ALCOHOL/DRUG RELATED ARRESTS
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+ACDAAR
QUIT
60 ;;AVE CLIENT STAGE BY COMPONENT
+1 SET ACDCBO=ACDCOMCL_"/"_ACDCOMT
+2 SET ACDADD=0
SET ACDADD=ACDSUS+ACDPS+ACDES+ACDSS+ACDCS+ACDBS
IF 'ACDADD
QUIT
+3 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDADD))
SET ^(ACDADD)=""
SET ^(ACDADD)=^(ACDADD)+6
QUIT
61 ;;CT'S BY HOSPITAL DAYS
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+ACDDH
QUIT
62 ;;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
63 ;;CT'S BY PRIMARY PROBLEM
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
64 ;;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
+5 ;
65 ;;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
+5 ;
G50 SET ACDC(1)="DISCHARGE PLAN"
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G51 SET ACDC(1)="DRUG TYPE"
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G52 SET ACDC(1)="T/ D/ C/ REASON"
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G53 SET ACDC(1)=ACDH(10)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G54 SET ACDC(1)=ACDH(11)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G55 SET ACDC(1)=ACDH(14)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G56 SET ACDC(1)="GOAL TREATMENT STATUS"
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
SET ACDC(2)=ACDH(6)
DO ^ACDWRP5
QUIT
G57 SET ACDC(1)=ACDH(9)
SET ACDC(2)=ACDH(12)
DO ^ACDWRP14
QUIT
G58 SET ACDC(1)=ACDH(9)
SET ACDC(2)=ACDH(13)
DO ^ACDWRP14
QUIT
G59 SET ACDC(1)=ACDH(59)
SET ACDC(2)=ACDH(60)
SET ACDC(3)=ACDH(57)
DO ^ACDWRP4
QUIT
G60 SET ACDC(1)=ACDH(55)
SET ACDC(2)=ACDH(56)
DO ^ACDWRP13
QUIT
G61 SET ACDC(1)=ACDH(59)
SET ACDC(2)=ACDH(61)
SET ACDC(3)=ACDH(58)
DO ^ACDWRP4
QUIT
G62 SET ACDC(1)=ACDH(11)
SET ACDC(2)=ACDH(10)
SET ACDC(3)=ACDH(14)
SET ACDC(4)=ACDH(6)
DO ^ACDWRP15
QUIT
G63 SET ACDC(1)=ACDH(51)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G64 SET ACDC(1)=ACDH(52)
SET ACDC(2)=ACDH(6)
SET ACDC(3)=ACDH(7)
SET ACDC(4)=ACDH(8)
DO ^ACDWRP5
QUIT
G65 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
+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
+4 KILL ACDAGE,ACDBT,ACDFOLL,ACDH,ACDHRS,ACDJOB,ACDOK,ACDOPT,ACDPLAAL,ACDPLARL,ACDPT,ACDSTAT,ACDTG,ACDTGSUB,ACDVET,ACDWDRV
+5 QUIT
