1 | YTAUIR ;ALB/ASF- AUIR DRIVER ;12/20/89 09:35 ;2/21/89 12:33
|
---|
2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
---|
3 | ;
|
---|
4 | X ^%ZOSF("NO-TYPE-AHEAD")
|
---|
5 | I '$D(J) S J=1,YSRP="",B="",YSBEGIN=DT
|
---|
6 | 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
|
---|
7 | NX ;
|
---|
8 | I $P($G(^YTT(601,YSTEST,"Q",J,0)),U,2)]"" S C=$P(^(0),U,2)
|
---|
9 | S K=$G(^YTT(601,YSTEST,"Q",J,"B")) S:K'="" B=K
|
---|
10 | MAR ;
|
---|
11 | I J=209 D MARQ,RD G BK:X="^",^YTAR2:X="*",MAR:X'=1&(X'=2) I X=1 S X="" D ^YTFILE Q
|
---|
12 | I '$D(^YTT(601,YSTEST,"Q",J,"I",1,0)) G D1
|
---|
13 | W @IOF F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"I",K)) W:$D(^(K,0)) !!?3,^(0)
|
---|
14 | W !!!?3,"PRESS THE SPACE BAR TO CONTINUE."
|
---|
15 | I2 ;
|
---|
16 | D RD I X'=" " G:X="*" ^YTAR2 W " ? " G I2
|
---|
17 | D1 ;
|
---|
18 | W @IOF F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"T",K)) W:$D(^(K,0)) !!?3,^(0)
|
---|
19 | X:B'="" B
|
---|
20 | D3 ;
|
---|
21 | S YZT=$P($H,",",2) D RD G HOLD:YZT+1>$P($H,",",2),D4:C[X,BK:X="^",^YTAR2:X="*",WHERE:X="?" W " ? " G D3
|
---|
22 | D4 S YSRP=YSRP_X D:J#200=0 EN4^YTFILE S J=J+1 I $D(^YTT(601,YSTEST,"Q",J)) G NX
|
---|
23 | D ^YTFILE Q
|
---|
24 | RD ;
|
---|
25 | R *X:900 S:'$T X=42 G:X<32 RD S X=$C(X)
|
---|
26 | Q
|
---|
27 | BK ;
|
---|
28 | G:J=1 D1 S J=J-1,X=$L(YSRP),YSRP=$S(X>1:$E(YSRP,1,X-1),X=1:"",1:$E(^YTD(601.4,YSDFN,1,YSENT,J\200),1,199)) G NX
|
---|
29 | WHERE ;
|
---|
30 | W !,YSTESTN," QUESTION # ",J,! X:B]"" B G D3
|
---|
31 | CR ;
|
---|
32 | I YSCH="IPAT"!(YSCH="PSYC") S YSTNM=$P($P(^YTT(601,YSTEST,"P"),U),"---",2),YSTNM=$E(YSTNM,1,$L(YSTNM)-1) G IP:YSCH="IPAT",PS:YSCH="PSYC"
|
---|
33 | W @IOF,!!!?3,^YTT(601.3,YSCHN,1,1,0)," ",YSCD," ",^YTT(601.3,YSCHN,1,2,0) S YSTX=2
|
---|
34 | NL ;
|
---|
35 | S YSTX=$O(^YTT(601.3,YSCHN,1,YSTX)) G:'YSTX H5 W !?3,^(YSTX,0) G NL
|
---|
36 | H5 ;
|
---|
37 | W !! H 5 K YSCH,YSCHN,YSCD,YSTX Q
|
---|
38 | IP ;
|
---|
39 | W @IOF,!!!?3,^YTT(601.3,YSCHN,1,1,0),!?3,^YTT(601.3,YSCHN,1,2,0),YSTNM,",",!?3,^YTT(601.3,YSCHN,1,3,0)," ",YSCD," ",^YTT(601.3,YSCHN,1,4,0),!?3,^YTT(601.3,YSCHN,1,5,0),! H 5 K YSCH,YSCHN,YSCD,YSTX,YSTNM Q
|
---|
40 | PS W @IOF,!!!?3,^YTT(601.3,YSCHN,1,1,0),YSTNM,!?3,^YTT(601.3,YSCHN,1,2,0)," ",YSCD,!?3,^YTT(601.3,YSCHN,1,3,0)," ",^YTT(601.3,YSCHN,1,4,0) H 5 K YSCH,YSCHN,YSCD,YSTX,YSTNM Q
|
---|
41 | HOLD ;
|
---|
42 | W !!,"Please read each question carefully",$C(7) R X:3 K X G D1
|
---|
43 | MARQ ;
|
---|
44 | W @IOF,!,"Have you been living in a marriage or marriage-type situation",!,"within the past six months?",!!!?3,"1. No",!!?3,"2. Yes" Q
|
---|