- 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
