YTMCMI3R ;ALB/ASF,HIOFO/FT - MCMI3 REPORT ;4/29/13 2:44pm
;;5.01;MENTAL HEALTH;**76,119**;Dec 30, 1994;Build 40
;No external references
REPT ;reports
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 !?40,$S(YSVFLAG'=0:"*** Invalid Profile *** "_YSVFLAG,1:"Valid Profile")
W:YSINPT?1A !,"Patient entered as an ",$S(YSINPT="I":"Inpatient",1:"Outpatient"),"." W:YSINPT="" !,"No setting entered, patient assumed to be outpatient."
W !,"Duration of recent Axis I episode: "
W:YSDUR?1N $P("Cannot Categorize^Less than 1 week^1-4 weeks^1-3 months^3-12 months^Periodic; 1-3 years^Coninuous; 1-3 years^Periodic; 3-7 years^Continuous 3-7 years^More than 7 years",U,YSDUR+1)
W !,"Inconsistency (Scale W)="_$P(R,U,29),!
F I=2:1:28 D D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
. W:I=2 !,"Modifying Indices"
. W:I=5 !,"Clinical Personality Patterns"
. W:I=16 !,"Severe Personality Pathology"
. W:I=19 !,"Clinical Syndromes"
. W:I=26 !,"Severe Clinical Syndromes"
. S YSSID=$P(^YTT(601,YSTEST,"S",I,0),U,2)
. W !,$P(YSSID," ")
. W ?5,$J($P(R,U,I),3)," ",$J($P(S,U,I),3)," "
. D CHART
. W ?53,$P(YSSID," ",2,99)
D NOTEWOR
Q
CHART ;
N X
S X=$P(S,U,I)
W $E("***************************************************************",1,$J(X/3,0,0))
Q
NOTEWOR ;note worthy responses
D RD^YTMCMI3
W !!?10,"*** Noteworthy Responses ***"
F I=1,4,11,37,55,74,75,107,130,149,10,18,27,48,63,69,92,99,105,161,165,167,174,9,14,22,30,34,77,83,87,96,116,124,134,24,44,112,128,142,150,151,154,171,81,132,121,143,155,163 D D:IOST?1"C-".E&($Y>21) SCR^YTREPT Q:YSTOUT!YSUOUT
. W:I=1 !!,"Health Preoccupation"
. W:I=10 !!,"Interpersonal Alienation"
. W:I=9 !!,"Emotional Dyscontrol"
. W:I=24 !!,"Self-Destructive Potential"
. W:I=81 !!,"Childhood Abuse"
. W:I=121 !!,"Eating Disorder"
. Q:$E(X,I)'="T"
. W !,$J(I,3,0),". ",^YTT(601,YSTEST,"Q",I,"T",1,0)
. W:$D(^YTT(601,YSTEST,"Q",I,"T",2,0)) !?5,^YTT(601,YSTEST,"Q",I,"T",2,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMCMI3R 2085 printed Apr 09, 2024@21:21:33 Page 2
YTMCMI3R ;ALB/ASF,HIOFO/FT - MCMI3 REPORT ;4/29/13 2:44pm
+1 ;;5.01;MENTAL HEALTH;**76,119**;Dec 30, 1994;Build 40
+2 ;No external references
REPT ;reports
+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 !?40,$SELECT(YSVFLAG'=0:"*** Invalid Profile *** "_YSVFLAG,1:"Valid Profile")
+6 if YSINPT?1A
WRITE !,"Patient entered as an ",$SELECT(YSINPT="I":"Inpatient",1:"Outpatient"),"."
if YSINPT=""
WRITE !,"No setting entered, patient assumed to be outpatient."
+7 WRITE !,"Duration of recent Axis I episode: "
+8 if YSDUR?1N
WRITE $PIECE("Cannot Categorize^Less than 1 week^1-4 weeks^1-3 months^3-12 months^Periodic; 1-3 years^Coninuous; 1-3 years^Periodic; 3-7 years^Continuous 3-7 years^More than 7 years",U,YSDUR+1)
+9 WRITE !,"Inconsistency (Scale W)="_$PIECE(R,U,29),!
+10 FOR I=2:1:28
Begin DoDot:1
+11 if I=2
WRITE !,"Modifying Indices"
+12 if I=5
WRITE !,"Clinical Personality Patterns"
+13 if I=16
WRITE !,"Severe Personality Pathology"
+14 if I=19
WRITE !,"Clinical Syndromes"
+15 if I=26
WRITE !,"Severe Clinical Syndromes"
+16 SET YSSID=$PIECE(^YTT(601,YSTEST,"S",I,0),U,2)
+17 WRITE !,$PIECE(YSSID," ")
+18 WRITE ?5,$JUSTIFY($PIECE(R,U,I),3)," ",$JUSTIFY($PIECE(S,U,I),3)," "
+19 DO CHART
+20 WRITE ?53,$PIECE(YSSID," ",2,99)
End DoDot:1
if IOST?1"C-".E&($Y>21)
DO SCR^YTREPT
if YSTOUT!YSUOUT
QUIT
+21 DO NOTEWOR
+22 QUIT
CHART ;
+1 NEW X
+2 SET X=$PIECE(S,U,I)
+3 WRITE $EXTRACT("***************************************************************",1,$JUSTIFY(X/3,0,0))
+4 QUIT
NOTEWOR ;note worthy responses
+1 DO RD^YTMCMI3
+2 WRITE !!?10,"*** Noteworthy Responses ***"
+3 FOR I=1,4,11,37,55,74,75,107,130,149,10,18,27,48,63,69,92,99,105,161,165,167,174,9,14,22,30,34,77,83,87,96,116,124,134,24,44,112,128,142,150,151,154,171,81,132,121,143,155,163
Begin DoDot:1
+4 if I=1
WRITE !!,"Health Preoccupation"
+5 if I=10
WRITE !!,"Interpersonal Alienation"
+6 if I=9
WRITE !!,"Emotional Dyscontrol"
+7 if I=24
WRITE !!,"Self-Destructive Potential"
+8 if I=81
WRITE !!,"Childhood Abuse"
+9 if I=121
WRITE !!,"Eating Disorder"
+10 if $EXTRACT(X,I)'="T"
QUIT
+11 WRITE !,$JUSTIFY(I,3,0),". ",^YTT(601,YSTEST,"Q",I,"T",1,0)
+12 if $DATA(^YTT(601,YSTEST,"Q",I,"T",2,0))
WRITE !?5,^YTT(601,YSTEST,"Q",I,"T",2,0)
End DoDot:1
if IOST?1"C-".E&($Y>21)
DO SCR^YTREPT
if YSTOUT!YSUOUT
QUIT
+13 QUIT
