source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YIHIST.m@ 1397

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