ACDRR1CB.m

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=""