YTDRIV ;SLC/DKG-TEST PKG: TEST DRIVER ;4/21/92 08:42 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
X ^%ZOSF("NO-TYPE-AHEAD")
I '$D(J) S J=1,(YSRP,B)="",YSBEGIN=DT
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
NX ;
I $D(^YTT(601,YSTEST,"Q",J,0))#2=1 S:$P(^(0),U,2)]"" C=$P(^(0),U,2)
I $D(^YTT(601,YSTEST,"Q",J,"B")) S K=^("B") S:K'="" B=K
I '$D(^YTT(601,YSTEST,"Q",J,"I",1,0)) G D1
W @IOF F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"I",K)) W:'$D(^YTT(601,YSTEST,"Q",J,"I",5)) ! W:$D(^YTT(601,YSTEST,"Q",J,"I",K,0)) !?3,^(0)
W !!!?3,"PRESS THE SPACE BAR TO CONTINUE."
I2 ;
D RD I X'=" " G:X="*" ^YTAR2 W " ? " G I2
D1 ;
W @IOF F K=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"T",K)) W:$D(^(K,0)) !!?3,^(0)
X:B'="" B
D3 ;
S YZT=$P($H,",",2) D RD G HOLD:YZT+1>$P($H,",",2) G D4:C[X,BK:X="^",^YTAR2:X="*",WHERE:X="?" W " ? " G D3
D4 ;
S YSRP=YSRP_X D:J#200=0 EN4^YTFILE S J=J+1 I $D(^YTT(601,YSTEST,"Q",J)) G NX
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 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
WHERE ;
W !,YSTESTN," QUESTION # ",J,! X:B]"" B G D3
CR ;
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"
W @IOF,!!!?3,^YTT(601.3,YSCHN,1,1,0)," ",YSCD," ",^YTT(601.3,YSCHN,1,2,0) S YSTX=2
F S YSTX=$O(^YTT(601.3,YSCHN,1,YSTX)) Q:'YSTX W !?3,^(YSTX,0)
I IOST?1"C-".E D WAIT^YSUTL
K YSCH,YSCHN,YSCD,YSTX Q
IP ;
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
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
HOLD ;
W @IOF,#,$C(7) R "Please read each question carefully!",X:3 K X G D1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTDRIV 2087 printed Apr 09, 2024@21:17:47 Page 2
YTDRIV ;SLC/DKG-TEST PKG: TEST DRIVER ;4/21/92 08:42 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 XECUTE ^%ZOSF("NO-TYPE-AHEAD")
+4 IF '$DATA(J)
SET J=1
SET (YSRP,B)=""
SET YSBEGIN=DT
+5 IF $PIECE(^YTT(601,YSTEST,0),U,6)]""
SET YSCH=$PIECE(^(0),U,6)
SET Y=$PIECE(^(0),U,7)
DO DD^%DT
SET YSCD=Y
IF $DATA(^YTT(601.3,YSCH,0))
SET YSCHN=YSCH
SET YSCH=$PIECE(^(0),U)
DO CR
NX ;
+1 IF $DATA(^YTT(601,YSTEST,"Q",J,0))#2=1
if $PIECE(^(0),U,2)]""
SET C=$PIECE(^(0),U,2)
+2 IF $DATA(^YTT(601,YSTEST,"Q",J,"B"))
SET K=^("B")
if K'=""
SET B=K
+3 IF '$DATA(^YTT(601,YSTEST,"Q",J,"I",1,0))
GOTO D1
+4 WRITE @IOF
FOR K=1:1
if '$DATA(^YTT(601,YSTEST,"Q",J,"I",K))
QUIT
if '$DATA(^YTT(601,YSTEST,"Q",J,"I",5))
WRITE !
if $DATA(^YTT(601,YSTEST,"Q",J,"I",K,0))
WRITE !?3,^(0)
+5 WRITE !!!?3,"PRESS THE SPACE BAR TO CONTINUE."
I2 ;
+1 DO RD
IF X'=" "
if X="*"
GOTO ^YTAR2
WRITE " ? "
GOTO I2
D1 ;
+1 WRITE @IOF
FOR K=1:1
if '$DATA(^YTT(601,YSTEST,"Q",J,"T",K))
QUIT
if $DATA(^(K,0))
WRITE !!?3,^(0)
+2 if B'=""
XECUTE B
D3 ;
+1 SET YZT=$PIECE($HOROLOG,",",2)
DO RD
if YZT+1>$PIECE($HOROLOG,",",2)
GOTO HOLD
if C[X
GOTO D4
if X="^"
GOTO BK
if X="*"
GOTO ^YTAR2
if X="?"
GOTO WHERE
WRITE " ? "
GOTO D3
D4 ;
+1 SET YSRP=YSRP_X
if J#200=0
DO EN4^YTFILE
SET J=J+1
IF $DATA(^YTT(601,YSTEST,"Q",J))
GOTO NX
+2 DO ^YTFILE
QUIT
RD ;
+1 READ "",*X:900
if '$TEST
SET X=42
if X<32
GOTO RD
SET X=$CHAR(X)
QUIT
BK ;
+1 if J=1
GOTO D1
SET J=J-1
SET X=$LENGTH(YSRP)
SET YSRP=$SELECT(X>1:$EXTRACT(YSRP,1,X-1),X=1:"",1:$EXTRACT(^YTD(601.4,YSDFN,1,YSENT,J\200),1,199))
GOTO NX
WHERE ;
+1 WRITE !,YSTESTN," QUESTION # ",J,!
if B]""
XECUTE B
GOTO D3
CR ;
+1 IF YSCH="IPAT"!(YSCH="PSYC")
SET YSTNM=$PIECE($PIECE(^YTT(601,YSTEST,"P"),U),"---",2)
SET YSTNM=$EXTRACT(YSTNM,1,$LENGTH(YSTNM)-1)
if YSCH="IPAT"
GOTO IP
if YSCH="PSYC"
GOTO PS
+2 WRITE @IOF,!!!?3,^YTT(601.3,YSCHN,1,1,0)," ",YSCD," ",^YTT(601.3,YSCHN,1,2,0)
SET YSTX=2
+3 FOR
SET YSTX=$ORDER(^YTT(601.3,YSCHN,1,YSTX))
if 'YSTX
QUIT
WRITE !?3,^(YSTX,0)
+4 IF IOST?1"C-".E
DO WAIT^YSUTL
+5 KILL YSCH,YSCHN,YSCD,YSTX
QUIT
IP ;
+1 WRITE @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),!
HANG 5
KILL YSCH,YSCHN,YSCD,YSTX,YSTNM
QUIT
PS ;
+1 WRITE @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)
HANG 5
KILL YSCH,YSCHN,YSCD,YSTX,YSTNM
QUIT
HOLD ;
+1 WRITE @IOF,#,$CHAR(7)
READ "Please read each question carefully!",X:3
KILL X
GOTO D1
