LRHYA ;DALOI/HOAK - HOWDY UTILITY-A ; 4/20/16 2:41pm
;;5.2;LAB SERVICE;**405,446,457,467**;Sep 27, 1994;Build 3
;
;
OLT ; This block looks in the Howdy site file for tests that will print
; order labels WILL NOT accession the test.
; order label tests
K LRNODONE
S LRHYHOK=0
S LRTSTS=0
S LRPLICK=1
F S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0 D
. S ^TMP("LRHYDY",$J,LRDFN,LR3DTN,LRTSTS)=""
. K LRNPZZX
. S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
. S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNODUP=1 S LRNOTST(LRTSTS)="" S LRNPZZX(LRORD,LR3SN,LRTSTS)="" QUIT
. I $D(^LRHY(69.86,LRHYSITE,25,"B",LRTSTS)) S LRHYHOK=1 D
.. S LROLT1(LR3DTN,LR3SN)=LRTSTS
.. S LRNOTST(LRTSTS)=""
.. D ^LRHYBLD ;print order labels
D DONE
QUIT
;
LTE ; This block looks in the Howdy site file for those test to exclude
; from accessioning by Howdy
;
Q:'$G(LRCOL99)
K LRNODONE
K LRCCOM
; exclude lab test
;
S LRIENZZ=0
S LRHYHOK=0
S LRTSTS=0
;
S LRHYTOK=0
K LRNPZZX
K LRNODUP
F S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0 S LRHYHOK=0 D
. ;
. S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
. I $D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) S LRHYHOK=1 S LRHYT654=LRTSTS S LRNOTST(LRTSTS)="",LREXORD(LRORD)="" QUIT
. K LRNPZZX
. K LRCCOM
. S LRCOL99=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
. ;
. K LRNODONE
. S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
. I $P($G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0)),U,6)'="" QUIT
. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA" S LRNODONE=1,LRHYHOK=1 QUIT
. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA" QUIT
. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))'["CA" S LRHYTOK=LRTSTS
. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNODUP=1 QUIT
. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA" QUIT
. ;
. I $D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) S LRHYHOK=1 QUIT
. I LR3DTN=DT I $D(^TMP("LRHYDY",$J,"DUPTEST",LRTSTS,LRCOL99)) D
.. ; duplicate auto np function
.. ;
.. Q:$D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) ;no excepted test
.. Q:$D(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS)) ;no order label tests
.. Q:$D(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99))
.. ;
.. S LRIENZZ=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
.. K ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN)
.. K LRNPZZX
.. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRHYHOK=1 QUIT
.. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNPZZX(LRORD,LR3SN,LRTSTS)="" S LRNODUP=1 S LRHYHOK=+LRTSTS QUIT
.. ; a future enhancement may be used to cancel a test
.. S LRT(LRTSTS)=LR3SN_U_LRIENZZ_U_LRTSTS S LRJ=LRTSTS
.. ;
.. K LRCCOMX,LRCCOM0,LRCCOM1
.. I $G(^LRHY(69.86,LRHYSITE,52))="" S LRNODUP=1
.. I $G(^LRHY(69.86,LRHYSITE,52))="N" S LRNODUP=1
.. Q:$G(LRNODUP) S LRHYHOK=1 K LRCCOM S ZTRTN="FX2^LRHYDEL",ZTSAVE("L*")="",ZTDTH=$H,ZTIO="NULL" S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD
.. H 5
. E D
.. Q:$D(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
.. Q:$D(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
.. Q:$D(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS)) ;no excepted test
.. Q:$D(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS)) ;no order label tests
.. Q:$D(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99))
.. Q:$D(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
.. K LRNPZZX
.. I $G(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'="" S LRNPZZX(LRORD,LR3SN,LRTSTS)="" S LRNODUP=1 S LRHYHOK=+LRTSTS QUIT
.. ;
.. I LR3DTN=DT S ^TMP("LRHYDY",$J,"DUPTEST",LRTSTS,LRCOL99)=""
;
D DONE
QUIT
;
CSE ; This block checks for collection sample exclusion
S LRHYHOK=0
S LRHYSPC7=$P($G(^LAB(62,LRCOL99,0)),U,2)
I $G(LRHYSPC7) I $D(^LRHY(69.86,LRHYSITE,6,"B",LRHYSPC7)) S LRHYHOK=1
K LRNODONE
I $D(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99)) S LRHYHOK=1
I LRHYHOK=1 S LRHYCS33(LR3DTN,LR3SN)=LRCOL99
QUIT
;
CSTATUS ; This block checks for collection types to exclude
S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
K LRNODONE
K LRWCZZZ
S LRHYHOK=0
I $D(^LRHY(69.86,LRHYSITE,8,"B",LRCSTAT)) S LRHYHOK=1 S LRWCZZZ=1
I LRHYHOK=1 S ^TMP("LRHYDY",$J,"STATUS",LRORD)=""
D DONE
QUIT
;
EXLOC ; This block checks for Hospital locations to exclude
;
I LR3DTN=DT Q
;
; This logic is to look for tests from an excluded location on the same specimen
; number as tests from a non-excluded location because of orders being merged.
; Variable LRLOCS will indicate this situation and will trigger a "check with clerk"
; message.
;
N LREX,LRNONEX,LRX,LRXX,LRMGINFO,LRMGDT,LRMGSN,LRXXLOC
I $D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) S LREX=1
I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) S LRNONEX=1
;
S LRTSTS=0
F S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0 D Q:$G(LRLOCS)
. S LR3ZTST=0
. S LR3ZTST=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,LR3ZTST)) Q:+LR3ZTST'>0
. ;
. S LRX=$G(^LRO(69,LR3DTN,1,LR3SN,2,LR3ZTST,0))
. S LRMGINFO=$P(LRX,U,14)
. Q:LRMGINFO=""
. S LRMGDT=$P(LRMGINFO,";",1),LRMGSN=$P(LRMGINFO,";",2)
. S LRXX=$G(^LRO(69,LRMGDT,1,LRMGSN,0)),LRXXLOC=$P(LRXX,U,9)
. Q:LRXXLOC=""
. ;
. I $D(^LRHY(69.86,LRHYSITE,16,"B",LRXXLOC)),$G(LRNONEX)=1 S LRLOCS=1 Q
. I '$D(^LRHY(69.86,LRHYSITE,16,"B",LRXXLOC)),$G(LREX)=1 S LRLOCS=1 Q
;
I $G(LRLOCS) S LRHYHOK=1
I $D(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66)) S LRHYHOK=1 D DONE S ^TMP("LRHYDY",$J,"EXLOC",LRORD,LRLLOC66,LR3SN)=""
QUIT
DONE ;
Q:$D(LROLT1)
Q:$G(LRHYT654)
I $G(LRHYTOK) S LRHYHOK=0
Q:$G(LRNODONE)
I LRHYHOK=1 S ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN,1)=""
I LRHYHOK>1 S ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN,LRHYHOK)=""
QUIT
URG ;
S LRHYHOK=0
S LRTSTS=0
F S LRTSTS=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS)) Q:+LRTSTS'>0!(LRHYHOK) D URGP
QUIT
D DONE
QUIT
URGP ;
S LR3ZTST=0
S LR3ZTST=$O(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,LR3ZTST)) Q:+LR3ZTST'>0!(LRHYHOK) D URG1 Q:LRHYHOK
QUIT
URG1 ;
S LRURGZ19=$P(^LRO(69,LR3DTN,1,LR3SN,2,LR3ZTST,0),U,2)
I $D(^LRHY(69.86,LRHYSITE,30,"B",LRURGZ19)) S LRHYHOK=1 S LRHYURG3(LR3DTN,LR3SN)=LR3ZTST
I LRHYHOK=1 S ^TMP("LRHYDY",$J,"KILL",LR3DTN,LR3SN,1)=""
S LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
I LRHYHOK=1 S ^TMP("LRHYDY",$J,"URG",LRORD)=""
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHYA 6291 printed Oct 16, 2024@18:15:55 Page 2
LRHYA ;DALOI/HOAK - HOWDY UTILITY-A ; 4/20/16 2:41pm
+1 ;;5.2;LAB SERVICE;**405,446,457,467**;Sep 27, 1994;Build 3
+2 ;
+3 ;
OLT ; This block looks in the Howdy site file for tests that will print
+1 ; order labels WILL NOT accession the test.
+2 ; order label tests
+3 KILL LRNODONE
+4 SET LRHYHOK=0
+5 SET LRTSTS=0
+6 SET LRPLICK=1
+7 FOR
SET LRTSTS=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS))
if +LRTSTS'>0
QUIT
Begin DoDot:1
+8 SET ^TMP("LRHYDY",$JOB,LRDFN,LR3DTN,LRTSTS)=""
+9 KILL LRNPZZX
+10 SET LRIENZZ=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
+11 SET LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
+12 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'=""
SET LRNODUP=1
SET LRNOTST(LRTSTS)=""
SET LRNPZZX(LRORD,LR3SN,LRTSTS)=""
QUIT
+13 IF $DATA(^LRHY(69.86,LRHYSITE,25,"B",LRTSTS))
SET LRHYHOK=1
Begin DoDot:2
+14 SET LROLT1(LR3DTN,LR3SN)=LRTSTS
+15 SET LRNOTST(LRTSTS)=""
+16 ;print order labels
DO ^LRHYBLD
End DoDot:2
End DoDot:1
+17 DO DONE
+18 QUIT
+19 ;
LTE ; This block looks in the Howdy site file for those test to exclude
+1 ; from accessioning by Howdy
+2 ;
+3 if '$GET(LRCOL99)
QUIT
+4 KILL LRNODONE
+5 KILL LRCCOM
+6 ; exclude lab test
+7 ;
+8 SET LRIENZZ=0
+9 SET LRHYHOK=0
+10 SET LRTSTS=0
+11 ;
+12 SET LRHYTOK=0
+13 KILL LRNPZZX
+14 KILL LRNODUP
+15 FOR
SET LRTSTS=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS))
if +LRTSTS'>0
QUIT
SET LRHYHOK=0
Begin DoDot:1
+16 ;
+17 SET LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
+18 IF $DATA(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS))
SET LRHYHOK=1
SET LRHYT654=LRTSTS
SET LRNOTST(LRTSTS)=""
SET LREXORD(LRORD)=""
QUIT
+19 KILL LRNPZZX
+20 KILL LRCCOM
+21 SET LRCOL99=$PIECE(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
+22 ;
+23 KILL LRNODONE
+24 SET LRIENZZ=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
+25 IF $PIECE($GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0)),U,6)'=""
QUIT
+26 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA"
SET LRNODONE=1
SET LRHYHOK=1
QUIT
+27 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA"
QUIT
+28 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))'["CA"
SET LRHYTOK=LRTSTS
+29 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'=""
SET LRNODUP=1
QUIT
+30 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA"
QUIT
+31 ;
+32 IF $DATA(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS))
SET LRHYHOK=1
QUIT
+33 IF LR3DTN=DT
IF $DATA(^TMP("LRHYDY",$JOB,"DUPTEST",LRTSTS,LRCOL99))
Begin DoDot:2
+34 ; duplicate auto np function
+35 ;
+36 ;no excepted test
if $DATA(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS))
QUIT
+37 ;no order label tests
if $DATA(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS))
QUIT
+38 if $DATA(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99))
QUIT
+39 ;
+40 SET LRIENZZ=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
+41 KILL ^TMP("LRHYDY",$JOB,"KILL",LR3DTN,LR3SN)
+42 KILL LRNPZZX
+43 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'=""
SET LRHYHOK=1
QUIT
+44 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'=""
SET LRNPZZX(LRORD,LR3SN,LRTSTS)=""
SET LRNODUP=1
SET LRHYHOK=+LRTSTS
QUIT
+45 ; a future enhancement may be used to cancel a test
+46 SET LRT(LRTSTS)=LR3SN_U_LRIENZZ_U_LRTSTS
SET LRJ=LRTSTS
+47 ;
+48 KILL LRCCOMX,LRCCOM0,LRCCOM1
+49 IF $GET(^LRHY(69.86,LRHYSITE,52))=""
SET LRNODUP=1
+50 IF $GET(^LRHY(69.86,LRHYSITE,52))="N"
SET LRNODUP=1
+51 if $GET(LRNODUP)
QUIT
SET LRHYHOK=1
KILL LRCCOM
SET ZTRTN="FX2^LRHYDEL"
SET ZTSAVE("L*")=""
SET ZTDTH=$HOROLOG
SET ZTIO="NULL"
if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZTLOAD
+52 HANG 5
End DoDot:2
+53 IF '$TEST
Begin DoDot:2
+54 if $DATA(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
QUIT
+55 if $DATA(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
QUIT
+56 ;no excepted test
if $DATA(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS))
QUIT
+57 ;no order label tests
if $DATA(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS))
QUIT
+58 if $DATA(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99))
QUIT
+59 if $DATA(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
QUIT
+60 KILL LRNPZZX
+61 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'=""
SET LRNPZZX(LRORD,LR3SN,LRTSTS)=""
SET LRNODUP=1
SET LRHYHOK=+LRTSTS
QUIT
+62 ;
+63 IF LR3DTN=DT
SET ^TMP("LRHYDY",$JOB,"DUPTEST",LRTSTS,LRCOL99)=""
End DoDot:2
End DoDot:1
+64 ;
+65 DO DONE
+66 QUIT
+67 ;
CSE ; This block checks for collection sample exclusion
+1 SET LRHYHOK=0
+2 SET LRHYSPC7=$PIECE($GET(^LAB(62,LRCOL99,0)),U,2)
+3 IF $GET(LRHYSPC7)
IF $DATA(^LRHY(69.86,LRHYSITE,6,"B",LRHYSPC7))
SET LRHYHOK=1
+4 KILL LRNODONE
+5 IF $DATA(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99))
SET LRHYHOK=1
+6 IF LRHYHOK=1
SET LRHYCS33(LR3DTN,LR3SN)=LRCOL99
+7 QUIT
+8 ;
CSTATUS ; This block checks for collection types to exclude
+1 SET LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
+2 KILL LRNODONE
+3 KILL LRWCZZZ
+4 SET LRHYHOK=0
+5 IF $DATA(^LRHY(69.86,LRHYSITE,8,"B",LRCSTAT))
SET LRHYHOK=1
SET LRWCZZZ=1
+6 IF LRHYHOK=1
SET ^TMP("LRHYDY",$JOB,"STATUS",LRORD)=""
+7 DO DONE
+8 QUIT
+9 ;
EXLOC ; This block checks for Hospital locations to exclude
+1 ;
+2 IF LR3DTN=DT
QUIT
+3 ;
+4 ; This logic is to look for tests from an excluded location on the same specimen
+5 ; number as tests from a non-excluded location because of orders being merged.
+6 ; Variable LRLOCS will indicate this situation and will trigger a "check with clerk"
+7 ; message.
+8 ;
+9 NEW LREX,LRNONEX,LRX,LRXX,LRMGINFO,LRMGDT,LRMGSN,LRXXLOC
+10 IF $DATA(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66))
SET LREX=1
+11 IF '$DATA(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66))
SET LRNONEX=1
+12 ;
+13 SET LRTSTS=0
+14 FOR
SET LRTSTS=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS))
if +LRTSTS'>0
QUIT
Begin DoDot:1
+15 SET LR3ZTST=0
+16 SET LR3ZTST=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,LR3ZTST))
if +LR3ZTST'>0
QUIT
+17 ;
+18 SET LRX=$GET(^LRO(69,LR3DTN,1,LR3SN,2,LR3ZTST,0))
+19 SET LRMGINFO=$PIECE(LRX,U,14)
+20 if LRMGINFO=""
QUIT
+21 SET LRMGDT=$PIECE(LRMGINFO,";",1)
SET LRMGSN=$PIECE(LRMGINFO,";",2)
+22 SET LRXX=$GET(^LRO(69,LRMGDT,1,LRMGSN,0))
SET LRXXLOC=$PIECE(LRXX,U,9)
+23 if LRXXLOC=""
QUIT
+24 ;
+25 IF $DATA(^LRHY(69.86,LRHYSITE,16,"B",LRXXLOC))
IF $GET(LRNONEX)=1
SET LRLOCS=1
QUIT
+26 IF '$DATA(^LRHY(69.86,LRHYSITE,16,"B",LRXXLOC))
IF $GET(LREX)=1
SET LRLOCS=1
QUIT
End DoDot:1
if $GET(LRLOCS)
QUIT
+27 ;
+28 IF $GET(LRLOCS)
SET LRHYHOK=1
+29 IF $DATA(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66))
SET LRHYHOK=1
DO DONE
SET ^TMP("LRHYDY",$JOB,"EXLOC",LRORD,LRLLOC66,LR3SN)=""
+30 QUIT
DONE ;
+1 if $DATA(LROLT1)
QUIT
+2 if $GET(LRHYT654)
QUIT
+3 IF $GET(LRHYTOK)
SET LRHYHOK=0
+4 if $GET(LRNODONE)
QUIT
+5 IF LRHYHOK=1
SET ^TMP("LRHYDY",$JOB,"KILL",LR3DTN,LR3SN,1)=""
+6 IF LRHYHOK>1
SET ^TMP("LRHYDY",$JOB,"KILL",LR3DTN,LR3SN,LRHYHOK)=""
+7 QUIT
URG ;
+1 SET LRHYHOK=0
+2 SET LRTSTS=0
+3 FOR
SET LRTSTS=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS))
if +LRTSTS'>0!(LRHYHOK)
QUIT
DO URGP
+4 QUIT
+5 DO DONE
+6 QUIT
URGP ;
+1 SET LR3ZTST=0
+2 SET LR3ZTST=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,LR3ZTST))
if +LR3ZTST'>0!(LRHYHOK)
QUIT
DO URG1
if LRHYHOK
QUIT
+3 QUIT
URG1 ;
+1 SET LRURGZ19=$PIECE(^LRO(69,LR3DTN,1,LR3SN,2,LR3ZTST,0),U,2)
+2 IF $DATA(^LRHY(69.86,LRHYSITE,30,"B",LRURGZ19))
SET LRHYHOK=1
SET LRHYURG3(LR3DTN,LR3SN)=LR3ZTST
+3 IF LRHYHOK=1
SET ^TMP("LRHYDY",$JOB,"KILL",LR3DTN,LR3SN,1)=""
+4 SET LRORD=^LRO(69,LR3DTN,1,LR3SN,.1)
+5 IF LRHYHOK=1
SET ^TMP("LRHYDY",$JOB,"URG",LRORD)=""
+6 QUIT
