Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YTDEMO

YTDEMO.m

Go to the documentation of this file.
  1. YTDEMO ;SLC/DKG-TEST PKG: CRT DEMO PROGRAM ; 10/19/88 17:29 ;
  1. ;;5.01;MENTAL HEALTH;;Dec 30, 1994
  1. ;
  1. S YSTEST=$O(^YTT(601,"B","DEMO",0)) G:'YSTEST END S J=1,C=" ;3;T; ;^; "
  1. D0 ;
  1. D D1,RD G:J<7 D0
  1. END ;
  1. K C,J,K,L,X,YSTEST Q
  1. D1 ;
  1. 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)
  1. K E Q
  1. RD ;
  1. R *X:900 G:'$T!(X=42) H^XUS G:X<32 RD S X=$C(X)
  1. I X=$P(C,";",J) S J=J+1 Q
  1. S K=J,J=7,E=1
  1. I K=5,X=6 S J=8 D D2 S E1=1,J=5 D D2 K E1 G RD
  1. I K=5,X="N" S J=10 D D2 S E1=1,J=5 D D2 K E1 G RD
  1. D D2 S J=K Q
  1. D2 ;
  1. W:'$D(E1) @IOF F L=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"T",L,0)) W:^(0)'["!" !?3,^(0)
  1. Q