- 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 Feb 18, 2025@23:43:27 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