LRHYB ;DALOI/HOAK - HOWDY B DRIVER ;Sep 16, 2000
 ;;5.2;LAB SERVICE;**405,417,446,457,467,491,573**;Sep 27, 1994;Build 7
 ;
TEST ;
 S DIC=2 S DIC(0)="AEMQZ" D ^DIC
 Q:Y=-1
 S LRDFN=$G(^DPT(+Y,"LR"))
 ;
 ;
 ;
ORDCHK ; Here is where the search for an order number starts
 K LRHYT654
 ; The Howdy site file will help determine which orders the site
 ; will accept. Once an order has been selected it is handed off
 ; to LRORDST to start the accessioning process.
 ;
 N LRNAAAC
 K LRWCZZZ,LRDTF
 K LRHYCS33
 K ^TMP("LRHYDY",$J,"KILL")
 ;
 ;
 K ^TMP("LRHYDY",$J,"MULTD")
 K ^TMP("LRHYDY",$J,"DUPTEST")
 K LRHYCS
 K ^TMP("LRHYDY",$J,"MT")
 S LRHOWDY=1
 S LREND=0
 S LRORD=""
 Q:'LRDFN
 ;
 K ^TMP("LRHYDY",$J,"LRSN"),LRNPZZX
 S LRHYOK=0
 ;
 ;  18 days ahead
 ;  20 days back
 ;
 S X2=0 K LRNPZZX
 S LRAHEAD=$G(^LRHY(69.86,LRHYSITE,18))
 S LRPAST=$G(^LRHY(69.86,LRHYSITE,20))
 K LRWCZZZ,LREXORD
 S LRLOCS=0 ; flag for non-EXLOC and EXLOC on same specimen number
 F LRI=-LRPAST:1:LRAHEAD D  Q:$G(LRLOCS)  ;Search window set by site file.
 .  S X1=DT S X2=LRI D C^%DTC S LR3DTN=X
 .  I $D(^LRO(69,LR3DTN,1,"AA",LRDFN)) S LRHYOK=1 D
 ..  S LR3SN=0
 ..  F  S LR3SN=$O(^LRO(69,LR3DTN,1,"AA",LRDFN,LR3SN)) Q:+LR3SN'>0  D  Q:$G(LRLOCS)
 ...  Q:$P($G(^LRO(69,LR3DTN,1,LR3SN,1)),U,4)="C"  ;collected
 ...  K LRWCZZZ
 ...  ;
 ...  K LRCOL99 S LRCOL99=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
 ...  K LRCSTAT S LRCSTAT=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,4)
 ...  D CSTATUS^LRHYA Q:LRHYHOK  ;Check collection status
 ...  ;
 ...  ;LR573 check for accession area conflict:
 ...  S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1) I '$$Q18^LROE2(DUZ(2)) S (LRLAAX,LRHYHOK)=1
 ...  Q:LRHYHOK
 ...  ;
 ...  D OLT^LRHYA  ;print order label tests
 ...  Q:LRHYHOK
 ...  ;
 ...  ;
 ...  K LRNOTST
 ...  S LRNODUP=0 D LTE^LRHYA Q:LRHYHOK  ;check for excluded lab tests
 ...  ;
 ...  S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
 ...  S LRLLOC66=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,9)
 ...  D EXLOC^LRHYA Q:LRHYHOK  ;check for locations to exclude
 ...  ;
 ...  S LRLLOC=$G(LRLLOC66)
 ...  S LRORD24=0
 ...  D OLT^LRHYA Q:LRHYHOK  ;print order label tests
 ...  ;
 ...  D URG^LRHYA Q:LRHYHOK  ;;  CHECK URGENCY
 ...  K LRCOL99 S LRCOL99=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
 ...  D CSE^LRHYA Q:LRHYHOK  ;check for excluded collection samples
 ...  ;
 ...  I $O(^TMP("LRHYDY",$J,"EXLOC",LRORD,0))=$G(LRLLOC66) I $O(^LRO(69,"C",LRORD,0))'=DT QUIT
 ...  ;  CHECK URGENCY
 ...  S LRTST6=0 ; micro test
 ...  F  S LRTST6=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTST6)) Q:+LRTST6'>0  D
 ....  S LRTSTZ99(LRTST6)=""
 ....  I LRTST6 S LRSUB1=$P(^LAB(60,LRTST6,0),U,4) ; subscript
 ....  Q:$D(LRNPZZX(^LRO(69,LR3DTN,1,LR3SN,.1),LR3SN,LRTST6))
 ....  S LRORD=$G(^LRO(69,LR3DTN,1,LR3SN,.1))
 ....  I $G(LRORD) I $D(^TMP("LRHYDY",$J,"STATUS",LRORD)) QUIT
 ....  I $D(LRNOTST) I $D(LRNOTST(LRTST6)) K LRORD QUIT
 ....  S ^TMP("LRHYDY",$J,"LRSN",LR3DTN,^LRO(69,LR3DTN,1,LR3SN,.1))=""
 ....  S LRDTX=""
 ....  S LRDTX=$O(^LRO(69,"C",^LRO(69,LR3DTN,1,LR3SN,.1),0))
 ....  I $D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)),LR3DTN=DT,$G(LRDTX) S ^TMP("LRHYDY",$J,"MT",LRDTX)=""
 ....  I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) I $G(LRDTX) S ^TMP("LRHYDY",$J,"MT",LRDTX)=""
 ;
 ;
 K LRMULT
 I $G(LRWCMULT) W !!!!,"Multple Orders Present" S LRMULT=1 D LOG1^LRHY0 K LRWCMULT QUIT
 ; per Libba 1/14/2002
 I $D(^TMP("LRHYDY",$J,"LRSN",DT)) S LR3DTN=DT ; I prefer today's orders but...
 E  S LR3DTN=$O(^TMP("LRHYDY",$J,"LRSN",0)) ; I'll take whatever ya got
 I 'LR3DTN K LRORD QUIT
 ;
 I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) I $O(^TMP("LRHYDY",$J,"LRSN",LR3DTN)) W !,"MULTIPLE DAYS WITH ORDERS" S LRMULT=1 D LOG1^LRHY0 QUIT
 ;
 S LRTIC=0
 S LRMULT=0
 ;
 F  S LRTIC=$O(^TMP("LRHYDY",$J,"LRSN",LRTIC)) Q:+LRTIC'>0  S LRMULT=LRMULT+1
 I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) I LRMULT>1 W !,"MULTIPLE DAYS WITH ORDERS" S LRMULT=0 D LOG1^LRHY0 QUIT
 ;MODIFIED BY HOAK to flag when wc and sp are on same visit
 ;
 ;
MOVE ;
 I $D(LRNOTST) I $G(LRHYT654) I $D(LRNOTST(LRHYT654)) K LRORD QUIT
 I $G(LRORD),$D(LREXORD(LRORD)) K LRORD QUIT
 S LRHY3SN3=0
 S LRHY3DT3=0
 I $G(LRORD),$D(^TMP("LRHYDY",$J,"URG",LRORD)) K LRORD QUIT
 I $D(^LRHY(69.86,LRHYSITE,30,"B",LRURGZ19)) K LRORD QUIT
 S LRTIC=0
 S LRMULT=0
 F  S LRTIC=$O(^TMP("LRHYDY",$J,"MT",LRTIC)) Q:+LRTIC'>0  S LRMULT=LRMULT+1
 S LR3MULT=LRMULT
 I LRMULT>1 W !,"MULTIPLE DAYS WITH ORDERS" S LRORD=0 QUIT
 E  S LRMULT=0
 ; may be accessioned.
 ; Setting up task to continue based on the specimen.
 K LR3ZTST
MOVE1 ;
 S LRORD=0
 F  S LRORD=$O(^TMP("LRHYDY",$J,"LRSN",LR3DTN,LRORD)) Q:+LRORD'>0  D
 .  S:'$G(LR3ORD) LR3ORD=LRORD
 .  I $D(^TMP("LRHYDY",$J,"URG",LRORD)) QUIT
 .  S LRHYORDZ=LRORD
 .  ;
 .  S ZTSAVE("^TMP(""LRHYDY"",$J,")=""
 .  S ZTRTN="PAST^LRHYPH0",ZTSAVE("L*")="",ZTDTH=$H,ZTDESC="HOWDY"
 .  S ZTIO="NULL"
 .  S ZTSAVE("L*")=""
 .  S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD
 .  S LRGOTIT=1
 .  S LRORD=LRHYORDZ
 .  K LRSTOPZ(LRORD)
 K ^TMP("LRHYDY",$J,"MULTD")
 S LRORD=$G(LR3ORD) K LR3ORD
 K LRHOWDY,LR3SN24,LR3DTN24,LR3ZTST,LROLT1,LRNAAAC
 I $G(LRORD) I $D(LRSTOPZ(LRORD)) K LRORD,LRSTOPZ QUIT
 ;
 QUIT
 ;
MMM ;
 N LRI S LRI=0
 N LR3DTN,LR3SN,LRIENZZ,LRTSTX
 K LRHYMORD
 K LRHYMULT
 F LRI=-LRPAST:1:LRAHEAD D
 .  S X1=DT S X2=LRI D C^%DTC S LR3DTN=X
 .  ;
 .  I $D(^LRO(69,LR3DTN,1,"AA",LRDFN)) D
 ..  S LR3SN=0
 ..  F  S LR3SN=$O(^LRO(69,LR3DTN,1,"AA",LRDFN,LR3SN)) Q:+LR3SN'>0  D
 ...  ;
 ...  Q:$P($G(^LRO(69,LR3DTN,1,LR3SN,1)),U,4)="C"  ;collected
 ...  S LRTSTX=0
 ...  F  S LRTSTX=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTX)) Q:+LRTSTX'>0  D
 ....  S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTX,0))
 ....  ;
 ....  Q:$G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'=""
 ....  K LRCOL99 S LRCOL99=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
 ....  S LRHYHOK=0 D CSE^LRHYA Q:LRHYHOK
 ....  S LRCSTAT=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,4)
 ....  S LRHYHOK=0 D CSTATUS^LRHYA Q:LRHYHOK
 ....  S LRLLOC66=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,9)
 ....  S LRHYHOK=0 D EXLOC^LRHYA Q:LRHYHOK
 ....  S LRHYMULT(LR3DTN,LR3SN,LRIENZZ)=LRTSTX
 N CNT
 S CNT=0
 S LR3DTN=0
 F  S LR3DTN=$O(LRHYMULT(LR3DTN)) Q:+LR3DTN'>0  S CNT=CNT+1
 I CNT>1 S LRHYMORD=1
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHYB   6262     printed  Sep 23, 2025@19:50:52                                                                                                                                                                                                       Page 2
LRHYB     ;DALOI/HOAK - HOWDY B DRIVER ;Sep 16, 2000
 +1       ;;5.2;LAB SERVICE;**405,417,446,457,467,491,573**;Sep 27, 1994;Build 7
 +2       ;
TEST      ;
 +1        SET DIC=2
           SET DIC(0)="AEMQZ"
           DO ^DIC
 +2        if Y=-1
               QUIT 
 +3        SET LRDFN=$GET(^DPT(+Y,"LR"))
 +4       ;
 +5       ;
 +6       ;
ORDCHK    ; Here is where the search for an order number starts
 +1        KILL LRHYT654
 +2       ; The Howdy site file will help determine which orders the site
 +3       ; will accept. Once an order has been selected it is handed off
 +4       ; to LRORDST to start the accessioning process.
 +5       ;
 +6        NEW LRNAAAC
 +7        KILL LRWCZZZ,LRDTF
 +8        KILL LRHYCS33
 +9        KILL ^TMP("LRHYDY",$JOB,"KILL")
 +10      ;
 +11      ;
 +12       KILL ^TMP("LRHYDY",$JOB,"MULTD")
 +13       KILL ^TMP("LRHYDY",$JOB,"DUPTEST")
 +14       KILL LRHYCS
 +15       KILL ^TMP("LRHYDY",$JOB,"MT")
 +16       SET LRHOWDY=1
 +17       SET LREND=0
 +18       SET LRORD=""
 +19       if 'LRDFN
               QUIT 
 +20      ;
 +21       KILL ^TMP("LRHYDY",$JOB,"LRSN"),LRNPZZX
 +22       SET LRHYOK=0
 +23      ;
 +24      ;  18 days ahead
 +25      ;  20 days back
 +26      ;
 +27       SET X2=0
           KILL LRNPZZX
 +28       SET LRAHEAD=$GET(^LRHY(69.86,LRHYSITE,18))
 +29       SET LRPAST=$GET(^LRHY(69.86,LRHYSITE,20))
 +30       KILL LRWCZZZ,LREXORD
 +31      ; flag for non-EXLOC and EXLOC on same specimen number
           SET LRLOCS=0
 +32      ;Search window set by site file.
           FOR LRI=-LRPAST:1:LRAHEAD
               Begin DoDot:1
 +33               SET X1=DT
                   SET X2=LRI
                   DO C^%DTC
                   SET LR3DTN=X
 +34               IF $DATA(^LRO(69,LR3DTN,1,"AA",LRDFN))
                       SET LRHYOK=1
                       Begin DoDot:2
 +35                       SET LR3SN=0
 +36                       FOR 
                               SET LR3SN=$ORDER(^LRO(69,LR3DTN,1,"AA",LRDFN,LR3SN))
                               if +LR3SN'>0
                                   QUIT 
                               Begin DoDot:3
 +37      ;collected
                                   if $PIECE($GET(^LRO(69,LR3DTN,1,LR3SN,1)),U,4)="C"
                                       QUIT 
 +38                               KILL LRWCZZZ
 +39      ;
 +40                               KILL LRCOL99
                                   SET LRCOL99=$PIECE(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
 +41                               KILL LRCSTAT
                                   SET LRCSTAT=$PIECE(^LRO(69,LR3DTN,1,LR3SN,0),U,4)
 +42      ;Check collection status
                                   DO CSTATUS^LRHYA
                                   if LRHYHOK
                                       QUIT 
 +43      ;
 +44      ;LR573 check for accession area conflict:
 +45                               SET LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
                                   IF '$$Q18^LROE2(DUZ(2))
                                       SET (LRLAAX,LRHYHOK)=1
 +46                               if LRHYHOK
                                       QUIT 
 +47      ;
 +48      ;print order label tests
                                   DO OLT^LRHYA
 +49                               if LRHYHOK
                                       QUIT 
 +50      ;
 +51      ;
 +52                               KILL LRNOTST
 +53      ;check for excluded lab tests
                                   SET LRNODUP=0
                                   DO LTE^LRHYA
                                   if LRHYHOK
                                       QUIT 
 +54      ;
 +55                               SET LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
 +56                               SET LRLLOC66=$PIECE(^LRO(69,LR3DTN,1,LR3SN,0),U,9)
 +57      ;check for locations to exclude
                                   DO EXLOC^LRHYA
                                   if LRHYHOK
                                       QUIT 
 +58      ;
 +59                               SET LRLLOC=$GET(LRLLOC66)
 +60                               SET LRORD24=0
 +61      ;print order label tests
                                   DO OLT^LRHYA
                                   if LRHYHOK
                                       QUIT 
 +62      ;
 +63      ;;  CHECK URGENCY
                                   DO URG^LRHYA
                                   if LRHYHOK
                                       QUIT 
 +64                               KILL LRCOL99
                                   SET LRCOL99=$PIECE(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
 +65      ;check for excluded collection samples
                                   DO CSE^LRHYA
                                   if LRHYHOK
                                       QUIT 
 +66      ;
 +67                               IF $ORDER(^TMP("LRHYDY",$JOB,"EXLOC",LRORD,0))=$GET(LRLLOC66)
                                       IF $ORDER(^LRO(69,"C",LRORD,0))'=DT
                                           QUIT 
 +68      ;  CHECK URGENCY
 +69      ; micro test
                                   SET LRTST6=0
 +70                               FOR 
                                       SET LRTST6=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTST6))
                                       if +LRTST6'>0
                                           QUIT 
                                       Begin DoDot:4
 +71                                       SET LRTSTZ99(LRTST6)=""
 +72      ; subscript
                                           IF LRTST6
                                               SET LRSUB1=$PIECE(^LAB(60,LRTST6,0),U,4)
 +73                                       if $DATA(LRNPZZX(^LRO(69,LR3DTN,1,LR3SN,.1),LR3SN,LRTST6))
                                               QUIT 
 +74                                       SET LRORD=$GET(^LRO(69,LR3DTN,1,LR3SN,.1))
 +75                                       IF $GET(LRORD)
                                               IF $DATA(^TMP("LRHYDY",$JOB,"STATUS",LRORD))
                                                   QUIT 
 +76                                       IF $DATA(LRNOTST)
                                               IF $DATA(LRNOTST(LRTST6))
                                                   KILL LRORD
                                                   QUIT 
 +77                                       SET ^TMP("LRHYDY",$JOB,"LRSN",LR3DTN,^LRO(69,LR3DTN,1,LR3SN,.1))=""
 +78                                       SET LRDTX=""
 +79                                       SET LRDTX=$ORDER(^LRO(69,"C",^LRO(69,LR3DTN,1,LR3SN,.1),0))
 +80                                       IF $DATA(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66))
                                               IF LR3DTN=DT
                                                   IF $GET(LRDTX)
                                                       SET ^TMP("LRHYDY",$JOB,"MT",LRDTX)=""
 +81                                       IF '$DATA(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66))
                                               IF $GET(LRDTX)
                                                   SET ^TMP("LRHYDY",$JOB,"MT",LRDTX)=""
                                       End DoDot:4
                               End DoDot:3
                               if $GET(LRLOCS)
                                   QUIT 
                       End DoDot:2
               End DoDot:1
               if $GET(LRLOCS)
                   QUIT 
 +82      ;
 +83      ;
 +84       KILL LRMULT
 +85       IF $GET(LRWCMULT)
               WRITE !!!!,"Multple Orders Present"
               SET LRMULT=1
               DO LOG1^LRHY0
               KILL LRWCMULT
               QUIT 
 +86      ; per Libba 1/14/2002
 +87      ; I prefer today's orders but...
           IF $DATA(^TMP("LRHYDY",$JOB,"LRSN",DT))
               SET LR3DTN=DT
 +88      ; I'll take whatever ya got
          IF '$TEST
               SET LR3DTN=$ORDER(^TMP("LRHYDY",$JOB,"LRSN",0))
 +89       IF 'LR3DTN
               KILL LRORD
               QUIT 
 +90      ;
 +91       IF '$DATA(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66))
               IF $ORDER(^TMP("LRHYDY",$JOB,"LRSN",LR3DTN))
                   WRITE !,"MULTIPLE DAYS WITH ORDERS"
                   SET LRMULT=1
                   DO LOG1^LRHY0
                   QUIT 
 +92      ;
 +93       SET LRTIC=0
 +94       SET LRMULT=0
 +95      ;
 +96       FOR 
               SET LRTIC=$ORDER(^TMP("LRHYDY",$JOB,"LRSN",LRTIC))
               if +LRTIC'>0
                   QUIT 
               SET LRMULT=LRMULT+1
 +97       IF '$DATA(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66))
               IF LRMULT>1
                   WRITE !,"MULTIPLE DAYS WITH ORDERS"
                   SET LRMULT=0
                   DO LOG1^LRHY0
                   QUIT 
 +98      ;MODIFIED BY HOAK to flag when wc and sp are on same visit
 +99      ;
 +100     ;
MOVE      ;
 +1        IF $DATA(LRNOTST)
               IF $GET(LRHYT654)
                   IF $DATA(LRNOTST(LRHYT654))
                       KILL LRORD
                       QUIT 
 +2        IF $GET(LRORD)
               IF $DATA(LREXORD(LRORD))
                   KILL LRORD
                   QUIT 
 +3        SET LRHY3SN3=0
 +4        SET LRHY3DT3=0
 +5        IF $GET(LRORD)
               IF $DATA(^TMP("LRHYDY",$JOB,"URG",LRORD))
                   KILL LRORD
                   QUIT 
 +6        IF $DATA(^LRHY(69.86,LRHYSITE,30,"B",LRURGZ19))
               KILL LRORD
               QUIT 
 +7        SET LRTIC=0
 +8        SET LRMULT=0
 +9        FOR 
               SET LRTIC=$ORDER(^TMP("LRHYDY",$JOB,"MT",LRTIC))
               if +LRTIC'>0
                   QUIT 
               SET LRMULT=LRMULT+1
 +10       SET LR3MULT=LRMULT
 +11       IF LRMULT>1
               WRITE !,"MULTIPLE DAYS WITH ORDERS"
               SET LRORD=0
               QUIT 
 +12      IF '$TEST
               SET LRMULT=0
 +13      ; may be accessioned.
 +14      ; Setting up task to continue based on the specimen.
 +15       KILL LR3ZTST
MOVE1     ;
 +1        SET LRORD=0
 +2        FOR 
               SET LRORD=$ORDER(^TMP("LRHYDY",$JOB,"LRSN",LR3DTN,LRORD))
               if +LRORD'>0
                   QUIT 
               Begin DoDot:1
 +3                if '$GET(LR3ORD)
                       SET LR3ORD=LRORD
 +4                IF $DATA(^TMP("LRHYDY",$JOB,"URG",LRORD))
                       QUIT 
 +5                SET LRHYORDZ=LRORD
 +6       ;
 +7                SET ZTSAVE("^TMP(""LRHYDY"",$J,")=""
 +8                SET ZTRTN="PAST^LRHYPH0"
                   SET ZTSAVE("L*")=""
                   SET ZTDTH=$HOROLOG
                   SET ZTDESC="HOWDY"
 +9                SET ZTIO="NULL"
 +10               SET ZTSAVE("L*")=""
 +11               if $DATA(ZTQUEUED)
                       SET ZTREQ="@"
                   DO ^%ZTLOAD
 +12               SET LRGOTIT=1
 +13               SET LRORD=LRHYORDZ
 +14               KILL LRSTOPZ(LRORD)
               End DoDot:1
 +15       KILL ^TMP("LRHYDY",$JOB,"MULTD")
 +16       SET LRORD=$GET(LR3ORD)
           KILL LR3ORD
 +17       KILL LRHOWDY,LR3SN24,LR3DTN24,LR3ZTST,LROLT1,LRNAAAC
 +18       IF $GET(LRORD)
               IF $DATA(LRSTOPZ(LRORD))
                   KILL LRORD,LRSTOPZ
                   QUIT 
 +19      ;
 +20       QUIT 
 +21      ;
MMM       ;
 +1        NEW LRI
           SET LRI=0
 +2        NEW LR3DTN,LR3SN,LRIENZZ,LRTSTX
 +3        KILL LRHYMORD
 +4        KILL LRHYMULT
 +5        FOR LRI=-LRPAST:1:LRAHEAD
               Begin DoDot:1
 +6                SET X1=DT
                   SET X2=LRI
                   DO C^%DTC
                   SET LR3DTN=X
 +7       ;
 +8                IF $DATA(^LRO(69,LR3DTN,1,"AA",LRDFN))
                       Begin DoDot:2
 +9                        SET LR3SN=0
 +10                       FOR 
                               SET LR3SN=$ORDER(^LRO(69,LR3DTN,1,"AA",LRDFN,LR3SN))
                               if +LR3SN'>0
                                   QUIT 
                               Begin DoDot:3
 +11      ;
 +12      ;collected
                                   if $PIECE($GET(^LRO(69,LR3DTN,1,LR3SN,1)),U,4)="C"
                                       QUIT 
 +13                               SET LRTSTX=0
 +14                               FOR 
                                       SET LRTSTX=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTX))
                                       if +LRTSTX'>0
                                           QUIT 
                                       Begin DoDot:4
 +15                                       SET LRIENZZ=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTX,0))
 +16      ;
 +17                                       if $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'=""
                                               QUIT 
 +18                                       KILL LRCOL99
                                           SET LRCOL99=$PIECE(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
 +19                                       SET LRHYHOK=0
                                           DO CSE^LRHYA
                                           if LRHYHOK
                                               QUIT 
 +20                                       SET LRCSTAT=$PIECE(^LRO(69,LR3DTN,1,LR3SN,0),U,4)
 +21                                       SET LRHYHOK=0
                                           DO CSTATUS^LRHYA
                                           if LRHYHOK
                                               QUIT 
 +22                                       SET LRLLOC66=$PIECE(^LRO(69,LR3DTN,1,LR3SN,0),U,9)
 +23                                       SET LRHYHOK=0
                                           DO EXLOC^LRHYA
                                           if LRHYHOK
                                               QUIT 
 +24                                       SET LRHYMULT(LR3DTN,LR3SN,LRIENZZ)=LRTSTX
                                       End DoDot:4
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +25       NEW CNT
 +26       SET CNT=0
 +27       SET LR3DTN=0
 +28       FOR 
               SET LR3DTN=$ORDER(LRHYMULT(LR3DTN))
               if +LR3DTN'>0
                   QUIT 
               SET CNT=CNT+1
 +29       IF CNT>1
               SET LRHYMORD=1