source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMP6.m@ 1608

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1YTMMP6 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:12 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 S N2=0,L=10,YSLFT=0 S:'$D(YSMMPR) YSMMPR=$O(^YTT(601,"B","MMPR",0))
5N5 ;
6 S L=L-1,N1=YSNT(L) G:T(N1)>44 C0 S N=$S(N1<5:N1+99,N1<9:N1+98,1:0) G:'N N5 D PR G:YSLFT C70 S N2=N2+1 G N5:N2<3,C0
7E0 ;
8 S N2=0,L=0,YSLFT=0
9E5 ;
10 S L=L+1 G C0:L>10 S N1=YSNT(L) G:T(N1)<60 C0
11 G E10:N1=1,E25:N1=2,E40:N1=3,E55:N1=4,E5:N1=5,E70:N1=6,E85:N1=7,E100:N1=8,E115:N1=9,E5:N1=10
12E10 ;
13 G:YSHP1=1!(T(1)<65) E5 S N=$S(T(1)>84:80,T(1)>74:79,1:78) S:T(1)>84 M=2 G E125
14E25 ;
15 S N=$S(YSNS9:0,T(2)<70:81,YSHP1=2!(YSHP2=2):0,T(2)<85:82,1:83) G:'N E5 S:N>81 M=24 S YSNS39=1 G E125
16E40 ;
17 S N=$S(T(3)<65:0,T(3)<70:84,YSHP1=3!(YSHP2=3):0,T(3)<85:85,1:86) G E125:N,E5
18E55 ;
19 G:YSHP1=4!(YSHP2=4)!(T(4)<65) E5 S N=$S(T(4)<75:87,T(4)<85:88,1:89) G E125
20E70 ;
21 S N=$S(T(6)<70:90,YSHP1=6!(YSHP2=6):0,T(6)<80:91,1:92) G E125:N,E5
22E85 ;
23 G:YSHP1=7!(YSHP2=7) E5 S N=$S(T(7)<75:93,T(7)<85:94,1:95) G E125
24E100 ;
25 G:YSHP1=8!(YSHP2=8)!(T(8)<65) E5 S N=$S(T(8)<75:96,1:97) G E125
26E115 ;
27 G:YSHP1=9!(YSHP2=9)!(T(9)<65) E5 S N=$S(T(9)<75:98,1:99)
28E125 ;
29 D PR G:YSLFT C70 S N2=N2+1 G:N2<3 E5
30C0 ;
31 I 'YSNS9&(T(1)>59)&(T(3)>59)&(T(3)-T(2)>9)&(T(1)-T(2)>9) S N=107 D PR G:YSLFT C70
32 I T(2)>59&(T(9)<45) S N=108,YSNS39=1 D PR G:YSLFT C70
33 G:YSSX="M" C25 I T(4)>69&(T(4)-T(5)>29) S N=109 D PR G:YSLFT C70
34 I 'YSNS26&(T(4)>59)&(T(6)>59)&(T(4)-T(3)>9)&(T(4)-T(5)>9)&(T(6)-T(5)>9)&(T(6)-T(7)>9) S N=110 D PR G:YSLFT C70
35 S N=$S(T(5)<41:111,T(5)>59:112,1:0) D:N PR G:YSLFT C70 G C40
36C25 ;
37 S N=$S(T(5)<41:113,T(5)<60:0,T(5)<70:114,1:115) D:N PR G:YSLFT C70
38C40 ;
39 S N=$S(YSNTY=3&(T(10)<45):116,YSNTY'=3&(T(10)>59)&(T(10)<70):117,1:0) D:N PR G:YSLFT C70
40 I YSHP1'=10&(T(10)>69) S N=118 D PR G:YSLFT C70
41 I T(2)>69&(YSHP1'=2)&(YSHP2'=2)&(YSNS9+YSNS39=0) S YSNSS=YSNSS_15
42C60 ;
43 G:YSNSS="" C70 W ! S N=119 D PR F L=1:1 S N=$P(YSNSS,U,L)+119 Q:N=119 D PR Q:YSLFT
44C70 K A,YSHP1,YSHP2,YSIS,YSJJ,YSKC,L,M,N,N1,N2,YSNS26,YSNS39,YSNS9,YSNSS,YSNT,YSNTY,T G ^YTMMP3:YSANLL=2,^YTMMP1
45PR ;
46 I $Y>51 D DTA^YTREPT W !!
47 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)
48 S:M YSNSS=YSNSS_M_"^",M=0 W ! Q
49WAIT ;
50 ; Added 5/6/94 LJA
51 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
52 N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
53 N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
54 ;
55 F I0=1:1:(IOSL-$Y-2) W !
56 N DTOUT,DUOUT,DIRUT
57 S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
58 W @IOF Q
Note: See TracBrowser for help on using the repository browser.