YTDEMO.m

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 ---YTDEMO   672     printed  Apr 09, 2024@21:17:44                                                                                                                                                                                                       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