- LRHYBLD ;VA/DALOI/HOAK - PRINT ORDER LABELS FOR HOWDY ; 13-Aug-2013 09:16 ; MKK
- ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997
- ;
- ; 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
- LRHYBLD ;VA/DALOI/HOAK - PRINT ORDER LABELS FOR HOWDY ; 13-Aug-2013 09:16 ; MKK
- +1 ;;5.2;LAB SERVICE;**405,1033**;NOV 01, 1997
- +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
