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  Sep 23, 2025@19:53:42                                                                                                                                                                                                    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