source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMPI2P.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1YTMMPI2P ;SLC/DKG,ALB/ASF-TEST PKG: MMPI2 PROFILE; ;4/11/91 15:51
2 ;;5.01;MENTAL HEALTH;**19,37**;Dec 30, 1994
3A ;
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
12L ;
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:" ")
15W ;
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
20END ;
21 K A,B,YSA,YSTV,YSTVL,YSBV,YSINC,YSIN2,YSLE,YSVS,YSHS,V,H,YSLL,YSLC1,YSWS Q
22WL ;
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
28WS ;
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
35DTA ;
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
39WAIT ;
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
43NK ;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
45HD ;
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
48BOTTM ;
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
58CR ;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
62WPO ;
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
Note: See TracBrowser for help on using the repository browser.