ACDRR1CC ;IHS/ADC/EDE/KML - BROKE UP ACDRR1CB;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
PATCNT ; EP-COUNT PATIENT DATA
S ACDSEX=$$SEX^AUPNPAT(ACDPIEN) S:ACDSEX="" ACDSEX="M"
S Y=$$AGE^AUPNPAT(ACDPIEN,ACDDTLO),ACDAGE=$S(Y<13:1,Y<21:2,1:3)
S Y=$$TRIBE^AUPNPAT(ACDPIEN,"E"),ACDTRIBE=$S(Y="":"UNKNOWN",1:Y)
D COUNTCS
D COMPDAYS
S ACDCT("SEEN")=ACDCT("SEEN")+1
S ACDCT("SEEN",ACDSEX)=$G(ACDCT("SEEN",ACDSEX))+1
S ACDCT("SEEN","AGE",ACDAGE)=$G(ACDCT("SEEN","AGE",ACDAGE))+1
S ACDCT("TRIBE",ACDTRIBE)=$G(ACDCT("TRIBE",ACDTRIBE))+1
S ACDCT("TRIBE",ACDTRIBE,ACDSEX)=$G(ACDCT("TRIBE",ACDTRIBE,ACDSEX))+1
S ACDCT("TRIBE",ACDTRIBE,"AGE",ACDAGE)=$G(ACDCT("TRIBE",ACDTRIBE,"AGE",ACDAGE))+1
S (X,Y)=0
F S Y=$O(^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"T",Y)) Q:Y="" S X=X+Y
S:X>3 X=3
I X D
. S ACDCT("TOBACCO",X)=ACDCT("TOBACCO",X)+1
. S ACDCT("TOBACCO",X,ACDSEX)=$G(ACDCT("TOBACCO",X,ACDSEX))+1
. S ACDCT("TOBACCO",X,"AGE",ACDAGE)=$G(ACDCT("TOBACCO",X,"AGE",ACDAGE))+1
. Q
S ACDA=$O(^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"A",0))
S ACDD=$O(^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"D",0))
I ACDA D
. S ACDCT("ALCOHOL")=ACDCT("ALCOHOL")+1
. S ACDCT("ALCOHOL","CS")=ACDCT("ALCOHOL","CS")+ACDCSC
. S ACDCT("ALCOHOL","DAYS")=ACDCT("ALCOHOL","DAYS")+ACDADAYS
. S ACDCT("ALCOHOL","HRS")=ACDCT("ALCOHOL","HRS")+ACDCSH
. S ACDCT("ALCOHOL",ACDSEX)=ACDCT("ALCOHOL",ACDSEX)+1
. S ACDCT("ALCOHOL","AGE",ACDAGE)=$G(ACDCT("ALCOHOL","AGE",ACDAGE))+1
. Q
I ACDD D
. S ACDCT("DRUGS")=ACDCT("DRUGS")+1
. S ACDCT("DRUGS","CS")=ACDCT("DRUGS","CS")+ACDCSC
. S ACDCT("DRUGS","DAYS")=ACDCT("DRUGS","DAYS")+ACDDDAYS
. S ACDCT("DRUGS","HRS")=ACDCT("DRUGS","HRS")+ACDCSH
. S ACDCT("DRUGS",ACDSEX)=ACDCT("DRUGS",ACDSEX)+1
. S ACDCT("DRUGS","AGE",ACDAGE)=$G(ACDCT("DRUGS","AGE",ACDAGE))+1
. Q
I ACDA,ACDD D
. S ACDCT("ALCOHOL&DRUGS")=ACDCT("ALCOHOL&DRUGS")+1
. S ACDCT("ALCOHOL&DRUGS","CS")=ACDCT("ALCOHOL&DRUGS","CS")+ACDCSC
. S ACDCT("ALCOHOL&DRUGS","DAYS")=ACDCT("ALCOHOL&DRUGS","DAYS")+ACDADAYS
. S ACDCT("ALCOHOL&DRUGS","HRS")=ACDCT("ALCOHOL&DRUGS","HRS")+ACDCSH
. S ACDCT("ALCOHOL&DRUGS",ACDSEX)=ACDCT("ALCOHOL&DRUGS",ACDSEX)+1
. Q
I ACDA,'ACDD D
. S ACDCT("ALCOHOL ONLY")=ACDCT("ALCOHOL ONLY")+1
. S ACDCT("ALCOHOL ONLY","CS")=ACDCT("ALCOHOL ONLY","CS")+ACDCSC
. S ACDCT("ALCOHOL ONLY","DAYS")=ACDCT("ALCOHOL ONLY","DAYS")+ACDADAYS
. S ACDCT("ALCOHOL ONLY","HRS")=ACDCT("ALCOHOL ONLY","HRS")+ACDCSH
. S ACDCT("ALCOHOL ONLY",ACDSEX)=ACDCT("ALCOHOL ONLY",ACDSEX)+1
. Q
I ACDD,'ACDA D
. S ACDCT("DRUGS ONLY")=ACDCT("DRUGS ONLY")+1
. S ACDCT("DRUGS ONLY","CS")=ACDCT("DRUGS ONLY","CS")+ACDCSC
. S ACDCT("DRUGS ONLY","DAYS")=ACDCT("DRUGS ONLY","DAYS")+ACDDDAYS
. S ACDCT("DRUGS ONLY","HRS")=ACDCT("DRUGS ONLY","HRS")+ACDCSH
. S ACDCT("DRUGS ONLY",ACDSEX)=ACDCT("DRUGS ONLY",ACDSEX)+1
. Q
I 'ACDA,'ACDD D
. S ACDCT("NEITHER")=ACDCT("NEITHER")+1
. S ACDCT("NEITHER","CS")=ACDCT("NEITHER","CS")+ACDCSC
. S ACDCT("NEITHER","DAYS")=ACDCT("NEITHER","DAYS")+ACDADAYS
. S ACDCT("NEITHER","HRS")=ACDCT("NEITHER","HRS")+ACDCSH
. S ACDCT("NEITHER",ACDSEX)=ACDCT("NEITHER",ACDSEX)+1
. Q
Q
;
COUNTCS ; COUNT ALL CS ENTRIES FOR THIS PATIENT & GET AVG HOURS
NEW ACDVIEN
S (ACDVIEN,ACDCSC,ACDCSH,ACDCSHC)=0
F S ACDVIEN=$O(^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"CS",ACDVIEN)) Q:'ACDVIEN D
. S ACDCSIEN=0
. F S ACDCSIEN=$O(^ACDCS("C",ACDVIEN,ACDCSIEN)) Q:'ACDCSIEN S ACDCSC=ACDCSC+1 I $D(^ACDCS(ACDCSIEN,0)) S X=$P(^(0),U,4) S:X ACDCSHC=ACDCSHC+1,ACDCSH=ACDCSH+X
. Q
I ACDCSHC S ACDCSH=ACDCSH/ACDCSHC,ACDCSH=ACDCSH+.5,ACDCSH=$P(ACDCSH,".")
Q
;
COMPDAYS ; COMPUTE AVERAGE NUMBER OF DAYS USED FOR ALCOHOL/DRUGS
NEW ACDVIEN
S (ACDADAYS,ACDVIEN,C,V)=0
F S ACDVIEN=$O(^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"A",ACDVIEN)) Q:'ACDVIEN S Y=$G(^(ACDVIEN,"DAYS")) I Y S C=C+1,V=V+Y
I V,C S ACDADAYS=V/C,ACDADAYS=ACDADAYS+.5,ACDADAYS=$P(ACDADAYS,".")
S (ACDDDAYS,ACDVIEN,C,V)=0
F S ACDVIEN=$O(^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"D",ACDVIEN)) Q:'ACDVIEN S Y=$G(^(ACDVIEN,"DAYS")) I Y S C=C+1,V=V+Y
I V,C S ACDDDAYS=V/C,ACDDDAYS=ACDDDAYS+.5,ACDDDAYS=$P(ACDDDAYS,".")
Q
;
;
PROBCNT ; EP-COUNT PATIENTS BY PROBLEM
; compute patient totals for each problem
NEW A,C,F,M,Y
S ACDPRIEN=0
F S ACDPRIEN=$O(^TMP("ACDRR1",$J,1,"PROBLEM",ACDPRIEN)) Q:'ACDPRIEN D
. F Y=1:1:3 S ACDATBL(Y)=0
. S (C,F,M,Y)=0
. F S Y=$O(^TMP("ACDRR1",$J,1,"PROBLEM",ACDPRIEN,Y)) Q:'Y D
.. S C=C+1
.. S ACDSEX=$$SEX^AUPNPAT(Y) S:ACDSEX="-1" ACDSEX="M"
.. S @ACDSEX=@ACDSEX+1
.. S A=$$AGE^AUPNPAT(Y,ACDDTLO),ACDAGE=$S(A<13:1,A<21:2,1:3)
.. S ACDATBL(ACDAGE)=ACDATBL(ACDAGE)+1
.. Q
. K ^TMP("ACDRR1",$J,1,"PROBLEM",ACDPRIEN) S ^(ACDPRIEN)=C
. F ACDSEX="M","F" S ^TMP("ACDRR1",$J,1,"PROBLEM",ACDPRIEN,ACDSEX)=@ACDSEX
. F ACDAGE=1:1:3 S ^TMP("ACDRR1",$J,1,"PROBLEM",ACDPRIEN,"AGE",ACDAGE)=$G(ACDATBL(ACDAGE))
. Q
K ACDATBL
S ACDPRIEN=0
F S ACDPRIEN=$O(^TMP("ACDRR1",$J,1,"PRI PROB",ACDPRIEN)) Q:'ACDPRIEN D
. F Y=1:1:3 S ACDATBL(Y)=0
. S (C,F,M,Y)=0
. F S Y=$O(^TMP("ACDRR1",$J,1,"PRI PROB",ACDPRIEN,Y)) Q:'Y D
.. S C=C+1
.. S ACDSEX=$$SEX^AUPNPAT(Y) S:ACDSEX="-1" ACDSEX="M"
.. S @ACDSEX=@ACDSEX+1
.. S A=$$AGE^AUPNPAT(Y,ACDDTLO),ACDAGE=$S(A<13:1,A<21:2,1:3)
.. S ACDATBL(ACDAGE)=ACDATBL(ACDAGE)+1
.. Q
. K ^TMP("ACDRR1",$J,1,"PRI PROB",ACDPRIEN) S ^(ACDPRIEN)=C
. F ACDSEX="M","F" S ^TMP("ACDRR1",$J,1,"PRI PROB",ACDPRIEN,ACDSEX)=@ACDSEX
. F ACDAGE=1:1:3 S ^TMP("ACDRR1",$J,1,"PRI PROB",ACDPRIEN,"AGE",ACDAGE)=$G(ACDATBL(ACDAGE))
. Q
K ACDATBL
Q
;
DRUGCNT ; EP-COUNT PATIENTS BY DRUG USED
; compute patient totals for each drug
NEW A,C,F,M,Y
S ACDDIEN=""
F S ACDDIEN=$O(^TMP("ACDRR1",$J,1,"DRUG",ACDDIEN)) Q:ACDDIEN="" D
. F Y=1:1:3 S ACDATBL(Y)=0
. S (C,F,M,Y)=0
. F S Y=$O(^TMP("ACDRR1",$J,1,"DRUG",ACDDIEN,Y)) Q:'Y D
.. S C=C+1
.. S ACDSEX=$$SEX^AUPNPAT(Y) S:ACDSEX="" ACDSEX="M"
.. S @ACDSEX=@ACDSEX+1
.. S A=$$AGE^AUPNPAT(Y,ACDDTLO),ACDAGE=$S(A<13:1,A<21:2,1:3)
.. S ACDATBL(ACDAGE)=ACDATBL(ACDAGE)+1
.. Q
. K ^TMP("ACDRR1",$J,1,"DRUG",ACDDIEN) S ^(ACDDIEN)=C
. F ACDSEX="M","F" S ^TMP("ACDRR1",$J,1,"DRUG",ACDDIEN,ACDSEX)=@ACDSEX
. F ACDAGE=1:1:3 S ^TMP("ACDRR1",$J,1,"DRUG",ACDDIEN,"AGE",ACDAGE)=$G(ACDATBL(ACDAGE))
. Q
; compute patient totals for each drug combonation (alcohol included)
K ACDATBL
S X=""
F S X=$O(^TMP("ACDRR1",$J,1,"DRUG COMBO",X)) Q:X="" D
. F Y=1:1:3 S ACDATBL(Y)=0
. S (C,F,M,Y)=0
. F S ACDPIEN=$O(^TMP("ACDRR1",$J,1,"DRUG COMBO",X,ACDPIEN)) Q:'ACDPIEN D
.. S C=C+1
.. S ACDSEX=$$SEX^AUPNPAT(ACDPIEN) S:ACDSEX="-1" ACDSEX="M"
.. S @ACDSEX=@ACDSEX+1
.. S A=$$AGE^AUPNPAT(ACDPIEN,ACDDTLO),ACDAGE=$S(A<13:1,A<21:2,1:3)
.. S ACDATBL(ACDAGE)=ACDATBL(ACDAGE)+1
.. Q
. K ^TMP("ACDRR1",$J,1,"DRUG COMBO",X) S ^(X)=C
. F ACDSEX="M","F" S ^TMP("ACDRR1",$J,1,"DRUG COMBO",X,ACDSEX)=@ACDSEX
. F ACDAGE=1:1:3 S ^TMP("ACDRR1",$J,1,"DRUG COMBO",X,"AGE",ACDAGE)=$G(ACDATBL(ACDAGE))
. Q
K ACDATBL
Q
ACDRR1CC ;IHS/ADC/EDE/KML - BROKE UP ACDRR1CB;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
PATCNT ; EP-COUNT PATIENT DATA
+1 SET ACDSEX=$$SEX^AUPNPAT(ACDPIEN)
IF ACDSEX=""
SET ACDSEX="M"
+2 SET Y=$$AGE^AUPNPAT(ACDPIEN,ACDDTLO)
SET ACDAGE=$SELECT(Y<13:1,Y<21:2,1:3)
+3 SET Y=$$TRIBE^AUPNPAT(ACDPIEN,"E")
SET ACDTRIBE=$SELECT(Y="":"UNKNOWN",1:Y)
+4 DO COUNTCS
+5 DO COMPDAYS
+6 SET ACDCT("SEEN")=ACDCT("SEEN")+1
+7 SET ACDCT("SEEN",ACDSEX)=$GET(ACDCT("SEEN",ACDSEX))+1
+8 SET ACDCT("SEEN","AGE",ACDAGE)=$GET(ACDCT("SEEN","AGE",ACDAGE))+1
+9 SET ACDCT("TRIBE",ACDTRIBE)=$GET(ACDCT("TRIBE",ACDTRIBE))+1
+10 SET ACDCT("TRIBE",ACDTRIBE,ACDSEX)=$GET(ACDCT("TRIBE",ACDTRIBE,ACDSEX))+1
+11 SET ACDCT("TRIBE",ACDTRIBE,"AGE",ACDAGE)=$GET(ACDCT("TRIBE",ACDTRIBE,"AGE",ACDAGE))+1
+12 SET (X,Y)=0
+13 FOR
SET Y=$ORDER(^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN,"T",Y))
IF Y=""
QUIT
SET X=X+Y
+14 IF X>3
SET X=3
+15 IF X
Begin DoDot:1
+16 SET ACDCT("TOBACCO",X)=ACDCT("TOBACCO",X)+1
+17 SET ACDCT("TOBACCO",X,ACDSEX)=$GET(ACDCT("TOBACCO",X,ACDSEX))+1
+18 SET ACDCT("TOBACCO",X,"AGE",ACDAGE)=$GET(ACDCT("TOBACCO",X,"AGE",ACDAGE))+1
+19 QUIT
End DoDot:1
+20 SET ACDA=$ORDER(^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN,"A",0))
+21 SET ACDD=$ORDER(^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN,"D",0))
+22 IF ACDA
Begin DoDot:1
+23 SET ACDCT("ALCOHOL")=ACDCT("ALCOHOL")+1
+24 SET ACDCT("ALCOHOL","CS")=ACDCT("ALCOHOL","CS")+ACDCSC
+25 SET ACDCT("ALCOHOL","DAYS")=ACDCT("ALCOHOL","DAYS")+ACDADAYS
+26 SET ACDCT("ALCOHOL","HRS")=ACDCT("ALCOHOL","HRS")+ACDCSH
+27 SET ACDCT("ALCOHOL",ACDSEX)=ACDCT("ALCOHOL",ACDSEX)+1
+28 SET ACDCT("ALCOHOL","AGE",ACDAGE)=$GET(ACDCT("ALCOHOL","AGE",ACDAGE))+1
+29 QUIT
End DoDot:1
+30 IF ACDD
Begin DoDot:1
+31 SET ACDCT("DRUGS")=ACDCT("DRUGS")+1
+32 SET ACDCT("DRUGS","CS")=ACDCT("DRUGS","CS")+ACDCSC
+33 SET ACDCT("DRUGS","DAYS")=ACDCT("DRUGS","DAYS")+ACDDDAYS
+34 SET ACDCT("DRUGS","HRS")=ACDCT("DRUGS","HRS")+ACDCSH
+35 SET ACDCT("DRUGS",ACDSEX)=ACDCT("DRUGS",ACDSEX)+1
+36 SET ACDCT("DRUGS","AGE",ACDAGE)=$GET(ACDCT("DRUGS","AGE",ACDAGE))+1
+37 QUIT
End DoDot:1
+38 IF ACDA
IF ACDD
Begin DoDot:1
+39 SET ACDCT("ALCOHOL&DRUGS")=ACDCT("ALCOHOL&DRUGS")+1
+40 SET ACDCT("ALCOHOL&DRUGS","CS")=ACDCT("ALCOHOL&DRUGS","CS")+ACDCSC
+41 SET ACDCT("ALCOHOL&DRUGS","DAYS")=ACDCT("ALCOHOL&DRUGS","DAYS")+ACDADAYS
+42 SET ACDCT("ALCOHOL&DRUGS","HRS")=ACDCT("ALCOHOL&DRUGS","HRS")+ACDCSH
+43 SET ACDCT("ALCOHOL&DRUGS",ACDSEX)=ACDCT("ALCOHOL&DRUGS",ACDSEX)+1
+44 QUIT
End DoDot:1
+45 IF ACDA
IF 'ACDD
Begin DoDot:1
+46 SET ACDCT("ALCOHOL ONLY")=ACDCT("ALCOHOL ONLY")+1
+47 SET ACDCT("ALCOHOL ONLY","CS")=ACDCT("ALCOHOL ONLY","CS")+ACDCSC
+48 SET ACDCT("ALCOHOL ONLY","DAYS")=ACDCT("ALCOHOL ONLY","DAYS")+ACDADAYS
+49 SET ACDCT("ALCOHOL ONLY","HRS")=ACDCT("ALCOHOL ONLY","HRS")+ACDCSH
+50 SET ACDCT("ALCOHOL ONLY",ACDSEX)=ACDCT("ALCOHOL ONLY",ACDSEX)+1
+51 QUIT
End DoDot:1
+52 IF ACDD
IF 'ACDA
Begin DoDot:1
+53 SET ACDCT("DRUGS ONLY")=ACDCT("DRUGS ONLY")+1
+54 SET ACDCT("DRUGS ONLY","CS")=ACDCT("DRUGS ONLY","CS")+ACDCSC
+55 SET ACDCT("DRUGS ONLY","DAYS")=ACDCT("DRUGS ONLY","DAYS")+ACDDDAYS
+56 SET ACDCT("DRUGS ONLY","HRS")=ACDCT("DRUGS ONLY","HRS")+ACDCSH
+57 SET ACDCT("DRUGS ONLY",ACDSEX)=ACDCT("DRUGS ONLY",ACDSEX)+1
+58 QUIT
End DoDot:1
+59 IF 'ACDA
IF 'ACDD
Begin DoDot:1
+60 SET ACDCT("NEITHER")=ACDCT("NEITHER")+1
+61 SET ACDCT("NEITHER","CS")=ACDCT("NEITHER","CS")+ACDCSC
+62 SET ACDCT("NEITHER","DAYS")=ACDCT("NEITHER","DAYS")+ACDADAYS
+63 SET ACDCT("NEITHER","HRS")=ACDCT("NEITHER","HRS")+ACDCSH
+64 SET ACDCT("NEITHER",ACDSEX)=ACDCT("NEITHER",ACDSEX)+1
+65 QUIT
End DoDot:1
+66 QUIT
+67 ;
COUNTCS ; COUNT ALL CS ENTRIES FOR THIS PATIENT & GET AVG HOURS
+1 NEW ACDVIEN
+2 SET (ACDVIEN,ACDCSC,ACDCSH,ACDCSHC)=0
+3 FOR
SET ACDVIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN,"CS",ACDVIEN))
IF 'ACDVIEN
QUIT
Begin DoDot:1
+4 SET ACDCSIEN=0
+5 FOR
SET ACDCSIEN=$ORDER(^ACDCS("C",ACDVIEN,ACDCSIEN))
IF 'ACDCSIEN
QUIT
SET ACDCSC=ACDCSC+1
IF $DATA(^ACDCS(ACDCSIEN,0))
SET X=$PIECE(^(0),U,4)
IF X
SET ACDCSHC=ACDCSHC+1
SET ACDCSH=ACDCSH+X
+6 QUIT
End DoDot:1
+7 IF ACDCSHC
SET ACDCSH=ACDCSH/ACDCSHC
SET ACDCSH=ACDCSH+.5
SET ACDCSH=$PIECE(ACDCSH,".")
+8 QUIT
+9 ;
COMPDAYS ; COMPUTE AVERAGE NUMBER OF DAYS USED FOR ALCOHOL/DRUGS
+1 NEW ACDVIEN
+2 SET (ACDADAYS,ACDVIEN,C,V)=0
+3 FOR
SET ACDVIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN,"A",ACDVIEN))
IF 'ACDVIEN
QUIT
SET Y=$GET(^(ACDVIEN,"DAYS"))
IF Y
SET C=C+1
SET V=V+Y
+4 IF V
IF C
SET ACDADAYS=V/C
SET ACDADAYS=ACDADAYS+.5
SET ACDADAYS=$PIECE(ACDADAYS,".")
+5 SET (ACDDDAYS,ACDVIEN,C,V)=0
+6 FOR
SET ACDVIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"PATIENT",ACDPIEN,"D",ACDVIEN))
IF 'ACDVIEN
QUIT
SET Y=$GET(^(ACDVIEN,"DAYS"))
IF Y
SET C=C+1
SET V=V+Y
+7 IF V
IF C
SET ACDDDAYS=V/C
SET ACDDDAYS=ACDDDAYS+.5
SET ACDDDAYS=$PIECE(ACDDDAYS,".")
+8 QUIT
+9 ;
+10 ;
PROBCNT ; EP-COUNT PATIENTS BY PROBLEM
+1 ; compute patient totals for each problem
+2 NEW A,C,F,M,Y
+3 SET ACDPRIEN=0
+4 FOR
SET ACDPRIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"PROBLEM",ACDPRIEN))
IF 'ACDPRIEN
QUIT
Begin DoDot:1
+5 FOR Y=1:1:3
SET ACDATBL(Y)=0
+6 SET (C,F,M,Y)=0
+7 FOR
SET Y=$ORDER(^TMP("ACDRR1",$JOB,1,"PROBLEM",ACDPRIEN,Y))
IF 'Y
QUIT
Begin DoDot:2
+8 SET C=C+1
+9 SET ACDSEX=$$SEX^AUPNPAT(Y)
IF ACDSEX="-1"
SET ACDSEX="M"
+10 SET @ACDSEX=@ACDSEX+1
+11 SET A=$$AGE^AUPNPAT(Y,ACDDTLO)
SET ACDAGE=$SELECT(A<13:1,A<21:2,1:3)
+12 SET ACDATBL(ACDAGE)=ACDATBL(ACDAGE)+1
+13 QUIT
End DoDot:2
+14 KILL ^TMP("ACDRR1",$JOB,1,"PROBLEM",ACDPRIEN)
SET ^(ACDPRIEN)=C
+15 FOR ACDSEX="M","F"
SET ^TMP("ACDRR1",$JOB,1,"PROBLEM",ACDPRIEN,ACDSEX)=@ACDSEX
+16 FOR ACDAGE=1:1:3
SET ^TMP("ACDRR1",$JOB,1,"PROBLEM",ACDPRIEN,"AGE",ACDAGE)=$GET(ACDATBL(ACDAGE))
+17 QUIT
End DoDot:1
+18 KILL ACDATBL
+19 SET ACDPRIEN=0
+20 FOR
SET ACDPRIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"PRI PROB",ACDPRIEN))
IF 'ACDPRIEN
QUIT
Begin DoDot:1
+21 FOR Y=1:1:3
SET ACDATBL(Y)=0
+22 SET (C,F,M,Y)=0
+23 FOR
SET Y=$ORDER(^TMP("ACDRR1",$JOB,1,"PRI PROB",ACDPRIEN,Y))
IF 'Y
QUIT
Begin DoDot:2
+24 SET C=C+1
+25 SET ACDSEX=$$SEX^AUPNPAT(Y)
IF ACDSEX="-1"
SET ACDSEX="M"
+26 SET @ACDSEX=@ACDSEX+1
+27 SET A=$$AGE^AUPNPAT(Y,ACDDTLO)
SET ACDAGE=$SELECT(A<13:1,A<21:2,1:3)
+28 SET ACDATBL(ACDAGE)=ACDATBL(ACDAGE)+1
+29 QUIT
End DoDot:2
+30 KILL ^TMP("ACDRR1",$JOB,1,"PRI PROB",ACDPRIEN)
SET ^(ACDPRIEN)=C
+31 FOR ACDSEX="M","F"
SET ^TMP("ACDRR1",$JOB,1,"PRI PROB",ACDPRIEN,ACDSEX)=@ACDSEX
+32 FOR ACDAGE=1:1:3
SET ^TMP("ACDRR1",$JOB,1,"PRI PROB",ACDPRIEN,"AGE",ACDAGE)=$GET(ACDATBL(ACDAGE))
+33 QUIT
End DoDot:1
+34 KILL ACDATBL
+35 QUIT
+36 ;
DRUGCNT ; EP-COUNT PATIENTS BY DRUG USED
+1 ; compute patient totals for each drug
+2 NEW A,C,F,M,Y
+3 SET ACDDIEN=""
+4 FOR
SET ACDDIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"DRUG",ACDDIEN))
IF ACDDIEN=""
QUIT
Begin DoDot:1
+5 FOR Y=1:1:3
SET ACDATBL(Y)=0
+6 SET (C,F,M,Y)=0
+7 FOR
SET Y=$ORDER(^TMP("ACDRR1",$JOB,1,"DRUG",ACDDIEN,Y))
IF 'Y
QUIT
Begin DoDot:2
+8 SET C=C+1
+9 SET ACDSEX=$$SEX^AUPNPAT(Y)
IF ACDSEX=""
SET ACDSEX="M"
+10 SET @ACDSEX=@ACDSEX+1
+11 SET A=$$AGE^AUPNPAT(Y,ACDDTLO)
SET ACDAGE=$SELECT(A<13:1,A<21:2,1:3)
+12 SET ACDATBL(ACDAGE)=ACDATBL(ACDAGE)+1
+13 QUIT
End DoDot:2
+14 KILL ^TMP("ACDRR1",$JOB,1,"DRUG",ACDDIEN)
SET ^(ACDDIEN)=C
+15 FOR ACDSEX="M","F"
SET ^TMP("ACDRR1",$JOB,1,"DRUG",ACDDIEN,ACDSEX)=@ACDSEX
+16 FOR ACDAGE=1:1:3
SET ^TMP("ACDRR1",$JOB,1,"DRUG",ACDDIEN,"AGE",ACDAGE)=$GET(ACDATBL(ACDAGE))
+17 QUIT
End DoDot:1
+18 ; compute patient totals for each drug combonation (alcohol included)
+19 KILL ACDATBL
+20 SET X=""
+21 FOR
SET X=$ORDER(^TMP("ACDRR1",$JOB,1,"DRUG COMBO",X))
IF X=""
QUIT
Begin DoDot:1
+22 FOR Y=1:1:3
SET ACDATBL(Y)=0
+23 SET (C,F,M,Y)=0
+24 FOR
SET ACDPIEN=$ORDER(^TMP("ACDRR1",$JOB,1,"DRUG COMBO",X,ACDPIEN))
IF 'ACDPIEN
QUIT
Begin DoDot:2
+25 SET C=C+1
+26 SET ACDSEX=$$SEX^AUPNPAT(ACDPIEN)
IF ACDSEX="-1"
SET ACDSEX="M"
+27 SET @ACDSEX=@ACDSEX+1
+28 SET A=$$AGE^AUPNPAT(ACDPIEN,ACDDTLO)
SET ACDAGE=$SELECT(A<13:1,A<21:2,1:3)
+29 SET ACDATBL(ACDAGE)=ACDATBL(ACDAGE)+1
+30 QUIT
End DoDot:2
+31 KILL ^TMP("ACDRR1",$JOB,1,"DRUG COMBO",X)
SET ^(X)=C
+32 FOR ACDSEX="M","F"
SET ^TMP("ACDRR1",$JOB,1,"DRUG COMBO",X,ACDSEX)=@ACDSEX
+33 FOR ACDAGE=1:1:3
SET ^TMP("ACDRR1",$JOB,1,"DRUG COMBO",X,"AGE",ACDAGE)=$GET(ACDATBL(ACDAGE))
+34 QUIT
End DoDot:1
+35 KILL ACDATBL
+36 QUIT
