- YTMBMD2 ;ALB/ASF-MBMD ; 2/14/12 1:26pm
- ;;5.01;MENTAL HEALTH;**105**;Dec 30, 1994;Build 76
- ;No external references
- PERCENT ; bariatric untransformed prevalence scores
- F I=69:1:97 S $P(S,U,I)=$P(^YTT(601,YSTEST,"S",I,YSSEX),U,$P(R,U,I)+1)
- Q
- PAINREP ; pain pt report
- S (YSTOUT,YSUOUT)=""
- 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
- D DTA^YTREPT
- W !,?(72-$L(X)\2),X,!
- W !?50,$S(YSVFLAG:"*** Invalid Profile ***",1:"Valid Profile")
- W !,"*** Pain Patient Percentiles ***"
- F I=2:1:10 D D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
- . W:I=2 !,"Response Patterns" ;ASF 1/30/04 ABOVE LINE ALSO
- . W:I=5 !,"Negative Health Habits"
- . W !,?4,$P(^YTT(601,YSTEST,"S",I,0),U,2),?25 D LIKELY
- D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
- F I=69:1:97 D D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
- . W:I=69 !,"Psychiatric Indications"
- . W:I=74 !,"Coping Styles"
- . W:I=85 !,"Stress Moderators"
- . W:I=91 !,"Treatment Prognostics"
- . W:I=96 !,"Management Guides"
- . S YSSID=$P(^YTT(601,YSTEST,"S",I,0),U,2)
- . W !,$P(YSSID," ")
- . W ?5,$J($P(R,U,I),2)," ",$S($P(S,U,I)'<0:$J($P(S,U,I),3),1:" 0")," "
- . D CHART
- . W ?52,$P(YSSID," ",2,99)
- Q
- LIKELY ;
- N X
- S X=$P(S,U,I)
- W $S(X="L":"unlikely problem",X="M":"possible problem",X="H":"likely problem",1:"????")
- Q
- CHART ;
- N X
- S X=$P(S,U,I)
- ;W $E("***************************************************************",1,$J(X/3,0,0))
- W $E("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",1,$J(X/3,0,0))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMBMD2 1576 printed Feb 18, 2025@23:43:45 Page 2
- YTMBMD2 ;ALB/ASF-MBMD ; 2/14/12 1:26pm
- +1 ;;5.01;MENTAL HEALTH;**105**;Dec 30, 1994;Build 76
- +2 ;No external references
- PERCENT ; bariatric untransformed prevalence scores
- +1 FOR I=69:1:97
- SET $PIECE(S,U,I)=$PIECE(^YTT(601,YSTEST,"S",I,YSSEX),U,$PIECE(R,U,I)+1)
- +2 QUIT
- PAINREP ; pain pt report
- +1 SET (YSTOUT,YSUOUT)=""
- +2 SET X=$PIECE(^YTT(601,YSTEST,"P"),U)
- SET A=$PIECE(^("P"),U,2)
- SET B=$PIECE(^("P"),U,3)
- SET L1=58-A\2
- SET L2=L1+A+4
- if A<9
- SET A=9
- +3 DO DTA^YTREPT
- +4 WRITE !,?(72-$LENGTH(X)\2),X,!
- +5 WRITE !?50,$SELECT(YSVFLAG:"*** Invalid Profile ***",1:"Valid Profile")
- +6 WRITE !,"*** Pain Patient Percentiles ***"
- +7 FOR I=2:1:10
- Begin DoDot:1
- +8 ;ASF 1/30/04 ABOVE LINE ALSO
- if I=2
- WRITE !,"Response Patterns"
- +9 if I=5
- WRITE !,"Negative Health Habits"
- +10 WRITE !,?4,$PIECE(^YTT(601,YSTEST,"S",I,0),U,2),?25
- DO LIKELY
- End DoDot:1
- if IOST?1"C-".E&($Y>21)
- DO SCR^YTREPT
- if YSTOUT!YSUOUT
- QUIT
- +11 if IOST?1"C-".E&($Y>21)
- DO SCR^YTREPT
- if YSTOUT!YSUOUT
- QUIT
- +12 FOR I=69:1:97
- Begin DoDot:1
- +13 if I=69
- WRITE !,"Psychiatric Indications"
- +14 if I=74
- WRITE !,"Coping Styles"
- +15 if I=85
- WRITE !,"Stress Moderators"
- +16 if I=91
- WRITE !,"Treatment Prognostics"
- +17 if I=96
- WRITE !,"Management Guides"
- +18 SET YSSID=$PIECE(^YTT(601,YSTEST,"S",I,0),U,2)
- +19 WRITE !,$PIECE(YSSID," ")
- +20 WRITE ?5,$JUSTIFY($PIECE(R,U,I),2)," ",$SELECT($PIECE(S,U,I)'<0:$JUSTIFY($PIECE(S,U,I),3),1:" 0")," "
- +21 DO CHART
- +22 WRITE ?52,$PIECE(YSSID," ",2,99)
- End DoDot:1
- if IOST?1"C-".E&($Y>21)
- DO SCR^YTREPT
- if YSTOUT!YSUOUT
- QUIT
- +23 QUIT
- LIKELY ;
- +1 NEW X
- +2 SET X=$PIECE(S,U,I)
- +3 WRITE $SELECT(X="L":"unlikely problem",X="M":"possible problem",X="H":"likely problem",1:"????")
- +4 QUIT
- CHART ;
- +1 NEW X
- +2 SET X=$PIECE(S,U,I)
- +3 ;W $E("***************************************************************",1,$J(X/3,0,0))
- +4 WRITE $EXTRACT("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",1,$JUSTIFY(X/3,0,0))
- +5 QUIT