ACDWDRV4 ;IHS/ADC/EDE/KML - DRV 4 FOR REPORTS (ACDCS GLOBAL);
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;//[ACDR2MENU]
F K ACDQUIT D DIR I $D(ACDQUIT) D PRHDR^ACD G ^ACDWK
DIR ;Menu
S ACDWDRV(4)=4
D PRHDR^ACD
;S:'$D(ACD26) $P(ACD26,"*",26)="*"
;W !,ACD26,!,"* CLIENT SERVICE REPORTS *",!,ACD26,!
F I=200:1:205 W !,I," ",$P($T(@I),";",3) I I=205 S DIR(0)="L^200:205^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
S ACDFR=$E(ACDFR,1,5)_"00" ; CS visits in the B x-ref of the visit file need to be found so date string needs manipulation
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)'="CS" ; type not wanted
.. S ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)=""
.. S ACD1=0
.. F S ACD1=$O(^ACDCS("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 ^ACDWCS
.. I ACDOK,ACDDFNP D @ACDTG
.. Q
. Q
D HED
Q
;
HED ;Set header variables
S ACDH(0)=$P($T(@ACDTG),";",3)_U_ACDLOC,ACDWDRV(4)=4 D HV^ACDWUTL
U IO D H S ACDTG="G"_ACDTG D @ACDTG Q
H ;EP
W @IOF,!,"CDMIS CLIENT SERVICE 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
200 ;;UNIQUE CLIENT COUNT AND TOTAL VISITS
S:'$D(ACDCNT) ACDCNT=0 S:'$D(ACDUNIQ) ACDUNIQ=0 S ACDCNT=ACDCNT+1 S:'$D(ACDDFNA(ACDDFNP)) ACDDFNA(ACDDFNP)="",ACDUNIQ=ACDUNIQ+1
Q
;
201 ;;HOUR BY COMPONENT TYPE
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMTL)) ^(ACDCOMTL)="" S ^(ACDCOMTL)=^(ACDCOMTL)+ACDHOUR Q
202 ;;NUMBER SERVED AND HOUR BY COMPONENT TYPE
I ACDHOUR S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMTL,ACDHOUR,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
Q
203 ;;INPATIENT/OUTPATIENT/OTHER/NONE HOUR
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL)) ^(ACDCOMCL)="" S ^(ACDCOMCL)=^(ACDCOMCL)+ACDHOUR Q
204 ;;SERVICE/ACTIVITY BREAK-OUT BY COMPONENT
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL,ACDSVAC,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
205 ;;COMPONENT CODE & TYPE /HOURS/ UNIQUE CLIENTS/ NUMBER VISITS (NEW V4)
S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL_"/"_ACDCOMT,ACDHOUR,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
G200 S:$G(ACDUNIQ) ^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDUNIQ)=ACDCNT S ACDC(1)="UNIQUE CLIENT COUNT",ACDC(2)="VISIT COUNT" S ACDWDRV(4)=1 D ^ACDWRP2 Q
G201 S ACDC(1)="COMPONENT TYPE",ACDC(2)="HOUR COUNT" S ACDWDRV(4)=1 D ^ACDWRP2 Q
G202 S ACDC(1)="COMPONENT TYPE",ACDC(2)="HOUR COUNT",ACDC(3)="#CLIENTS",ACDC(4)=ACDH(7),ACDC(5)=ACDH(8) S ACDWDRV(4)=1 D ^ACDWRP6 Q
G203 S ACDC(1)="INP/OUT/OTHER/NONE",ACDC(2)="HOUR COUNT" S ACDWDRV(4)=1 D ^ACDWRP2 Q
G204 ;
S ACDC(1)=ACDH(54),ACDC(2)="SVC/ACT",ACDC(3)=ACDH(6),ACDC(4)=ACDH(7),ACDC(5)=ACDH(8) D ^ACDWRP3 Q
G205 ;
S ACDC(1)=ACDH(20),ACDC(2)="HOURS",ACDC(3)=ACDH(59),ACDC(4)=ACDH(7) D ^ACDWRP50 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
ACDWDRV4 ;IHS/ADC/EDE/KML - DRV 4 FOR REPORTS (ACDCS GLOBAL);
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;//[ACDR2MENU]
+3 FOR
KILL ACDQUIT
DO DIR
IF $DATA(ACDQUIT)
DO PRHDR^ACD
GOTO ^ACDWK
DIR ;Menu
+1 SET ACDWDRV(4)=4
+2 DO PRHDR^ACD
+3 ;S:'$D(ACD26) $P(ACD26,"*",26)="*"
+4 ;W !,ACD26,!,"* CLIENT SERVICE REPORTS *",!,ACD26,!
+5 FOR I=200:1:205
WRITE !,I," ",$PIECE($TEXT(@I),";",3)
IF I=205
SET DIR(0)="L^200:205^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
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 ; CS visits in the B x-ref of the visit file need to be found so date string needs manipulation
SET ACDFR=$EXTRACT(ACDFR,1,5)_"00"
+4 FOR ACD=ACDFR-.01:0
SET ACD=$ORDER(^ACDVIS("B",ACD))
IF 'ACD!(ACD>ACDTO)
QUIT
Begin DoDot:1
+5 SET ACDV=0
+6 FOR
SET ACDV=$ORDER(^ACDVIS("B",ACD,ACDV))
IF 'ACDV
QUIT
Begin DoDot:2
+7 ; type not wanted
IF $PIECE(^ACDVIS(ACDV,0),U,4)'="CS"
QUIT
+8 SET ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)=""
+9 SET ACD1=0
+10 FOR
SET ACD1=$ORDER(^ACDCS("C",ACDV,ACD1))
IF 'ACD1
QUIT
Begin DoDot:3
+11 SET ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)=""
+12 QUIT
End DoDot:3
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
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 ^ACDWCS
+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 DO HED
+11 QUIT
+12 ;
HED ;Set header variables
+1 SET ACDH(0)=$PIECE($TEXT(@ACDTG),";",3)_U_ACDLOC
SET ACDWDRV(4)=4
DO HV^ACDWUTL
+2 USE IO
DO H
SET ACDTG="G"_ACDTG
DO @ACDTG
QUIT
H ;EP
+1 WRITE @IOF,!,"CDMIS CLIENT SERVICE 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
200 ;;UNIQUE CLIENT COUNT AND TOTAL VISITS
+1 IF '$DATA(ACDCNT)
SET ACDCNT=0
IF '$DATA(ACDUNIQ)
SET ACDUNIQ=0
SET ACDCNT=ACDCNT+1
IF '$DATA(ACDDFNA(ACDDFNP))
SET ACDDFNA(ACDDFNP)=""
SET ACDUNIQ=ACDUNIQ+1
+2 QUIT
+3 ;
201 ;;HOUR BY COMPONENT TYPE
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMTL))
SET ^(ACDCOMTL)=""
SET ^(ACDCOMTL)=^(ACDCOMTL)+ACDHOUR
QUIT
202 ;;NUMBER SERVED AND HOUR BY COMPONENT TYPE
+1 IF ACDHOUR
IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMTL,ACDHOUR,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
+2 QUIT
203 ;;INPATIENT/OUTPATIENT/OTHER/NONE HOUR
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL))
SET ^(ACDCOMCL)=""
SET ^(ACDCOMCL)=^(ACDCOMCL)+ACDHOUR
QUIT
204 ;;SERVICE/ACTIVITY BREAK-OUT BY COMPONENT
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL,ACDSVAC,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
205 ;;COMPONENT CODE & TYPE /HOURS/ UNIQUE CLIENTS/ NUMBER VISITS (NEW V4)
+1 IF '$DATA(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMCL_"/"_ACDCOMT,ACDHOUR,ACDDFNP))
SET ^(ACDDFNP)=""
SET ^(ACDDFNP)=^(ACDDFNP)+1
QUIT
G200 IF $GET(ACDUNIQ)
SET ^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDUNIQ)=ACDCNT
SET ACDC(1)="UNIQUE CLIENT COUNT"
SET ACDC(2)="VISIT COUNT"
SET ACDWDRV(4)=1
DO ^ACDWRP2
QUIT
G201 SET ACDC(1)="COMPONENT TYPE"
SET ACDC(2)="HOUR COUNT"
SET ACDWDRV(4)=1
DO ^ACDWRP2
QUIT
G202 SET ACDC(1)="COMPONENT TYPE"
SET ACDC(2)="HOUR COUNT"
SET ACDC(3)="#CLIENTS"
SET ACDC(4)=ACDH(7)
SET ACDC(5)=ACDH(8)
SET ACDWDRV(4)=1
DO ^ACDWRP6
QUIT
G203 SET ACDC(1)="INP/OUT/OTHER/NONE"
SET ACDC(2)="HOUR COUNT"
SET ACDWDRV(4)=1
DO ^ACDWRP2
QUIT
G204 ;
+1 SET ACDC(1)=ACDH(54)
SET ACDC(2)="SVC/ACT"
SET ACDC(3)=ACDH(6)
SET ACDC(4)=ACDH(7)
SET ACDC(5)=ACDH(8)
DO ^ACDWRP3
QUIT
G205 ;
+1 SET ACDC(1)=ACDH(20)
SET ACDC(2)="HOURS"
SET ACDC(3)=ACDH(59)
SET ACDC(4)=ACDH(7)
DO ^ACDWRP50
QUIT
+2 ;
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
