source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMPP.m@ 1582

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1YTMMPP ;SLC/DKG-TEST PKG: MMPI PROFILE ;1/10/92 15:07 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3A ;
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
18L ;
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:" ")
21W ;
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 !
30END ;
31 K A,B,YSA,YSNS,YSTV,YSTVL,YSBV,YSINC,YSIN2,YSLE,YSVS,YSHS,V,H,YSLL,YSLC1,YSWS,YSSNM,YSSNM1,YSAST,YSQ Q
32WE ;
33 W !?YSLM+5,"|" F I=1:1:YSNS-1 W "----"
34 W "---|" Q
35WL ;
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
39WS ;
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
43SL ;
44 W !?6,"?",?YSLM+6 F I=1:1:YSNS W $E($P(YSSNM,",",I)_" ",1,4)
45 Q
46SV ;
47 W !?YSLM+6 F I=1:1:YSNS W $E(A(I)_" ",1,4)
48 Q
49SV1 ;
50 W !?6,YSQ,?YSLM+6 F I=1:1:YSNS W $E(A(I)_" ",1,4)
51 Q
52MAX ;
53 F I=1:1:YSNS S:A(I)>YSTV YSTV=A(I)
54 Q
55MIN ;
56 S YSBV=99999 F I=1:1:YSNS S:A(I)<YSBV YSBV=A(I)
57 Q
58INC ;
59 S YSINC=$J(YSTV-YSBV/20,1,4)
60 Q
61DTA ;
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
65WAIT ;
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
Note: See TracBrowser for help on using the repository browser.