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

YTMBMD2.m

Go to the documentation of this file.
  1. YTMBMD2 ;ALB/ASF-MBMD ; 2/14/12 1:26pm
  1. ;;5.01;MENTAL HEALTH;**105**;Dec 30, 1994;Build 76
  1. ;No external references
  1. PERCENT ; bariatric untransformed prevalence scores
  1. F I=69:1:97 S $P(S,U,I)=$P(^YTT(601,YSTEST,"S",I,YSSEX),U,$P(R,U,I)+1)
  1. Q
  1. PAINREP ; pain pt report
  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 !,"*** Pain Patient Percentiles ***"
  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=69:1:97 D D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
  1. . W:I=69 !,"Psychiatric Indications"
  1. . W:I=74 !,"Coping Styles"
  1. . W:I=85 !,"Stress Moderators"
  1. . W:I=91 !,"Treatment Prognostics"
  1. . W:I=96 !,"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. 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