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

ACDRR1PB.m

Go to the documentation of this file. 
  1. ACDRR1PB ;IHS/ADC/EDE/KML - BROKE UP ACDRR1P;
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1. ALCDRUG ;EP-alcohol/drug problem
  1.  D F Q:ACDQ
  1.  W !!,?50,"SEX",?68,"AGE",!
  1.  W "PATIENT COUNT BY ALCOHOL/DRUG PROBLEM",?48,"M",?55,"F",?62,"<13",?67,"13-20",?75,"21+",!!
  1.  ; seen
  1.  D F Q:ACDQ
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN","AGE",%)
  1.  W ?2,$$LJRF^ACD("TOTAL SEEN",28,".")," ",X,?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!
  1.  ; alcohol
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL")
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","AGE",%)
  1.  W ?2,$$LJRF^ACD("ALCOHOL",28,".")," ",Y I Y W ?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5)
  1.  W !
  1.  ; drugs
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS")
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","AGE",%)
  1.  W ?2,$$LJRF^ACD("DRUGS",28,".")," ",Y I Y W ?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5)
  1.  W !
  1.  ; alcohol&drugs
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS")
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","AGE",%)
  1.  W ?2,$$LJRF^ACD("ALCOHOL&DRUGS",28,".")," ",Y I Y W ?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5)
  1.  W !
  1.  ; alcohol only
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY")
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","AGE",%)
  1.  W ?2,$$LJRF^ACD("ALCOHOL ONLY",28,".")," ",Y I Y W ?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5)
  1.  W !
  1.  ; drugs only
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY")
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","AGE",%)
  1.  W ?2,$$LJRF^ACD("DRUGS ONLY",28,".")," ",Y I Y W ?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5)
  1.  W !
  1.  ; neither
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER")
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","AGE",%)
  1.  W ?2,$$LJRF^ACD("NEITHER",28,".")," ",Y I Y W ?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5)
  1.  W !
  1.  Q
  1.  ;
  1. DAYSCS ;EP-alcohol/drug problem days used & client service info
  1.  D F Q:ACDQ
  1.  W !
  1.  W ?30,"AVG",?40,"CLIENT SERVICE INFO",!
  1.  W ?27,"DAYS USED",?41,"AVG #CS",?51,"AVG HRS",!!
  1.  ; alcohol
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL")
  1.  S W=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","CS")
  1.  S V=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","DAYS")
  1.  S Z=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL","HRS")
  1.  W ?2,$$LJRF^ACD("ALCOHOL",28,".") I Y W " ",$P(V/Y,"."),?42,$J(W/Y,5,0),?55,$J(Z/Y,2,0)
  1.  W !
  1.  ; drugs
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS")
  1.  S W=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","CS")
  1.  S V=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","DAYS")
  1.  S Z=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","HRS")
  1.  W ?2,$$LJRF^ACD("DRUGS",28,".") I Y W " ",$P(V/Y,"."),?42,$J(W/Y,5,0),?55,$J(Z/Y,2,0)
  1.  W !
  1.  ; alcohol&drugs
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS")
  1.  S W=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","CS")
  1.  S V=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","DAYS")
  1.  S Z=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL&DRUGS","HRS")
  1.  W ?2,$$LJRF^ACD("ALCOHOL&DRUGS",28,".") I Y W " ",$P(V/Y,"."),?42,$J(W/Y,5,0),?55,$J(Z/Y,2,0)
  1.  W !
  1.  ; alcohol only
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY")
  1.  S W=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","CS")
  1.  S V=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","DAYS")
  1.  S Z=^TMP("ACDRR1",ACDJOB,ACDBT,"ALCOHOL ONLY","HRS")
  1.  W ?2,$$LJRF^ACD("ALCOHOL ONLY",28,".") I Y W " ",$P(V/Y,"."),?42,$J(W/Y,5,0),?55,$J(Z/Y,2,0)
  1.  W !
  1.  ; drugs only
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY")
  1.  S W=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","CS")
  1.  S V=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","DAYS")
  1.  S Z=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS ONLY","HRS")
  1.  W ?2,$$LJRF^ACD("DRUGS ONLY",28,".") I Y W " ",$P(V/Y,"."),?42,$J(W/Y,5,0),?55,$J(Z/Y,2,0)
  1.  W !
  1.  ; neither
  1.  D F Q:ACDQ
  1.  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER")
  1.  S W=^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","CS")
  1.  S Z=^TMP("ACDRR1",ACDJOB,ACDBT,"NEITHER","HRS")
  1.  W ?2,$$LJRF^ACD("NEITHER",28,".") I Y W ?42,$J(W/Y,5,0),?55,$J(Z/Y,2,0)
  1.  W !
  1.  Q
  1.  ;
  1. TOBACCO ;EP-tobacco
  1.  D F Q:ACDQ
  1.  W !!,?50,"SEX",?68,"AGE",!
  1.  W "PATIENT COUNT BY TOBACCO USE",?48,"M",?55,"F",?62,"<13",?67,"13-20",?75,"21+",!!
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN","AGE",%)
  1.  W ?2,$$LJRF^ACD("TOTAL SEEN",28,".")," ",X,?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!
  1.  F T=1,2,3 D
  1.  .  Q:'$D(^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",T))
  1.  .  D F Q:ACDQ
  1.  .  S Y=^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",T)
  1.  .  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",T,%)
  1.  .  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"TOBACCO",T,"AGE",%)
  1.  .  S T=$S(T=1:"(SMOKING)",T=2:"(SMOKELESS)",1:"(SMOKING&SMOKELESS)")
  1.  .  W ?2,$$LJRF^ACD("TOBACCO"_T,28,".")," ",Y I Y W ?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5)
  1.  .  W !
  1.  .  Q
  1.  Q
  1.  ;
  1. PRIPROB ;EP-primary problem
  1.  D F Q:ACDQ
  1.  W !!,?50,"SEX",?68,"AGE",!
  1.  W "PATIENT COUNT BY PRIMARY PROBLEM",?48,"M",?55,"F",?62,"<13",?67,"13-20",?75,"21+",!!
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN","AGE",%)
  1.  W ?2,$$LJRF^ACD("TOTAL SEEN",28,".")," ",X,?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!
  1.  S Y="A"
  1.  F  S Y=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"PRI PROB",Y),-1) Q:'Y  D  Q:ACDQ
  1.  .  S ACDPRIEN=0
  1.  .  F  S ACDPRIEN=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"PRI PROB",Y,ACDPRIEN)) Q:'ACDPRIEN  S M=$G(^(ACDPRIEN,"M")),F=$G(^("F")) S %(1)=^("AGE",1),%(2)=^(2),%(3)=^(3) D  Q:ACDQ
  1.  ..  S Z=$P($G(^ACDPROB(ACDPRIEN,0)),U)
  1.  ..  D F Q:ACDQ
  1.  ..  W ?2,$$LJRF^ACD(Z,28,".")," ",Y,?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!
  1.  ..  Q
  1.  .  Q
  1.  Q
  1.  ;
  1. PROBLEM ;EP-problem
  1.  D F Q:ACDQ
  1.  W !!,?50,"SEX",?68,"AGE",!
  1.  W "PATIENT COUNT BY PROBLEM",?48,"M",?55,"F",?62,"<13",?67,"13-20",?75,"21+",!!
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"SEEN","AGE",%)
  1.  W ?2,$$LJRF^ACD("TOTAL SEEN",28,".")," ",X,?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!
  1.  S Y="A"
  1.  F  S Y=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"PROBLEM",Y),-1) Q:'Y  D  Q:ACDQ
  1.  .  S ACDPRIEN=0
  1.  .  F  S ACDPRIEN=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"PROBLEM",Y,ACDPRIEN)) Q:'ACDPRIEN  S M=$G(^(ACDPRIEN,"M")),F=$G(^("F")) S %(1)=^("AGE",1),%(2)=^(2),%(3)=^(3) D  Q:ACDQ
  1.  ..  S Z=$P($G(^ACDPROB(ACDPRIEN,0)),U)
  1.  ..  D F Q:ACDQ
  1.  ..  W ?2,$$LJRF^ACD(Z,28,".")," ",Y,?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!
  1.  ..  Q
  1.  .  Q
  1.  Q
  1.  ;
  1. DRUGUSED ;EP-drug used
  1.  D F Q:ACDQ
  1.  W !!,?50,"SEX",?68,"AGE",!
  1.  W "PATIENT COUNT BY DRUG USED",?48,"M",?55,"F",?62,"<13",?67,"13-20",?75,"21+",!!
  1.  NEW X
  1.  S X=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS")
  1.  Q:X<1  ;                    quit if no drugs used
  1.  F %="M","F" S @%=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS",%)
  1.  F %=1:1:3 S %(%)=^TMP("ACDRR1",ACDJOB,ACDBT,"DRUGS","AGE",%)
  1.  W ?2,$$LJRF^ACD("TOTAL USING DRUGS",28,".")," ",X,?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!
  1.  S Y="A"
  1.  F  S Y=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG",Y),-1) Q:'Y  D  Q:ACDQ
  1.  .  S ACDDIEN=0
  1.  .  F  S ACDDIEN=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG",Y,ACDDIEN)) Q:'ACDDIEN  S M=$G(^(ACDDIEN,"M")),F=$G(^("F")) S %(1)=^("AGE",1),%(2)=^(2),%(3)=^(3) D  Q:ACDQ
  1.  ..  S Z=$P($G(^ACDDRUG(ACDDIEN,0)),U) S:Z="" Z=ACDDIEN
  1.  ..  D F Q:ACDQ
  1.  ..  W ?2,$$LJRF^ACD(Z,28,".")," ",Y,?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!
  1.  ..  Q
  1.  .  Q
  1.  Q
  1.  ;
  1. DRUGCMB ;EP-drug combinations
  1.  I $D(^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG COMBO")) D
  1.  .  D F Q:ACDQ
  1.  .  W !!,?50,"SEX",?68,"AGE",!
  1.  .  W "PATIENT COUNT BY ALCOHOL/DRUG COMBINATIONS",?48,"M",?55,"F",?62,"<13",?67,"13-20",?75,"21+",!
  1.  .  S Y="A"
  1.  .  F  S Y=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG COMBO",Y),-1) Q:'Y  D  Q:ACDQ
  1.  ..  S ACDCMBO=""
  1.  ..  F  S ACDCMBO=$O(^TMP("ACDRR1",ACDJOB,ACDBT,"DRUG COMBO",Y,ACDCMBO)) Q:ACDCMBO=""  S M=$G(^(ACDCMBO,"M")),F=$G(^("F")) S %1=^("AGE",1),%2=^(2),%3=^(3) D  Q:ACDQ
  1.  ...  W !
  1.  ...  S Z=""
  1.  ...  F %=1:1 S ACDDIEN=$P(ACDCMBO,",",%) Q:ACDDIEN=""  D F Q:ACDQ  W:Z'="" ?2,Z,! S Z="" S:ACDDIEN="A" Z="ALCOHOL" I Z="" S Z=$P($G(^ACDDRUG(ACDDIEN,0)),U) S:Z="" Z=ACDDIEN
  1.  ...  D F Q:ACDQ
  1.  ...  W ?2,$$LJRF^ACD(Z,28,".")," ",Y,?37,$J((Y/X*100),3,0),"%",?44,$J(M,5),?51,$J(F,5),?60,$J(%(1),5),?67,$J(%(2),5),?73,$J(%(3),5),!
  1.  ...  Q
  1.  ..  Q
  1.  .  Q
  1.  Q
  1.  ;
  1. F ;Form feed
  1.  NEW V,W,X,Y,Z
  1.  I $Y+4>IOSL D
  1.  . I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST,1,2)'="P-" D PAUSE^ACDDEU S:$D(DIRUT) ACDQ=1
  1.  . W @IOF
  1.  . W !
  1.  . Q
  1.  Q