LRHYPH0.m

LRHYPH0 ;VA/DALOI/HOAK - HOWDY ORDER NUMBER SELECTOR PRIME ; 13-Aug-2013 09:16 ; MKK

 ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997

 ;

 K LRORIFN,LRNATURE,LREND,LRORDRR

 S LRLWC="WC"

 D ^LRPARAM

 I $G(LREND) S LREND=0 Q

L5 ;

NEXT ;

 K DIR

 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(^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

 K DIC,LRSND,LRSN

 W !!,"Select Order number: " R LRORD:DTIME W ! Q:LRORD["^"!(LRORD[".")!($D(LRLONG)&(LRORD=""))

PAST ; HOWDY IN HERE

 W @IOF S M9=0 G QUICK^LROE1:LRORD=""

 S:LRORD?.N LRORD=+LRORD IF LRORD'?.N D QMSG QUIT

 I '$D(^LRO(69,"C",LRORD)) W !!?10,"No order exist with that number ",$C(7),! QUIT

 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 LRNONE=2 W !,"The order has already been",$S(LRCHK<1:" partially",1:"")," accessioned." H 1

 I LRNONE=1 W !,"No order exists with that number." H 1 QUIT

 I '$$GOT(LRORD,LRODT) QUIT

 K DIR S DIR("A")="Is this the correct order",DIR(0)="Y"

 S DIR("B")="Yes"

 K DIR S Y=1

 I $D(DIRUT)!(Y'=1) K LRSN QUIT

 L +^LRO(69,"C",LRORD):$G(DILOCKTM,3)

 I '$T W !?5,"Someone else is editing this Order",!!,$C(7) QUIT

 K %DT

 S LRSTATUS="",%DT("B")=""

 D TIME K %DT

 D:$G(LRCDT)<1 UNL69 QUIT:LRCDT<1

 S LRTIM=+LRCDT

 S LRUN=$P(LRCDT,U,2) K LRCDT,LRSN

MORE ;

 S M9=0

 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

 . . S LRSN(LRSND)=LRSND,LRSN=LRSND

 . . K LRAA D Q15^LRHYPH2 K LRSN

 D TASK,UNL69

 QUIT

 ;

 ;

LROE2 ;

 I $D(^LRO(69,LRODT,1,DA,1)),$P(^(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,LR3X=^LRO(69,LRODT,1,LRSN,0),LRDFN=+LR3X,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX

 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 W ! 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

 ;

LROE ;

 QUIT

 ;

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

 D NOW^%DTC S LRCDT=% QUIT  ;STUFFED FOR HOWDY

 S %DT="SET" W !,"Collection Date@Time: ",$S($D(%DT("B")):%DT("B"),1:"NOW"),"//" R X:DTIME W ! I '$T!(X="^") S LRCDT=-1 Q

 S:X="" X=$S($D(%DT("B")):%DT("B"),1:"N")

 W:X["?" !!,"You may enter ""T@U"" or just ""U"", for Today at Unknown time",!!

 I X["@U",$P(X,"@U",2)="" S X=$P(X,"@U",1) D ^%DT G TIME:Y<1 S LRCDT=+Y_"^1" Q

 S:X="U" LRCDT=DT_"^1"

 I X'="U" D ^%DT D:X'["?" TIME1 G TIME:X["?" 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  F  W !,"You have specified a collection time in the future.  Are you sure" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o."

 S:%'=1 X="?" S X1=X

 Q

 ;

 ;

TASK ;

 ; If traditional Howdy is used this is where labels print-control passes to GT549

 ; If alternative Howdy is used label printing is delayed.

 I $G(^%ZIS(1,LRDEV,0))'["NUL" G T549

 N LRAD S LRAD=0

 N LRX,LRY

 D NOW^%DTC

 S LR3T=%

 S LRX=0

 F  S LRX=$O(LRLBL(LRX)) Q:+LRX'>0  D

 .  S LRY=0

 .  F  S LRY=$O(LRLBL(LRX,LRY)) Q:+LRY'>0  D

 ..  I $P(^LRO(68,LRX,0),U,3)="M" S LRAD=$E(DT,1,5)_"00"

 ..  I $P(^LRO(68,LRX,0),U,3)="Y" S LRAD=$E(DT,1,3)_"0000"

 ..  I '$G(LRAD) S LRAD=DT

 ..  S LRUID=$P($G(^LRO(68,LRX,1,LRAD,1,LRY,.3)),U) I $L(LRUID)<10 D

 ...  S $P(LRLBL(LRX,LRY),U,7)=LRORD

 ...  S LRUID=$P($G(^LRO(68,LRX,1,LRAD,1,LRY,.3)),U)

 ..  S ^XTMP("LRHY LABELS",LRDFN,LR3T,LRUID)=LRLBL(LRX,LRY)

 ..  K LRAD

 I $G(^%ZIS(1,LRDEV,0))["NUL" QUIT

 ;

T549 ; ADDED FOR PPOC APPROACH

 S LRCE=LRORD

 S LRX=0

 F  S LRX=$O(LRLBL(LRX)) Q:+LRX'>0  D

 .  S LRY=0

 .  F  S LRY=$O(LRLBL(LRX,LRY)) Q:+LRY'>0  D

 ..  S $P(LRLBL(LRX,LRY),U,7)=LRCE

 S ZTSAVE("L*")=""

 I $D(LRLABLIO) S ZTRTN="ENT^LRLABLD",ZTDTH=$H,ZTDESC="LAB LABELS",ZTIO=LRLABLIO,ZTSAVE("LRLBL(")="" S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD

 K LRLBL

 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,LRHYGOT

 D ^LRORDK,LROEND^LRORDK,STOP^LRCAPV

 Q

 ;

 ;

GOT(ORD,ODT) ;See if all tests have been canceled

 N LRHYI,SN,ODT

 S (LRHYGOT,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!(LRHYGOT)  D

 . . Q:'$D(^LRO(69,ODT,1,SN,0))

 . . S LRHYI=0 F  S LRHYI=$O(^LRO(69,ODT,1,SN,2,LRHYI)) Q:LRHYI<1  I $D(^(LRHYI,0)),'$P(^(0),"^",11) S LRHYGOT=1 Q

 Q LRHYGOT

 ;

 ;

UNL69 ;

 L -^LRO(69,"C",+$G(LRORD))

 Q

BCE ;

 S LRCE=$G(LRORD)

 Q:'$D(LRLABLIO)

 S ZTSAVE("L*")=""

 S ZTRTN="ENT^LRLABLD",ZTDTH=$H,ZTDESC="LAB LABELS"

 S ZTIO=LRLABLIO

 S LRDEV=LRLABLIO

 S IO=LRDEV S ZTSAVE("IO*")=""

 S ZTIO=$P(^%ZIS(1,+LRDEV,0),U)

 D ^%ZTLOAD

 K LRLBL

 I $D(LRCSQ),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV

 D STOP^LRCAPV K LRCOM,LRSPCDSC,LRCCOM,LRTCOM

LRHYPH0   ;VA/DALOI/HOAK - HOWDY ORDER NUMBER SELECTOR PRIME ; 13-Aug-2013 09:16 ; MKK

 +1       ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997

 +2       ;

 +3        KILL LRORIFN,LRNATURE,LREND,LRORDRR

 +4        SET LRLWC="WC"

 +5        DO ^LRPARAM

 +6        IF $GET(LREND)

               SET LREND=0

               QUIT 

L5        ;

NEXT      ;

 +1        KILL DIR

 +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(^LAB(69.9,1,"RO"))

               IF +$HOROLOG'=+$PIECE(^("RO"),U)

                   Begin DoDot:1

 +5                    WRITE $CHAR(7),!,"ROLLOVER ",$SELECT($PIECE(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$CHAR(7),!

 +6                    SET DIR("A")="  Are you sure you want to continue"

                       SET DIR(0)="Y"

                       SET DIR("B")="No"

                   End DoDot:1

 +7        IF $TEST

               DO ^DIR

               IF $DATA(DIRUT)

                   GOTO END

               IF Y'=1

                   WRITE !,"OK, try later."

                   QUIT 

 +8        SET X="T-7"

           SET %DT=""

           DO ^%DT

           SET LRTM7=+Y

 +9        KILL DIC,LRSND,LRSN

 +10       WRITE !!,"Select Order number: "

           READ LRORD:DTIME

           WRITE !

           IF LRORD["^"!(LRORD[".")!($DATA(LRLONG)&(LRORD=""))

               QUIT 

PAST      ; HOWDY IN HERE

 +1        WRITE @IOF

           SET M9=0

           IF LRORD=""

               GOTO QUICK^LROE1

 +2        IF LRORD?.N

               SET LRORD=+LRORD

           IF LRORD'?.N

               DO QMSG

               QUIT 

 +3        IF '$DATA(^LRO(69,"C",LRORD))

               WRITE !!?10,"No order exist with that number ",$CHAR(7),!

               QUIT 

 +4        SET (LRCHK,LRNONE)=1

           SET (M9,LRODT)=0

 +5        FOR 

               SET LRODT=+$ORDER(^LRO(69,"C",LRORD,LRODT))

               IF LRODT<1

                   QUIT 

               Begin DoDot:1

 +6                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

 +7        IF LRNONE=2

               WRITE !,"The order has already been",$SELECT(LRCHK<1:" partially",1:"")," accessioned."

               HANG 1

 +8        IF LRNONE=1

               WRITE !,"No order exists with that number."

               HANG 1

               QUIT 

 +9        IF '$$GOT(LRORD,LRODT)

               QUIT 

 +10       KILL DIR

           SET DIR("A")="Is this the correct order"

           SET DIR(0)="Y"

 +11       SET DIR("B")="Yes"

 +12       KILL DIR

           SET Y=1

 +13       IF $DATA(DIRUT)!(Y'=1)

               KILL LRSN

               QUIT 

 +14       LOCK +^LRO(69,"C",LRORD):$GET(DILOCKTM,3)

 +15       IF '$TEST

               WRITE !?5,"Someone else is editing this Order",!!,$CHAR(7)

               QUIT 

 +16       KILL %DT

 +17       SET LRSTATUS=""

           SET %DT("B")=""

 +18       DO TIME

           KILL %DT

 +19       IF $GET(LRCDT)<1

               DO UNL69

           IF LRCDT<1

               QUIT 

 +20       SET LRTIM=+LRCDT

 +21       SET LRUN=$PIECE(LRCDT,U,2)

           KILL LRCDT,LRSN

MORE      ;

 +1        SET M9=0

 +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                        SET LRSN(LRSND)=LRSND

                           SET LRSN=LRSND

 +7                        KILL LRAA

                           DO Q15^LRHYPH2

                           KILL LRSN

                       End DoDot:2

               End DoDot:1

 +8        DO TASK

           DO UNL69

 +9        QUIT 

 +10      ;

 +11      ;

LROE2     ;

 +1        IF $DATA(^LRO(69,LRODT,1,DA,1))

               IF $PIECE(^(1),U,4)=""

                   SET LRNONE=2

                   SET LRCHK=LRCHK+1

 +2        KILL LRSN

 +3        SET (LRSN,LRSN(DA))=+DA

 +4        IF '$DATA(^LRO(69,LRODT,1,LRSN,0))

               QUIT 

 +5        SET M9=$GET(M9)+1

           SET LR3X=^LRO(69,LRODT,1,LRSN,0)

           SET LRDFN=+LR3X

           SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)

           SET DFN=$PIECE(^(0),U,3)

           DO PT^LRX

 +6        QUIT 

 +7       ;

 +8       ;

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

           WRITE !

           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       ;

LROE      ;

 +1        QUIT 

 +2       ;

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       ;STUFFED FOR HOWDY

           DO NOW^%DTC

           SET LRCDT=%

           QUIT 

 +2        SET %DT="SET"

           WRITE !,"Collection Date@Time: ",$SELECT($DATA(%DT("B")):%DT("B"),1:"NOW"),"//"

           READ X:DTIME

           WRITE !

           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",!!

 +5        IF X["@U"

               IF $PIECE(X,"@U",2)=""

                   SET X=$PIECE(X,"@U",1)

                   DO ^%DT

                   IF Y<1

                       GOTO TIME

                   SET LRCDT=+Y_"^1"

                   QUIT 

 +6        IF X="U"

               SET LRCDT=DT_"^1"

 +7        IF X'="U"

               DO ^%DT

               IF X'["?"

                   DO TIME1

               IF X["?"

                   GOTO TIME

               SET LRCDT=+Y_"^"

               IF Y'["."

                   GOTO TIME

 +8        QUIT 

 +9       ;

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

           IF Y1'>Y

               QUIT 

           FOR 

               WRITE !,"You have specified a collection time in the future.  Are you sure"

               SET %=2

               DO YN^DICN

               IF %

                   QUIT 

               WRITE !,"Answer 'Y'es or 'N'o."

 +1        IF %'=1

               SET X="?"

           SET X1=X

 +2        QUIT 

 +3       ;

 +4       ;

TASK      ;

 +1       ; If traditional Howdy is used this is where labels print-control passes to GT549

 +2       ; If alternative Howdy is used label printing is delayed.

 +3        IF $GET(^%ZIS(1,LRDEV,0))'["NUL"

               GOTO T549

 +4        NEW LRAD

           SET LRAD=0

 +5        NEW LRX,LRY

 +6        DO NOW^%DTC

 +7        SET LR3T=%

 +8        SET LRX=0

 +9        FOR 

               SET LRX=$ORDER(LRLBL(LRX))

               IF +LRX'>0

                   QUIT 

               Begin DoDot:1

 +10               SET LRY=0

 +11               FOR 

                       SET LRY=$ORDER(LRLBL(LRX,LRY))

                       IF +LRY'>0

                           QUIT 

                       Begin DoDot:2

 +12                       IF $PIECE(^LRO(68,LRX,0),U,3)="M"

                               SET LRAD=$EXTRACT(DT,1,5)_"00"

 +13                       IF $PIECE(^LRO(68,LRX,0),U,3)="Y"

                               SET LRAD=$EXTRACT(DT,1,3)_"0000"

 +14                       IF '$GET(LRAD)

                               SET LRAD=DT

 +15                       SET LRUID=$PIECE($GET(^LRO(68,LRX,1,LRAD,1,LRY,.3)),U)

                           IF $LENGTH(LRUID)<10

                               Begin DoDot:3

 +16                               SET $PIECE(LRLBL(LRX,LRY),U,7)=LRORD

 +17                               SET LRUID=$PIECE($GET(^LRO(68,LRX,1,LRAD,1,LRY,.3)),U)

                               End DoDot:3

 +18                       SET ^XTMP("LRHY LABELS",LRDFN,LR3T,LRUID)=LRLBL(LRX,LRY)

 +19                       KILL LRAD

                       End DoDot:2

               End DoDot:1

 +20       IF $GET(^%ZIS(1,LRDEV,0))["NUL"

               QUIT 

 +21      ;

T549      ; ADDED FOR PPOC APPROACH

 +1        SET LRCE=LRORD

 +2        SET LRX=0

 +3        FOR 

               SET LRX=$ORDER(LRLBL(LRX))

               IF +LRX'>0

                   QUIT 

               Begin DoDot:1

 +4                SET LRY=0

 +5                FOR 

                       SET LRY=$ORDER(LRLBL(LRX,LRY))

                       IF +LRY'>0

                           QUIT 

                       Begin DoDot:2

 +6                        SET $PIECE(LRLBL(LRX,LRY),U,7)=LRCE

                       End DoDot:2

               End DoDot:1

 +7        SET ZTSAVE("L*")=""

 +8        IF $DATA(LRLABLIO)

               SET ZTRTN="ENT^LRLABLD"

               SET ZTDTH=$HOROLOG

               SET ZTDESC="LAB LABELS"

               SET ZTIO=LRLABLIO

               SET ZTSAVE("LRLBL(")=""

               IF $DATA(ZTQUEUED)

                   SET ZTREQ="@"

               DO ^%ZTLOAD

 +9        KILL LRLBL

 +10       IF $DATA(LRCSQ)

               IF $PIECE($GET(^LRO(68,+LRAA,0)),U,16)

                   DO STD^LRCAPV

 +11       DO STOP^LRCAPV

           KILL LRCOM,LRSPCDSC,LRCCOM,LRTCOM

 +12       QUIT 

 +13      ;

 +14      ;

END        KILL DIR,DIRUT,LRHYGOT

 +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 LRHYI,SN,ODT

 +2        SET (LRHYGOT,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!(LRHYGOT)

                           QUIT 

                       Begin DoDot:2

 +5                        IF '$DATA(^LRO(69,ODT,1,SN,0))

                               QUIT 

 +6                        SET LRHYI=0

                           FOR 

                               SET LRHYI=$ORDER(^LRO(69,ODT,1,SN,2,LRHYI))

                               IF LRHYI<1

                                   QUIT 

                               IF $DATA(^(LRHYI,0))

                                   IF '$PIECE(^(0),"^",11)

                                       SET LRHYGOT=1

                                       QUIT 

                       End DoDot:2

               End DoDot:1

 +7        QUIT LRHYGOT

 +8       ;

 +9       ;

UNL69     ;

 +1        LOCK -^LRO(69,"C",+$GET(LRORD))

 +2        QUIT 

BCE       ;

 +1        SET LRCE=$GET(LRORD)

 +2        IF '$DATA(LRLABLIO)

               QUIT 

 +3        SET ZTSAVE("L*")=""

 +4        SET ZTRTN="ENT^LRLABLD"

           SET ZTDTH=$HOROLOG

           SET ZTDESC="LAB LABELS"

 +5        SET ZTIO=LRLABLIO

 +6        SET LRDEV=LRLABLIO

 +7        SET IO=LRDEV

           SET ZTSAVE("IO*")=""

 +8        SET ZTIO=$PIECE(^%ZIS(1,+LRDEV,0),U)

 +9        DO ^%ZTLOAD

 +10       KILL LRLBL

 +11       IF $DATA(LRCSQ)

               IF $PIECE($GET(^LRO(68,+LRAA,0)),U,16)

                   DO STD^LRCAPV

 +12       DO STOP^LRCAPV

           KILL LRCOM,LRSPCDSC,LRCCOM,LRTCOM