- 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