AMHLEFP4 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
S(Y,F,C,T) ;set up array
I '$G(F) S F=0
I '$G(T) S T=0
;blank lines
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_Y
D S1
Q
S1 ;
S %=$P(^TMP("AMHS",$J,"DCS",0),U)+1,$P(^TMP("AMHS",$J,"DCS",0),U)=%
S ^TMP("AMHS",$J,"DCS",%)=X
Q
CDST ;EP
;print out cd items
I $P(^AMHREC(AMHR,0),U,32)]"" S X="",$E(X,3)="A/SA CD TYPE OF CONTACT: ",$E(X,28)=$$VAL^XBDIQ1(9002011,AMHR,.32) D S(X)
I $P($G(^AMHREC(AMHR,11)),U,1)]"" S X="",$E(X,3)="A/SA CD COMPONENT: ",$E(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1101) D S(X)
I $P($G(^AMHREC(AMHR,11)),U,5)]"" S X="",$E(X,3)="A/SA CD COMPONENT TYPE: ",$E(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1105) D S(X)
;I $P($G(^AMHREC(AMHR,11)),U,6)]"" S X="",$E(X,3)="PREVENTION ACTIVITY TARGET: ",$E(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1106) D S(X)
I $P($G(^AMHREC(AMHR,11)),U,2)]"" S X="",$E(X,3)="DAYS IN RESIDENTIAL TX: ",$E(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1102) D S(X)
I $P($G(^AMHREC(AMHR,11)),U,3)]"" S X="",$E(X,3)="DAYS IN AFTERCARE: ",$E(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1103) D S(X)
I AMHEFT="S" Q
S AMHCDST=$O(^AMHRCDST("B",AMHR,0))
I 'AMHCDST S X=$TR($J("",79)," ","_") D S(X) Q
S X="",$E(X,3)="------- STAGING TOOL -------" D S(X)
S AMHCDST0=^AMHRCDST(AMHCDST,0)
S X="",$E(X,3)="DAYS USED ALCOHOL: ",$E(X,28)=$P(AMHCDST0,U,6),$E(X,40)="DAYS USED DRUGS: ",$E(X,67)=$P(AMHCDST0,U,7) D S(X)
I $O(^AMHRCDST(AMHCDST,41,0)) D
.S X="",$E(X,3)="DRUG TYPE:"
.S Y=0 F S Y=$O(^AMHRCDST(AMHCDST,41,Y)) Q:Y'=+Y S D=$P(^AMHRCDST(AMHCDST,41,Y,0),U) I Y S X=X_" "_$P($G(^AMHTDRUG(D,0)),U)
.D S(X)
S X="",$E(X,3)="DAYS HOSPITALIZED: ",$E(X,28)=$P(AMHCDST0,U,8),$E(X,40)="ALC/DRUG RELATED ARRESTS:",$E(X,67)=$P(AMHCDST0,U,9) D S(X)
S X="",$E(X,3)="ALCOHOL/SUBSTANCE STAGE: ",$E(X,28)=$P(AMHCDST0,U,12),$E(X,40)="PHYSICAL STAGE: ",$E(X,67)=$P(AMHCDST0,U,13) D S(X)
S X="",$E(X,3)="EMOTIONAL STAGE: ",$E(X,28)=$P(AMHCDST0,U,14),$E(X,40)="SOCIAL STAGE: ",$E(X,67)=$P(AMHCDST0,U,15) D S(X)
S X="",$E(X,3)="CULTURAL/SPIRIT STAGE: ",$E(X,28)=$P(AMHCDST0,U,16),$E(X,40)="BEHAVIORAL STAGE: ",$E(X,67)=$P(AMHCDST0,U,17) D S(X)
S X="",$E(X,3)="VOCATIONAL/EDUC: ",$E(X,28)=$P(AMHCDST0,U,18),$E(X,40)="STAGING AVERAGE: ",$E(X,67)=$$VAL^XBDIQ1(9002011.06,AMHCDST,.018) D S(X)
S X="",$E(X,3)="RECOMMENDED PLACEMENT:",$E(X,28)=$$VAL^XBDIQ1(9002011.06,AMHCDST,.21) D S(X)
S X="",$E(X,3)="ACTUAL PLACEMENT:",$E(X,28)=$$VAL^XBDIQ1(9002011.06,AMHCDST,.22) D S(X)
S X="",$E(X,3)="DIFFERENCE REASON:",$E(X,28)=$$VAL^XBDIQ1(9002011.06,AMHCDST,.23) D S(X)
S X=$TR($J("",79)," ","_") D S(X)
Q
AMHLEFP4 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
S(Y,F,C,T) ;set up array
+1 IF '$GET(F)
SET F=0
+2 IF '$GET(T)
SET T=0
+3 ;blank lines
+4 FOR F=1:1:F
SET X=""
DO S1
+5 SET X=Y
+6 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+7 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+8 FOR %=1:1:T
SET X=" "_Y
+9 DO S1
+10 QUIT
S1 ;
+1 SET %=$PIECE(^TMP("AMHS",$JOB,"DCS",0),U)+1
SET $PIECE(^TMP("AMHS",$JOB,"DCS",0),U)=%
+2 SET ^TMP("AMHS",$JOB,"DCS",%)=X
+3 QUIT
CDST ;EP
+1 ;print out cd items
+2 IF $PIECE(^AMHREC(AMHR,0),U,32)]""
SET X=""
SET $EXTRACT(X,3)="A/SA CD TYPE OF CONTACT: "
SET $EXTRACT(X,28)=$$VAL^XBDIQ1(9002011,AMHR,.32)
DO S(X)
+3 IF $PIECE($GET(^AMHREC(AMHR,11)),U,1)]""
SET X=""
SET $EXTRACT(X,3)="A/SA CD COMPONENT: "
SET $EXTRACT(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1101)
DO S(X)
+4 IF $PIECE($GET(^AMHREC(AMHR,11)),U,5)]""
SET X=""
SET $EXTRACT(X,3)="A/SA CD COMPONENT TYPE: "
SET $EXTRACT(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1105)
DO S(X)
+5 ;I $P($G(^AMHREC(AMHR,11)),U,6)]"" S X="",$E(X,3)="PREVENTION ACTIVITY TARGET: ",$E(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1106) D S(X)
+6 IF $PIECE($GET(^AMHREC(AMHR,11)),U,2)]""
SET X=""
SET $EXTRACT(X,3)="DAYS IN RESIDENTIAL TX: "
SET $EXTRACT(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1102)
DO S(X)
+7 IF $PIECE($GET(^AMHREC(AMHR,11)),U,3)]""
SET X=""
SET $EXTRACT(X,3)="DAYS IN AFTERCARE: "
SET $EXTRACT(X,28)=$$VAL^XBDIQ1(9002011,AMHR,1103)
DO S(X)
+8 IF AMHEFT="S"
QUIT
+9 SET AMHCDST=$ORDER(^AMHRCDST("B",AMHR,0))
+10 IF 'AMHCDST
SET X=$TRANSLATE($JUSTIFY("",79)," ","_")
DO S(X)
QUIT
+11 SET X=""
SET $EXTRACT(X,3)="------- STAGING TOOL -------"
DO S(X)
+12 SET AMHCDST0=^AMHRCDST(AMHCDST,0)
+13 SET X=""
SET $EXTRACT(X,3)="DAYS USED ALCOHOL: "
SET $EXTRACT(X,28)=$PIECE(AMHCDST0,U,6)
SET $EXTRACT(X,40)="DAYS USED DRUGS: "
SET $EXTRACT(X,67)=$PIECE(AMHCDST0,U,7)
DO S(X)
+14 IF $ORDER(^AMHRCDST(AMHCDST,41,0))
Begin DoDot:1
+15 SET X=""
SET $EXTRACT(X,3)="DRUG TYPE:"
+16 SET Y=0
FOR
SET Y=$ORDER(^AMHRCDST(AMHCDST,41,Y))
IF Y'=+Y
QUIT
SET D=$PIECE(^AMHRCDST(AMHCDST,41,Y,0),U)
IF Y
SET X=X_" "_$PIECE($GET(^AMHTDRUG(D,0)),U)
+17 DO S(X)
End DoDot:1
+18 SET X=""
SET $EXTRACT(X,3)="DAYS HOSPITALIZED: "
SET $EXTRACT(X,28)=$PIECE(AMHCDST0,U,8)
SET $EXTRACT(X,40)="ALC/DRUG RELATED ARRESTS:"
SET $EXTRACT(X,67)=$PIECE(AMHCDST0,U,9)
DO S(X)
+19 SET X=""
SET $EXTRACT(X,3)="ALCOHOL/SUBSTANCE STAGE: "
SET $EXTRACT(X,28)=$PIECE(AMHCDST0,U,12)
SET $EXTRACT(X,40)="PHYSICAL STAGE: "
SET $EXTRACT(X,67)=$PIECE(AMHCDST0,U,13)
DO S(X)
+20 SET X=""
SET $EXTRACT(X,3)="EMOTIONAL STAGE: "
SET $EXTRACT(X,28)=$PIECE(AMHCDST0,U,14)
SET $EXTRACT(X,40)="SOCIAL STAGE: "
SET $EXTRACT(X,67)=$PIECE(AMHCDST0,U,15)
DO S(X)
+21 SET X=""
SET $EXTRACT(X,3)="CULTURAL/SPIRIT STAGE: "
SET $EXTRACT(X,28)=$PIECE(AMHCDST0,U,16)
SET $EXTRACT(X,40)="BEHAVIORAL STAGE: "
SET $EXTRACT(X,67)=$PIECE(AMHCDST0,U,17)
DO S(X)
+22 SET X=""
SET $EXTRACT(X,3)="VOCATIONAL/EDUC: "
SET $EXTRACT(X,28)=$PIECE(AMHCDST0,U,18)
SET $EXTRACT(X,40)="STAGING AVERAGE: "
SET $EXTRACT(X,67)=$$VAL^XBDIQ1(9002011.06,AMHCDST,.018)
DO S(X)
+23 SET X=""
SET $EXTRACT(X,3)="RECOMMENDED PLACEMENT:"
SET $EXTRACT(X,28)=$$VAL^XBDIQ1(9002011.06,AMHCDST,.21)
DO S(X)
+24 SET X=""
SET $EXTRACT(X,3)="ACTUAL PLACEMENT:"
SET $EXTRACT(X,28)=$$VAL^XBDIQ1(9002011.06,AMHCDST,.22)
DO S(X)
+25 SET X=""
SET $EXTRACT(X,3)="DIFFERENCE REASON:"
SET $EXTRACT(X,28)=$$VAL^XBDIQ1(9002011.06,AMHCDST,.23)
DO S(X)
+26 SET X=$TRANSLATE($JUSTIFY("",79)," ","_")
DO S(X)
+27 QUIT
