source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMPP.m@ 1061

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