| [613] | 1 | YTMMPP ;SLC/DKG-TEST PKG: MMPI PROFILE ;1/10/92 15:07 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | A ;
|
|---|
| 4 | 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
|
|---|
| 5 | S YSNS=13,YSTV=120,YSBV=20,YSINC=2,YSLE=5
|
|---|
| 6 | S X=" M M P I P R O F I L E ",Y=70-$L(X)\2 W !!?Y,X
|
|---|
| 7 | ; Following 2 lines commented 4/28/94 LJA. See 5*17
|
|---|
| 8 | ;I $D(^YTD(601.2,YSDFN,1,YSTEST,1,DOT,99)),^(99)="MMPIR" W "MMPIR"
|
|---|
| 9 | ;E W $P(^YTT(601,YSTEST,0),U)
|
|---|
| 10 | S YSVS=3,YSHS="70,50,30^"
|
|---|
| 11 | 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)
|
|---|
| 12 | S YSSNM1="" F I=1:1:13 S YSSNM1=YSSNM1_$P($P(YSSNM,",",I)," ")_$S($L($P(YSSNM,",",I))>1:"",1:" ")_","
|
|---|
| 13 | S V(3)="" F I=1:1 S J=$P(YSHS,",",I) Q:J="" S H(I)=+J
|
|---|
| 14 | S YSLM=80-(YSNS*4+20)\2
|
|---|
| 15 | S YSLC1=9999,YSLV=YSTV,YSIN2=YSINC/2
|
|---|
| 16 | S YSHS=$O(H(-1)),H(-1)=-999
|
|---|
| 17 | D WE
|
|---|
| 18 | L ;
|
|---|
| 19 | F I=1:1:YSNS S B(I)=(A(I)'<(YSLV-YSIN2))&(A(I)<(YSLV+YSIN2))
|
|---|
| 20 | S YSLL=$S(YSLC1'<YSLE:$J(YSLV,5,0),1:" ")
|
|---|
| 21 | W ;
|
|---|
| 22 | 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
|
|---|
| 23 | I 'YSWS D WL G:YSLFT END
|
|---|
| 24 | S YSLC1=YSLC1+1 S:YSLC1>YSLE YSLC1=1
|
|---|
| 25 | I YSLV>YSBV S YSLV=YSLV-YSINC GOTO L
|
|---|
| 26 | D WE,SL F I=1:1:13 S A(I)=YSA(I)
|
|---|
| 27 | 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
|
|---|
| 28 | D SV1
|
|---|
| 29 | I $D(YSHDR) W !! D DTA W !
|
|---|
| 30 | END ;
|
|---|
| 31 | K A,B,YSA,YSNS,YSTV,YSTVL,YSBV,YSINC,YSIN2,YSLE,YSVS,YSHS,V,H,YSLL,YSLC1,YSWS,YSSNM,YSSNM1,YSAST,YSQ Q
|
|---|
| 32 | WE ;
|
|---|
| 33 | W !?YSLM+5,"|" F I=1:1:YSNS-1 W "----"
|
|---|
| 34 | W "---|" Q
|
|---|
| 35 | WL ;
|
|---|
| 36 | D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W:'Z1 ! W ?YSLM,YSLL,"|" S Z1=0
|
|---|
| 37 | 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:" ")
|
|---|
| 38 | W "|",YSLL Q
|
|---|
| 39 | WS ;
|
|---|
| 40 | D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W:'Z1 ! W ?YSLM,YSLL,"|" S Z1=0
|
|---|
| 41 | 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:" ")
|
|---|
| 42 | W "|",YSLL Q
|
|---|
| 43 | SL ;
|
|---|
| 44 | W !?6,"?",?YSLM+6 F I=1:1:YSNS W $E($P(YSSNM,",",I)_" ",1,4)
|
|---|
| 45 | Q
|
|---|
| 46 | SV ;
|
|---|
| 47 | W !?YSLM+6 F I=1:1:YSNS W $E(A(I)_" ",1,4)
|
|---|
| 48 | Q
|
|---|
| 49 | SV1 ;
|
|---|
| 50 | W !?6,YSQ,?YSLM+6 F I=1:1:YSNS W $E(A(I)_" ",1,4)
|
|---|
| 51 | Q
|
|---|
| 52 | MAX ;
|
|---|
| 53 | F I=1:1:YSNS S:A(I)>YSTV YSTV=A(I)
|
|---|
| 54 | Q
|
|---|
| 55 | MIN ;
|
|---|
| 56 | S YSBV=99999 F I=1:1:YSNS S:A(I)<YSBV YSBV=A(I)
|
|---|
| 57 | Q
|
|---|
| 58 | INC ;
|
|---|
| 59 | S YSINC=$J(YSTV-YSBV/20,1,4)
|
|---|
| 60 | Q
|
|---|
| 61 | DTA ;
|
|---|
| 62 | 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)
|
|---|
| 63 | 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)
|
|---|
| 64 | W YSHDR," ",YSDTA W ! W:$D(YSAST) "'<' OR '>' indicates 'T' out of table range" W ?53,"PRINTED ENTERED " W:YSDTA'="" "ADMIN" Q
|
|---|
| 65 | WAIT ;
|
|---|
| 66 | ;%%%% POSSIBLE READER CALL NEED TO LOOK FOR YSLFT TO HCANGE TO YSTOUT%%%
|
|---|
| 67 | W $C(7) R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^" S:YSLFT["^"!'$T YSLFT=1 Q:YSLFT S Z1=1 W # Q
|
|---|
| 68 | Q
|
|---|
