source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMCMI2C.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1YTMCMI2C ;ALB/ASF-MCMI2 REPORT CONTINUED; ;4/11/91 15:39
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4V ;
5 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
6 I +R>590!(+R<145) W !,"Validity Questioned based on ",$S(+R>150:"high",1:"low")," DISCLOSURE score"
7 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."
8 W !,"Duration of recent Axis I episode: " W:YSEP'?1N "not entered assumed be one to four weeks"
9 W:YSEP?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,YSEP+1)
10 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
11CD ;
12 W !,"Personality Code= " I +R'>590,+R'<145,$P(R,U,26)<2 D CDX0 F J1="CP","SP" D CDX W "//"
13 W !,"Syndrome Code= " I +R'>590,+R'<145,$P(R,U,26)<2 F J1="CS","SS" D CDX W "//"
14 K ^UTILITY("YT",$J) W ! D ^YTMCMI2D
15 ;
16 G DONE:YSLFT D SCR G DONE:YSLFT W !!?20,"*** NOTEWORTHY RESPONSES ***",!
17HP D RD W !,"Health Preocupation" 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)
18 W:'J2 !?5," ** none **"
19IA ;
20 D:$Y+5>IOSL SCR G DONE:YSLFT W !!,"Interpersonal Alienation" S J2=0
21 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)
22 W:'J2 !?5," ** none **"
23ED ;
24 G DONE:YSLFT D:$Y+5>IOSL SCR G DONE:YSLFT W !!,"Emotional Dyscontrol" S J2=0
25 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)
26 W:'J2 !?5," ** none **"
27SDP ;
28 G DONE:YSLFT D:$Y+5>IOSL SCR W !!,"Self-Destructive Potential" S J2=0
29 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)
30 W:'J2 !?5," ** none **"
31 Q
32DONE ;
33 K YSTY,X,Y,A,B,K,YSKK,L,L1,L2,M,J,YSIT,YSRS,YSSS,I,P,YSMX,YSTL,YSTTL Q
34RD ;
35 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
36SCR ;
37 ; Added 5/6/94 LJA
38 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
39 N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
40 N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
41 ;
42 G:IOST'?1"C-".E TOP F I0=1:1:(IOSL-$Y-2) W !
43 N DTOUT,DUOUT,DIRUT
44 S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
45 D TOP:'YSLFT Q
46CDX0 ;
47 K ^UTILITY("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:"**"),^UTILITY("YT",$J,J1,J2,999-A,J)=""
48 Q
49CDX ;
50 F J2="**","*","+","""","''" Q:J1'="CP"&(J2="+") W:'$D(^UTILITY("YT",$J,J1,J2)) " - " D CDX1 W J2," "
51 Q
52CDX1 ;
53 S J3=0 F S J3=$O(^UTILITY("YT",$J,J1,J2,J3)) Q:'J3 D CDX2:J1'="CP",CDXM:J1="CP"&(YSSEX="M"),CDXF:J1="CP"&(YSSEX="F")
54 Q
55CDX2 S J4=0 F S J4=$O(^UTILITY("YT",$J,J1,J2,J3,J4)) Q:'J4 W $P($P(^YTT(601,201,"S",J4,0),U,2)," ")," "
56 Q
57CDXM ;
58 F J4=13,4,7,9,10,6,8,11,12,5 I $D(^UTILITY("YT",$J,J1,J2,J3,J4)) W $P($P(^YTT(601,201,"S",J4,0),U,2)," ")," "
59 Q
60CDXF ;
61 F J4=9,4,10,8,5,12,13,11,7,6 I $D(^UTILITY("YT",$J,J1,J2,J3,J4)) W $P($P(^YTT(601,201,"S",J4,0),U,2)," ")," "
62 Q
63TOP ;
64 S X=$P(^YTT(601,YSTEST,"P"),U) D DTA^YTREPT W !!?(72-$L(X)\2),X Q
Note: See TracBrowser for help on using the repository browser.