LRORD2.m

LRORD2 ;VA/SLC/CJS - MORE OF LAZY ACCESSION LOGGING ;8/11/97 [ 04/09/2003  8:55 AM ]

 ;;5.2;LR;**1010,1018,1030**;NOV 01, 1997

 ;;5.2;LAB SERVICE;**121,153**;Sep 27, 1994

MORE ;get more tests, from LRORD1

LRM ; F LRSSX=LRM:1 D Q15,^DIC  Q:Y<1  S LRWPC=LRWPC+1,LRTSTS=+Y,LRTX(LRTSTS)="",LRURGG=$P(Y(0),U,18) D ENQ K DIC("S") D GS^LRORD3 I LRSAMP>0&(LRSPEC>0) D Q20 S:'LREND LRM=LRM+1 I LREND K LRSAME Q

 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030 -- S:Y<1 %=1 corrects an issue at Q14^LRORD1

 F LRSSX=LRM:1 D Q15,^DIC  S:Y<1 %=1  Q:Y<1  S LRWPC=LRWPC+1,LRTSTS=+Y,LRTX(LRTSTS)="",LRURGG=$P(Y(0),U,18) D ENQ K DIC("S") D GS^LRORD3  I LRSAMP>0&(LRSPEC>0) D Q20 S:'LREND LRM=LRM+1  I LREND K LRSAME Q

 ; ----- END IHS/OIT/MKK - LR*5.2*1030

 K LRSAME Q

ENQ Q:$D(LRLABKY)  S DIC="^LAB(60,",DA=LRTSTS,DR=6 D EN^DIQ Q

Q15 ;from LRORD

 S DIC("S")="I $P(^(0),U,4)'="""""_$S('$D(LRLABKY):",""NO""'[$P(^(0),U,3)",'$P(LRLABKY,U,3):",""N""'[$P(^(0),U,3)",1:"") S:LRORDR="LC"!(LRORDR="I") DIC("S")=DIC("S")_",$P(^(0),U,9)"

 S:$G(LRORDRR)="R" DIC("S")=DIC("S")_",$G(^LAB(60,Y,64))"

 S DIC="^LAB(60,",DIC(0)="AEMOQZ"

 Q

Q20 ;

 ;S LREND=0,Z=0 F  S Z=$O(LROT(LRSAMP,LRSPEC,Z)) Q:Z<1  I +LROT(LRSAMP,LRSPEC,Z)=LRTSTS W !!?20," ~ ",$P(^LAB(60,LRTSTS,0),U),"   ",$S($D(^LAB(62,LRSAMP,0)):$P(^(0),U),1:""),"   ",$S($D(^LAB(61,LRSPEC,0)):$P(^(0),U),1:"")," ~" D DUP^LRORD2 H 2

 ;----- BEGIN IHS MODIFICATION LR*5.2*1018

 S LREND=0,Z=0

 F  S Z=$O(LROT(LRSAMP,LRSPEC,Z)) Q:Z<1  I +LROT(LRSAMP,LRSPEC,Z)=LRTSTS W:'$G(BLRGUI) !!?20," ~ ",$P(^LAB(60,LRTSTS,0),U),"   ",$S($D(^LAB(62,LRSAMP,0)):$P(^(0),U),1:""),"   ",$S($D(^LAB(61,LRSPEC,0)):$P(^(0),U),1:"")," ~" D DUP^LRORD2 H 2

 ;----- END IHS MODIFICATION

 Q:LREND

 S LROT(LRSAMP,LRSPEC,LRSSX)=LRTSTS,LREXP=$S($P($G(^LAB(60,LRTSTS,3,+$O(^LAB(60,LRTSTS,3,"B",+LRSAMP,0)),0)),U,6):$P(^(0),U,6),$P(^LAB(60,LRTSTS,0),U,19):$P(^(0),U,19),1:0)

 ;I '$D(LRLABKY) S DIC="WARD REMARKS: " S DR=0 F  S DR=$O(^LAB(60,LRTSTS,3,+LRSAMP,1,DR)) Q:DR'>0  W !,"  ",DIC,^(DR,0) S DIC=""

 ;-----BEGIN IHS MODIFICATION LR*5.2*1018

 I '$D(LRLABKY),'$G(BLRGUI) S DIC="WARD REMARKS: " S DR=0 F  S DR=$O(^LAB(60,LRTSTS,3,+LRSAMP,1,DR)) Q:DR'>0  W !,"  ",DIC,^(DR,0) S DIC=""

 ;-----END IHS MODIFICATION

 S:LREXP LROT(LRSAMP,LRSPEC,LRSSX,2)=LREXP S DIC("B")=LROUTINE D URG

 Q

% R %:DTIME Q:%=""!(%["N")!(%["Y")  W !,"Answer 'Y' or 'N': " G %

 W !,"For ",$P(^TMP("LRSTIK",$J,LRSSX),U,2)

URG ;from LRMIBL, LRORD1, LRWU1

 S H=+$P(^LAB(60,+LRTSTS,0),U,16),H(0)=$P(^(0),U,18) I $D(LRURGG),LRURGG'<H S X=LRURGG K LRURGG G URG1

 S:'$D(LROUTINE) LROUTINE=+$P($G(^LAB(69.9,1,3)),U,2)

 ;K DIC S DIC("A")="Select Urgency Status: ",DIC("S")="I '$P(^(0),U,3)",DIC="^LAB(62.05,",DIC(0)="AEQ" S DIC("B")=$S(LRORDR="WC":H(0),1:LROUTINE)

 ;----- BEGIN IHS MODIFICATION LR*5.2*1018

 I '$G(BLRGUI) K DIC S DIC("A")="Select Urgency Status: ",DIC("S")="I '$P(^(0),U,3)",DIC="^LAB(62.05,",DIC(0)="AEQ" S DIC("B")=$S(LRORDR="WC":H(0),1:LROUTINE)

 I $G(BLRGUI) S X=$P(BGUPRAM,";",4),DIC="^LAB(62.05,",DIC(0)="X" S:'$D(DIC("B")) DIC("B")=$S("WC"[LRORDR:H(0),1:"")

 ;----- END IHS MODIFICATION

 S DIC("S")="I '$P(^(0),U,3),Y'<"_H S:LRORDR="LC" DIC("S")=DIC("S")_" I $P(^(0),U,2)" D ^DIC S:Y>0 X=+Y S:Y<1 X=9

URG1 K DIC,H S LROT(LRSAMP,LRSPEC,LRSSX,1)=X Q

RCOM ;from LRORDST, LROW1

 S LRCCOM="" S:'$D(LREXP) LREXP=0 S:'$D(LRTSTNM) LRTSTNM="" ;ASK REQUIRED COMENT

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018 VARIOUS ADDITIONS OF VARIABLE BLRGUI

 I '$G(BLRGUI),LREXP,$L(^LAB(62.07,LREXP,.1)) X ^(.1) Q:$G(LRKIL)  W:$E(LRCCOM)="?"&$D(^LAB(62.07,LREXP,.2)) ^(.2) G RCOM:$E(LRCCOM)="?"

 I '$G(BLRGUI),'LREXP R !,"Enter Order Comment: ",LRCCOM:DTIME

 S:$G(BLRGUI) LRCCOM=BPCCOM  ;NEW LINE FOR LR*5.2*1018 PATIENT CHART

RC1 I '$G(BLRGUI) G ZQ:LRCCOM="?"!(LRCCOM="??"),Z3:LRCCOM=""!(LRCCOM="^") I LRCCOM["^"!(LRCCOM[";") W !,"No up-arrows or semicolons allowed." G ZQ

Z0 I '$G(BLRGUI) G ZQ:$L(LRCCOM)>67!($L(LRCCOM)<1)!(LRCCOM'?.ANP) S B3="~",LRPCE=$S($E(LRCCOM,1)="~":$E(LRCCOM,1),1:""),LRCCOM=$S($L(LRPCE):$E(LRCCOM,2,999),1:LRCCOM) D Z1 W "  (",$E(B3,1,$L(B3)-1),")" S LRCCOM=B3 K A4,B3,B6

Z3 I '$G(BLRGUI) Q:$D(LRQ)

 I '$G(BLRGUI) S:LRCCOM["^" LRCCOM="" I $L(LRCCOM) S %=1 W !,"  OK" D YN^DICN I %'=1 S:%=-1 LRCCOM="" G RCOM:%=2 I %=0 W !,"Unless special comments are required, this comment will be associated with",!,"all tests requested for this entry." G Z3

 I $D(LRTEST(+$G(LRTSTN))) D TCOM(+LRTEST(LRTSTN),LRCCOM)

RCS ;from LREXECU, LRORDST, LROW2

 Q

Z1 F V=1:1 Q:$P(LRCCOM," ",V,99)=""  S B6=$P(LRCCOM," ",V),Y="" D:B6]"" Z2 S A4=$L(B3)+$L(B6) S:A4'>68 B3=B3_B6_" " I A4>68 W "  too long",! Q

 S LRCCOM=$S('$L(LRPCE):LRCCOM,1:LRPCE_LRCCOM) K LRPCE Q

 Q

Z2 S Y=0 F  S Y=$O(^LAB(62.5,"B",B6,Y)) Q:Y=""  I "KA"[$P(^LAB(62.5,Y,0),U,4) S B6=$P(^LAB(62.5,Y,0),"^",2) Q:'$D(^(9))  S Y=$P(X," ",I-1),Y=$E(Y,$L(Y)) S:Y>1 B6=^(9) Q

 Q

ZQ S X=$S(LRCCOM="??":"??",1:"?"),(DIE,DIC)="^LAB(62.5,",DIC(0)="Q",DIC("S")="I ""KA""[$P(^(0),U,4)",D="B",DZ=X K DO D DQ^DICQ K DIC S DIC=DIE D DO^DIC1

 G RCOM

GCOM ;from LRORD1, LRPHITEM, LRTSTJAN, LRWU1

 S LREXP=0 D RCOM S LRGCOM=LRCCOM Q

DUP ;from LRORDD

 ;I '$G(BLRGUI),LRTSTS=+LROT(LRSAMP,LRSPEC,Z) W !,"Since this test, collection sample, and site/specimen has already",!,"been requested on this order, it will NOT be duplicated.",$C(7),!,"If you really need a duplicate, place a separate order." S LREND=1

 I '$G(BLRGUI),LRTSTS=+LROT(LRSAMP,LRSPEC,Z) D

 . W !,"Since this test, collection sample, and site/specimen has already",!

 . W "been requested on this order, it will NOT be duplicated.",$C(7),!

 . W "If you really need a duplicate, place a separate order."

 . S LREND=1

 I $G(BLRGUI),LRTSTS=+LROT(LRSAMP,LRSPEC,Z) S LREND=1  ;NEW LINE FOR LR*5.2*1018 PATIENT CHART

 Q

TCOM(TEST,COM) ;Get comments by test

 N X

 Q:'$G(TEST)  Q:'$L($GET(COM))

 S X=1+$S($D(LRTCOM(TEST)):LRTCOM(TEST),1:0),LRTCOM(TEST)=X,LRTCOM(TEST,X)="~For Test: "_$P(^LAB(60,TEST,0),"^")

 S X=X+1,LRTCOM(TEST)=X,LRTCOM(TEST,X)=COM

 Q

LRORD2    ;VA/SLC/CJS - MORE OF LAZY ACCESSION LOGGING ;8/11/97 [ 04/09/2003  8:55 AM ]

 +1       ;;5.2;LR;**1010,1018,1030**;NOV 01, 1997

 +2       ;;5.2;LAB SERVICE;**121,153**;Sep 27, 1994

MORE      ;get more tests, from LRORD1

LRM       ; F LRSSX=LRM:1 D Q15,^DIC  Q:Y<1  S LRWPC=LRWPC+1,LRTSTS=+Y,LRTX(LRTSTS)="",LRURGG=$P(Y(0),U,18) D ENQ K DIC("S") D GS^LRORD3 I LRSAMP>0&(LRSPEC>0) D Q20 S:'LREND LRM=LRM+1 I LREND K LRSAME Q

 +1       ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030 -- S:Y<1 %=1 corrects an issue at Q14^LRORD1

 +2        FOR LRSSX=LRM:1

               DO Q15

               DO ^DIC

               IF Y<1

                   SET %=1

               IF Y<1

                   QUIT 

               SET LRWPC=LRWPC+1

               SET LRTSTS=+Y

               SET LRTX(LRTSTS)=""

               SET LRURGG=$PIECE(Y(0),U,18)

               DO ENQ

               KILL DIC("S")

               DO GS^LRORD3

               IF LRSAMP>0&(LRSPEC>0)

                   DO Q20

                   IF 'LREND

                       SET LRM=LRM+1

                   IF LREND

                       KILL LRSAME

                       QUIT 

 +3       ; ----- END IHS/OIT/MKK - LR*5.2*1030

 +4        KILL LRSAME

           QUIT 

ENQ        IF $DATA(LRLABKY)

               QUIT 

           SET DIC="^LAB(60,"

           SET DA=LRTSTS

           SET DR=6

           DO EN^DIQ

           QUIT 

Q15       ;from LRORD

 +1        SET DIC("S")="I $P(^(0),U,4)'="""""_$SELECT('$DATA(LRLABKY):",""NO""'[$P(^(0),U,3)",'$PIECE(LRLABKY,U,3):",""N""'[$P(^(0),U,3)",1:"")

           IF LRORDR="LC"!(LRORDR="I")

               SET DIC("S")=DIC("S")_",$P(^(0),U,9)"

 +2        IF $GET(LRORDRR)="R"

               SET DIC("S")=DIC("S")_",$G(^LAB(60,Y,64))"

 +3        SET DIC="^LAB(60,"

           SET DIC(0)="AEMOQZ"

 +4        QUIT 

Q20       ;

 +1       ;S LREND=0,Z=0 F  S Z=$O(LROT(LRSAMP,LRSPEC,Z)) Q:Z<1  I +LROT(LRSAMP,LRSPEC,Z)=LRTSTS W !!?20," ~ ",$P(^LAB(60,LRTSTS,0),U),"   ",$S($D(^LAB(62,LRSAMP,0)):$P(^(0),U),1:""),"   ",$S($D(^LAB(61,LRSPEC,0)):$P(^(0),U),1:"")," ~" D DUP^LRORD2 H 2

 +2       ;----- BEGIN IHS MODIFICATION LR*5.2*1018

 +3        SET LREND=0

           SET Z=0

 +4        FOR 

               SET Z=$ORDER(LROT(LRSAMP,LRSPEC,Z))

               IF Z<1

                   QUIT 

               IF +LROT(LRSAMP,LRSPEC,Z)=LRTSTS

                   IF '$GET(BLRGUI)

                       WRITE !!?20," ~ ",$PIECE(^LAB(60,LRTSTS,0),U),"   ",$SELECT($DATA(^LAB(62,LRSAMP,0)):$PIECE(^(0),U),1:""),"   ",$SELECT($DATA(^LAB(61,LRSPEC,0)):$PIECE(^(0),U),1:"")," ~"

                   DO DUP^LRORD2

                   HANG 2

 +5       ;----- END IHS MODIFICATION

 +6        IF LREND

               QUIT 

 +7        SET LROT(LRSAMP,LRSPEC,LRSSX)=LRTSTS

           SET LREXP=$SELECT($PIECE($GET(^LAB(60,LRTSTS,3,+$ORDER(^LAB(60,LRTSTS,3,"B",+LRSAMP,0)),0)),U,6):$PIECE(^(0),U,6),$PIECE(^LAB(60,LRTSTS,0),U,19):$PIECE(^(0),U,19),1:0)

 +8       ;I '$D(LRLABKY) S DIC="WARD REMARKS: " S DR=0 F  S DR=$O(^LAB(60,LRTSTS,3,+LRSAMP,1,DR)) Q:DR'>0  W !,"  ",DIC,^(DR,0) S DIC=""

 +9       ;-----BEGIN IHS MODIFICATION LR*5.2*1018

 +10       IF '$DATA(LRLABKY)

               IF '$GET(BLRGUI)

                   SET DIC="WARD REMARKS: "

                   SET DR=0

                   FOR 

                       SET DR=$ORDER(^LAB(60,LRTSTS,3,+LRSAMP,1,DR))

                       IF DR'>0

                           QUIT 

                       WRITE !,"  ",DIC,^(DR,0)

                       SET DIC=""

 +11      ;-----END IHS MODIFICATION

 +12       IF LREXP

               SET LROT(LRSAMP,LRSPEC,LRSSX,2)=LREXP

           SET DIC("B")=LROUTINE

           DO URG

 +13       QUIT 

%          READ %:DTIME

           IF %=""!(%["N")!(%["Y")

               QUIT 

           WRITE !,"Answer 'Y' or 'N': "

           GOTO %

 +1        WRITE !,"For ",$PIECE(^TMP("LRSTIK",$JOB,LRSSX),U,2)

URG       ;from LRMIBL, LRORD1, LRWU1

 +1        SET H=+$PIECE(^LAB(60,+LRTSTS,0),U,16)

           SET H(0)=$PIECE(^(0),U,18)

           IF $DATA(LRURGG)

               IF LRURGG'<H

                   SET X=LRURGG

                   KILL LRURGG

                   GOTO URG1

 +2        IF '$DATA(LROUTINE)

               SET LROUTINE=+$PIECE($GET(^LAB(69.9,1,3)),U,2)

 +3       ;K DIC S DIC("A")="Select Urgency Status: ",DIC("S")="I '$P(^(0),U,3)",DIC="^LAB(62.05,",DIC(0)="AEQ" S DIC("B")=$S(LRORDR="WC":H(0),1:LROUTINE)

 +4       ;----- BEGIN IHS MODIFICATION LR*5.2*1018

 +5        IF '$GET(BLRGUI)

               KILL DIC

               SET DIC("A")="Select Urgency Status: "

               SET DIC("S")="I '$P(^(0),U,3)"

               SET DIC="^LAB(62.05,"

               SET DIC(0)="AEQ"

               SET DIC("B")=$SELECT(LRORDR="WC":H(0),1:LROUTINE)

 +6        IF $GET(BLRGUI)

               SET X=$PIECE(BGUPRAM,";",4)

               SET DIC="^LAB(62.05,"

               SET DIC(0)="X"

               IF '$DATA(DIC("B"))

                   SET DIC("B")=$SELECT("WC"[LRORDR:H(0),1:"")

 +7       ;----- END IHS MODIFICATION

 +8        SET DIC("S")="I '$P(^(0),U,3),Y'<"_H

           IF LRORDR="LC"

               SET DIC("S")=DIC("S")_" I $P(^(0),U,2)"

           DO ^DIC

           IF Y>0

               SET X=+Y

           IF Y<1

               SET X=9

URG1       KILL DIC,H

           SET LROT(LRSAMP,LRSPEC,LRSSX,1)=X

           QUIT 

RCOM      ;from LRORDST, LROW1

 +1       ;ASK REQUIRED COMENT

           SET LRCCOM=""

           IF '$DATA(LREXP)

               SET LREXP=0

           IF '$DATA(LRTSTNM)

               SET LRTSTNM=""

 +2       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018 VARIOUS ADDITIONS OF VARIABLE BLRGUI

 +3        IF '$GET(BLRGUI)

               IF LREXP

                   IF $LENGTH(^LAB(62.07,LREXP,.1))

                       XECUTE ^(.1)

                       IF $GET(LRKIL)

                           QUIT 

                       IF $EXTRACT(LRCCOM)="?"&$DATA(^LAB(62.07,LREXP,.2))

                           WRITE ^(.2)

                       IF $EXTRACT(LRCCOM)="?"

                           GOTO RCOM

 +4        IF '$GET(BLRGUI)

               IF 'LREXP

                   READ !,"Enter Order Comment: ",LRCCOM:DTIME

 +5       ;NEW LINE FOR LR*5.2*1018 PATIENT CHART

           IF $GET(BLRGUI)

               SET LRCCOM=BPCCOM

RC1        IF '$GET(BLRGUI)

               IF LRCCOM="?"!(LRCCOM="??")

                   GOTO ZQ

               IF LRCCOM=""!(LRCCOM="^")

                   GOTO Z3

               IF LRCCOM["^"!(LRCCOM[";")

                   WRITE !,"No up-arrows or semicolons allowed."

                   GOTO ZQ

Z0         IF '$GET(BLRGUI)

               IF $LENGTH(LRCCOM)>67!($LENGTH(LRCCOM)<1)!(LRCCOM'?.ANP)

                   GOTO ZQ

               SET B3="~"

               SET LRPCE=$SELECT($EXTRACT(LRCCOM,1)="~":$EXTRACT(LRCCOM,1),1:"")

               SET LRCCOM=$SELECT($LENGTH(LRPCE):$EXTRACT(LRCCOM,2,999),1:LRCCOM)

               DO Z1

               WRITE "  (",$EXTRACT(B3,1,$LENGTH(B3)-1),")"

               SET LRCCOM=B3

               KILL A4,B3,B6

Z3         IF '$GET(BLRGUI)

               IF $DATA(LRQ)

                   QUIT 

 +1        IF '$GET(BLRGUI)

               IF LRCCOM["^"

                   SET LRCCOM=""

               IF $LENGTH(LRCCOM)

                   SET %=1

                   WRITE !,"  OK"

                   DO YN^DICN

                   IF %'=1

                       IF %=-1

                           SET LRCCOM=""

                       IF %=2

                           GOTO RCOM

                       IF %=0

                           WRITE !,"Unless special comments are required, this comment will be associated with",!,"all tests requested for this entry."

                           GOTO Z3

 +2        IF $DATA(LRTEST(+$GET(LRTSTN)))

               DO TCOM(+LRTEST(LRTSTN),LRCCOM)

RCS       ;from LREXECU, LRORDST, LROW2

 +1        QUIT 

Z1         FOR V=1:1

               IF $PIECE(LRCCOM," ",V,99)=""

                   QUIT 

               SET B6=$PIECE(LRCCOM," ",V)

               SET Y=""

               IF B6]""

                   DO Z2

               SET A4=$LENGTH(B3)+$LENGTH(B6)

               IF A4'>68

                   SET B3=B3_B6_" "

               IF A4>68

                   WRITE "  too long",!

                   QUIT 

 +1        SET LRCCOM=$SELECT('$LENGTH(LRPCE):LRCCOM,1:LRPCE_LRCCOM)

           KILL LRPCE

           QUIT 

 +2        QUIT 

Z2         SET Y=0

           FOR 

               SET Y=$ORDER(^LAB(62.5,"B",B6,Y))

               IF Y=""

                   QUIT 

               IF "KA"[$PIECE(^LAB(62.5,Y,0),U,4)

                   SET B6=$PIECE(^LAB(62.5,Y,0),"^",2)

                   IF '$DATA(^(9))

                       QUIT 

                   SET Y=$PIECE(X," ",I-1)

                   SET Y=$EXTRACT(Y,$LENGTH(Y))

                   IF Y>1

                       SET B6=^(9)

                   QUIT 

 +1        QUIT 

ZQ         SET X=$SELECT(LRCCOM="??":"??",1:"?")

           SET (DIE,DIC)="^LAB(62.5,"

           SET DIC(0)="Q"

           SET DIC("S")="I ""KA""[$P(^(0),U,4)"

           SET D="B"

           SET DZ=X

           KILL DO

           DO DQ^DICQ

           KILL DIC

           SET DIC=DIE

           DO DO^DIC1

 +1        GOTO RCOM

GCOM      ;from LRORD1, LRPHITEM, LRTSTJAN, LRWU1

 +1        SET LREXP=0

           DO RCOM

           SET LRGCOM=LRCCOM

           QUIT 

DUP       ;from LRORDD

 +1       ;I '$G(BLRGUI),LRTSTS=+LROT(LRSAMP,LRSPEC,Z) W !,"Since this test, collection sample, and site/specimen has already",!,"been requested on this order, it will NOT be duplicated.",$C(7),!,"If you really need a duplicate, place a separate order." S

 LREND=1

 +2        IF '$GET(BLRGUI)

               IF LRTSTS=+LROT(LRSAMP,LRSPEC,Z)

                   Begin DoDot:1

 +3                    WRITE !,"Since this test, collection sample, and site/specimen has already",!

 +4                    WRITE "been requested on this order, it will NOT be duplicated.",$CHAR(7),!

 +5                    WRITE "If you really need a duplicate, place a separate order."

 +6                    SET LREND=1

                   End DoDot:1

 +7       ;NEW LINE FOR LR*5.2*1018 PATIENT CHART

           IF $GET(BLRGUI)

               IF LRTSTS=+LROT(LRSAMP,LRSPEC,Z)

                   SET LREND=1

 +8        QUIT 

TCOM(TEST,COM) ;Get comments by test

 +1        NEW X

 +2        IF '$GET(TEST)

               QUIT 

           IF '$LENGTH($GET(COM))

               QUIT 

 +3        SET X=1+$SELECT($DATA(LRTCOM(TEST)):LRTCOM(TEST),1:0)

           SET LRTCOM(TEST)=X

           SET LRTCOM(TEST,X)="~For Test: "_$PIECE(^LAB(60,TEST,0),"^")

 +4        SET X=X+1

           SET LRTCOM(TEST)=X

           SET LRTCOM(TEST,X)=COM

 +5        QUIT