VistA-WorldVistAEHR/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMP3.m

50 lines
2.3 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
YTMMP3 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:09 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
I IOST?1"C-".E,($Y>1) D WAIT G:YSLFT DONE
S YSLFT=0 S:'$D(YSMMPI) YSMMPI=$O(^YTT(601,"B","MMPI",0)) D DTA^YTREPT W !!?25,"--- CRITICAL ITEMS ---",! F I=1:1:3 W !,^YTT(601,YSMMPI,"G",1,1,I,0)
S YSFC="5^T^27^T^86^T^142^T^152^F^158^T^168^T^178^F^182^T^259^T^337^T^88^F^139^T^202^T^209^T^339^T^35,131^T^110^T^121^T^123^T^151^T^200^T^275^T^284^T^293^T^347^F^364^T^33,123^T^48^T^66^T^184^T^291^T^334^T^345^T"
S X1=^YTD(601.2,YSDFN,1,YSET,1,YSED,1),X2="" I $D(^YTD(601.2,YSDFN,1,YSET,1,YSED,2)) S X2=^YTD(601.2,YSDFN,1,YSET,1,YSED,2)
S Y="" F I=1:2:67 D CRIT
S YSFC="349^T^350^T^20,110^F^37,102^F^69^T^133^F^179^T^297^T^38,111^T^59^T^118^T^205^T^294^F^156^T^215^T^251^T^21,108^T^96^F^137^F^212^T^216^T^237^F^245^T^2^F^9^F^23,88^T^55^F^114^T^125^T^153^F^175^F^189^T^243^F"
F I=1:2:65 D CRIT
S YSFC="11^5^11^9^6^5^3^7^10"
S YSLE=0,YSLN=2
F I=1:1:10 S YSLB=YSLE+1,YSLE=YSLE+$P(YSFC,U,I) D PRT Q:YSLFT
K X1,X2,YSFC,Y
G DONE ;SLC; W !#,YSHDR,!!!?25,"--- ITEM RESPONSES ---",!! S L=200,M=0,YSIT=1
R2 ;
D RD S A=$L(X),B=A\10 G:'B R31
R3 ;
S K=10 F I=1:1:B D RLN
R31 ;
S K=-10*B+A I K D RLN G DONE
G:A<200 DONE S L=L+200,M=M+200 I $D(^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200))#2 G R2
DONE ;
K X G DONE^YTMMP4:$P(^YTT(601,YSTEST,0),U)'="MMPI" W ! G ^YTMMP4
RLN ;
W ?1 F YSKK=1:1:K W $J(YSIT,3,0)," ",$E(X,YSIT-M)," " S YSIT=YSIT+1
W ! Q
RD ;
S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
CRIT ;
S YSIT1=$P(YSFC,U,I),YSIT2=$P(YSIT1,",",2),YSIT1=+YSIT1,A=$P(YSFC,U,I+1)
I YSIT1>200 S C=$E(X2,YSIT1-200)
E S C=$E(X1,YSIT1)
I YSIT2'="" S C=C_$E(X2,YSIT2)
S Y=Y_(C[A) Q
PRT ;
I $E(Y,YSLB,YSLE)'[1 S YSLN=YSLN+YSLE-YSLB+2 Q
I $Y>52&(IOST?1"P".E) D DTA^YTREPT W !!
S A=^YTT(601,YSMMPI,"G",YSLN,1,1,0),B=72-$L(A)\2,YSLN=YSLN+1,YSJJ=YSLB D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W !!?B,A,!
PRT3 ;
I $Y>52&(IOST?1"C-".E) D DTA^YTREPT W !!
I $E(Y,YSJJ)=1 D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W !,^YTT(601,YSMMPI,"G",YSLN,1,1,0) I $D(^YTT(601,YSMMPI,"G",YSLN,1,2,0)) W !,^(0)
S YSLN=YSLN+1,YSJJ=YSJJ+1 G:YSJJ'>YSLE PRT3 Q
WAIT ;
F I0=1:1:(IOSL-$Y-2) W !
;%%%% YSLFT TO YSTOUT ! YSUOUT
W !,"Press return to continue or ""^"" to omit Critical Item display " R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^"
S:YSLFT["^"!'$T YSLFT=1
W @IOF K I0 Q