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 %
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROW1A 1035 printed Dec 13, 2024@02:19:08 Page 2
LROW1A ;SLC/CJS - TEST & SAMP CONTINUED FROM LROW1 ;8/11/97
+1 ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
+2 SET LRCCOM=""
SET LREXP=0
IF LRCSP>0
IF $DATA(^LAB(60,+LRTEST(LRTSTN),3,LRCSP,0))
IF $LENGTH($PIECE(^(0),U,6))
SET LREXP=+$PIECE(^(0),U,6)
+3 IF 'LREXP
SET LREXP=$SELECT($PIECE(^LAB(60,+LRTEST(LRTSTN),0),U,19):$PIECE(^(0),U,19),1:0)
+4 SET LREND=0
if $DATA(X3(+LRTEST(LRTSTN),LRSAMP,LRSPEC))
DO DUPL^LROW2
IF LREND
DO SCRUB
GOTO ONE
+5 IF LREXP!$DATA(LRNEDC)
DO TCOM^LROW2
DO RCOM^LRORD2
IF LRCCOM=""
IF $DATA(LRCOM(LRSAMP,LRSPEC))
SET X=+LRCOM(LRSAMP,LRSPEC)
IF $DATA(LRCOM(LRSAMP,LRSPEC,X))
IF LRCOM(LRSAMP,LRSPEC,X)["~For Test:"
KILL LRCOM(LRSAMP,LRSPEC,X)
SET LRCOM(LRSAMP,LRSPEC)=X-1
+6 SET LRXST(LRSAMP,LRTSTN)=LRSPEC
SET X3(+LRTEST(LRTSTN),LRSAMP,LRSPEC)=""
+7 if '$DATA(^LAB(60,+LRTEST(LRTSTN),3,LRCSN,0))
GOTO ONE
+8 IF LRLWC="WC"
IF $DATA(LRCSX(LRCS(LRCSN)))
SET DIC="^LAB(60,"_+LRTEST(LRTSTN)_",3,"
SET DA=LRCSX(LRCS(LRCSN))
SET DR=0
IF DA>0
DO EN^DIQ
ONE if LRNN'=0
QUIT
GOTO L2^LROW1
SCRUB KILL LRXST($SELECT(LRSAMP'=0:LRSAMP,1:"0"),LRTSTN),X3(+LRTEST(LRTSTN))
SET LRTSTN=LRTSTN-1
QUIT
% READ %:DTIME
if '$TEST
SET DTOUT=1
if %=""!(%["N")!(%["Y")
QUIT
WRITE !,"Answer 'Y' OR 'N' "
GOTO %
