LROE ;DALOI/CJS/FHS-LAB ORDER ENTRY AND ACCESSION ;Nov 12, 2020@15:02
;;5.2;LAB SERVICE;**100,121,201,221,263,286,360,423,432,438,450,479,541,573**;Sep 27, 1994;Build 7
;
K LRORIFN,LRNATURE,LREND,LRORDRR
;;*
N LRSVODT,LRORDR,LRNAAAC
S (LRORDR,LRLWC)="WC"
;;;*
D ^LRPARAM
I $G(LREND) S LREND=0 Q
L5 ;
NEXT ;from LROE1
K DIR,LRSVODT
I $D(LROESTAT) D:$P(LRPARAM,U,14) ^LRCAPV I $G(LREND) K LRLONG,LRPANEL Q
S (LRODT,X,DT)=$$DT^XLFDT(),LRODT0=$$FMTE^XLFDT(DT,5)
I '$D(^LRO(69,DT,1,0)) S ^LRO(69,DT,0)=DT,^LRO(69,DT,1,0)="^69.01PA^^",^LRO(69,"B",DT,DT)=""
I $D(^LAB(69.9,1,"RO")),+$H'=+$P(^("RO"),U) D
. W $C(7),!,"ROLLOVER ",$S($P(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$C(7),!
. S DIR("A")=" Are you sure you want to continue",DIR(0)="Y",DIR("B")="No"
I $T D ^DIR G END:$D(DIRUT) I Y'=1 W !,"OK, try later." Q
S X="T-7",%DT="" D ^%DT S LRTM7=+Y
;W @IOF
K DIC,LRSND,LRSN
W !!,"Select Order number: " R LRORD:DTIME Q:LRORD["^"!(LRORD[".")!($D(LRLONG)&(LRORD=""))
W @IOF S M9=0 G QUICK^LROE1:LRORD=""
I $L(LRORD)>8 W !,"The order number entered is too long." H 1 G NEXT
S:LRORD?.N LRORD=+LRORD IF LRORD'?.N D QMSG G NEXT
I '$D(^LRO(69,"C",LRORD)) W !!?10,"No order exist with that number ",$C(7),! G NEXT
S (LRCHK,LRNONE)=1,(M9,LRODT)=0
F S LRODT=+$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D
. S DA=0 F S DA=$O(^LRO(69,"C",LRORD,LRODT,DA)) Q:DA<1 S LRCHK=LRCHK-1 S:LRNONE'=2 LRNONE=0 D LROE2
;;*
I $G(LRSN),$G(LRSVODT),$O(^LRO(69,LRSVODT,1,LRSN,13,0)) D G NEXT
. W !,$$CJ^XLFSTR("This is an Anatomic Path order",IOM),!
. W !,$$CJ^XLFSTR("Must use 'Log-in, anat path' Option to accession this Order",IOM),!
. H 5
;;;*
I DOD'="" S Y=DOD D DD^LRX W !,!,?5,@LRVIDO,"Patient ",PNM," died on: ",Y,@LRVIDOF W !
I '$$GOT(LRORD,LRODT) W !,"All tests for this order have been canceled." H 1 G NEXT
I DOD'="" D I Y=0!($D(DIRUT)) K DIRUT,DTOUT,DUOUT,Y D KVAR^LRX G NEXT
. K Y
. S DIR(0)="Y"
. S DIR("A")="Do you wish to continue with this accession [Yes/No]"
. S DIR("T")=120
. D ^DIR K DIR
I LRNONE=2,LRCHK<1 W !,"The order has already been partially accessioned." H 1
I LRNONE=2,LRCHK>0 W !,"The order has already been accessioned." H 1 G NEXT
I LRNONE=1 W !,"No order exists with that number." H 1 G NEXT
;I '$$GOT(LRORD,LRODT) G NEXT ;W !!,"All tests for this order have been canceled.",!,"Are you sure you want to accession it" S %=1 D YN^DICN I %'=1 G NEXT
K DIR S DIR("A")="Is this the correct order",DIR(0)="Y"
S DIR("B")="Yes"
D ^DIR K DIR
I $D(DIRUT)!(Y'=1) K LRSN G NEXT
L +^LRO(69,"C",LRORD):$G(DILOCKTM,3)
I '$T W !?5,"Someone else is editing this Order",!!,$C(7) G NEXT
K %DT
S LRSTATUS="C",%DT("B")=""
D TIME K %DT
D:$G(LRCDT)<1 UNL69 G NEXT:LRCDT<1
S LRTIM=+LRCDT
;S:'$P(^LRO(69,LRODT,1,LRSN,0),U,8) $P(^(0),U,8)=LRTIM
S LRUN=$P(LRCDT,U,2) K LRCDT,LRSN
I '$$Q18^LROE2(DUZ(2)) D UNL69 G NEXT ;LR573 check for accession area conflict with user
MORE I M9>1 K DIR S DIR("A")="Do you have the entire order",DIR(0)="Y" D ^DIR K DIR S:Y=1 M9=0
I $D(DIRUT) D UNL69 G NEXT
S (LRODT,LRSND)=0
F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D
. S LRSND=0
. F S LRSND=$O(^LRO(69,"C",LRORD,LRODT,LRSND)) Q:LRSND<1 D
. . I $D(^LRO(69,LRODT,1,LRSND,1)),$P(^(1),U,4)="C" Q
. . S LRSN(LRSND)=LRSND,LRSN=LRSND
. . K LRAA D Q15^LROE2 K LRSN
D TASK,UNL69
G NEXT
;
;
LROE2 ;
I '$D(^LRO(69,LRODT,1,DA,0)) Q
I $D(^LRO(69,LRODT,1,DA,1)) D
. I $P(^LRO(69,LRODT,1,DA,1),U,4)="C" S LRNONE=2,LRCHK=LRCHK+1 Q
. I $P(^LRO(69,LRODT,1,DA,0),U,4)="LC",$P(^LRO(69,LRODT,1,DA,1),U,4)="" S LRNONE=2,LRCHK=LRCHK+1
;
K LRSN
S (LRSN,LRSN(DA))=+DA
I '$D(^LRO(69,LRODT,1,LRSN,0)) Q
S M9=$G(M9)+1,LRZX=^LRO(69,LRODT,1,LRSN,0),LRDFN=+LRZX,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,PNM,?30,SSN S LRWRDS=LRWRD
W ?45,"Requesting location: ",$P(LRZX,U,7) S Y=$P(LRZX,U,5) D DD^LRX W !,"Date/Time Ordered: ",Y,?45,"By: ",$S($D(^VA(200,+$P(LRZX,U,2),0)):$P(^(0),U),1:"")
;;*
;
S LRSVODT=LRODT
D ORDER^LROS
;;;*
Q
;
;
QMSG W !,"Enter the order entry number assigned when the test was ordered."
W:'$D(LRLONG) !,"If the test has not been ordered, type the RETURN key to order the test."
W !,"To exit, type the ""^"" key and RETURN key."
Q
;
;
YN R X:DTIME S:'$T DTOUT=1 Q:X=""!(X["N")!(X["Y")
W !,"Answer 'Y' or 'N': " G YN
;
;
EN ;
LROEN S LRNCWL=1
D LROE,END K LRNCWL
Q
;
;
EN01 ; ENTER ORDER # THEN ENTER DATA
STAT ;
D ^LRPARAM
I '$D(LRLABKY) W !!?10,"You do not have the proper security Keys",! Q
;
; Select peforming laboratory
S X=$$SELPL^LRVERA(DUZ(2))
I X<1 D END Q
I X'=DUZ(2) N LRPL S LRPL=X
;
S LRLONG="",LRPANEL=0,LROESTAT=""
S %H=$H-60 D YMD^LRX S LRTM60=9999999-X
D LROE K LRTM60,LRLONG,LREND,LROESTAT
D END
Q
;
;
TIME ;from LROE1, LRORD1
N LRFUTURE S LRFUTURE=0
S %DT="SET" W !,"Collection Date@Time: ",$S($D(%DT("B")):%DT("B"),1:"NOW"),"//" R X:DTIME I '$T!(X="^") S LRCDT=-1 Q
S:X="" X=$S($D(%DT("B")):%DT("B"),1:"N")
I X["?" W !!,"You may enter ""T@U"" or just ""U"", for Today at Unknown time",!! G TIME
I X["@U",$P(X,"@U",2)="" D Q
. S X=$P(X,"@U",1)
. D ^%DT
. I Y<1 D TIME Q
. I $E(Y,6,7)="00" D Q
. . W !,"Please enter a specific month, day, and year."
. . D TIME
. I Y>DT D TIME1,TIME Q
. I $G(DOB),Y<DOB D
. . W !,"Invalid - Collection date precedes patient's date of birth."
. . D TIME
. S LRCDT=Y_"^1"
I X="U" S LRCDT=DT_"^1" Q
D ^%DT,TIME1
I LRFUTURE G TIME
I Y>0,$G(DOB),Y<DOB D Q
. W !,"Invalid - Collection date precedes patient's date of birth."
. D TIME
S LRCDT=+Y_"^" G TIME:Y'["."
Q
;
TIME1 S X1=X,Y1=Y D TIME2 S X=X1,Y=Y1 K X1,Y1
Q
;
TIME2 S X="N",%DT="ST" D ^%DT
Q:Y1'>Y
W !,"Future date/time may not be entered."
S LRFUTURE=1
Q
;
;
TASK ;
I $D(LRLABLIO),$D(LRLBL) S ZTRTN="ENT^LRLABLD",ZTDTH=$H,ZTDESC="LAB LABELS",ZTIO=LRLABLIO,ZTSAVE("LRLBL(")="" D ^%ZTLOAD
K LRLBL
I $D(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) K ^XTMP("LRCAP",LRCSQ,DUZ),LRCSQ
I $D(LRCSQ),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV
D STOP^LRCAPV K LRCOM,LRSPCDSC,LRCCOM,LRTCOM
Q
;
;
END K DIR,DIRUT,GOT,LRNAAAC
D ^LRORDK,LROEND^LRORDK,STOP^LRCAPV
Q
;
;
GOT(ORD,ODT) ;See if all tests have been canceled
N I,SN,ODT
S (GOT,ODT,SN)=0
F S ODT=$O(^LRO(69,"C",ORD,ODT)) Q:ODT<1 D
. S SN=0 F S SN=$O(^LRO(69,"C",ORD,ODT,SN)) Q:SN<1!(GOT) D
. . Q:'$D(^LRO(69,ODT,1,SN,0))
. . S I=0 F S I=$O(^LRO(69,ODT,1,SN,2,I)) Q:I<1 I $D(^(I,0)),'$P(^(0),"^",11),$P(^(0),U,9)'="CA" S GOT=1 Q
Q GOT
;
;
UNL69 ;
L -^LRO(69,"C",+$G(LRORD))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROE 6712 printed Sep 23, 2025@19:54:09 Page 2
LROE ;DALOI/CJS/FHS-LAB ORDER ENTRY AND ACCESSION ;Nov 12, 2020@15:02
+1 ;;5.2;LAB SERVICE;**100,121,201,221,263,286,360,423,432,438,450,479,541,573**;Sep 27, 1994;Build 7
+2 ;
+3 KILL LRORIFN,LRNATURE,LREND,LRORDRR
+4 ;;*
+5 NEW LRSVODT,LRORDR,LRNAAAC
+6 SET (LRORDR,LRLWC)="WC"
+7 ;;;*
+8 DO ^LRPARAM
+9 IF $GET(LREND)
SET LREND=0
QUIT
L5 ;
NEXT ;from LROE1
+1 KILL DIR,LRSVODT
+2 IF $DATA(LROESTAT)
if $PIECE(LRPARAM,U,14)
DO ^LRCAPV
IF $GET(LREND)
KILL LRLONG,LRPANEL
QUIT
+3 SET (LRODT,X,DT)=$$DT^XLFDT()
SET LRODT0=$$FMTE^XLFDT(DT,5)
+4 IF '$DATA(^LRO(69,DT,1,0))
SET ^LRO(69,DT,0)=DT
SET ^LRO(69,DT,1,0)="^69.01PA^^"
SET ^LRO(69,"B",DT,DT)=""
+5 IF $DATA(^LAB(69.9,1,"RO"))
IF +$HOROLOG'=+$PIECE(^("RO"),U)
Begin DoDot:1
+6 WRITE $CHAR(7),!,"ROLLOVER ",$SELECT($PIECE(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$CHAR(7),!
+7 SET DIR("A")=" Are you sure you want to continue"
SET DIR(0)="Y"
SET DIR("B")="No"
End DoDot:1
+8 IF $TEST
DO ^DIR
if $DATA(DIRUT)
GOTO END
IF Y'=1
WRITE !,"OK, try later."
QUIT
+9 SET X="T-7"
SET %DT=""
DO ^%DT
SET LRTM7=+Y
+10 ;W @IOF
+11 KILL DIC,LRSND,LRSN
+12 WRITE !!,"Select Order number: "
READ LRORD:DTIME
if LRORD["^"!(LRORD[".")!($DATA(LRLONG)&(LRORD=""))
QUIT
+13 WRITE @IOF
SET M9=0
if LRORD=""
GOTO QUICK^LROE1
+14 IF $LENGTH(LRORD)>8
WRITE !,"The order number entered is too long."
HANG 1
GOTO NEXT
+15 if LRORD?.N
SET LRORD=+LRORD
IF LRORD'?.N
DO QMSG
GOTO NEXT
+16 IF '$DATA(^LRO(69,"C",LRORD))
WRITE !!?10,"No order exist with that number ",$CHAR(7),!
GOTO NEXT
+17 SET (LRCHK,LRNONE)=1
SET (M9,LRODT)=0
+18 FOR
SET LRODT=+$ORDER(^LRO(69,"C",LRORD,LRODT))
if LRODT<1
QUIT
Begin DoDot:1
+19 SET DA=0
FOR
SET DA=$ORDER(^LRO(69,"C",LRORD,LRODT,DA))
if DA<1
QUIT
SET LRCHK=LRCHK-1
if LRNONE'=2
SET LRNONE=0
DO LROE2
End DoDot:1
+20 ;;*
+21 IF $GET(LRSN)
IF $GET(LRSVODT)
IF $ORDER(^LRO(69,LRSVODT,1,LRSN,13,0))
Begin DoDot:1
+22 WRITE !,$$CJ^XLFSTR("This is an Anatomic Path order",IOM),!
+23 WRITE !,$$CJ^XLFSTR("Must use 'Log-in, anat path' Option to accession this Order",IOM),!
+24 HANG 5
End DoDot:1
GOTO NEXT
+25 ;;;*
+26 IF DOD'=""
SET Y=DOD
DO DD^LRX
WRITE !,!,?5,@LRVIDO,"Patient ",PNM," died on: ",Y,@LRVIDOF
WRITE !
+27 IF '$$GOT(LRORD,LRODT)
WRITE !,"All tests for this order have been canceled."
HANG 1
GOTO NEXT
+28 IF DOD'=""
Begin DoDot:1
+29 KILL Y
+30 SET DIR(0)="Y"
+31 SET DIR("A")="Do you wish to continue with this accession [Yes/No]"
+32 SET DIR("T")=120
+33 DO ^DIR
KILL DIR
End DoDot:1
IF Y=0!($DATA(DIRUT))
KILL DIRUT,DTOUT,DUOUT,Y
DO KVAR^LRX
GOTO NEXT
+34 IF LRNONE=2
IF LRCHK<1
WRITE !,"The order has already been partially accessioned."
HANG 1
+35 IF LRNONE=2
IF LRCHK>0
WRITE !,"The order has already been accessioned."
HANG 1
GOTO NEXT
+36 IF LRNONE=1
WRITE !,"No order exists with that number."
HANG 1
GOTO NEXT
+37 ;I '$$GOT(LRORD,LRODT) G NEXT ;W !!,"All tests for this order have been canceled.",!,"Are you sure you want to accession it" S %=1 D YN^DICN I %'=1 G NEXT
+38 KILL DIR
SET DIR("A")="Is this the correct order"
SET DIR(0)="Y"
+39 SET DIR("B")="Yes"
+40 DO ^DIR
KILL DIR
+41 IF $DATA(DIRUT)!(Y'=1)
KILL LRSN
GOTO NEXT
+42 LOCK +^LRO(69,"C",LRORD):$GET(DILOCKTM,3)
+43 IF '$TEST
WRITE !?5,"Someone else is editing this Order",!!,$CHAR(7)
GOTO NEXT
+44 KILL %DT
+45 SET LRSTATUS="C"
SET %DT("B")=""
+46 DO TIME
KILL %DT
+47 if $GET(LRCDT)<1
DO UNL69
if LRCDT<1
GOTO NEXT
+48 SET LRTIM=+LRCDT
+49 ;S:'$P(^LRO(69,LRODT,1,LRSN,0),U,8) $P(^(0),U,8)=LRTIM
+50 SET LRUN=$PIECE(LRCDT,U,2)
KILL LRCDT,LRSN
+51 ;LR573 check for accession area conflict with user
IF '$$Q18^LROE2(DUZ(2))
DO UNL69
GOTO NEXT
MORE IF M9>1
KILL DIR
SET DIR("A")="Do you have the entire order"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
if Y=1
SET M9=0
+1 IF $DATA(DIRUT)
DO UNL69
GOTO NEXT
+2 SET (LRODT,LRSND)=0
+3 FOR
SET LRODT=$ORDER(^LRO(69,"C",LRORD,LRODT))
if LRODT<1
QUIT
Begin DoDot:1
+4 SET LRSND=0
+5 FOR
SET LRSND=$ORDER(^LRO(69,"C",LRORD,LRODT,LRSND))
if LRSND<1
QUIT
Begin DoDot:2
+6 IF $DATA(^LRO(69,LRODT,1,LRSND,1))
IF $PIECE(^(1),U,4)="C"
QUIT
+7 SET LRSN(LRSND)=LRSND
SET LRSN=LRSND
+8 KILL LRAA
DO Q15^LROE2
KILL LRSN
End DoDot:2
End DoDot:1
+9 DO TASK
DO UNL69
+10 GOTO NEXT
+11 ;
+12 ;
LROE2 ;
+1 IF '$DATA(^LRO(69,LRODT,1,DA,0))
QUIT
+2 IF $DATA(^LRO(69,LRODT,1,DA,1))
Begin DoDot:1
+3 IF $PIECE(^LRO(69,LRODT,1,DA,1),U,4)="C"
SET LRNONE=2
SET LRCHK=LRCHK+1
QUIT
+4 IF $PIECE(^LRO(69,LRODT,1,DA,0),U,4)="LC"
IF $PIECE(^LRO(69,LRODT,1,DA,1),U,4)=""
SET LRNONE=2
SET LRCHK=LRCHK+1
End DoDot:1
+5 ;
+6 KILL LRSN
+7 SET (LRSN,LRSN(DA))=+DA
+8 IF '$DATA(^LRO(69,LRODT,1,LRSN,0))
QUIT
+9 SET M9=$GET(M9)+1
SET LRZX=^LRO(69,LRODT,1,LRSN,0)
SET LRDFN=+LRZX
SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
DO PT^LRX
WRITE !,PNM,?30,SSN
SET LRWRDS=LRWRD
+10 WRITE ?45,"Requesting location: ",$PIECE(LRZX,U,7)
SET Y=$PIECE(LRZX,U,5)
DO DD^LRX
WRITE !,"Date/Time Ordered: ",Y,?45,"By: ",$SELECT($DATA(^VA(200,+$PIECE(LRZX,U,2),0)):$PIECE(^(0),U),1:"")
+11 ;;*
+12 ;
+13 SET LRSVODT=LRODT
+14 DO ORDER^LROS
+15 ;;;*
+16 QUIT
+17 ;
+18 ;
QMSG WRITE !,"Enter the order entry number assigned when the test was ordered."
+1 if '$DATA(LRLONG)
WRITE !,"If the test has not been ordered, type the RETURN key to order the test."
+2 WRITE !,"To exit, type the ""^"" key and RETURN key."
+3 QUIT
+4 ;
+5 ;
YN READ X:DTIME
if '$TEST
SET DTOUT=1
if X=""!(X["N")!(X["Y")
QUIT
+1 WRITE !,"Answer 'Y' or 'N': "
GOTO YN
+2 ;
+3 ;
EN ;
LROEN SET LRNCWL=1
+1 DO LROE
DO END
KILL LRNCWL
+2 QUIT
+3 ;
+4 ;
EN01 ; ENTER ORDER # THEN ENTER DATA
STAT ;
+1 DO ^LRPARAM
+2 IF '$DATA(LRLABKY)
WRITE !!?10,"You do not have the proper security Keys",!
QUIT
+3 ;
+4 ; Select peforming laboratory
+5 SET X=$$SELPL^LRVERA(DUZ(2))
+6 IF X<1
DO END
QUIT
+7 IF X'=DUZ(2)
NEW LRPL
SET LRPL=X
+8 ;
+9 SET LRLONG=""
SET LRPANEL=0
SET LROESTAT=""
+10 SET %H=$HOROLOG-60
DO YMD^LRX
SET LRTM60=9999999-X
+11 DO LROE
KILL LRTM60,LRLONG,LREND,LROESTAT
+12 DO END
+13 QUIT
+14 ;
+15 ;
TIME ;from LROE1, LRORD1
+1 NEW LRFUTURE
SET LRFUTURE=0
+2 SET %DT="SET"
WRITE !,"Collection Date@Time: ",$SELECT($DATA(%DT("B")):%DT("B"),1:"NOW"),"//"
READ X:DTIME
IF '$TEST!(X="^")
SET LRCDT=-1
QUIT
+3 if X=""
SET X=$SELECT($DATA(%DT("B")):%DT("B"),1:"N")
+4 IF X["?"
WRITE !!,"You may enter ""T@U"" or just ""U"", for Today at Unknown time",!!
GOTO TIME
+5 IF X["@U"
IF $PIECE(X,"@U",2)=""
Begin DoDot:1
+6 SET X=$PIECE(X,"@U",1)
+7 DO ^%DT
+8 IF Y<1
DO TIME
QUIT
+9 IF $EXTRACT(Y,6,7)="00"
Begin DoDot:2
+10 WRITE !,"Please enter a specific month, day, and year."
+11 DO TIME
End DoDot:2
QUIT
+12 IF Y>DT
DO TIME1
DO TIME
QUIT
+13 IF $GET(DOB)
IF Y<DOB
Begin DoDot:2
+14 WRITE !,"Invalid - Collection date precedes patient's date of birth."
+15 DO TIME
End DoDot:2
+16 SET LRCDT=Y_"^1"
End DoDot:1
QUIT
+17 IF X="U"
SET LRCDT=DT_"^1"
QUIT
+18 DO ^%DT
DO TIME1
+19 IF LRFUTURE
GOTO TIME
+20 IF Y>0
IF $GET(DOB)
IF Y<DOB
Begin DoDot:1
+21 WRITE !,"Invalid - Collection date precedes patient's date of birth."
+22 DO TIME
End DoDot:1
QUIT
+23 SET LRCDT=+Y_"^"
if Y'["."
GOTO TIME
+24 QUIT
+25 ;
TIME1 SET X1=X
SET Y1=Y
DO TIME2
SET X=X1
SET Y=Y1
KILL X1,Y1
+1 QUIT
+2 ;
TIME2 SET X="N"
SET %DT="ST"
DO ^%DT
+1 if Y1'>Y
QUIT
+2 WRITE !,"Future date/time may not be entered."
+3 SET LRFUTURE=1
+4 QUIT
+5 ;
+6 ;
TASK ;
+1 IF $DATA(LRLABLIO)
IF $DATA(LRLBL)
SET ZTRTN="ENT^LRLABLD"
SET ZTDTH=$HOROLOG
SET ZTDESC="LAB LABELS"
SET ZTIO=LRLABLIO
SET ZTSAVE("LRLBL(")=""
DO ^%ZTLOAD
+2 KILL LRLBL
+3 IF $DATA(LRCSQ)
IF '$ORDER(^XTMP("LRCAP",LRCSQ,DUZ,0))
KILL ^XTMP("LRCAP",LRCSQ,DUZ),LRCSQ
+4 IF $DATA(LRCSQ)
IF $PIECE($GET(^LRO(68,+LRAA,0)),U,16)
DO STD^LRCAPV
+5 DO STOP^LRCAPV
KILL LRCOM,LRSPCDSC,LRCCOM,LRTCOM
+6 QUIT
+7 ;
+8 ;
END KILL DIR,DIRUT,GOT,LRNAAAC
+1 DO ^LRORDK
DO LROEND^LRORDK
DO STOP^LRCAPV
+2 QUIT
+3 ;
+4 ;
GOT(ORD,ODT) ;See if all tests have been canceled
+1 NEW I,SN,ODT
+2 SET (GOT,ODT,SN)=0
+3 FOR
SET ODT=$ORDER(^LRO(69,"C",ORD,ODT))
if ODT<1
QUIT
Begin DoDot:1
+4 SET SN=0
FOR
SET SN=$ORDER(^LRO(69,"C",ORD,ODT,SN))
if SN<1!(GOT)
QUIT
Begin DoDot:2
+5 if '$DATA(^LRO(69,ODT,1,SN,0))
QUIT
+6 SET I=0
FOR
SET I=$ORDER(^LRO(69,ODT,1,SN,2,I))
if I<1
QUIT
IF $DATA(^(I,0))
IF '$PIECE(^(0),"^",11)
IF $PIECE(^(0),U,9)'="CA"
SET GOT=1
QUIT
End DoDot:2
End DoDot:1
+7 QUIT GOT
+8 ;
+9 ;
UNL69 ;
+1 LOCK -^LRO(69,"C",+$GET(LRORD))
+2 QUIT
