source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMP5.m@ 1739

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1YTMMP5 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:11 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 I IOST?1"C-".E,($Y>0) D WAIT G:YSLFT END
5 S YSNSS="",(M,YSNS9,YSNS26,YSNS39,YSHP1,YSHP2)=0,YSLFT=0,YSMMPR=$O(^YTT(601,"B","MMPR",0)) F L=1:1:13 S T(L)=$P(S,U,L)
6 D DTA^YTREPT W !!?21,"--- PROFILE INTERPRETATION ---",!
7 W !,"THE FOLLOWING MMPI INTERPRETATION SHOULD BE VIEWED AS A SERIES OF",!,"HYPOTHESES WHICH MAY REQUIRE FURTHER INVESTIGATION.",!
8 S YSKC=$P(R,U,12)-$P(R,U,13)
9 G:YSKC<17&(T(12)<100) V10 F N=3:1:7 D PR Q:YSLFT
10 G ^YTMMP3:YSANLL=2,^YTMMP1
11V10 ;
12 I YSKC>11 S N=2 G V100
13 G V65:T(12)>69,V35:T(12)<60,V25:T(13)-T(12)>9,V20:T(11)-T(12)<6 S N=8 G V40
14V20 ;
15 S N=$S(T(12)<65!(T(11)>54)!(T(13)>44):22,1:14) G V100
16V25 ;
17 S N=$S(T(13)-T(12)>14:12,1:11) G V55
18V35 ;
19 G:T(13)>64 V50 S N=$S(T(11)<56:22,T(13)>59:10,1:8) G:N'=8 V100
20V40 ;
21 D PR G:YSLFT END I T(11)>63 S N=9 G V100
22V50 ;
23 S N=$S(T(13)>69:12,1:11)
24V55 ;
25 D PR G:YSLFT END I T(11)>59,T(13)-T(12)>9,T(11)-T(12)>9 S N=13 G V100
26 G V101
27V65 ;
28 S:YSKC>11!(YSKC<8) YSKC=0 G V80:T(11)>65!(T(13)>65),V70:T(12)>79 S N=15 G:'YSKC V100 D PR G:YSLFT END S N=16 G V100
29V70 ;
30 S N=17 G:'YSKC V100 D PR G:YSLFT END S N=18 G V100
31V80 ;
32 G V85:T(13)>65,V101:T(11)<66 S N=20 G V100
33V85 ;
34 S N=$S(T(11)>65:21,1:19)
35V100 ;
36 D PR G:YSLFT END
37V101 ;
38 S T(5)=0 F L=1:1:10 S YSNT(L)=L
39A10 ;
40 S YSIS=0 F L=2:1:10 S:T(L)>T(L-1) YSIS=1,N1=T(L),T(L)=T(L-1),T(L-1)=N1,N1=YSNT(L),YSNT(L)=YSNT(L-1),YSNT(L-1)=N1
41 G:YSIS A10 F L=1:1:10 S T(L)=$P(S,U,L)
42 S A=T(YSNT(1)) I A>69 S YSNTY=1 G N35
43 G N30:A>64,N10:A<60,N30:T(2)>59!(T(6)>59),N10:T(7)<60,N30
44N10 ;
45 S YSNTY=3,N=24 D PR G:YSLFT END G ^YTMMP6
46N30 ;
47 S YSNTY=2,N=23 D PR G:YSLFT END G E0^YTMMP6
48N35 ;
49 S N1=YSNT(1),N2=YSNT(2) G:T(N2)>69 H75
50H5 ;
51 S YSHP1=N1,YSHP2=0 I N1=1 S N=$S(T(1)>84:27,T(1)>74:26,1:25),M=$S(T(1)>84:2,T(1)>74:1,1:0) G H300
52 I N1=9 S N=$S(T(9)>79:36,T(9)>74:35,1:34) S:T(9)>79 M=6 G H300
53 S N=$S(N1<5:N1+26,N1<10:N1+25,1:37),M=$S(N1=2:3,N1=4:4,N1=6:5,1:0) G H300
54H75 ;
55 I N1=10!(N2=10) S:N1=10 N1=N2 G:N1=2 H175 S N2=YSNT(3) G:T(N2)<70 H5
56 S:N1>N2 L=N1,N1=N2,N2=L
57 S YSHP1=N1,YSHP2=N2 I N1=1,N2=2 G:T(2)>T(1)&(T(1)<T(10)) H299
58 I N1=1 S N=N2+36,M=$S(N2=2:7,N2=4:10,N2=6:11,N2=8:12,N2=9:13,N2=3:8,1:0) G:N2'=3!(T(1)-T(2)<5)!(T(3)-T(2)<10) H300 D PR G:YSLFT END S N=41,M=9,YSNS9=1 G H300
59 I N1=2 G:T(2)>T(N2)&(T(N2)<T(10)) H299 S N=$S(N2<5:N2+44,1:N2+43),M=$S(N2=4:16,1:N2+11) S:N2=3&(YSSX="F") N=46 G H300
60 I N1=3 S N=$S(N2=4:54,1:N2+51),M=$S(N2=4:22,N2=6:23,N2=8:25,1:0) G:N2'=4 H300 D PR G:YSLFT END S N=$S(T(4)-T(3)<6:56,1:55) G H300
61 I N1=4 S N=N2+56 S:N2<9 M=N2+21 S:N2=6&(YSSX="F") N=61,M=26,YSNS26=1 G H300
62 I N1=6 S N=$S(N2<9:N2+59,1:71),M=N2+23 G:N2'=8 H300 D PR G:YSLFT END G H255
63 S N=$S(N1=8:77,N2=8:72,1:76),M=$S(N1=8:37,N2=9:36,1:0) G:N2=9 H300 D PR G:YSLFT END S N=$S(T(7)-T(8)>5:73,T(8)-T(7)<6:75,1:74),M=$S(T(7)-T(8)>5:33,T(8)-T(7)<6:35,1:34) G H300
64H175 ;
65 S YSHP1=10,YSHP2=2,N=53,M=21 G H300
66H255 ;
67 I T(6)-T(7)>9,T(8)-T(7)>9 S N=68 D PR G:YSLFT END
68 I T(6)>79 S N=69 D PR G:YSLFT END
69 I T(8)>79 S N=70 D PR G:YSLFT END
70 G H301
71H299 ;
72 S YSHP1=-1,YSHP2=-1 G H301
73H300 ;
74 D PR G:YSLFT END
75H301 ;
76 G E0^YTMMP6
77PR ;
78 I $Y>51&(IOST?1"P".E) D DTA^YTREPT W !!
79 F YSJJ=1:1 Q:'$D(^YTT(601,YSMMPR,"G",N,1,YSJJ,0)) D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W !,^(0)
80 S:M YSNSS=YSNSS_M_"^",M=0 W ! Q
81WAIT ;
82 F I0=1:1:(IOSL-$Y-2) W !
83 ;%%% YSLFT TO YSTOUT OR YSUOUT
84 W !,"Press return to continue or ""^"" to omit Interpretive Report " R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^" S:YSLFT["^"!'$T YSLFT=1
85 W @IOF K I0 Q
86END ;
87 G C70^YTMMP6
Note: See TracBrowser for help on using the repository browser.