ACDRR1CB ;IHS/ADC/EDE/KML - BROKE UP ACDRR1C;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
PATIENTS ; EP-PROCESS PATIENTS WITH VISITS WITHIN TIME FRAME
D ZEROCNTS
S ACDPIEN=0
F S ACDPIEN=$O(^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN)) Q:'ACDPIEN D:'^(ACDPIEN) FINDPRB D:^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN) PATCNT
D PROBCNT ; count patients by problem
D DRUGCNT ; count patients by drug used
D COMPLOS ; length of stay by cc/ct
D TBLCNTS ; save counts for print routine
Q
;
ZEROCNTS ; ZERO COUNTERS
S ACDCT("SEEN")=0
S ACDCT("SEEN","M")=0
S ACDCT("SEEN","F")=0
S ACDCT("ALCOHOL")=0
S ACDCT("ALCOHOL","CS")=0
S ACDCT("ALCOHOL","DAYS")=0
S ACDCT("ALCOHOL","HRS")=0
S ACDCT("ALCOHOL","M")=0
S ACDCT("ALCOHOL","F")=0
S ACDCT("ALCOHOL ONLY")=0
S ACDCT("ALCOHOL ONLY","CS")=0
S ACDCT("ALCOHOL ONLY","DAYS")=0
S ACDCT("ALCOHOL ONLY","HRS")=0
S ACDCT("ALCOHOL ONLY","M")=0
S ACDCT("ALCOHOL ONLY","F")=0
S ACDCT("DRUGS")=0
S ACDCT("DRUGS","CS")=0
S ACDCT("DRUGS","DAYS")=0
S ACDCT("DRUGS","HRS")=0
S ACDCT("DRUGS","M")=0
S ACDCT("DRUGS","F")=0
S ACDCT("DRUGS ONLY")=0
S ACDCT("DRUGS ONLY","CS")=0
S ACDCT("DRUGS ONLY","DAYS")=0
S ACDCT("DRUGS ONLY","HRS")=0
S ACDCT("DRUGS ONLY","M")=0
S ACDCT("DRUGS ONLY","F")=0
S ACDCT("ALCOHOL&DRUGS")=0
S ACDCT("ALCOHOL&DRUGS","CS")=0
S ACDCT("ALCOHOL&DRUGS","DAYS")=0
S ACDCT("ALCOHOL&DRUGS","HRS")=0
S ACDCT("ALCOHOL&DRUGS","M")=0
S ACDCT("ALCOHOL&DRUGS","F")=0
S ACDCT("NEITHER")=0
S ACDCT("NEITHER","CS")=0
S ACDCT("NEITHER","DAYS")=0
S ACDCT("NEITHER","HRS")=0
S ACDCT("NEITHER","M")=0
S ACDCT("NEITHER","F")=0
F Y=1:1:3 D
. S ACDCT("TOBACCO",Y)=0
. S ACDCT("TOBACCO",Y,"M")=0
. S ACDCT("TOBACCO",Y,"F")=0
. Q
Q
;
PATCNT ; COUNT PATIENT DATA
D PATCNT^ACDRR1CC
Q
;
PROBCNT ; PATIENT COUNT BY PROBLEM
D PROBCNT^ACDRR1CC
Q
;
DRUGCNT ; PATIENT COUNT BY DRUG
D DRUGCNT^ACDRR1CC
Q
;
TBLCNTS ; TABLE COUNTS FOR PRINT ROUTINE
K ^TMP("ACDRR1",ACDJOB,ACDBT)
; seen
S ^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN")=ACDCT("SEEN")
F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN",X)=+$G(ACDCT("SEEN",X))
F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN","AGE",X)=+$G(ACDCT("SEEN","AGE",X))
; length of stay by component code/type
S ACDCCT=""
F S ACDCCT=$O(^TMP("ACDRR1",$J,1,"LOS","T",ACDCCT)) Q:ACDCCT="" D
. S Z=$P(ACDCCT,"/"),Z=$P($G(^ACDCOMP(Z,0)),U,2) S:Z="" Z=$P(ACDCCT,"/") S Z=Z_"/"_$P(ACDCCT,"/",2)
. S ^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",Z,"AVG")=^TMP("ACDRR1",$J,1,"LOS","T",ACDCCT,"TOTAL")/^TMP("ACDRR1",$J,1,"LOS","T",ACDCCT,"COUNT")
. S ^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",Z,"COUNT")=^TMP("ACDRR1",$J,1,"LOS","T",ACDCCT,"COUNT")
. Q
; tribe
S ACDTRIBE=""
F S ACDTRIBE=$O(ACDCT("TRIBE",ACDTRIBE)) Q:ACDTRIBE="" D
. S ^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE)=ACDCT("TRIBE",ACDTRIBE)
. F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE,X)=+$G(ACDCT("TRIBE",ACDTRIBE,X))
. F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE,"AGE",X)=+$G(ACDCT("TRIBE",ACDTRIBE,"AGE",X))
. Q
; alcohol
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL")=ACDCT("ALCOHOL")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","CS")=ACDCT("ALCOHOL","CS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","DAYS")=ACDCT("ALCOHOL","DAYS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","HRS")=ACDCT("ALCOHOL","HRS")
F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL",X)=+$G(ACDCT("ALCOHOL",X))
F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","AGE",X)=+$G(ACDCT("ALCOHOL","AGE",X))
; alcohol only
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY")=ACDCT("ALCOHOL ONLY")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","CS")=ACDCT("ALCOHOL ONLY","CS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","DAYS")=ACDCT("ALCOHOL ONLY","DAYS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","HRS")=ACDCT("ALCOHOL ONLY","HRS")
F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY",X)=+$G(ACDCT("ALCOHOL ONLY",X))
F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","AGE",X)=+$G(ACDCT("ALCOHOL ONLY","AGE",X))
; drugs
S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS")=ACDCT("DRUGS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","CS")=ACDCT("DRUGS","CS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","DAYS")=ACDCT("DRUGS","DAYS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","HRS")=ACDCT("DRUGS","HRS")
F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS",X)=+$G(ACDCT("DRUGS",X))
F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","AGE",X)=+$G(ACDCT("DRUGS","AGE",X))
; drugs only
S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY")=ACDCT("DRUGS ONLY")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","CS")=ACDCT("DRUGS ONLY","CS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","DAYS")=ACDCT("DRUGS ONLY","DAYS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","HRS")=ACDCT("DRUGS ONLY","HRS")
F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY",X)=+$G(ACDCT("DRUGS ONLY",X))
F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","AGE",X)=+$G(ACDCT("DRUGS ONLY","AGE",X))
; alcohol&drugs
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS")=ACDCT("ALCOHOL&DRUGS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","CS")=ACDCT("ALCOHOL&DRUGS","CS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","DAYS")=ACDCT("ALCOHOL&DRUGS","DAYS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","HRS")=ACDCT("ALCOHOL&DRUGS","HRS")
F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS",X)=+$G(ACDCT("ALCOHOL&DRUGS",X))
F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","AGE",X)=+$G(ACDCT("ALCOHOL&DRUGS","AGE",X))
; neither
S ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER")=ACDCT("NEITHER")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","CS")=ACDCT("NEITHER","CS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","DAYS")=ACDCT("NEITHER","DAYS")
S ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","HRS")=ACDCT("NEITHER","HRS")
F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER",X)=+$G(ACDCT("NEITHER",X))
F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","AGE",X)=+$G(ACDCT("NEITHER","AGE",X))
; tobacco
F Y=1:1:3 D
. S ^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",Y)=ACDCT("TOBACCO",Y)
. F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",Y,X)=+$G(ACDCT("TOBACCO",Y,X))
. F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",Y,"AGE",X)=+$G(ACDCT("TOBACCO",Y,"AGE",X))
. Q
; problem
S ACDPRIEN=0
F S ACDPRIEN=$O(^TMP("ACDRR1",$J,1,"PROBLEM",ACDPRIEN)) Q:'ACDPRIEN S Y=^(ACDPRIEN) D
. S ^TMP("ACDRR1",ACDJOB,ACDBT,"PROBLEM",Y,ACDPRIEN)=""
. F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"PROBLEM",Y,ACDPRIEN,X)=$G(^TMP("ACDRR1",$J,1,"PROBLEM",ACDPRIEN,X))
. F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"PROBLEM",Y,ACDPRIEN,"AGE",X)=$G(^TMP("ACDRR1",$J,1,"PROBLEM",ACDPRIEN,"AGE",X))
. Q
; primary problem
S ACDPRIEN=0
F S ACDPRIEN=$O(^TMP("ACDRR1",$J,1,"PRI PROB",ACDPRIEN)) Q:'ACDPRIEN S Y=^(ACDPRIEN) D
. S ^TMP("ACDRR1",ACDJOB,ACDBT,"PRI PROB",Y,ACDPRIEN)=""
. F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"PRI PROB",Y,ACDPRIEN,X)=$G(^TMP("ACDRR1",$J,1,"PRI PROB",ACDPRIEN,X))
. F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"PRI PROB",Y,ACDPRIEN,"AGE",X)=$G(^TMP("ACDRR1",$J,1,"PRI PROB",ACDPRIEN,"AGE",X))
. Q
; drugs
S ACDDRUG=""
F S ACDDRUG=$O(^TMP("ACDRR1",$J,1,"DRUG",ACDDRUG)) Q:ACDDRUG="" S Y=^(ACDDRUG) D
. S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG",Y,ACDDRUG)=""
. F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG",Y,ACDDRUG,X)=$G(^TMP("ACDRR1",$J,1,"DRUG",ACDDRUG,X))
. F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG",Y,ACDDRUG,"AGE",X)=$G(^TMP("ACDRR1",$J,1,"DRUG",ACDDRUG,"AGE",X))
. Q
; drug combinations
S ACDCMBO=""
F S ACDCMBO=$O(^TMP("ACDRR1",$J,1,"DRUG COMBO",ACDCMBO)) Q:ACDCMBO="" D
. S C=^TMP("ACDRR1",$J,1,"DRUG COMBO",ACDCMBO)
. S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG COMBO",ACDCMBO)=C
. F X="M","F" S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG COMBO",C,ACDCMBO,X)=$G(^TMP("ACDRR1",$J,1,"DRUG COMBO",ACDCMBO,X))
. F X=1:1:3 S ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG COMBO",C,ACDCMBO,"AGE",X)=$G(^TMP("ACDRR1",$J,1,"DRUG COMBO",ACDCMBO,"AGE",X))
. Q
Q
;
FINDPRB ; FIND PROBLEMS IN EARLIER IN/RE/FU OR LATER TD
; find in/re/fu before time frame or td after time frame
S ACDVIEN=0,ACDVHIT=0
F S ACDVIEN=$O(^ACDVIS("D",ACDPIEN,ACDVIEN)) Q:'ACDVIEN I $D(^ACDVIS(ACDVIEN,0)) S X=^(0) I $G(^ACDVIS(ACDVIEN,"BWP"))=ACDPGM D Q:^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN)
. S ACDVDATE=$P(X,U)
. I ACDVDATE>ACDDTLO,ACDVHIT NEW ACDVIEN S ACDVIEN=ACDVHIT D PRCIIF^ACDRR1C Q:^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN) S ACDVHIT=0
. S ACDTC=$P(X,U,4)
. I ACDTC'="IN",ACDTC'="RE",ACDTC'="FU",ACDTC'="TD" Q
. I ACDVDATE>ACDDTLO,ACDTC'="TD" Q
. S ACDVHIT=ACDVIEN
. I ACDTC="TD" NEW ACDVIEN S ACDVIEN=ACDVHIT,ACDVHIT=0 D PRCTD^ACDRR1C
. Q
Q
;
COMPLOS ; COMPUTE LENGTH OF STAY BY COMP CODE/TYPE
S ACDPIEN=0
F S ACDPIEN=$O(^TMP("ACDRR1",$J,1,"LOS",ACDPIEN)) Q:'ACDPIEN D
. S ACDCCT=""
. F S ACDCCT=$O(^TMP("ACDRR1",$J,1,"LOS",ACDPIEN,ACDCCT)) Q:ACDCCT="" D
.. S ACDDATE=""
.. F S ACDDATE=$O(^TMP("ACDRR1",$J,1,"LOS",ACDPIEN,ACDCCT,ACDDATE)) Q:ACDDATE="" D COMPLOS2
.. Q
. Q
Q
;
COMPLOS2 ; COMPUTE LENGTH OF STAY FOR ONE TD
; find in/re for same patient & component code/type before td
S ACDCC=$P(ACDCCT,"/"),ACDCT=$P(ACDCCT,"/",2)
S ACDVIEN=0,ACDINRE=0
F S ACDVIEN=$O(^ACDVIS("D",ACDPIEN,ACDVIEN)) Q:'ACDVIEN I $D(^ACDVIS(ACDVIEN,0)) S X=^(0) D
. Q:$G(^ACDVIS(ACDVIEN,"BWP"))'=ACDPGM
. Q:$P(X,U,2)'=ACDCC
. Q:$P(X,U,7)'=ACDCT
. I $P(X,U,4)'="IN",$P(X,U,4)'="RE" Q
. S X=$P(X,U)
. Q:X>ACDDATE
. S:X>ACDINRE ACDINRE=X
. Q
Q:'ACDINRE
S X2=ACDINRE,X1=ACDDATE
D ^%DTC
Q:'%Y
S ^TMP("ACDRR1",$J,1,"LOS","T",ACDCCT,"TOTAL")=$G(^TMP("ACDRR1",$J,1,"LOS","T",ACDCCT,"TOTAL"))+X
S ^TMP("ACDRR1",$J,1,"LOS","T",ACDCCT,"COUNT")=$G(^TMP("ACDRR1",$J,1,"LOS","T",ACDCCT,"COUNT"))+1
Q
ACDRR1CB ;IHS/ADC/EDE/KML - BROKE UP ACDRR1C;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
PATIENTS ; EP-PROCESS PATIENTS WITH VISITS WITHIN TIME FRAME
+1 DO ZEROCNTS
+2 SET ACDPIEN=0
+3 FOR
SET ACDPIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN))
IF 'ACDPIEN
QUIT
IF '^(ACDPIEN)
DO FINDPRB
IF ^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN)
DO PATCNT
+4 ; count patients by problem
DO PROBCNT
+5 ; count patients by drug used
DO DRUGCNT
+6 ; length of stay by cc/ct
DO COMPLOS
+7 ; save counts for print routine
DO TBLCNTS
+8 QUIT
+9 ;
ZEROCNTS ; ZERO COUNTERS
+1 SET ACDCT("SEEN")=0
+2 SET ACDCT("SEEN","M")=0
+3 SET ACDCT("SEEN","F")=0
+4 SET ACDCT("ALCOHOL")=0
+5 SET ACDCT("ALCOHOL","CS")=0
+6 SET ACDCT("ALCOHOL","DAYS")=0
+7 SET ACDCT("ALCOHOL","HRS")=0
+8 SET ACDCT("ALCOHOL","M")=0
+9 SET ACDCT("ALCOHOL","F")=0
+10 SET ACDCT("ALCOHOL ONLY")=0
+11 SET ACDCT("ALCOHOL ONLY","CS")=0
+12 SET ACDCT("ALCOHOL ONLY","DAYS")=0
+13 SET ACDCT("ALCOHOL ONLY","HRS")=0
+14 SET ACDCT("ALCOHOL ONLY","M")=0
+15 SET ACDCT("ALCOHOL ONLY","F")=0
+16 SET ACDCT("DRUGS")=0
+17 SET ACDCT("DRUGS","CS")=0
+18 SET ACDCT("DRUGS","DAYS")=0
+19 SET ACDCT("DRUGS","HRS")=0
+20 SET ACDCT("DRUGS","M")=0
+21 SET ACDCT("DRUGS","F")=0
+22 SET ACDCT("DRUGS ONLY")=0
+23 SET ACDCT("DRUGS ONLY","CS")=0
+24 SET ACDCT("DRUGS ONLY","DAYS")=0
+25 SET ACDCT("DRUGS ONLY","HRS")=0
+26 SET ACDCT("DRUGS ONLY","M")=0
+27 SET ACDCT("DRUGS ONLY","F")=0
+28 SET ACDCT("ALCOHOL&DRUGS")=0
+29 SET ACDCT("ALCOHOL&DRUGS","CS")=0
+30 SET ACDCT("ALCOHOL&DRUGS","DAYS")=0
+31 SET ACDCT("ALCOHOL&DRUGS","HRS")=0
+32 SET ACDCT("ALCOHOL&DRUGS","M")=0
+33 SET ACDCT("ALCOHOL&DRUGS","F")=0
+34 SET ACDCT("NEITHER")=0
+35 SET ACDCT("NEITHER","CS")=0
+36 SET ACDCT("NEITHER","DAYS")=0
+37 SET ACDCT("NEITHER","HRS")=0
+38 SET ACDCT("NEITHER","M")=0
+39 SET ACDCT("NEITHER","F")=0
+40 FOR Y=1:1:3
Begin DoDot:1
+41 SET ACDCT("TOBACCO",Y)=0
+42 SET ACDCT("TOBACCO",Y,"M")=0
+43 SET ACDCT("TOBACCO",Y,"F")=0
+44 QUIT
End DoDot:1
+45 QUIT
+46 ;
PATCNT ; COUNT PATIENT DATA
+1 DO PATCNT^ACDRR1CC
+2 QUIT
+3 ;
PROBCNT ; PATIENT COUNT BY PROBLEM
+1 DO PROBCNT^ACDRR1CC
+2 QUIT
+3 ;
DRUGCNT ; PATIENT COUNT BY DRUG
+1 DO DRUGCNT^ACDRR1CC
+2 QUIT
+3 ;
TBLCNTS ; TABLE COUNTS FOR PRINT ROUTINE
+1 KILL ^TMP("ACDRR1",ACDJOB,ACDBT)
+2 ; seen
+3 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN")=ACDCT("SEEN")
+4 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN",X)=+$GET(ACDCT("SEEN",X))
+5 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN","AGE",X)=+$GET(ACDCT("SEEN","AGE",X))
+6 ; length of stay by component code/type
+7 SET ACDCCT=""
+8 FOR
SET ACDCCT=$ORDER(^TMP("ACDRR1",$JOB,1,"LOS","T",ACDCCT))
IF ACDCCT=""
QUIT
Begin DoDot:1
+9 SET Z=$PIECE(ACDCCT,"/")
SET Z=$PIECE($GET(^ACDCOMP(Z,0)),U,2)
IF Z=""
SET Z=$PIECE(ACDCCT,"/")
SET Z=Z_"/"_$PIECE(ACDCCT,"/",2)
+10 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",Z,"AVG")=^TMP("ACDRR1",$JOB,1,"LOS","T",ACDCCT,"TOTAL")/^TMP("ACDRR1",$JOB,1,"LOS","T",ACDCCT,"COUNT")
+11 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"LOS",Z,"COUNT")=^TMP("ACDRR1",$JOB,1,"LOS","T",ACDCCT,"COUNT")
+12 QUIT
End DoDot:1
+13 ; tribe
+14 SET ACDTRIBE=""
+15 FOR
SET ACDTRIBE=$ORDER(ACDCT("TRIBE",ACDTRIBE))
IF ACDTRIBE=""
QUIT
Begin DoDot:1
+16 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE)=ACDCT("TRIBE",ACDTRIBE)
+17 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE,X)=+$GET(ACDCT("TRIBE",ACDTRIBE,X))
+18 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"TRIBE",ACDTRIBE,"AGE",X)=+$GET(ACDCT("TRIBE",ACDTRIBE,"AGE",X))
+19 QUIT
End DoDot:1
+20 ; alcohol
+21 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL")=ACDCT("ALCOHOL")
+22 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","CS")=ACDCT("ALCOHOL","CS")
+23 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","DAYS")=ACDCT("ALCOHOL","DAYS")
+24 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","HRS")=ACDCT("ALCOHOL","HRS")
+25 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL",X)=+$GET(ACDCT("ALCOHOL",X))
+26 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","AGE",X)=+$GET(ACDCT("ALCOHOL","AGE",X))
+27 ; alcohol only
+28 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY")=ACDCT("ALCOHOL ONLY")
+29 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","CS")=ACDCT("ALCOHOL ONLY","CS")
+30 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","DAYS")=ACDCT("ALCOHOL ONLY","DAYS")
+31 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","HRS")=ACDCT("ALCOHOL ONLY","HRS")
+32 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY",X)=+$GET(ACDCT("ALCOHOL ONLY",X))
+33 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","AGE",X)=+$GET(ACDCT("ALCOHOL ONLY","AGE",X))
+34 ; drugs
+35 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS")=ACDCT("DRUGS")
+36 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","CS")=ACDCT("DRUGS","CS")
+37 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","DAYS")=ACDCT("DRUGS","DAYS")
+38 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","HRS")=ACDCT("DRUGS","HRS")
+39 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS",X)=+$GET(ACDCT("DRUGS",X))
+40 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","AGE",X)=+$GET(ACDCT("DRUGS","AGE",X))
+41 ; drugs only
+42 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY")=ACDCT("DRUGS ONLY")
+43 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","CS")=ACDCT("DRUGS ONLY","CS")
+44 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","DAYS")=ACDCT("DRUGS ONLY","DAYS")
+45 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","HRS")=ACDCT("DRUGS ONLY","HRS")
+46 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY",X)=+$GET(ACDCT("DRUGS ONLY",X))
+47 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","AGE",X)=+$GET(ACDCT("DRUGS ONLY","AGE",X))
+48 ; alcohol&drugs
+49 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS")=ACDCT("ALCOHOL&DRUGS")
+50 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","CS")=ACDCT("ALCOHOL&DRUGS","CS")
+51 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","DAYS")=ACDCT("ALCOHOL&DRUGS","DAYS")
+52 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","HRS")=ACDCT("ALCOHOL&DRUGS","HRS")
+53 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS",X)=+$GET(ACDCT("ALCOHOL&DRUGS",X))
+54 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","AGE",X)=+$GET(ACDCT("ALCOHOL&DRUGS","AGE",X))
+55 ; neither
+56 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER")=ACDCT("NEITHER")
+57 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","CS")=ACDCT("NEITHER","CS")
+58 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","DAYS")=ACDCT("NEITHER","DAYS")
+59 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","HRS")=ACDCT("NEITHER","HRS")
+60 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER",X)=+$GET(ACDCT("NEITHER",X))
+61 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","AGE",X)=+$GET(ACDCT("NEITHER","AGE",X))
+62 ; tobacco
+63 FOR Y=1:1:3
Begin DoDot:1
+64 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",Y)=ACDCT("TOBACCO",Y)
+65 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",Y,X)=+$GET(ACDCT("TOBACCO",Y,X))
+66 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",Y,"AGE",X)=+$GET(ACDCT("TOBACCO",Y,"AGE",X))
+67 QUIT
End DoDot:1
+68 ; problem
+69 SET ACDPRIEN=0
+70 FOR
SET ACDPRIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"PROBLEM",ACDPRIEN))
IF 'ACDPRIEN
QUIT
SET Y=^(ACDPRIEN)
Begin DoDot:1
+71 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"PROBLEM",Y,ACDPRIEN)=""
+72 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"PROBLEM",Y,ACDPRIEN,X)=$GET(^TMP("ACDRR1",$JOB,1,"PROBLEM",ACDPRIEN,X))
+73 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"PROBLEM",Y,ACDPRIEN,"AGE",X)=$GET(^TMP("ACDRR1",$JOB,1,"PROBLEM",ACDPRIEN,"AGE",X))
+74 QUIT
End DoDot:1
+75 ; primary problem
+76 SET ACDPRIEN=0
+77 FOR
SET ACDPRIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"PRI PROB",ACDPRIEN))
IF 'ACDPRIEN
QUIT
SET Y=^(ACDPRIEN)
Begin DoDot:1
+78 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"PRI PROB",Y,ACDPRIEN)=""
+79 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"PRI PROB",Y,ACDPRIEN,X)=$GET(^TMP("ACDRR1",$JOB,1,"PRI PROB",ACDPRIEN,X))
+80 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"PRI PROB",Y,ACDPRIEN,"AGE",X)=$GET(^TMP("ACDRR1",$JOB,1,"PRI PROB",ACDPRIEN,"AGE",X))
+81 QUIT
End DoDot:1
+82 ; drugs
+83 SET ACDDRUG=""
+84 FOR
SET ACDDRUG=$ORDER(^TMP("ACDRR1",$JOB,1,"DRUG",ACDDRUG))
IF ACDDRUG=""
QUIT
SET Y=^(ACDDRUG)
Begin DoDot:1
+85 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG",Y,ACDDRUG)=""
+86 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG",Y,ACDDRUG,X)=$GET(^TMP("ACDRR1",$JOB,1,"DRUG",ACDDRUG,X))
+87 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG",Y,ACDDRUG,"AGE",X)=$GET(^TMP("ACDRR1",$JOB,1,"DRUG",ACDDRUG,"AGE",X))
+88 QUIT
End DoDot:1
+89 ; drug combinations
+90 SET ACDCMBO=""
+91 FOR
SET ACDCMBO=$ORDER(^TMP("ACDRR1",$JOB,1,"DRUG COMBO",ACDCMBO))
IF ACDCMBO=""
QUIT
Begin DoDot:1
+92 SET C=^TMP("ACDRR1",$JOB,1,"DRUG COMBO",ACDCMBO)
+93 SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG COMBO",ACDCMBO)=C
+94 FOR X="M","F"
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG COMBO",C,ACDCMBO,X)=$GET(^TMP("ACDRR1",$JOB,1,"DRUG COMBO",ACDCMBO,X))
+95 FOR X=1:1:3
SET ^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG COMBO",C,ACDCMBO,"AGE",X)=$GET(^TMP("ACDRR1",$JOB,1,"DRUG COMBO",ACDCMBO,"AGE",X))
+96 QUIT
End DoDot:1
+97 QUIT
+98 ;
FINDPRB ; FIND PROBLEMS IN EARLIER IN/RE/FU OR LATER TD
+1 ; find in/re/fu before time frame or td after time frame
+2 SET ACDVIEN=0
SET ACDVHIT=0
+3 FOR
SET ACDVIEN=$ORDER(^ACDVIS("D",ACDPIEN,ACDVIEN))
IF 'ACDVIEN
QUIT
IF $DATA(^ACDVIS(ACDVIEN,0))
SET X=^(0)
IF $GET(^ACDVIS(ACDVIEN,"BWP"))=ACDPGM
Begin DoDot:1
+4 SET ACDVDATE=$PIECE(X,U)
+5 IF ACDVDATE>ACDDTLO
IF ACDVHIT
NEW ACDVIEN
SET ACDVIEN=ACDVHIT
DO PRCIIF^ACDRR1C
IF ^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN)
QUIT
SET ACDVHIT=0
+6 SET ACDTC=$PIECE(X,U,4)
+7 IF ACDTC'="IN"
IF ACDTC'="RE"
IF ACDTC'="FU"
IF ACDTC'="TD"
QUIT
+8 IF ACDVDATE>ACDDTLO
IF ACDTC'="TD"
QUIT
+9 SET ACDVHIT=ACDVIEN
+10 IF ACDTC="TD"
NEW ACDVIEN
SET ACDVIEN=ACDVHIT
SET ACDVHIT=0
DO PRCTD^ACDRR1C
+11 QUIT
End DoDot:1
IF ^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN)
QUIT
+12 QUIT
+13 ;
COMPLOS ; COMPUTE LENGTH OF STAY BY COMP CODE/TYPE
+1 SET ACDPIEN=0
+2 FOR
SET ACDPIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"LOS",ACDPIEN))
IF 'ACDPIEN
QUIT
Begin DoDot:1
+3 SET ACDCCT=""
+4 FOR
SET ACDCCT=$ORDER(^TMP("ACDRR1",$JOB,1,"LOS",ACDPIEN,ACDCCT))
IF ACDCCT=""
QUIT
Begin DoDot:2
+5 SET ACDDATE=""
+6 FOR
SET ACDDATE=$ORDER(^TMP("ACDRR1",$JOB,1,"LOS",ACDPIEN,ACDCCT,ACDDATE))
IF ACDDATE=""
QUIT
DO COMPLOS2
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
COMPLOS2 ; COMPUTE LENGTH OF STAY FOR ONE TD
+1 ; find in/re for same patient & component code/type before td
+2 SET ACDCC=$PIECE(ACDCCT,"/")
SET ACDCT=$PIECE(ACDCCT,"/",2)
+3 SET ACDVIEN=0
SET ACDINRE=0
+4 FOR
SET ACDVIEN=$ORDER(^ACDVIS("D",ACDPIEN,ACDVIEN))
IF 'ACDVIEN
QUIT
IF $DATA(^ACDVIS(ACDVIEN,0))
SET X=^(0)
Begin DoDot:1
+5 IF $GET(^ACDVIS(ACDVIEN,"BWP"))'=ACDPGM
QUIT
+6 IF $PIECE(X,U,2)'=ACDCC
QUIT
+7 IF $PIECE(X,U,7)'=ACDCT
QUIT
+8 IF $PIECE(X,U,4)'="IN"
IF $PIECE(X,U,4)'="RE"
QUIT
+9 SET X=$PIECE(X,U)
+10 IF X>ACDDATE
QUIT
+11 IF X>ACDINRE
SET ACDINRE=X
+12 QUIT
End DoDot:1
+13 IF 'ACDINRE
QUIT
+14 SET X2=ACDINRE
SET X1=ACDDATE
+15 DO ^%DTC
+16 IF '%Y
QUIT
+17 SET ^TMP("ACDRR1",$JOB,1,"LOS","T",ACDCCT,"TOTAL")=$GET(^TMP("ACDRR1",$JOB,1,"LOS","T",ACDCCT,"TOTAL"))+X
+18 SET ^TMP("ACDRR1",$JOB,1,"LOS","T",ACDCCT,"COUNT")=$GET(^TMP("ACDRR1",$JOB,1,"LOS","T",ACDCCT,"COUNT"))+1
+19 QUIT
