source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMMP4.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.3 KB
RevLine 
[613]1YTMMP4 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 7/6/89 11:22 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 I IOST?1"C-".E,($Y>1) D WAIT G:YSLFT DONE
5 D DTA^YTREPT W !!!?26,"--- SCALE SCORES ---",!
6 F J=1:1:3 S X(J)=^YTD(601.2,YSDFN,1,YSET,1,YSED,J)
7E ;
8 W !!!?3," HS D HY PD MF PA PT SC MA SI L F K"
9 S L1=1,L2=13 D SC
10 W !!!?3," D-O D-S HY-O HY-S PD-O PD-S PA-O PA-S MA-O MA-S ES A R"
11 S L1=14,L2=26 D SR,SC
12 W !!!?3," LB CA DY DO RE PR ST CN D1 D2 D3 D4 D5"
13 S L1=27,L2=39 D SR,SC
14 W !!!?3," HY1 HY2 HY3 HY4 HY5 PD1 PD2 PD3 PD4A PD4B PA1 PA2 PA3"
15 S L1=40,L2=52 D SR,SC
16 I IOST?1"C-".E D WAIT G:YSLFT DONE
17 W !!!?3," SC1A SC1B SC2A SC2B SC2C SC3 MA1 MA2 MA3 MA4 MAC ICA HE"
18 S L1=53,L2=65 D SR,SC
19 W !!!?3," MAS MF1 MF2 MF3 MF4 MF5 MF6 SI1 SI2 SI3 SI4 SI5 SI6"
20 S L1=66,L2=78 D SR,SC
21 W !!!?3," SOC DEP FEM MOR REL AUT PSY ORG FAM HOS PHO HYP HEA"
22 S L1=79,L2=91 D SR,SC
23 W !!!?3," TI TII TIII TIV TV TVI TVII OH NPD SK PTSD"
24 S L1=92,L2=102 D SR,SC
25 I $D(YSAST) W !!,"'<' or '>' indicates 'T' out of table range"
26DONE ;
27 W ! K A,B,C,DOT,J,K,L,L1,L2,M,N,N1,N2,P,R,S,S1,T,X,Y,YSANLL,YSAST,YSAU,YSHP1,YSHP2,YSIT,YSIT1,YSIT2,YSJJ,YSKC,YSKK,YSLB,YSLE,YSLM,YSLN,YSLV,YSMA,YSMF,YSMMPI
28 K YSMMPR,YSNS26,YSNS39,YSNS9,YSNSS,YSPD,YSPS,YSRAW,YSRH,YSSCALE,YSSH,YSSI,YSSP,YSSP4,YSTL,YSTVL,YSZ,Z1 Q
29SR ;
30 S R="",S="",J=L1,S1=0,YSPS=YSSX
31S1 ;
32 S YSKK=1,YSTL=0
33S2 ;
34 I '$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) S R=R_YSTL_"^" G LK
35 S Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0),P=1
36S3 ;
37 S YSIT=$P(Y,U,P) I YSIT="" S YSKK=YSKK+1 G S2
38 S B=$P(Y,U,P+1),P=P+2
39 S:$E(X(YSIT-1\200+1),YSIT-1#200+1)=B YSTL=YSTL+1 G S3
40LK ;
41 S S1=S1+1,X=^YTT(601,YSTEST,"S",J,YSPS),YSZ=$P(X,U) I YSTL<YSZ S YSTVL=$P(X,U,2),YSTAR(S1)="<" S:J=5&(YSPS=2) YSTAR(S1)=">" G LK1
42 S YSTVL=$P(X,U,YSTL+2-YSZ) I YSTVL="" S YSTVL=$P(X,U,$L(X,"^")),YSTAR(S1)=">" S:J=5&(YSPS)=2 YSTAR(S1)="<"
43LK1 ;
44 S S=S_YSTVL_"^",J=J+1 G:J'>L2 S1 Q
45SC ;
46 S:$D(YSTAR) YSAST=1 S K=L2-L1+1 W !,"RAW" F J=1:1:K W $J($P(R,U,J),5,0)
47 W !," T " F J=1:1:K S S1=$P(S,U,J) S:$D(YSTAR(J)) S1=YSTAR(J)_S1 W $J(S1,5)
48 K YSTAR Q
49WAIT ;
50 F I0=1:1:(IOSL-$Y-2) W !
51 ;%%%% YSLFT TO YSTOUT OR YSUOUT
52 W !,"Press return to continue or ""^"" to omit Scale Scores " R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^"
53 S:YSLFT["^"!'$T YSLFT=1
54 W @IOF K I0 Q
Note: See TracBrowser for help on using the repository browser.