92 lines
3.7 KiB
Mathematica
92 lines
3.7 KiB
Mathematica
YIHIST ;SLC/DKG-INTERVIEW HISTORY DRIVER ;11/15/90 16:23 ;
|
|
;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|
G A
|
|
;
|
|
CK ;
|
|
I $T D WAIT:'P0 Q:YSZZ D HDR
|
|
Q
|
|
L ;
|
|
S Y1=$E(YSYTX,1,78-YSIND),Y2=$E(YSYTX,79-YSIND,255)
|
|
I Y2="" X P1 D CK Q:YSZZ W !?YSIND,Y1 Q
|
|
F YSYI=78-YSIND:-1:1 I $E(Y1,YSYI)?1P X P1 D CK Q:YSZZ W !?YSIND,$E(Y1,1,YSYI) S YSYTX=$E(Y1,YSYI+1,78-YSIND)_Y2 Q
|
|
I $E(Y1,YSYI)'?1P X P1 D CK Q:YSZZ W !?YSIND,Y1 S YSYTX=Y2
|
|
G L
|
|
;
|
|
A ;
|
|
S YSJT=0 I '$D(J) S J=1,YSRP=""
|
|
NX ;
|
|
G DONE:'$D(^YTT(601,YSTEST,"Q",J)),D1:'$D(^(J,"I",1))
|
|
W @IOF,!! F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"I",K,0)) W !?3,^(0)
|
|
W !!!?3,"PRESS THE SPACE BAR TO CONTINUE."
|
|
N2 ;
|
|
D RD I X'=" " G:X="*" ^YTAR2 W " ? " G N2
|
|
D1 ;
|
|
S YSTY=^YTT(601,YSTEST,"Q",J,1),T=+YSTY,B=$P(YSTY,U,2,99) G T0:T=0,T1:T=1,T2:T=2,T3
|
|
T0 ;
|
|
W @IOF
|
|
F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"T",K,0)) W !!?3,^(0)
|
|
W !!?3,"(Y OR N)",!!
|
|
A2 ;
|
|
S R1="T0" W $C(13)," " D RD G STOR:"YN"[X,BK:X="^",^YTAR2:X="*",WH:X="?" W " ?" G A2
|
|
T3 ;
|
|
W @IOF
|
|
F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"T",K,0)) W:+^(0)=1 ! W !?3,^(0)
|
|
S M=$P(YSTY,",",2)+1 W !!!?3,"ANSWER = "
|
|
A4 ;
|
|
S R1="T3" S YZT=$P($H,",",2) D RD G HOLD:YZT+1>$P($H,",",2) G STOR:X>0&(X<M),BK:X="^",^YTAR2:X="*",WH:X="?" W " ? " G A4
|
|
T2 ;
|
|
W !?12 F K=1:1 G:'$D(^YTT(601,YSTEST,"Q",J,"T",K,0)) A2 W !?12,^(0)
|
|
T1 ;
|
|
W @IOF,!!!?3,^YTT(601,YSTEST,"Q",J,"T",1,0)
|
|
F K=2:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"T",K+1,0)) Q:$E(^(0),1,3)=" " W !?3,^YTT(601,YSTEST,"Q",J,"T",K,0)
|
|
W !!?3,"(Y OR N)",!!?12,^YTT(601,YSTEST,"Q",J,"T",K,0) F K=K+1:1 G:'$D(^YTT(601,YSTEST,"Q",J,"T",K,0)) A2 W !?12,^YTT(601,YSTEST,"Q",J,"T",K,0)
|
|
STOR ;
|
|
S YSRP=YSRP_X D:J#200=0 EN4^YTFILE S J=J+1,YSJT=0 X:B'="" B G:'YSJT NX
|
|
S M=J-1#200,J=J+YSJT,T=M+YSJT-1,K=T S:K>199 K=199 F L=M:1:K S YSRP=YSRP_" "
|
|
I T>198 D EN4^YTFILE I T>199 F L=200:1:T S YSRP=YSRP_" "
|
|
G NX
|
|
DONE ;
|
|
D ^YTFILE Q
|
|
RD ;
|
|
R *X:900 S:'$T X=42 G:X<32 RD S X=$C(X) Q
|
|
BK ;
|
|
G:J=1 D1 F I=1:1 S YSRP=$S($L(YSRP):YSRP,1:^YTD(601.4,YSDFN,1,YSENT,J\200)),X=$E(YSRP,$L(YSRP)) Q:X'=" " S J=J-1,YSRP=$E(YSRP,1,$L(YSRP)-1)
|
|
S J=J-1,YSRP=$E(YSRP,1,$L(YSRP)-1) G NX
|
|
RP ;
|
|
S J=1,U1=0,L=-200,YSLCK=200,YSZZ=0 D HDR
|
|
S P1=$S(IOST?1"C-".E:"I IOSL-$Y<3",1:"I IOSL-$Y<7"),P3=$S(P1[3:"I IOSL-$Y<6",1:"I IOSL-$Y<10"),P0=$S(P1[3:0,1:1)
|
|
R1 ;
|
|
I '$D(^YTT(601,YSTEST,"G",J,1,1,0)) K A,B,I,YSIND,J,L,YSLCK,R,YSSTEM,U1,YSYX,YSYCK,YSSCK Q
|
|
S A=^YTT(601,YSTEST,"G",J,1,1,0),J=J+1,B=$P(A,U),I=+B,YSIND=$P(B,",",2)
|
|
I I=0 X P3 D CK G:YSZZ END W !!?YSIND,$P(A,U,2),! S YSLCK=200 G R1
|
|
I I'>L!(I>U1) S L=(I-1)\200*200,U1=L+200,YSYX=^YTD(601.2,YSDFN,1,YSET,1,YSED,U1\200)
|
|
S R=$E(YSYX,I-L) G:R=" " R1
|
|
S YSSTEM=$P(A,U,2) G:YSSTEM'["##" YSRP1 S YSSCK=$S(YSSTEM["2":2,YSSTEM["1":1,1:0) I YSSTEM["L" S YSLCK=YSIND,YSYCK=$P(A,U,3) G R1
|
|
I YSSCK X P3 D CK G:YSZZ END
|
|
W:YSSCK ! W !?YSIND,$P(A,U,3) W:YSSCK=2 ! G R1
|
|
YSRP1 ;
|
|
I "YN"[R S R=R="N"+1 I YSSTEM'["#" S R=$P(A,U,R+1) G NOST:R'="",R1
|
|
S R=$P(A,U,R+2) G R1:R="",NOST:YSSTEM=""
|
|
D:YSIND>YSLCK STM G:YSZZ END
|
|
I YSSTEM'["#" S YSYTX=YSSTEM_R D L G R1:'YSZZ,END
|
|
S A=$F(YSSTEM,"#") I A<3 S YSYTX=R_$E(YSSTEM,2,99) D L G R1:'YSZZ,END
|
|
S YSYTX=$E(YSSTEM,1,A-2)_R_$E(YSSTEM,A,99) D L G R1:'YSZZ,END
|
|
NOST ;
|
|
D:YSIND>YSLCK STM G:YSZZ END S YSYTX=R D L G R1:'YSZZ,END
|
|
STM ;
|
|
I YSSCK X P3 D CK Q:YSZZ
|
|
W:YSSCK ! W !?YSLCK,YSYCK W:YSSCK=2 ! S YSLCK=200 Q
|
|
WH ;
|
|
W !,$P(^YTT(601,YSTEST,0),U)," QUESTION # ",J,! H 2 G @(R1)
|
|
HDR ;
|
|
S YSHDR=$E(YSHDR,1,43)_" "_YSSEX_" AGE "_$J(YSAGE,2,0)_" "_YSDT(0)_" "_$E(YSHD,4,5)_"/"_$E(YSHD,6,7)_"/"_$E(YSHD,2,3) W @IOF,YSHDR,!?53,"PRINTED",?62,"ENTERED" Q
|
|
WAIT ;
|
|
F I0=1:1:IOSL-$Y-2 W !
|
|
N DTOUT,DUOUT,DIRUT
|
|
W $C(7) S DIR(0)="E" D ^DIR K DIR S YSZZ=$D(DIRUT) W @IOF
|
|
Q
|
|
END ;
|
|
K I,YSIND,YSLCK,R,YSSTEM,YSYX,YSYCK,YSSCK Q
|
|
HOLD ;
|
|
W !!,"Please read each question carefully!",$C(7) R X:3 K X G T3
|