LRHYBLD ;DALOI/HOAK - PRINT ORDER LABELS FOR HOWDY ;8/28/2005
;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93
;
; This routine has been modified by the
; NTXHCS VALOR Clinical Applications Team to be used
; with the Howdy Phlebotomy Patient Log-in Process.
;
; from LRHYA
ENT ;
; Howdy routine for printing order labels
; Make sure printer is ID'd sufficiently
;
D ^LRHYBL1 ; get subtype of printer
;
ID I $G(LRLABLIO)="" D
. S LRLABLIO=$P(^%ZIS(1,LRDEV,0),U)
. I $G(LRLABSTP)'="" S LRLABLIO=LRLABLIO_";"_LRLABSTP
. E S LRLABLIO=LRLABLIO_";P-OTC560/BARCODE;132;30"
;
;
S ZTRTN="BACK^LRHYBLD",ZTDTH=$H,ZTDESC="LAB LABELS"
S ZTIO=LRLABLIO,ZTSAVE("LR*")=""
S:$D(ZTQUEUED) ZTREQ="@" D ^%ZTLOAD
QUIT
;
;
BACK ;
; after task come back here
;
; find the best label routine
I $D(ZTQUEUED) S ZTREQ="@"
; from site file
S LRLABEL="^LRLABEL"_$S($D(^LAB(69.9,1,3)):$P(^(3),U,3),1:"")
; from Howdy site file
I $G(^LRHY(69.86,LRHYSITE,11))'="" S LRLABEL="^"_$G(^LRHY(69.86,LRHYSITE,11)) ;order label rtn
; default printer routine
;
N X S X=$P(LRLABEL,U,2) X ^%ZOSF("TEST") I '$T S LRLABEL="^LRLABEL"_$S($D(^LAB(69.9,1,3)):$P(^(3),U,3),1:"")
BC ;
S LRBAR0=$S($L($G(^%ZIS(2,+IOST(0),"BAR0"))):^("BAR0"),1:"$C(32)")
S LRBAR1=$S($L($G(^%ZIS(2,+IOST(0),"BAR1"))):^("BAR1"),1:"$C(32)")
K LRBAR S LRLABLIO=IO
;
;
; SET all variables for label routine
TST ;
S LRTST=LRTSTS
D INIT
K ZTQUEUED,ZTREQ,LRBAR,LRLABEL,LRLABLIO
QUIT
INIT ;
K PNM,SSN,LRDPF D PT^LRX S LRDAT=$$Y2K^LRX(LR3DTN)
S LRORD=$G(^LRO(69,LR3DTN,1,LR3SN,.1))
S LRAN=$G(LRORD)
S LRUID=$G(LRORD)
S LRXL="" S LRPREF=$G(LRPREF,0)
S LRACC=$G(LRACC,LRORD)
S LRINFW=$G(LRINFW,1)
S LRCE=LRORD
S LRTUBE=$P(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
S LRTUBE=$E($P(^LAB(62,LRTUBE,0),U),1,11)
S LRTNM=$E($P(^LAB(60,LRTST,0),U),1,10) S LRURGT="ROUTINE"
S LRURGA=LRURGT
S LRURG=LRURGT
S LRTXT=LRTNM
S LRTOP=LRTUBE,LRTS(LRTST)=LRTNM
S LRLLOC="LAB"
D @LRLABEL
QUIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHYBLD 2024 printed Oct 16, 2024@18:16 Page 2
LRHYBLD ;DALOI/HOAK - PRINT ORDER LABELS FOR HOWDY ;8/28/2005
+1 ;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93
+2 ;
+3 ; This routine has been modified by the
+4 ; NTXHCS VALOR Clinical Applications Team to be used
+5 ; with the Howdy Phlebotomy Patient Log-in Process.
+6 ;
+7 ; from LRHYA
ENT ;
+1 ; Howdy routine for printing order labels
+2 ; Make sure printer is ID'd sufficiently
+3 ;
+4 ; get subtype of printer
DO ^LRHYBL1
+5 ;
ID IF $GET(LRLABLIO)=""
Begin DoDot:1
+1 SET LRLABLIO=$PIECE(^%ZIS(1,LRDEV,0),U)
+2 IF $GET(LRLABSTP)'=""
SET LRLABLIO=LRLABLIO_";"_LRLABSTP
+3 IF '$TEST
SET LRLABLIO=LRLABLIO_";P-OTC560/BARCODE;132;30"
End DoDot:1
+4 ;
+5 ;
+6 SET ZTRTN="BACK^LRHYBLD"
SET ZTDTH=$HOROLOG
SET ZTDESC="LAB LABELS"
+7 SET ZTIO=LRLABLIO
SET ZTSAVE("LR*")=""
+8 if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZTLOAD
+9 QUIT
+10 ;
+11 ;
BACK ;
+1 ; after task come back here
+2 ;
+3 ; find the best label routine
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 ; from site file
+6 SET LRLABEL="^LRLABEL"_$SELECT($DATA(^LAB(69.9,1,3)):$PIECE(^(3),U,3),1:"")
+7 ; from Howdy site file
+8 ;order label rtn
IF $GET(^LRHY(69.86,LRHYSITE,11))'=""
SET LRLABEL="^"_$GET(^LRHY(69.86,LRHYSITE,11))
+9 ; default printer routine
+10 ;
+11 NEW X
SET X=$PIECE(LRLABEL,U,2)
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET LRLABEL="^LRLABEL"_$SELECT($DATA(^LAB(69.9,1,3)):$PIECE(^(3),U,3),1:"")
BC ;
+1 SET LRBAR0=$SELECT($LENGTH($GET(^%ZIS(2,+IOST(0),"BAR0"))):^("BAR0"),1:"$C(32)")
+2 SET LRBAR1=$SELECT($LENGTH($GET(^%ZIS(2,+IOST(0),"BAR1"))):^("BAR1"),1:"$C(32)")
+3 KILL LRBAR
SET LRLABLIO=IO
+4 ;
+5 ;
+6 ; SET all variables for label routine
TST ;
+1 SET LRTST=LRTSTS
+2 DO INIT
+3 KILL ZTQUEUED,ZTREQ,LRBAR,LRLABEL,LRLABLIO
+4 QUIT
INIT ;
+1 KILL PNM,SSN,LRDPF
DO PT^LRX
SET LRDAT=$$Y2K^LRX(LR3DTN)
+2 SET LRORD=$GET(^LRO(69,LR3DTN,1,LR3SN,.1))
+3 SET LRAN=$GET(LRORD)
+4 SET LRUID=$GET(LRORD)
+5 SET LRXL=""
SET LRPREF=$GET(LRPREF,0)
+6 SET LRACC=$GET(LRACC,LRORD)
+7 SET LRINFW=$GET(LRINFW,1)
+8 SET LRCE=LRORD
+9 SET LRTUBE=$PIECE(^LRO(69,LR3DTN,1,LR3SN,0),U,3)
+10 SET LRTUBE=$EXTRACT($PIECE(^LAB(62,LRTUBE,0),U),1,11)
+11 SET LRTNM=$EXTRACT($PIECE(^LAB(60,LRTST,0),U),1,10)
SET LRURGT="ROUTINE"
+12 SET LRURGA=LRURGT
+13 SET LRURG=LRURGT
+14 SET LRTXT=LRTNM
+15 SET LRTOP=LRTUBE
SET LRTS(LRTST)=LRTNM
+16 SET LRLLOC="LAB"
+17 DO @LRLABEL
+18 QUIT
+19 QUIT
