source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMP3.m@ 1608

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1YTMMP3 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:09 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 I IOST?1"C-".E,($Y>1) D WAIT G:YSLFT DONE
5 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)
6 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"
7 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)
8 S Y="" F I=1:2:67 D CRIT
9 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"
10 F I=1:2:65 D CRIT
11 S YSFC="11^5^11^9^6^5^3^7^10"
12 S YSLE=0,YSLN=2
13 F I=1:1:10 S YSLB=YSLE+1,YSLE=YSLE+$P(YSFC,U,I) D PRT Q:YSLFT
14 K X1,X2,YSFC,Y
15 G DONE ;SLC; W !#,YSHDR,!!!?25,"--- ITEM RESPONSES ---",!! S L=200,M=0,YSIT=1
16R2 ;
17 D RD S A=$L(X),B=A\10 G:'B R31
18R3 ;
19 S K=10 F I=1:1:B D RLN
20R31 ;
21 S K=-10*B+A I K D RLN G DONE
22 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
23DONE ;
24 K X G DONE^YTMMP4:$P(^YTT(601,YSTEST,0),U)'="MMPI" W ! G ^YTMMP4
25RLN ;
26 W ?1 F YSKK=1:1:K W $J(YSIT,3,0)," ",$E(X,YSIT-M)," " S YSIT=YSIT+1
27 W ! Q
28RD ;
29 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
30CRIT ;
31 S YSIT1=$P(YSFC,U,I),YSIT2=$P(YSIT1,",",2),YSIT1=+YSIT1,A=$P(YSFC,U,I+1)
32 I YSIT1>200 S C=$E(X2,YSIT1-200)
33 E S C=$E(X1,YSIT1)
34 I YSIT2'="" S C=C_$E(X2,YSIT2)
35 S Y=Y_(C[A) Q
36PRT ;
37 I $E(Y,YSLB,YSLE)'[1 S YSLN=YSLN+YSLE-YSLB+2 Q
38 I $Y>52&(IOST?1"P".E) D DTA^YTREPT W !!
39 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,!
40PRT3 ;
41 I $Y>52&(IOST?1"C-".E) D DTA^YTREPT W !!
42 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)
43 S YSLN=YSLN+1,YSJJ=YSJJ+1 G:YSJJ'>YSLE PRT3 Q
44WAIT ;
45 F I0=1:1:(IOSL-$Y-2) W !
46 ;%%%% YSLFT TO YSTOUT ! YSUOUT
47 W !,"Press return to continue or ""^"" to omit Critical Item display " R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^"
48 S:YSLFT["^"!'$T YSLFT=1
49 W @IOF K I0 Q
Note: See TracBrowser for help on using the repository browser.