Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACDWDRV2

ACDWDRV2.m

Go to the documentation of this file. 
  1. 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
  1.  ;//[ACDR3MENU]
  1.  ;//[ACDR3MENU]
  1.  F  K ACDQUIT D DIR I $D(ACDQUIT) D PRHDR^ACD G ^ACDWK
  1. DIR ;Menu
  1.  S ACDWDRV(2)=2
  1.  D PRHDR^ACD
  1.  ;S:'$D(ACD20) $P(ACD20,"*",20)="*"
  1.  ;W !,ACD20,!,"* T/ D/ C/ REPORTS *",!,ACD20
  1.  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)
  1.  I $D(ACDQUIT) K ACDWDRV Q
  1.  D ^ACDWRQ I $D(ACDQUIT) K ACDQUIT Q
  1.  D ^ACDWQ ;        call to XBDBQUE
  1.  Q
  1.  ;
  1. L ;EP TM entry
  1.  S ACDNW(1)=ACDTO,ACDNW(2)=ACDFR,ACDNW(3)=ACDLOC,ACDNW(4)=ACDRPTS
  1.  S ACDTO=ACDNW(1),ACDFR=ACDNW(2),ACDLOC=ACDNW(3)
  1.  D ACDV
  1.  Q
  1.  ;
  1. ACDV ;Visit
  1.  K ^TMP("ACD",ACDJOB,ACDBT)
  1.  S ACDDO=0
  1.  F ACD=ACDFR-.01:0 S ACD=$O(^ACDVIS("B",ACD)) Q:'ACD!(ACD>ACDTO)  D
  1.  . S ACDV=0
  1.  . F  S ACDV=$O(^ACDVIS("B",ACD,ACDV)) Q:'ACDV  D
  1.  .. S ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)=""
  1.  .. S ACD1=0
  1.  .. F  S ACD1=$O(^ACDTDC("C",ACDV,ACD1)) Q:'ACD1  S ^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)=""
  1.  .. Q
  1.  . Q
  1.  Q
  1.  ;
  1. P ;EP - PRINT REPORT
  1.  K DIRUT
  1.  S ACDNW(1)=ACDTO,ACDNW(2)=ACDFR,ACDNW(3)=ACDLOC,ACDNW(4)=ACDRPTS
  1.  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)
  1.  Q
  1.  ;
  1. P2 ;
  1.  S ACDV=0
  1.  F  S ACDV=$O(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV)) Q:'ACDV  D  Q:$D(DIRUT)
  1.  . S ACDDA=ACDV D ^ACDWVIS
  1.  . S ACD1=0
  1.  . F  S ACD1=$O(^TMP("ACD",ACDJOB,ACDBT,"HIT",ACDV,ACD1)) Q:'ACD1  D  Q:$D(DIRUT)
  1.  .. S ACDDA=ACD1 D ^ACDWTDC
  1.  .. I ACDOK,ACDDFNP D @ACDTG
  1.  .. Q
  1.  . Q
  1.  Q:$D(DIRUT)
  1.  D HED
  1.  Q
  1.  ;
  1. HED ;H-vars
  1.  S ACDH(0)=$P($T(@ACDTG),";",3)_U_ACDLOC,ACDWDRV(2)=2 D HV^ACDWUTL
  1.  U IO D H S ACDTG="G"_ACDTG D @ACDTG Q
  1. H ;EP
  1.  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),!
  1.  Q
  1. 50 ;;CT'S WITH A DISCHARGE/AFTERCARE PLAN
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDAP,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
  1. 51 ;;CT'S BY DRUG TYPE
  1.  D C^ACDWUTL
  1.  S ACDDT="" F  S ACDDT=$O(ACDDTA(ACDDT)) Q:ACDDT=""  D
  1.  .S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDT,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
  1.  Q
  1. 52 ;;CT'S BY T/ D/ C/ REASON
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDTDCR,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
  1. 53 ;;CT'S BY ACTUAL PLACEMENT
  1.  S ACDCBO=ACDPLAA_"/"_ACDPLAA1
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
  1. 54 ;;CT'S BY RECOMMENDED PLACEMENT
  1.  S ACDCBO=ACDPLAR_"/"_ACDPLAR1
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
  1. 55 ;;CT'S BY DIFFERENCE REASON
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDIF,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
  1. 56 ;;CT'S BY GOAL TREATMENT STATUS
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDGA,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
  1. 57 ;;CT'S FOR AVE DAYS USED DRUGS WITHIN CONTACT
  1.  S:'ACDDUD ACDDUD=.1 S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUD)) ^(ACDDUD)="" S ^(ACDDUD)=^(ACDDUD)+1 Q
  1. 58 ;;CT'S FOR AVE DAYS USED ALCOHOL WITHIN CONTACT
  1.  S:'ACDDUA ACDDUA=.1 S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCONTL,ACDDUA)) ^(ACDDUA)="" S ^(ACDDUA)=^(ACDDUA)+1 Q
  1. 59 ;;CT'S BY ALCOHOL/DRUG RELATED ARRESTS
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+ACDAAR Q
  1. 60 ;;AVE CLIENT STAGE BY COMPONENT
  1.  S ACDCBO=ACDCOMCL_"/"_ACDCOMT
  1.  S ACDADD=0 S ACDADD=ACDSUS+ACDPS+ACDES+ACDSS+ACDCS+ACDBS Q:'ACDADD
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCBO,ACDADD)) ^(ACDADD)="" S ^(ACDADD)=^(ACDADD)+6 Q
  1. 61 ;;CT'S BY HOSPITAL DAYS
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+ACDDH Q
  1. 62 ;;PLACEMENT DIFFERENCE VOLUME
  1.  S ACDCBO=ACDPLAA_"/"_ACDPLAA1,ACDCOMB=ACDPLAR_"/"_ACDPLAR1
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDCOMB,ACDCBO,ACDDIF)) ^(ACDDIF)="" S ^(ACDDIF)=^(ACDDIF)+1 Q
  1. 63 ;;CT'S BY PRIMARY PROBLEM
  1.  S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1 Q
  1. 64 ;;CT'S BY OTHER PROBLEM
  1.  D C1^ACDWUTL
  1.  S ACDPT="" F  S ACDPT=$O(ACDPTA(ACDPT)) Q:ACDPT=""  D
  1.  .S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPT,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
  1.  Q
  1.  ;
  1. 65 ;;CT'S FOR OTHER PROBLEM WITHIN PRIMARY PROBLEM
  1.  ;D C1^ACDWUTL
  1.  S ACDPT="" F  S ACDPT=$O(ACDPTA(ACDPT)) Q:ACDPT=""  D
  1.  .S:'$D(^TMP("ACD",ACDJOB,ACDBT,ACDTGSUB,"VAL",ACDPROBP,ACDPT,ACDDFNP)) ^(ACDDFNP)="" S ^(ACDDFNP)=^(ACDDFNP)+1
  1.  Q
  1.  ;
  1. G50 S ACDC(1)="DISCHARGE PLAN",ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
  1. G51 S ACDC(1)="DRUG TYPE",ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
  1. G52 S ACDC(1)="T/ D/ C/ REASON",ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
  1. G53 S ACDC(1)=ACDH(10),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
  1. G54 S ACDC(1)=ACDH(11),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
  1. G55 S ACDC(1)=ACDH(14),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
  1. G56 S ACDC(1)="GOAL TREATMENT STATUS",ACDC(3)=ACDH(7),ACDC(4)=ACDH(8),ACDC(2)=ACDH(6) D ^ACDWRP5 Q
  1. G57 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(12) D ^ACDWRP14 Q
  1. G58 S ACDC(1)=ACDH(9),ACDC(2)=ACDH(13) D ^ACDWRP14 Q
  1. G59 S ACDC(1)=ACDH(59),ACDC(2)=ACDH(60),ACDC(3)=ACDH(57) D ^ACDWRP4 Q
  1. G60 S ACDC(1)=ACDH(55),ACDC(2)=ACDH(56) D ^ACDWRP13 Q
  1. G61 S ACDC(1)=ACDH(59),ACDC(2)=ACDH(61),ACDC(3)=ACDH(58) D ^ACDWRP4 Q
  1. G62 S ACDC(1)=ACDH(11),ACDC(2)=ACDH(10),ACDC(3)=ACDH(14),ACDC(4)=ACDH(6) D ^ACDWRP15 Q
  1. G63 S ACDC(1)=ACDH(51),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
  1. G64 S ACDC(1)=ACDH(52),ACDC(2)=ACDH(6),ACDC(3)=ACDH(7),ACDC(4)=ACDH(8) D ^ACDWRP5 Q
  1. 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
  1.  ;
  1. EOJ ;EP - EOJ FOR XBDBQUE
  1.  K ^TMP("ACD",ACDJOB,ACDBT)
  1.  LOCK -^TMP("ACD",ACDJOB,ACDBT)
  1.  K ACDNW,ACDQ,ACDFAC,ACDAREA,ACDSU,ACDTRB,ACDSTA
  1.  K ACDAGE,ACDBT,ACDFOLL,ACDH,ACDHRS,ACDJOB,ACDOK,ACDOPT,ACDPLAAL,ACDPLARL,ACDPT,ACDSTAT,ACDTG,ACDTGSUB,ACDVET,ACDWDRV
  1.  Q