VistA-FOIAVistA/r/LAB_SERVICE-LR-LS/LROW1A.m

13 lines
1023 B
Mathematica

LROW1A ;SLC/CJS - TEST & SAMP CONTINUED FROM LROW1 ;8/11/97
;;5.2;LAB SERVICE;**121**;Sep 27, 1994
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)
I 'LREXP S LREXP=$S($P(^LAB(60,+LRTEST(LRTSTN),0),U,19):$P(^(0),U,19),1:0)
S LREND=0 D DUPL^LROW2:$D(X3(+LRTEST(LRTSTN),LRSAMP,LRSPEC)) I LREND D SCRUB G ONE
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
S LRXST(LRSAMP,LRTSTN)=LRSPEC,X3(+LRTEST(LRTSTN),LRSAMP,LRSPEC)=""
G ONE:'$D(^LAB(60,+LRTEST(LRTSTN),3,LRCSN,0))
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
ONE Q:LRNN'=0 G L2^LROW1
SCRUB K LRXST($S(LRSAMP'=0:LRSAMP,1:"0"),LRTSTN),X3(+LRTEST(LRTSTN)) S LRTSTN=LRTSTN-1 Q
% R %:DTIME S:'$T DTOUT=1 Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' OR 'N' " G %