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

LROW1A.m

Go to the documentation of this file.
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 %