YTMCMI2C ;ALB/ASF,HIOFO/FT - MCMI2 REPORT CONTINUED ;8/7/12 3:46 am
;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
;
;No external references
;
V ;
D TOP S V=$P(R,U,26) W !!,"This report is ",$S(V=1:"OF QUESTIONABLE VALIDITY",V>1:"**** INVALID ***",1:"VALID")," based on the validity scale." K V
I +R>590!(+R<145) W !,"Validity Questioned based on ",$S(+R>150:"high",1:"low")," DISCLOSURE score"
D RD S YSIO=$E(X,176),YSEP=$E(X,177) W:YSIO?1A !,"Patient entered as an ",$S(YSIO="I":"Inpatient",1:"Outpatient"),"." W:YSIO="" !,"No setting entered, patient assumed to be outpatient."
W !,"Duration of recent Axis I episode: " W:YSEP'?1N "not entered assumed be one to four weeks"
W:YSEP?1N $P("Cannot Categorize^Less than 1 week^1-4 weeks^1-3 months^3-12 months^Periodic; 1-3 years^Continuous; 1-3 years^Periodic; 3-7 years^Continuous 3-7 years^More than 7 years",U,YSEP+1)
I $L(X,"X")>12 W !!!,"There were less than 164 responses to the items on the inventory.",!,"Computer interpretative analysis of any responses to these",!,"items would not yield valid results." D:IOST?1"C-".E SCR G DONE
CD ;
W !,"Personality Code= " I +R'>590,+R'<145,$P(R,U,26)<2 D CDX0 F J1="CP","SP" D CDX W "//"
W !,"Syndrome Code= " I +R'>590,+R'<145,$P(R,U,26)<2 F J1="CS","SS" D CDX W "//"
K ^TMP("YT",$J) W ! D ^YTMCMI2D
;
G DONE:YSLFT D SCR G DONE:YSLFT W !!?20,"*** NOTEWORTHY RESPONSES ***",!
HP D RD W !,"Health Preoccupation" S J2=0 F J1=18,29,33,68,71,72,96 I $E(X,J1)="T" W !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0) S J2=J2+1,J3=1 F S J3=$O(^YTT(601,201,"Q",J1,"T",J3)) Q:'J3 W !?5,^(J3,0)
W:'J2 !?5," ** none **"
IA ;
D:$Y+5>IOSL SCR G DONE:YSLFT W !!,"Interpersonal Alienation" S J2=0
F J1=13,32,47,49,83,102,141,150 D:$Y+5>IOSL SCR Q:YSLFT I $E(X,J1)="T" W !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0) S J2=J2+1,J3=1 F S J3=$O(^YTT(601,201,"Q",J1,"T",J3)) Q:'J3 W !?5,^(J3,0)
W:'J2 !?5," ** none **"
ED ;
G DONE:YSLFT D:$Y+5>IOSL SCR G DONE:YSLFT W !!,"Emotional Dyscontrol" S J2=0
F J1=5,26,36,43,58,67,151,167 D:$Y+5>IOSL SCR Q:YSLFT I $E(X,J1)="T" W !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0) S J2=J2+1,J3=1 F S J3=$O(^YTT(601,201,"Q",J1,"T",J3)) Q:'J3 W !?5,^(J3,0)
W:'J2 !?5," ** none **"
SDP ;
G DONE:YSLFT D:$Y+5>IOSL SCR W !!,"Self-Destructive Potential" S J2=0
F J1=54,59,76,79,108,115,120,136 D:$Y+5>IOSL SCR Q:YSLFT I $E(X,J1)="T" W !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0) S J2=J2+1,J3=1 F S J3=$O(^YTT(601,201,"Q",J1,"T",J3)) Q:'J3 W !?5,^(J3,0)
W:'J2 !?5," ** none **"
Q
DONE ;
K YSTY,X,Y,A,B,K,YSKK,L,L1,L2,M,J,YSIT,YSRS,YSSS,I,P,YSMX,YSTL,YSTTL Q
RD ;
S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
SCR ;
; Added 5/6/94 LJA
N A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N
N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
;
G:IOST'?1"C-".E TOP F I0=1:1:(IOSL-$Y-2) W !
N DTOUT,DUOUT,DIRUT
S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
D TOP:'YSLFT Q
CDX0 ;
K ^TMP("YT",$J) F J=2:1:25 S A=$P(S,U,J),J1=$S(J<4:"MOD",J<14:"CP",J<17:"SP",J<23:"CS",1:"SS") S J2=$S(A<35:"''",A<60:"""",A<75:"+",A<85:"*",1:"**"),^TMP("YT",$J,J1,J2,999-A,J)=""
Q
CDX ;
F J2="**","*","+","""","''" Q:J1'="CP"&(J2="+") W:'$D(^TMP("YT",$J,J1,J2)) " - " D CDX1 W J2," "
Q
CDX1 ;
S J3=0 F S J3=$O(^TMP("YT",$J,J1,J2,J3)) Q:'J3 D CDX2:J1'="CP",CDXM:J1="CP"&(YSSEX="M"),CDXF:J1="CP"&(YSSEX="F")
Q
CDX2 S J4=0 F S J4=$O(^TMP("YT",$J,J1,J2,J3,J4)) Q:'J4 W $P($P(^YTT(601,201,"S",J4,0),U,2)," ")," "
Q
CDXM ;
F J4=13,4,7,9,10,6,8,11,12,5 I $D(^TMP("YT",$J,J1,J2,J3,J4)) W $P($P(^YTT(601,201,"S",J4,0),U,2)," ")," "
Q
CDXF ;
F J4=9,4,10,8,5,12,13,11,7,6 I $D(^TMP("YT",$J,J1,J2,J3,J4)) W $P($P(^YTT(601,201,"S",J4,0),U,2)," ")," "
Q
TOP ;
S X=$P(^YTT(601,YSTEST,"P"),U) D DTA^YTREPT W !!?(72-$L(X)\2),X Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMCMI2C 3913 printed Dec 13, 2024@02:17:33 Page 2
YTMCMI2C ;ALB/ASF,HIOFO/FT - MCMI2 REPORT CONTINUED ;8/7/12 3:46 am
+1 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
+2 ;
+3 ;No external references
+4 ;
V ;
+1 DO TOP
SET V=$PIECE(R,U,26)
WRITE !!,"This report is ",$SELECT(V=1:"OF QUESTIONABLE VALIDITY",V>1:"**** INVALID ***",1:"VALID")," based on the validity scale."
KILL V
+2 IF +R>590!(+R<145)
WRITE !,"Validity Questioned based on ",$SELECT(+R>150:"high",1:"low")," DISCLOSURE score"
+3 DO RD
SET YSIO=$EXTRACT(X,176)
SET YSEP=$EXTRACT(X,177)
if YSIO?1A
WRITE !,"Patient entered as an ",$SELECT(YSIO="I":"Inpatient",1:"Outpatient"),"."
if YSIO=""
WRITE !,"No setting entered, patient assumed to be outpatient."
+4 WRITE !,"Duration of recent Axis I episode: "
if YSEP'?1N
WRITE "not entered assumed be one to four weeks"
+5 if YSEP?1N
WRITE $PIECE("Cannot Categorize^Less than 1 week^1-4 weeks^1-3 months^3-12 months^Periodic; 1-3 years^Continuous; 1-3 years^Periodic; 3-7 years^Continuous 3-7 years^More than 7 years",U,YSEP+1)
+6 IF $LENGTH(X,"X")>12
WRITE !!!,"There were less than 164 responses to the items on the inventory.",!,"Computer interpretative analysis of any responses to these",!,"items would not yield valid results."
if IOST?1"C-".E
DO SCR
GOTO DONE
CD ;
+1 WRITE !,"Personality Code= "
IF +R'>590
IF +R'<145
IF $PIECE(R,U,26)<2
DO CDX0
FOR J1="CP","SP"
DO CDX
WRITE "//"
+2 WRITE !,"Syndrome Code= "
IF +R'>590
IF +R'<145
IF $PIECE(R,U,26)<2
FOR J1="CS","SS"
DO CDX
WRITE "//"
+3 KILL ^TMP("YT",$JOB)
WRITE !
DO ^YTMCMI2D
+4 ;
+5 if YSLFT
GOTO DONE
DO SCR
if YSLFT
GOTO DONE
WRITE !!?20,"*** NOTEWORTHY RESPONSES ***",!
HP DO RD
WRITE !,"Health Preoccupation"
SET J2=0
FOR J1=18,29,33,68,71,72,96
IF $EXTRACT(X,J1)="T"
WRITE !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0)
SET J2=J2+1
SET J3=1
FOR
SET J3=$ORDER(^YTT(601,201,"Q",J1,"T",J3))
if 'J3
QUIT
WRITE !?5,^(J3,0)
+1 if 'J2
WRITE !?5," ** none **"
IA ;
+1 if $Y+5>IOSL
DO SCR
if YSLFT
GOTO DONE
WRITE !!,"Interpersonal Alienation"
SET J2=0
+2 FOR J1=13,32,47,49,83,102,141,150
if $Y+5>IOSL
DO SCR
if YSLFT
QUIT
IF $EXTRACT(X,J1)="T"
WRITE !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0)
SET J2=J2+1
SET J3=1
FOR
SET J3=$ORDER(^YTT(601,201,"Q",J1,"T",J3))
if 'J3
QUIT
WRITE !?5,^(J3,0)
+3 if 'J2
WRITE !?5," ** none **"
ED ;
+1 if YSLFT
GOTO DONE
if $Y+5>IOSL
DO SCR
if YSLFT
GOTO DONE
WRITE !!,"Emotional Dyscontrol"
SET J2=0
+2 FOR J1=5,26,36,43,58,67,151,167
if $Y+5>IOSL
DO SCR
if YSLFT
QUIT
IF $EXTRACT(X,J1)="T"
WRITE !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0)
SET J2=J2+1
SET J3=1
FOR
SET J3=$ORDER(^YTT(601,201,"Q",J1,"T",J3))
if 'J3
QUIT
WRITE !?5,^(J3,0)
+3 if 'J2
WRITE !?5," ** none **"
SDP ;
+1 if YSLFT
GOTO DONE
if $Y+5>IOSL
DO SCR
WRITE !!,"Self-Destructive Potential"
SET J2=0
+2 FOR J1=54,59,76,79,108,115,120,136
if $Y+5>IOSL
DO SCR
if YSLFT
QUIT
IF $EXTRACT(X,J1)="T"
WRITE !,J1,"."," ",^YTT(601,201,"Q",J1,"T",1,0)
SET J2=J2+1
SET J3=1
FOR
SET J3=$ORDER(^YTT(601,201,"Q",J1,"T",J3))
if 'J3
QUIT
WRITE !?5,^(J3,0)
+3 if 'J2
WRITE !?5," ** none **"
+4 QUIT
DONE ;
+1 KILL YSTY,X,Y,A,B,K,YSKK,L,L1,L2,M,J,YSIT,YSRS,YSSS,I,P,YSMX,YSTL,YSTTL
QUIT
RD ;
+1 SET X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200)
QUIT
SCR ;
+1 ; Added 5/6/94 LJA
+2 NEW A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N
+3 NEW N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
+4 NEW V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
+5 ;
+6 if IOST'?1"C-".E
GOTO TOP
FOR I0=1:1:(IOSL-$Y-2)
WRITE !
+7 NEW DTOUT,DUOUT,DIRUT
+8 SET DIR(0)="E"
DO ^DIR
KILL DIR
SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
SET YSLFT=$DATA(DIRUT)
+9 if 'YSLFT
DO TOP
QUIT
CDX0 ;
+1 KILL ^TMP("YT",$JOB)
FOR J=2:1:25
SET A=$PIECE(S,U,J)
SET J1=$SELECT(J<4:"MOD",J<14:"CP",J<17:"SP",J<23:"CS",1:"SS")
SET J2=$SELECT(A<35:"''",A<60:"""",A<75:"+",A<85:"*",1:"**")
SET ^TMP("YT",$JOB,J1,J2,999-A,J)=""
+2 QUIT
CDX ;
+1 FOR J2="**","*","+","""","''"
if J1'="CP"&(J2="+")
QUIT
if '$DATA(^TMP("YT",$JOB,J1,J2))
WRITE " - "
DO CDX1
WRITE J2," "
+2 QUIT
CDX1 ;
+1 SET J3=0
FOR
SET J3=$ORDER(^TMP("YT",$JOB,J1,J2,J3))
if 'J3
QUIT
if J1'="CP"
DO CDX2
if J1="CP"&(YSSEX="M")
DO CDXM
if J1="CP"&(YSSEX="F")
DO CDXF
+2 QUIT
CDX2 SET J4=0
FOR
SET J4=$ORDER(^TMP("YT",$JOB,J1,J2,J3,J4))
if 'J4
QUIT
WRITE $PIECE($PIECE(^YTT(601,201,"S",J4,0),U,2)," ")," "
+1 QUIT
CDXM ;
+1 FOR J4=13,4,7,9,10,6,8,11,12,5
IF $DATA(^TMP("YT",$JOB,J1,J2,J3,J4))
WRITE $PIECE($PIECE(^YTT(601,201,"S",J4,0),U,2)," ")," "
+2 QUIT
CDXF ;
+1 FOR J4=9,4,10,8,5,12,13,11,7,6
IF $DATA(^TMP("YT",$JOB,J1,J2,J3,J4))
WRITE $PIECE($PIECE(^YTT(601,201,"S",J4,0),U,2)," ")," "
+2 QUIT
TOP ;
+1 SET X=$PIECE(^YTT(601,YSTEST,"P"),U)
DO DTA^YTREPT
WRITE !!?(72-$LENGTH(X)\2),X
QUIT
