1 | YTMMPI2P ;SLC/DKG,ALB/ASF-TEST PKG: MMPI2 PROFILE; ;4/11/91 15:51
|
---|
2 | ;;5.01;MENTAL HEALTH;**19,37**;Dec 30, 1994
|
---|
3 | A ;
|
---|
4 | K YSAST S YSTV=110,YSBV=30,YSINC=2,YSLE=5 S Z1=0,X=YSSCALE,YSLFT=0 F J=1:1:YSNS S (A(J),YSA(J))=$P(X,U,J),YSAST(J)="" S:A(J)>YSTV YSAST(J)=">" S:A(J)>YSBV YSAST=">"
|
---|
5 | S YSVS=3,YSHS="110,66,50,30^"
|
---|
6 | F J=1:1:YSNS S Z1=$P(YSSNM,",",J),Z1=$P(Z1," "),$P(YSSNM,",",J)=Z1_YSAST(J)
|
---|
7 | S YSSNM1="" F I=1:1:YSNS S YSSNM1=YSSNM1_$P($P(YSSNM,",",I)," ")_$S($L($P(YSSNM,",",I))>1:"",1:" ")_","
|
---|
8 | F I=1:1 S J=$P(YSHS,",",I) Q:J="" S H(I)=+J
|
---|
9 | S YSLM=80-(YSNS*4+20)\2+5
|
---|
10 | S YSLC1=9999,YSLV=YSTV,YSIN2=YSINC/2
|
---|
11 | S YSHS=$O(H(-1)),H(-1)=-999
|
---|
12 | L ;
|
---|
13 | F I=1:1:YSNS S B(I)=(A(I)'<(YSLV-YSIN2))&(A(I)<(YSLV+YSIN2)) I $D(C(I)) S:(C(I)'<(YSLV-YSIN2))&(C(I)<(YSLV+YSIN2)) B(I)=2
|
---|
14 | S YSLL=$S(YSLC1'<YSLE:$J(YSLV,5,0),1:" ")
|
---|
15 | W ;
|
---|
16 | S YSWS=(H(YSHS)>(YSLV-YSIN2))&(H(YSHS)<(YSLV+YSIN2)) I YSWS D WS G:YSLFT END S YSHS=$O(H(YSHS))
|
---|
17 | I 'YSWS D WL G:YSLFT END
|
---|
18 | S YSLC1=YSLC1+1 S:YSLC1>YSLE YSLC1=1
|
---|
19 | I YSLV>YSBV S YSLV=YSLV-YSINC GOTO L
|
---|
20 | END ;
|
---|
21 | K A,B,YSA,YSTV,YSTVL,YSBV,YSINC,YSIN2,YSLE,YSVS,YSHS,V,H,YSLL,YSLC1,YSWS Q
|
---|
22 | WL ;
|
---|
23 | D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W:'Z1 ! W ?YSLM,YSLL,"|" S Z1=0
|
---|
24 | I YSSK="B" 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:" ")
|
---|
25 | I YSSK="K" F I=1:1:YSNS W $S(B(I)=2:" + ",B(I):$E($P(YSSNM1,",",I)_" ",1,3),1:" ") I I<YSNS W $S($D(V(I)):"|",1:" ")
|
---|
26 | I YSSK'="B"&(YSSK'="K") F I=1:1:YSNS S X="* " S:$P(YSSNM,",",I)?1"TR".E&(YSSK="S") X=$S($P(YSRAW,U,I)<9:"F ",$P(YSRAW,U,I)>9:"T ",1:"# ") W $S(B(I):X,1:" ")
|
---|
27 | W "|",$E(YSLL,3,5) Q
|
---|
28 | WS ;
|
---|
29 | D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W:'Z1 ! W ?YSLM,YSLL,"|" S Z1=0
|
---|
30 | I YSSK="B" F I=1:1:YSNS W $S(B(I):$P(YSSNM1,",",I)_"-",1:"---") I I<YSNS W $S($D(V(I)):"|",1:"-")
|
---|
31 | I YSSK="K" F I=1:1:YSNS W "-",$S(B(I)=2:"+-",B(I):$P(YSSNM,",",I),1:"--") I I<YSNS W $S($D(V(I)):"|",1:"-")
|
---|
32 | I YSSK'="B"&(YSSK'="K") F I=1:1:YSNS S X="*---" S:$P(YSSNM,",",I)?1"TR".E&(YSSK="S") X=$S($P(YSRAW,U,I)<9:"F---",$P(YSRAW,U,I)>9:"T---",1:"#---") W $S(B(I):X,1:"----")
|
---|
33 | W "|",$E(YSLL,3,5) Q
|
---|
34 | Q
|
---|
35 | DTA ;
|
---|
36 | S YSDTA=$P(^YTD(601.2,YSDFN,1,YSET,1,YSHD,0),U,5) S:YSDTA'="" YSDTA=$$FMTE^XLFDT(YSDTA,"5ZD")
|
---|
37 | S YSHDR=$E(YSHDR,1,43)_" "_YSSX_" AGE "_$J(YSAGE,2,0)_" "_$$FMTE^XLFDT(DT,"5ZD")_" "_$$FMTE^XLFDT(YSHD,"5ZD")
|
---|
38 | W YSHDR," ",YSDTA W ! W:$D(YSAST) "'<' OR '>' indicates 'T' out of table range" W ?53,"PRINTED ENTERED " W:YSDTA'="" "ADMIN" Q
|
---|
39 | WAIT ;
|
---|
40 | ; %% ANOTHER READER CALL ???? LOOK YSLFT = YSTOUT %%%
|
---|
41 | Q:IOST'?1"C-".E W $C(7) R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^" S:YSLFT["^"!'$T YSLFT=1 Q:YSLFT S Z1=1 W # Q
|
---|
42 | Q
|
---|
43 | NK ;NON-K CORRECTED
|
---|
44 | S J=100 F I=4,7,10,11,12 S J=J+1,A(J)=$P(YSRNK,U,I),S="" D LK^YTMMPI2A S C(I)=+S
|
---|
45 | HD ;
|
---|
46 | S (S,YSSCALE)=YSSCALEB,DOT=YSHD,YSNS=13,V(3)="",YSSK="K",YSSNM="L ,F ,K ,HS,D ,HY,PD,MF,PA,PT,SC,MA,SI"
|
---|
47 | W @IOF,!!?25,"K and Non-K Corrected Profile",! D ^YTMMPI2P Q:YSLFT
|
---|
48 | BOTTM ;
|
---|
49 | W !?YSLM+6 F I=1:1:YSNS W $E($P(YSSNM,",",I)_" ",1,4)
|
---|
50 | W !?2,"Raw Score:" F I=1:1:YSNS W $J($P(YSRNK,U,I),4) W:I=3 " "
|
---|
51 | S X=$P(YSRNK,U,3) W !!?2,"K Corr.",?27,$J(X*.5,2,0),?$X+10,$J(X*.4,2,0),?$X+10,$J(X,2)," ",$J(X,2)," ",$J(X*.2,2,0)
|
---|
52 | W !!?2,"T Score: " F I=1:1:YSNS W $J($P(S,U,I),4) W:I=3 " "
|
---|
53 | W !!?2,"+Non-K Corr.",!?3,"T Score:",?26,$J(C(4),3),?$X+9,$J(C(7),3),?$X+9,$J(C(10),3)," ",$J(C(11),3)," ",$J(C(12),3)
|
---|
54 | W !!?2,"? Cannot Say (Raw): ",YSQR K A,C,S,YSRAW,YSNRK
|
---|
55 | W !! D DTA,WAIT,CR G:YSLFT END^YTMMPI2 S YSFORM=1 D IR^YTREPT
|
---|
56 | D ^YTMMPI2C ;Print user comments
|
---|
57 | Q
|
---|
58 | CR ;COPYRIGHT
|
---|
59 | I $P(^YTT(601,YSTEST,0),U,6)]"" S YSCH=$P(^(0),U,6),Y=$P(^(0),U,7) D DD^%DT S YSCD=Y I $D(^YTT(601.3,YSCH,0)) S YSCHN=YSCH,YSCH=$P(^(0),U) D CR^YTDRIV
|
---|
60 | I IOST'?1"C-".E D WPO
|
---|
61 | Q
|
---|
62 | WPO ;
|
---|
63 | ;WRITE PRINTED BY - ORDERED BY ------MJD 10/15/96
|
---|
64 | N YSI
|
---|
65 | F YSI=1:1:IOSL-$Y-5 W !
|
---|
66 | W !,"Printed by: ",$P(^VA(200,DUZ,0),U),!
|
---|
67 | S YSORD=$P(^YTD(601.2,YSDFN,1,YSET,1,YSED,0),U,3)
|
---|
68 | I YSORD,$D(^VA(200,YSORD,0)) W "Ordered by: ",$P(^(0),U)
|
---|
69 | Q
|
---|