1 | LROW1A ;SLC/CJS - TEST & SAMP CONTINUED FROM LROW1 ;8/11/97
|
---|
2 | ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
|
---|
3 | S LRCCOM="",LREXP=0 I LRCSP>0,$D(^LAB(60,+LRTEST(LRTSTN),3,LRCSP,0)),$L($P(^(0),U,6)) S LREXP=+$P(^(0),U,6)
|
---|
4 | I 'LREXP S LREXP=$S($P(^LAB(60,+LRTEST(LRTSTN),0),U,19):$P(^(0),U,19),1:0)
|
---|
5 | S LREND=0 D DUPL^LROW2:$D(X3(+LRTEST(LRTSTN),LRSAMP,LRSPEC)) I LREND D SCRUB G ONE
|
---|
6 | I LREXP!$D(LRNEDC) D TCOM^LROW2,RCOM^LRORD2 I LRCCOM="",$D(LRCOM(LRSAMP,LRSPEC)) S X=+LRCOM(LRSAMP,LRSPEC) I $D(LRCOM(LRSAMP,LRSPEC,X)),LRCOM(LRSAMP,LRSPEC,X)["~For Test:" K LRCOM(LRSAMP,LRSPEC,X) S LRCOM(LRSAMP,LRSPEC)=X-1
|
---|
7 | S LRXST(LRSAMP,LRTSTN)=LRSPEC,X3(+LRTEST(LRTSTN),LRSAMP,LRSPEC)=""
|
---|
8 | G ONE:'$D(^LAB(60,+LRTEST(LRTSTN),3,LRCSN,0))
|
---|
9 | I LRLWC="WC",$D(LRCSX(LRCS(LRCSN))) S DIC="^LAB(60,"_+LRTEST(LRTSTN)_",3,",DA=LRCSX(LRCS(LRCSN)),DR=0 I DA>0 D EN^DIQ
|
---|
10 | ONE Q:LRNN'=0 G L2^LROW1
|
---|
11 | SCRUB K LRXST($S(LRSAMP'=0:LRSAMP,1:"0"),LRTSTN),X3(+LRTEST(LRTSTN)) S LRTSTN=LRTSTN-1 Q
|
---|
12 | % R %:DTIME S:'$T DTOUT=1 Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' OR 'N' " G %
|
---|