LRHYA ;VA/DALOI/HOAK - HOWDY UTILITY-A ; 13-Aug-2013 09:16 ; MKK
;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997
;
;
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)="" 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 $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
. 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 $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
LRHYA ;VA/DALOI/HOAK - HOWDY UTILITY-A ; 13-Aug-2013 09:16 ; MKK
+1 ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997
+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)=""
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 $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA"
SET LRNODONE=1
SET LRHYHOK=1
QUIT
+26 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA"
QUIT
+27 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))'["CA"
SET LRHYTOK=LRTSTS
+28 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'=""
SET LRNODUP=1
QUIT
+29 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,0))["CA"
QUIT
+30 ;
+31 IF $DATA(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS))
SET LRHYHOK=1
QUIT
+32 IF LR3DTN=DT
IF $DATA(^TMP("LRHYDY",$JOB,"DUPTEST",LRTSTS,LRCOL99))
Begin DoDot:2
+33 ; duplicate auto np function
+34 ;
+35 ;no excepted test
IF $DATA(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS))
QUIT
+36 ;no order label tests
IF $DATA(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS))
QUIT
+37 IF $DATA(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99))
QUIT
+38 ;
+39 SET LRIENZZ=$ORDER(^LRO(69,LR3DTN,1,LR3SN,2,"B",LRTSTS,0))
+40 KILL ^TMP("LRHYDY",$JOB,"KILL",LR3DTN,LR3SN)
+41 KILL LRNPZZX
+42 IF $GET(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))'=""
SET LRHYHOK=1
QUIT
+43 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
+44 ; a future enhancement may be used to cancel a test
+45 SET LRT(LRTSTS)=LR3SN_U_LRIENZZ_U_LRTSTS
SET LRJ=LRTSTS
+46 ;
+47 KILL LRCCOMX,LRCCOM0,LRCCOM1
+48 IF $GET(^LRHY(69.86,LRHYSITE,52))=""
SET LRNODUP=1
+49 IF $GET(^LRHY(69.86,LRHYSITE,52))="N"
SET LRNODUP=1
+50 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
End DoDot:2
+51 IF '$TEST
Begin DoDot:2
+52 IF $DATA(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
QUIT
+53 IF $DATA(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
QUIT
+54 ;no excepted test
IF $DATA(^LRHY(69.86,LRHYSITE,2,"B",LRTSTS))
QUIT
+55 ;no order label tests
IF $DATA(^LRHY(69.86,LRHYSITE,25,1,"B",LRTSTS))
QUIT
+56 IF $DATA(^LRHY(69.86,LRHYSITE,4,"B",LRCOL99))
QUIT
+57 IF $DATA(^LRO(69,LR3DTN,1,LR3SN,2,LRIENZZ,1.1,1,0))
QUIT
+58 KILL LRNPZZX
+59 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
+60 ;
+61 IF LR3DTN=DT
SET ^TMP("LRHYDY",$JOB,"DUPTEST",LRTSTS,LRCOL99)=""
End DoDot:2
End DoDot:1
+62 ;
+63 DO DONE
+64 QUIT
+65 ;
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 IF $DATA(^LRHY(69.86,LRHYSITE,16,"B",LRLLOC66))
SET LRHYHOK=1
DO DONE
SET ^TMP("LRHYDY",$JOB,"EXLOC",LRORD,LRLLOC66,LR3SN)=""
+2 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
