YTDEMO ;SLC/DKG-TEST PKG: CRT DEMO PROGRAM ; 10/19/88 17:29 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
S YSTEST=$O(^YTT(601,"B","DEMO",0)) G:'YSTEST END S J=1,C=" ;3;T; ;^; "
D0 ;
D D1,RD G:J<7 D0
END ;
K C,J,K,L,X,YSTEST Q
D1 ;
W:'$D(E) @IOF W !! F L=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"T",L,0)) W !?3 W:'$D(E) ^(0) W:$D(E)&(^(0)'["!") ^(0)
K E Q
RD ;
R *X:900 G:'$T!(X=42) H^XUS G:X<32 RD S X=$C(X)
I X=$P(C,";",J) S J=J+1 Q
S K=J,J=7,E=1
I K=5,X=6 S J=8 D D2 S E1=1,J=5 D D2 K E1 G RD
I K=5,X="N" S J=10 D D2 S E1=1,J=5 D D2 K E1 G RD
D D2 S J=K Q
D2 ;
W:'$D(E1) @IOF F L=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"T",L,0)) W:^(0)'["!" !?3,^(0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTDEMO 672 printed Nov 22, 2024@17:27:12 Page 2
YTDEMO ;SLC/DKG-TEST PKG: CRT DEMO PROGRAM ; 10/19/88 17:29 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 SET YSTEST=$ORDER(^YTT(601,"B","DEMO",0))
if 'YSTEST
GOTO END
SET J=1
SET C=" ;3;T; ;^; "
D0 ;
+1 DO D1
DO RD
if J<7
GOTO D0
END ;
+1 KILL C,J,K,L,X,YSTEST
QUIT
D1 ;
+1 if '$DATA(E)
WRITE @IOF
WRITE !!
FOR L=1:1
if '$DATA(^YTT(601,YSTEST,"Q",J,"T",L,0))
QUIT
WRITE !?3
if '$DATA(E)
WRITE ^(0)
if $DATA(E)&(^(0)'["!")
WRITE ^(0)
+2 KILL E
QUIT
RD ;
+1 READ *X:900
if '$TEST!(X=42)
GOTO H^XUS
if X<32
GOTO RD
SET X=$CHAR(X)
+2 IF X=$PIECE(C,";",J)
SET J=J+1
QUIT
+3 SET K=J
SET J=7
SET E=1
+4 IF K=5
IF X=6
SET J=8
DO D2
SET E1=1
SET J=5
DO D2
KILL E1
GOTO RD
+5 IF K=5
IF X="N"
SET J=10
DO D2
SET E1=1
SET J=5
DO D2
KILL E1
GOTO RD
+6 DO D2
SET J=K
QUIT
D2 ;
+1 if '$DATA(E1)
WRITE @IOF
FOR L=1:1
if '$DATA(^YTT(601,YSTEST,"Q",J,"T",L,0))
QUIT
if ^(0)'["!"
WRITE !?3,^(0)
+2 QUIT
