59 lines
2.5 KiB
Mathematica
59 lines
2.5 KiB
Mathematica
YTMMP6 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:12 ;
|
|
;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|
;
|
|
S N2=0,L=10,YSLFT=0 S:'$D(YSMMPR) YSMMPR=$O(^YTT(601,"B","MMPR",0))
|
|
N5 ;
|
|
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
|
|
E0 ;
|
|
S N2=0,L=0,YSLFT=0
|
|
E5 ;
|
|
S L=L+1 G C0:L>10 S N1=YSNT(L) G:T(N1)<60 C0
|
|
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
|
|
E10 ;
|
|
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
|
|
E25 ;
|
|
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
|
|
E40 ;
|
|
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
|
|
E55 ;
|
|
G:YSHP1=4!(YSHP2=4)!(T(4)<65) E5 S N=$S(T(4)<75:87,T(4)<85:88,1:89) G E125
|
|
E70 ;
|
|
S N=$S(T(6)<70:90,YSHP1=6!(YSHP2=6):0,T(6)<80:91,1:92) G E125:N,E5
|
|
E85 ;
|
|
G:YSHP1=7!(YSHP2=7) E5 S N=$S(T(7)<75:93,T(7)<85:94,1:95) G E125
|
|
E100 ;
|
|
G:YSHP1=8!(YSHP2=8)!(T(8)<65) E5 S N=$S(T(8)<75:96,1:97) G E125
|
|
E115 ;
|
|
G:YSHP1=9!(YSHP2=9)!(T(9)<65) E5 S N=$S(T(9)<75:98,1:99)
|
|
E125 ;
|
|
D PR G:YSLFT C70 S N2=N2+1 G:N2<3 E5
|
|
C0 ;
|
|
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
|
|
I T(2)>59&(T(9)<45) S N=108,YSNS39=1 D PR G:YSLFT C70
|
|
G:YSSX="M" C25 I T(4)>69&(T(4)-T(5)>29) S N=109 D PR G:YSLFT C70
|
|
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
|
|
S N=$S(T(5)<41:111,T(5)>59:112,1:0) D:N PR G:YSLFT C70 G C40
|
|
C25 ;
|
|
S N=$S(T(5)<41:113,T(5)<60:0,T(5)<70:114,1:115) D:N PR G:YSLFT C70
|
|
C40 ;
|
|
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
|
|
I YSHP1'=10&(T(10)>69) S N=118 D PR G:YSLFT C70
|
|
I T(2)>69&(YSHP1'=2)&(YSHP2'=2)&(YSNS9+YSNS39=0) S YSNSS=YSNSS_15
|
|
C60 ;
|
|
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
|
|
C70 K A,YSHP1,YSHP2,YSIS,YSJJ,YSKC,L,M,N,N1,N2,YSNS26,YSNS39,YSNS9,YSNSS,YSNT,YSNTY,T G ^YTMMP3:YSANLL=2,^YTMMP1
|
|
PR ;
|
|
I $Y>51 D DTA^YTREPT W !!
|
|
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)
|
|
S:M YSNSS=YSNSS_M_"^",M=0 W ! Q
|
|
WAIT ;
|
|
; 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
|
|
;
|
|
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)
|
|
W @IOF Q
|