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

YTMBMD.m

Go to the documentation of this file.
  1. YTMBMD ;ALB/ASF,HIOFO/FT - MBMD ; 7/15/13 1:43pm
  1. ;;5.01;MENTAL HEALTH;**76,83,105**;Dec 30, 1994;Build 76
  1. ;No external references
  1. MAIN ;
  1. N A,B,G,I,L1,L2,N,X,YSANS,YSDAS,YSDAS1,YSIN,YSSID,YSTOUT,YSUOUT,YSVFLAG
  1. D PTVAR^YSLRP
  1. D RD
  1. D VALIDITY ;Q:YSVFLAG
  1. D RAW
  1. D PS1 ; general untransformed
  1. D RPA ; general response adjustment
  1. D HPA ; general high point coping
  1. D HPA1 ; general high point AA-EE a-m
  1. D:YSTY["*" REPT
  1. S R=R_U_$P(R,U,11,999)_U_$P(R,U,11,999)
  1. D PSB^YTMBMD1 ; bariatric untransformed
  1. D RPAB^YTMBMD1 ; bariatric response adjustment
  1. D HPAB^YTMBMD1 ; bariatric high point coping
  1. D HPA1B^YTMBMD1 ; bariatric high point AA-EE a-m
  1. D:YSTY["*" REPTB^YTMBMD1
  1. D PERCENT^YTMBMD2
  1. D:YSTY["*" PAINREP^YTMBMD2
  1. Q:$G(YSTOUT)!$G(YSUOUT) S (YSTOUT,YSUOUT)=""
  1. D:YSTY["*" NOTEWOR
  1. Q
  1. RD S X=^YTD(601.2,YSDFN,1,YSTEST,1,YSED,1)
  1. Q
  1. VALIDITY ;check if ok to score
  1. S YSVFLAG=0
  1. I $L(X,"X")>11 S YSVFLAG=1 Q
  1. I ($E(X,106)="T")&($E(X,124)="T") S YSVFLAG=1 Q
  1. I (YSAGE<18)!(YSAGE>85) S YSVFLAG=1 Q
  1. Q
  1. RAW ; raw scores
  1. S R="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
  1. F N=1:1:39 D
  1. . S G=^YTT(601,YSTEST,"S",N,"K",1,0),I=1
  1. . F S YSIN=$P(G,U,I),YSANS=$E($P(G,U,I+1),1),YSWT=$P($P(G,U,I+1),";",2),I=I+2 Q:YSIN="" S:$E(X,YSIN)=YSANS $P(R,U,N)=$P(R,U,N)+YSWT
  1. Q
  1. PS1 ; untransformed prevalence scores
  1. S S="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
  1. F I=11:1:39 S $P(S,U,I)=$P(^YTT(601,YSTEST,"S",I,YSSEX),U,$P(R,U,I)+1)
  1. S X=$P(R,U,2) S $P(S,U,2)=$S(X<9:"L",X=9:"M",X=10:"H",1:0) ;scale X ASF 1/30/04
  1. S X=$P(R,U,3) S $P(S,U,3)=$S(X<10:"L",X<13:"M",X>12:"H",1:0) ;scale Y ASF 1/30/04
  1. S X=$P(R,U,4) S $P(S,U,4)=$S(X<5:"L",X=5:"M",X>5:"H",1:0) ;scale Z ASF 1/30/04
  1. F I=5:1:10 S X=$P(R,U,I) S $P(S,U,I)=$S(X=0:"L",X<3:"M",X>2:"H",1:0) ;indicators ASF 1/30/04
  1. Q
  1. RPA ;Response Pattern Adjustment
  1. S YSDAS=0
  1. I ($P(S,U,2)="H")&($P(S,U,3)="H")&($P(S,U,4)'="H") S YSDAS=10
  1. I ($P(S,U,2)'="H")&($P(S,U,3)="H")&($P(S,U,4)'="H") S YSDAS=10
  1. I ($P(S,U,2)="H")&($P(S,U,3)'="H")&($P(S,U,4)'="H") S YSDAS=-5
  1. I ($P(S,U,2)="H")&($P(S,U,3)'="H")&($P(S,U,4)="H") S YSDAS=-10
  1. I ($P(S,U,2)'="H")&($P(S,U,3)'="H")&($P(S,U,4)="H") S YSDAS=-10
  1. F I=11,12,13,14,15,27,28,29,30,31,32,33,34,35,36,37,38,39 S $P(S,U,I)=$P(S,U,I)+YSDAS
  1. Q
  1. HPA ;High Point Adjustment COPING
  1. S N=0 F I=16:1:26 S:$P(S,U,I)>59 N=N+1
  1. S YSDAS=$S(N>9:-10,N>7:-5,N>4:0,N>2:5,N>0:10,1:15)
  1. F I=16:1:26 S $P(S,U,I)=$P(S,U,I)+YSDAS
  1. Q
  1. HPA1 ;high point AA-EE, a-m
  1. S N=0
  1. F I=11,12,13,14,15,27,28,29,30,31,32,33,34,35,36,37,38,39 S:$P(S,U,I)>59 N=N+1
  1. S YSDAS=$S(N>16:-15,N>14:-10,N>12:-5,N>7:0,N>5:5,N>2:10,1:15)
  1. S YSDAS1=$S(N>12:0,N>7:5,N>5:10,N>2:15,1:20)
  1. F I=11,12,13,14,15,27,28,29,30,31,32,33,34,35,36,37 S $P(S,U,I)=$P(S,U,I)+YSDAS
  1. F I=38,39 S $P(S,U,I)=$P(S,U,I)+YSDAS1
  1. Q
  1. REPT ;reports
  1. S (YSTOUT,YSUOUT)=""
  1. S X=$P(^YTT(601,YSTEST,"P"),U),A=$P(^("P"),U,2),B=$P(^("P"),U,3),L1=58-A\2,L2=L1+A+4 S:A<9 A=9
  1. D DTA^YTREPT
  1. W !,?(72-$L(X)\2),X,!
  1. W !?50,$S(YSVFLAG:"*** Invalid Profile ***",1:"Valid Profile")
  1. W !,"*** General Medical Norms ***"
  1. F I=2:1:10 D D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
  1. . W:I=2 !,"Response Patterns" ;ASF 1/30/04 ABOVE LINE ALSO
  1. . W:I=5 !,"Negative Health Habits"
  1. . W !,?4,$P(^YTT(601,YSTEST,"S",I,0),U,2),?25 D LIKELY
  1. D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
  1. F I=11:1:39 D D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
  1. . W:I=11 !,"Psychiatric Indications"
  1. . W:I=16 !,"Coping Styles"
  1. . W:I=27 !,"Stress Moderators"
  1. . W:I=33 !,"Treatment Prognostics"
  1. . W:I=38 !,"Management Guides"
  1. . S YSSID=$P(^YTT(601,YSTEST,"S",I,0),U,2)
  1. . W !,$P(YSSID," ")
  1. . W ?5,$J($P(R,U,I),2)," ",$S($P(S,U,I)'<0:$J($P(S,U,I),3),1:" 0")," "
  1. . D CHART
  1. . W ?52,$P(YSSID," ",2,99)
  1. ;D NOTEWOR
  1. Q
  1. LIKELY ;
  1. N X
  1. S X=$P(S,U,I)
  1. W $S(X="L":"unlikely problem",X="M":"possible problem",X="H":"likely problem",1:"????")
  1. Q
  1. CHART ;
  1. N X
  1. S X=$P(S,U,I)
  1. ;W $E("***************************************************************",1,$J(X/3,0,0))
  1. W $E("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",1,$J(X/3,0,0))
  1. Q
  1. NOTEWOR ;note worthy responses
  1. D RD
  1. W !!?10,"*** Noteworthy Responses ***"
  1. F I=1,14,28,66,6,117,131,157,3,20,41,62,5,10,103,116,49 D D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
  1. .W:I=1 !!?4,"Panic Susceptibility"
  1. .W:I=6 !!?4,"Disorientation"
  1. .W:I=3 !!?4,"Medical Anxiety"
  1. .W:I=5 !!?4,"Adherence Problems"
  1. .W:I=49 !!?4,"Suicidal Tendencies"
  1. . W:$E(X,I)="T" !,$J(I,3,0),". ",^YTT(601,YSTEST,"Q",I,"T",1,0)
  1. I (($E(X,49)="T")&($E(X,58)="T"))!(($E(X,161)="T")&($E(X,58)="T")) W !," 58. ",^YTT(601,YSTEST,"Q",58,"T",1,0)
  1. I (($E(X,49)="T")&($E(X,161)="T"))!(($E(X,161)="T")&($E(X,58)="T")) W !,"161. ",^YTT(601,YSTEST,"Q",161,"T",1,0)