LRLABELD ;DALOI/JMC - ZEBRA STRIPE 1X2 label printer ; 6/4/98
;;5.2;LAB SERVICE;**218**;Sep 27, 1994
;
EN ; Print 1x2 label formats
;
N ETX,LRFONT,LRFMT,LRTXT,LRX,LRZ,STX
;
S LRRB=$G(LRRB)
;
; Set specific symbology.
S LRFMT=+$G(LRBAR(+$G(LRAA)))
;
; Set up list of tests
S LRTXT=$$LRTXT^LRLABLD(.LRTS,30)
;
D LH
;
I 'LRFMT D NOBAR Q
I LRFMT=1 D BAR1 Q
I LRFMT>1 D BAR2
Q
;
NOBAR ; Print Lab 25mm X 50mm (1 X 2) labels.
; Plain label, no barcode identifier.
; Label length = 200 dots (8 dots/mm printhead).
;
W STX
S LRFONT="^ADN,36,10"
;
; Print accession.
D PL(0,5,LRACC,LRFONT)
D FONT
;
; Print accession date.
D PL(0,40,LRDAT,LRFONT)
;
; Print collection sample.
I LRXL,N-I<LRXL S LRZ=LRTOP
E S LRZ=LRPREF_LRTOP
D PL(0,60,$E(LRZ,1,17),LRFONT)
;
; Accession urgency
I $P(LRURGA,"^",2) D
. S LRFONT="^ADN,36,10"
. I $P(LRURGA,"^",2)=2 D
. . ; Set up graphic box.
. . D GB(285,40,15+($L($P(LRURGA,"^"))*12)_",35,35")
. . S LRFONT=LRFONT_"^FR" ; Field reverse.
. D PL(295,45,$P(LRURGA,"^"),LRFONT)
. D FONT
;
; Patient name
S LRFONT="^ADN,36,10"
D PL(40,80,$E(PNM,1,21),LRFONT),FONT
;
; Print patient identifier.
D PL(40,115,SSN,LRFONT)
;
; Print order number.
D PL(0,143,"Order #"_LRCE,LRFONT)
;
; Patient location/room-bed number
D PL(200,143,"W:"_LRLLOC_$S($L(LRRB):" B:"_LRRB,1:""),LRFONT)
;
; Print test list
S LRFONT="^ADN,36,10"
D PL(0,161,LRTXT,LRFONT)
D FONT
;
W ETX
Q
;
BAR1 ; Print Lab 25mm X 50mm (1 X 2) labels.
; Barcode identifier - use Code 39 with check-digit.
; Label length = 200 dots (8 dots/mm printhead).
;
W STX
S LRFONT="^ADN,36,10"
;
; Patient name
D PL(75,5,$E(PNM,1,18),LRFONT)
D FONT
;
; Accession urgency
I $P(LRURGA,"^",2) D
. S LRFONT="^ADN,36,10"
. ; Set up graphic box.
. I $P(LRURGA,"^",2)=2 D
. . D GB(295,0,15+($L($P(LRURGA,"^"))*12)_",35,35")
. . S LRFONT=LRFONT_"^FR" ; Field reverse.
. D PL(305,5,$P(LRURGA,"^"),LRFONT)
. D FONT
;
; Print patient identifier.
D PL(75,40,SSN,LRFONT)
;
; Patient location/room-bed number
D PL(230,40,$S($L(LRRB):"B:"_LRRB,1:"W:"_LRLLOC),LRFONT)
;
; Print barcode.
S LRX=$S($L(LRBARID)<7:75,$L(LRBARID)>10:80,1:85)
S LRFONT="^BY2,"_$S($L(LRBARID)<7:3,1:2)_",60^"
S LRFONT=LRFONT_"B3N,Y,,N,N"
D PL(LRX,60,LRBARID,LRFONT)
;
; Print order number.
D FONT
D PL(75,125,"Order #"_LRCE,LRFONT)
;
; Print collection sample.
I LRXL,N-I<LRXL S LRZ=LRTOP
E S LRZ=LRPREF_LRTOP
D PL(75,143,$E(LRZ,1,16),LRFONT)
;
; Print test list
S LRFONT="^ADN,36,10"
D PL(75,161,LRTXT,LRFONT)
;
; Print accession.
D FONT S LRFONT="^ADN,36,10^FWB"
D PL(0,0,$$CJ^XLFSTR(LRACC,16),LRFONT)
;
; Print accession date.
D FONT S LRFONT=LRFONT_"^FWB"
D PL(40,0,$$CJ^XLFSTR(LRDAT,16),LRFONT)
;
W ETX
Q
;
BAR2 ; Print Lab 25mm X 50mm (1 X 2) labels.
; Barcode identifier using specified symbology for accession area.
; Label length = 200 dots (8 dots/mm printhead).
;
W STX
S LRFONT="^ADN,36,10"
;
; Patient name
D PL(0,5,$E(PNM,1,22),LRFONT),FONT
;
; Accession urgency
I $P(LRURGA,"^",2) D
. S LRFONT="^ADN,36,10"
. ; Set up graphic box.
. I $P(LRURGA,"^",2)=2 D
. . D GB(275,0,15+($L($P(LRURGA,"^"))*12)_",35,35")
. . S LRFONT=LRFONT_"^FR" ; Field reverse.
. D PL(285,5,$P(LRURGA,"^"),LRFONT),FONT
;
; Print patient identifier.
D PL(0,40,SSN,LRFONT)
;
; Patient location/room-bed number
D PL(150,40,"W:"_LRLLOC_$S($L(LRRB):"/"_LRRB,1:""),LRFONT)
;
; Print barcode.
S LRX=$S($L(LRBARID)<7:75,LRFMT=4:35,1:20)
S LRFONT="^BY"_$S($L(LRBARID)>10:1,1:2)_","_$S($L(LRBARID)<7:3,1:2)_",60^"
S LRFONT=LRFONT_$S(LRFMT=2:"B3N,N,,N,N",LRFMT=3:"B3N,Y,,N,N",LRFMT=4:"BCN,,N,N",LRFMT=5:"B4N,,N,A",1:"BCN,,N,N")
D PL(LRX,60,LRBARID,LRFONT),FONT
;
; Print human-readable ID.
D PL(0,125,LRBARID,LRFONT)
;
; Print infection warning if present.
I $L(LRINFW) D
. D GB(135,123,10+($L(LRINFW)*12)_",16,16") ; make box
. S LRFONT=LRFONT_"^FR"
. D PL(140,124,LRINFW,LRFONT)
;
; Print accession date.
D PL(0,143,$P(LRDAT," "),LRFONT)
;
; Print accession.
D PL(120,143,LRACC,LRFONT)
;
; Print order number.
D PL(0,161,"Order #"_LRCE,LRFONT)
;
; Print collection sample.
I LRXL,N-I<LRXL S LRZ=LRTOP
E S LRZ=LRPREF_LRTOP
D PL(180,161,$E(LRZ,1,16),LRFONT)
;
; Print test list
D PL(0,179,LRTXT,LRFONT)
;
W ETX
;
Q
;
;
PL(LRX,LRY,LRZ,LRFONT) ; Send print command to printer.
; Call with LRX = column position (in dots).
; LRY = row position (in dots).
; LRZ = text to print.
; LRFONT = font to use.
;
W "^FO",+$G(LRX),",",+$G(LRY),$G(LRFONT),"^FD",$G(LRZ),"^FS"
Q
;
;
GB(LRGBX,LRGBY,LRGBZ) ; Send print command to printer for graphic box.
; Call with LRGBX = column position (in dots).
; LRGBY = row position (in dots).
; LRGBZ = graphic box to print.
;
W "^FO",+$G(LRGBX),",",+$G(LRGBY),"^GB",$G(LRGBZ),"^FS"
Q
;
;
LH ; Set Label Home ("LH") parameters.
;
S STX=$C(2),ETX=$C(3)
;
; Set Print Orientation ("PO") to Inverted and Label Home ("LH") parameters.
W STX,"^POI^LH450,0",ETX
;
FONT ; Default font
S LRFONT="^ADN"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLABELD 5308 printed Sep 23, 2025@19:51:40 Page 2
LRLABELD ;DALOI/JMC - ZEBRA STRIPE 1X2 label printer ; 6/4/98
+1 ;;5.2;LAB SERVICE;**218**;Sep 27, 1994
+2 ;
EN ; Print 1x2 label formats
+1 ;
+2 NEW ETX,LRFONT,LRFMT,LRTXT,LRX,LRZ,STX
+3 ;
+4 SET LRRB=$GET(LRRB)
+5 ;
+6 ; Set specific symbology.
+7 SET LRFMT=+$GET(LRBAR(+$GET(LRAA)))
+8 ;
+9 ; Set up list of tests
+10 SET LRTXT=$$LRTXT^LRLABLD(.LRTS,30)
+11 ;
+12 DO LH
+13 ;
+14 IF 'LRFMT
DO NOBAR
QUIT
+15 IF LRFMT=1
DO BAR1
QUIT
+16 IF LRFMT>1
DO BAR2
+17 QUIT
+18 ;
NOBAR ; Print Lab 25mm X 50mm (1 X 2) labels.
+1 ; Plain label, no barcode identifier.
+2 ; Label length = 200 dots (8 dots/mm printhead).
+3 ;
+4 WRITE STX
+5 SET LRFONT="^ADN,36,10"
+6 ;
+7 ; Print accession.
+8 DO PL(0,5,LRACC,LRFONT)
+9 DO FONT
+10 ;
+11 ; Print accession date.
+12 DO PL(0,40,LRDAT,LRFONT)
+13 ;
+14 ; Print collection sample.
+15 IF LRXL
IF N-I<LRXL
SET LRZ=LRTOP
+16 IF '$TEST
SET LRZ=LRPREF_LRTOP
+17 DO PL(0,60,$EXTRACT(LRZ,1,17),LRFONT)
+18 ;
+19 ; Accession urgency
+20 IF $PIECE(LRURGA,"^",2)
Begin DoDot:1
+21 SET LRFONT="^ADN,36,10"
+22 IF $PIECE(LRURGA,"^",2)=2
Begin DoDot:2
+23 ; Set up graphic box.
+24 DO GB(285,40,15+($LENGTH($PIECE(LRURGA,"^"))*12)_",35,35")
+25 ; Field reverse.
SET LRFONT=LRFONT_"^FR"
End DoDot:2
+26 DO PL(295,45,$PIECE(LRURGA,"^"),LRFONT)
+27 DO FONT
End DoDot:1
+28 ;
+29 ; Patient name
+30 SET LRFONT="^ADN,36,10"
+31 DO PL(40,80,$EXTRACT(PNM,1,21),LRFONT)
DO FONT
+32 ;
+33 ; Print patient identifier.
+34 DO PL(40,115,SSN,LRFONT)
+35 ;
+36 ; Print order number.
+37 DO PL(0,143,"Order #"_LRCE,LRFONT)
+38 ;
+39 ; Patient location/room-bed number
+40 DO PL(200,143,"W:"_LRLLOC_$SELECT($LENGTH(LRRB):" B:"_LRRB,1:""),LRFONT)
+41 ;
+42 ; Print test list
+43 SET LRFONT="^ADN,36,10"
+44 DO PL(0,161,LRTXT,LRFONT)
+45 DO FONT
+46 ;
+47 WRITE ETX
+48 QUIT
+49 ;
BAR1 ; Print Lab 25mm X 50mm (1 X 2) labels.
+1 ; Barcode identifier - use Code 39 with check-digit.
+2 ; Label length = 200 dots (8 dots/mm printhead).
+3 ;
+4 WRITE STX
+5 SET LRFONT="^ADN,36,10"
+6 ;
+7 ; Patient name
+8 DO PL(75,5,$EXTRACT(PNM,1,18),LRFONT)
+9 DO FONT
+10 ;
+11 ; Accession urgency
+12 IF $PIECE(LRURGA,"^",2)
Begin DoDot:1
+13 SET LRFONT="^ADN,36,10"
+14 ; Set up graphic box.
+15 IF $PIECE(LRURGA,"^",2)=2
Begin DoDot:2
+16 DO GB(295,0,15+($LENGTH($PIECE(LRURGA,"^"))*12)_",35,35")
+17 ; Field reverse.
SET LRFONT=LRFONT_"^FR"
End DoDot:2
+18 DO PL(305,5,$PIECE(LRURGA,"^"),LRFONT)
+19 DO FONT
End DoDot:1
+20 ;
+21 ; Print patient identifier.
+22 DO PL(75,40,SSN,LRFONT)
+23 ;
+24 ; Patient location/room-bed number
+25 DO PL(230,40,$SELECT($LENGTH(LRRB):"B:"_LRRB,1:"W:"_LRLLOC),LRFONT)
+26 ;
+27 ; Print barcode.
+28 SET LRX=$SELECT($LENGTH(LRBARID)<7:75,$LENGTH(LRBARID)>10:80,1:85)
+29 SET LRFONT="^BY2,"_$SELECT($LENGTH(LRBARID)<7:3,1:2)_",60^"
+30 SET LRFONT=LRFONT_"B3N,Y,,N,N"
+31 DO PL(LRX,60,LRBARID,LRFONT)
+32 ;
+33 ; Print order number.
+34 DO FONT
+35 DO PL(75,125,"Order #"_LRCE,LRFONT)
+36 ;
+37 ; Print collection sample.
+38 IF LRXL
IF N-I<LRXL
SET LRZ=LRTOP
+39 IF '$TEST
SET LRZ=LRPREF_LRTOP
+40 DO PL(75,143,$EXTRACT(LRZ,1,16),LRFONT)
+41 ;
+42 ; Print test list
+43 SET LRFONT="^ADN,36,10"
+44 DO PL(75,161,LRTXT,LRFONT)
+45 ;
+46 ; Print accession.
+47 DO FONT
SET LRFONT="^ADN,36,10^FWB"
+48 DO PL(0,0,$$CJ^XLFSTR(LRACC,16),LRFONT)
+49 ;
+50 ; Print accession date.
+51 DO FONT
SET LRFONT=LRFONT_"^FWB"
+52 DO PL(40,0,$$CJ^XLFSTR(LRDAT,16),LRFONT)
+53 ;
+54 WRITE ETX
+55 QUIT
+56 ;
BAR2 ; Print Lab 25mm X 50mm (1 X 2) labels.
+1 ; Barcode identifier using specified symbology for accession area.
+2 ; Label length = 200 dots (8 dots/mm printhead).
+3 ;
+4 WRITE STX
+5 SET LRFONT="^ADN,36,10"
+6 ;
+7 ; Patient name
+8 DO PL(0,5,$EXTRACT(PNM,1,22),LRFONT)
DO FONT
+9 ;
+10 ; Accession urgency
+11 IF $PIECE(LRURGA,"^",2)
Begin DoDot:1
+12 SET LRFONT="^ADN,36,10"
+13 ; Set up graphic box.
+14 IF $PIECE(LRURGA,"^",2)=2
Begin DoDot:2
+15 DO GB(275,0,15+($LENGTH($PIECE(LRURGA,"^"))*12)_",35,35")
+16 ; Field reverse.
SET LRFONT=LRFONT_"^FR"
End DoDot:2
+17 DO PL(285,5,$PIECE(LRURGA,"^"),LRFONT)
DO FONT
End DoDot:1
+18 ;
+19 ; Print patient identifier.
+20 DO PL(0,40,SSN,LRFONT)
+21 ;
+22 ; Patient location/room-bed number
+23 DO PL(150,40,"W:"_LRLLOC_$SELECT($LENGTH(LRRB):"/"_LRRB,1:""),LRFONT)
+24 ;
+25 ; Print barcode.
+26 SET LRX=$SELECT($LENGTH(LRBARID)<7:75,LRFMT=4:35,1:20)
+27 SET LRFONT="^BY"_$SELECT($LENGTH(LRBARID)>10:1,1:2)_","_$SELECT($LENGTH(LRBARID)<7:3,1:2)_",60^"
+28 SET LRFONT=LRFONT_$SELECT(LRFMT=2:"B3N,N,,N,N",LRFMT=3:"B3N,Y,,N,N",LRFMT=4:"BCN,,N,N",LRFMT=5:"B4N,,N,A",1:"BCN,,N,N")
+29 DO PL(LRX,60,LRBARID,LRFONT)
DO FONT
+30 ;
+31 ; Print human-readable ID.
+32 DO PL(0,125,LRBARID,LRFONT)
+33 ;
+34 ; Print infection warning if present.
+35 IF $LENGTH(LRINFW)
Begin DoDot:1
+36 ; make box
DO GB(135,123,10+($LENGTH(LRINFW)*12)_",16,16")
+37 SET LRFONT=LRFONT_"^FR"
+38 DO PL(140,124,LRINFW,LRFONT)
End DoDot:1
+39 ;
+40 ; Print accession date.
+41 DO PL(0,143,$PIECE(LRDAT," "),LRFONT)
+42 ;
+43 ; Print accession.
+44 DO PL(120,143,LRACC,LRFONT)
+45 ;
+46 ; Print order number.
+47 DO PL(0,161,"Order #"_LRCE,LRFONT)
+48 ;
+49 ; Print collection sample.
+50 IF LRXL
IF N-I<LRXL
SET LRZ=LRTOP
+51 IF '$TEST
SET LRZ=LRPREF_LRTOP
+52 DO PL(180,161,$EXTRACT(LRZ,1,16),LRFONT)
+53 ;
+54 ; Print test list
+55 DO PL(0,179,LRTXT,LRFONT)
+56 ;
+57 WRITE ETX
+58 ;
+59 QUIT
+60 ;
+61 ;
PL(LRX,LRY,LRZ,LRFONT) ; Send print command to printer.
+1 ; Call with LRX = column position (in dots).
+2 ; LRY = row position (in dots).
+3 ; LRZ = text to print.
+4 ; LRFONT = font to use.
+5 ;
+6 WRITE "^FO",+$GET(LRX),",",+$GET(LRY),$GET(LRFONT),"^FD",$GET(LRZ),"^FS"
+7 QUIT
+8 ;
+9 ;
GB(LRGBX,LRGBY,LRGBZ) ; Send print command to printer for graphic box.
+1 ; Call with LRGBX = column position (in dots).
+2 ; LRGBY = row position (in dots).
+3 ; LRGBZ = graphic box to print.
+4 ;
+5 WRITE "^FO",+$GET(LRGBX),",",+$GET(LRGBY),"^GB",$GET(LRGBZ),"^FS"
+6 QUIT
+7 ;
+8 ;
LH ; Set Label Home ("LH") parameters.
+1 ;
+2 SET STX=$CHAR(2)
SET ETX=$CHAR(3)
+3 ;
+4 ; Set Print Orientation ("PO") to Inverted and Label Home ("LH") parameters.
+5 WRITE STX,"^POI^LH450,0",ETX
+6 ;
FONT ; Default font
+1 SET LRFONT="^ADN"
+2 QUIT
