69 lines
2.8 KiB
Mathematica
69 lines
2.8 KiB
Mathematica
YTMMPP ;SLC/DKG-TEST PKG: MMPI PROFILE ;1/10/92 15:07 ;
|
|
;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|
A ;
|
|
S Z1=0,X=YSSCALE,J=1,YSLFT=0 F I=11,12,13,1,2,3,4,5,6,7,8,9,10 S (A(J),YSA(J))=$P(X,U,I) S:$D(YSTAR(I)) YSAST(J)=YSTAR(I) S J=J+1
|
|
S YSNS=13,YSTV=120,YSBV=20,YSINC=2,YSLE=5
|
|
S X=" M M P I P R O F I L E ",Y=70-$L(X)\2 W !!?Y,X
|
|
; Following 2 lines commented 4/28/94 LJA. See 5*17
|
|
;I $D(^YTD(601.2,YSDFN,1,YSTEST,1,DOT,99)),^(99)="MMPIR" W "MMPIR"
|
|
;E W $P(^YTT(601,YSTEST,0),U)
|
|
S YSVS=3,YSHS="70,50,30^"
|
|
S YSSNM="L ,F ,K ,HS,D ,HY,PD,MF,PA,PT,SC,MA,SI" F J=1:1:13 S:$D(YSAST(J)) Z1=$P(YSSNM,",",J),Z1=$P(Z1," "),$P(YSSNM,",",J)=Z1_YSAST(J)
|
|
S YSSNM1="" F I=1:1:13 S YSSNM1=YSSNM1_$P($P(YSSNM,",",I)," ")_$S($L($P(YSSNM,",",I))>1:"",1:" ")_","
|
|
S V(3)="" F I=1:1 S J=$P(YSHS,",",I) Q:J="" S H(I)=+J
|
|
S YSLM=80-(YSNS*4+20)\2
|
|
S YSLC1=9999,YSLV=YSTV,YSIN2=YSINC/2
|
|
S YSHS=$O(H(-1)),H(-1)=-999
|
|
D WE
|
|
L ;
|
|
F I=1:1:YSNS S B(I)=(A(I)'<(YSLV-YSIN2))&(A(I)<(YSLV+YSIN2))
|
|
S YSLL=$S(YSLC1'<YSLE:$J(YSLV,5,0),1:" ")
|
|
W ;
|
|
S YSWS=(H(YSHS)>(YSLV-YSIN2))&(H(YSHS)<(YSLV+YSIN2)) I YSWS D WS G:YSLFT END S YSHS=$O(H(YSHS)) S:YSHS="" YSHS=-1
|
|
I 'YSWS D WL G:YSLFT END
|
|
S YSLC1=YSLC1+1 S:YSLC1>YSLE YSLC1=1
|
|
I YSLV>YSBV S YSLV=YSLV-YSINC GOTO L
|
|
D WE,SL F I=1:1:13 S A(I)=YSA(I)
|
|
D SV S X=YSRAW,J=1 F I=11,12,13,1,2,3,4,5,6,7,8,9,10 S A(J)=$P(X,U,I),J=J+1
|
|
D SV1
|
|
I $D(YSHDR) W !! D DTA W !
|
|
END ;
|
|
K A,B,YSA,YSNS,YSTV,YSTVL,YSBV,YSINC,YSIN2,YSLE,YSVS,YSHS,V,H,YSLL,YSLC1,YSWS,YSSNM,YSSNM1,YSAST,YSQ Q
|
|
WE ;
|
|
W !?YSLM+5,"|" F I=1:1:YSNS-1 W "----"
|
|
W "---|" Q
|
|
WL ;
|
|
D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W:'Z1 ! W ?YSLM,YSLL,"|" S Z1=0
|
|
F I=1:1:YSNS W $S(B(I):$E($P(YSSNM1,",",I)_" ",1,3),1:" ") I I<YSNS W $S($D(V(I)):"|",1:" ")
|
|
W "|",YSLL Q
|
|
WS ;
|
|
D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W:'Z1 ! W ?YSLM,YSLL,"|" S Z1=0
|
|
F I=1:1:YSNS W "-",$S(B(I):$P(YSSNM,",",I),I>3:I-3#10_"-",1:"--") I I<YSNS W $S($D(V(I)):"|",1:" ")
|
|
W "|",YSLL Q
|
|
SL ;
|
|
W !?6,"?",?YSLM+6 F I=1:1:YSNS W $E($P(YSSNM,",",I)_" ",1,4)
|
|
Q
|
|
SV ;
|
|
W !?YSLM+6 F I=1:1:YSNS W $E(A(I)_" ",1,4)
|
|
Q
|
|
SV1 ;
|
|
W !?6,YSQ,?YSLM+6 F I=1:1:YSNS W $E(A(I)_" ",1,4)
|
|
Q
|
|
MAX ;
|
|
F I=1:1:YSNS S:A(I)>YSTV YSTV=A(I)
|
|
Q
|
|
MIN ;
|
|
S YSBV=99999 F I=1:1:YSNS S:A(I)<YSBV YSBV=A(I)
|
|
Q
|
|
INC ;
|
|
S YSINC=$J(YSTV-YSBV/20,1,4)
|
|
Q
|
|
DTA ;
|
|
S YSDTA=$P(^YTD(601.2,YSDFN,1,YSET,1,YSHD,0),U,5) S:YSDTA'="" YSDTA=$E(YSDTA,4,5)_"/"_$E(YSDTA,6,7)_"/"_$E(YSDTA,2,3)
|
|
S YSHDR=$E(YSHDR,1,43)_" "_YSSX_" AGE "_$J(YSAGE,2,0)_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)_" "_$E(YSHD,4,5)_"/"_$E(YSHD,6,7)_"/"_$E(YSHD,2,3)
|
|
W YSHDR," ",YSDTA W ! W:$D(YSAST) "'<' OR '>' indicates 'T' out of table range" W ?53,"PRINTED ENTERED " W:YSDTA'="" "ADMIN" Q
|
|
WAIT ;
|
|
;%%%% POSSIBLE READER CALL NEED TO LOOK FOR YSLFT TO HCANGE TO YSTOUT%%%
|
|
W $C(7) R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^" S:YSLFT["^"!'$T YSLFT=1 Q:YSLFT S Z1=1 W # Q
|
|
Q
|