Last change
on this file since 634 was 613, checked in by George Lilly, 15 years ago |
initial load of WorldVistAEHR
|
File size:
651 bytes
|
Rev | Line | |
---|
[613] | 1 | YTDEMO ;SLC/DKG-TEST PKG: CRT DEMO PROGRAM ; 10/19/88 17:29 ;
|
---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
---|
| 3 | ;
|
---|
| 4 | S YSTEST=$O(^YTT(601,"B","DEMO",0)) G:'YSTEST END S J=1,C=" ;3;T; ;^; "
|
---|
| 5 | D0 ;
|
---|
| 6 | D D1,RD G:J<7 D0
|
---|
| 7 | END ;
|
---|
| 8 | K C,J,K,L,X,YSTEST Q
|
---|
| 9 | D1 ;
|
---|
| 10 | 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)
|
---|
| 11 | K E Q
|
---|
| 12 | RD ;
|
---|
| 13 | R *X:900 G:'$T!(X=42) H^XUS G:X<32 RD S X=$C(X)
|
---|
| 14 | I X=$P(C,";",J) S J=J+1 Q
|
---|
| 15 | S K=J,J=7,E=1
|
---|
| 16 | I K=5,X=6 S J=8 D D2 S E1=1,J=5 D D2 K E1 G RD
|
---|
| 17 | I K=5,X="N" S J=10 D D2 S E1=1,J=5 D D2 K E1 G RD
|
---|
| 18 | D D2 S J=K Q
|
---|
| 19 | D2 ;
|
---|
| 20 | W:'$D(E1) @IOF F L=1:1 Q:'$D(^YTT(601,YSTEST,"Q",J,"T",L,0)) W:^(0)'["!" !?3,^(0)
|
---|
| 21 | Q
|
---|
Note:
See
TracBrowser
for help on using the repository browser.