LRLABELE ;DALOI/JMC - Zebra Stripe 2.5x4 10 part label; 6/4/98
;;5.2;LAB SERVICE;**218**;Sep 27, 1994
;
EN ; Print 2.5x4 10 part label format
;
N J,LRDTXT,LRFONT,LRFMT,LRLPNM,LRTXT,LRTUBE,LRX,LRZ,ETX,STX
;
S LRLPNM=$E(PNM,1,14),LRRB=$G(LRRB)
;
; Determine collection sample text
I LRXL,N-I<LRXL S LRTUBE=LRTOP
E S LRTUBE=LRPREF_LRTOP
;
D LH
;
; Set specific symbology.
S LRFMT=+$G(LRBAR(+$G(LRAA)))
;
; Setup test list
S LRTXT=$$LRTXT^LRLABLD(.LRTS,$S(LRFMT<2:25,1:32))
I LRTXT[";" S LRDTXT=".............."
E S LRDTXT=LRTXT
;
I LRFMT<2 D BAR1 Q
I LRFMT>1 D BAR2
;
Q
;
BAR1 ; Print 2.5x4 10 part labels.
; Barcode identifier - use Code 39 with check-digit.
; Label length = 812 dots (8 dots/mm printhead).
;
W STX
S LRFONT="^ADN,36,10^FWR"
;
; Patient name
D PL^LRLABELD(433,90,$E(PNM,1,21),LRFONT)
D FONT S LRFONT=LRFONT_"^FWR"
;
; Print patient identifier.
D PL^LRLABELD(418,90,SSN,LRFONT)
;
; Patient location/room-bed number
D PL^LRLABELD(418,260,$S($L(LRRB):"B:"_LRRB,1:"W:"_LRLLOC),LRFONT)
;
; Print barcode.
S LRFONT="^BY2,2"
I $L(LRBARID)<7 S LRFONT="^BY3,2,"
S LRFONT=LRFONT_",60^B3N,Y,,N,N^FWR"
D PL^LRLABELD(355,95,LRBARID,LRFONT)
;
; Print order number.
D FONT S LRFONT=LRFONT_"^FWR"
D PL^LRLABELD(330,90,"Order #"_LRCE,LRFONT)
;
; Print collection sample.
D PL^LRLABELD(315,90,$E(LRTUBE,1,$S($G(LRURG0)=1:18,1:24)),LRFONT)
;
; Accession urgency
I $G(LRURG0)=1 D
. ; Set up graphic box.
. D GB^LRLABELD(320,317,"35,63,35")
. S LRFONT="^ADN,36,10^FWR^FR"
. ; Print urgency
. D PL^LRLABELD(315,322,"STAT",LRFONT)
;
; Print test list
S LRFONT="^ADN,36,10^FWR"
D PL^LRLABELD(280,90,LRTXT,LRFONT)
;
; Print accession.
S LRFONT="^ADN,36,10"
D PL^LRLABELD(280,0,$$CJ^XLFSTR(LRACC,16),LRFONT),FONT
;
; Print accession date.
D PL^LRLABELD(280,40,$$CJ^XLFSTR(LRDAT,16),LRFONT)
;
; Print accession - 2nd 1x2.
S LRFONT="^ADN,36,10^FWR"
D PL^LRLABELD(433,406,LRACC,LRFONT)
;
; Print accession date - 2nd 1x2..
D FONT S LRFONT=LRFONT_"^FWR"
D PL^LRLABELD(418,406,LRDAT,LRFONT)
;
; Print collection sample - 2nd 1x2.
D PL^LRLABELD(400,406,$E(LRTUBE,1,$S($G(LRURG0)=1:21,1:30)),LRFONT)
;
; Accession urgency - 2nd 1x2.
I $G(LRURG0)=1 D
. ; Set up graphic box.
. D GB^LRLABELD(410,666,"35,63,35")
. S LRFONT="^ADN,36,10^FWR^FR"
. ; Print urgency
. D PL^LRLABELD(405,671,"STAT",LRFONT),FONT
;
; Patient name - 2nd 1x2.
S LRFONT="^ADN,36,10^FWR"
D PL^LRLABELD(360,444,$E(PNM,1,21),LRFONT),FONT
;
; Print patient identifier - 2nd 1x2.
S LRFONT=LRFONT_"^FWR"
D PL^LRLABELD(345,444,SSN,LRFONT)
;
; Print order number - 2nd 1x2.
D PL^LRLABELD(325,406,"Order #"_LRCE,LRFONT)
;
; Print test list - 2nd 1x2, redo test list for wider area on 2nd label
S LRFONT="^ADN,36,10^FWR"
S LRTXT=$$LRTXT^LRLABLD(.LRTS,32)
I LRTXT[";" S LRDTXT=".............."
E S LRDTXT=LRTXT
D PL^LRLABELD(280,406,LRTXT,LRFONT)
;
D FONT,COMMON
W ETX
Q
;
BAR2 ; Print 2.5x4 10 part labels.
; Barcode identifier using specified symbology for accession area.
; Label length = 812 dots (8 dots/mm printhead).
;
W STX
S LRFONT="^ADN,36,10^FWR"
;
; Patient name
F LRY=0,406 D PL^LRLABELD(433,LRY,$E(PNM,1,21),LRFONT)
;
; Accession urgency
I $P(LRURGA,"^",2) D
. S LRFONT="^ADN,36,10^FWR"
. I $P(LRURGA,"^",2)=2 D
. . ; Set up graphic box.
. . F LRY=295,699 D GB^LRLABELD(437,LRY,"35,"_(15+($L($P(LRURGA,"^"))*12))_",35")
. . ; Field reverse.
. . S LRFONT=LRFONT_"^FR"
. ; Print urgency
. F LRY=300,704 D PL^LRLABELD(433,LRY,$P(LRURGA,"^"),LRFONT)
;
; Print patient identifier.
D FONT S LRFONT=LRFONT_"^FWR"
F LRY=0,406 D PL^LRLABELD(418,LRY,SSN,LRFONT)
;
; Patient location/room-bed number
F LRY=170,576 D PL^LRLABELD(418,LRY,"W:"_LRLLOC_$S($L(LRRB):"/"_LRRB,1:""),LRFONT)
;
; Print barcode.
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",1:"BCN,,N,N")
S LRFONT=LRFONT_"^FWR"
F LRZ=10,416 D
. S LRY=LRZ+$S($L(LRBARID)<7:55,LRFMT=3:5,LRFMT=4:15,1:0)
. D PL^LRLABELD(358,LRY,LRBARID,LRFONT)
;
; Print human-readable ID.
D FONT S LRFONT=LRFONT_"^FWR"
F LRY=0,406 D PL^LRLABELD(335,LRY,LRBARID,LRFONT)
;
; Print infection warning if present.
I $L(LRINFW) D
. ; Set up graphic box.
. F LRY=140,544 D GB^LRLABELD(337,LRY,"16,"_(10+($L(LRINFW)*12))_",16,")
. D FONT S LRFONT=LRFONT_"^FWR^FR"
. ; Print infection warning.
. F LRY=145,549 D PL^LRLABELD(335,LRY,LRINFW,LRFONT)
. D FONT S LRFONT=LRFONT_"^FWR"
;
; Print accession date.
F LRY=0,406 D PL^LRLABELD(316,LRY,$P(LRDAT," "),LRFONT)
;
; Print accession.
F LRY=120,526 D PL^LRLABELD(316,LRY,LRACC,LRFONT)
;
; Print order number.
F LRY=0,406 D PL^LRLABELD(298,LRY,"Order #"_LRCE,LRFONT)
;
; Print collection sample.
F LRY=180,586 D PL^LRLABELD(298,LRY,$E(LRTUBE,1,17),LRFONT)
;
; Print test list
F LRY=0,406 D PL^LRLABELD(280,LRY,LRTXT,LRFONT)
D FONT,COMMON
;
W ETX
Q
;
COMMON ; Print lower 8 sections of label - common to both formats.
;
N LRJ
;
S LRTXT=$$LRTXT^LRLABLD(.LRTS,200)
;
F LRY=0,203,406,609 D
. ; Print accession
. S LRX=220,LRFONT="^ADN,36,10^FWR"
. D PL^LRLABELD(LRX,LRY,LRACC,LRFONT)
. ;
. ; Print collection sample
. S LRX=190 D FONT S LRFONT=LRFONT_"^FWR"
. D PL^LRLABELD(LRX,LRY,$E(LRTUBE,1,15),LRFONT)
. ;
. ; Print accession
. S LRX=130,LRFONT="^ADN,36,10^FWR"
. D PL^LRLABELD(LRX,LRY,LRACC,LRFONT)
. ;
. ; Print patient name
. S LRX=95
. D PL^LRLABELD(LRX,LRY,LRLPNM,LRFONT)
. ;
. ; Print patient identifier.
. S LRX=75 D FONT S LRFONT=LRFONT_"^FWR"
. D PL^LRLABELD(LRX,LRY,SSN,LRFONT)
. ;
. ; Print collection date/time
. S LRX=50
. D PL^LRLABELD(LRX,LRY,LRDAT,LRFONT)
. ;
. ; Print test list
. S LRX=0,LRFONT="^ADN,36,10^FWR"
. S LRJ=$S(LRY=203:2,LRY=406:3,LRY=609:4,1:1)
. S LRZ=$S($P(LRTXT,";",LRJ)'="":$E($P(LRTXT,";",LRJ),1,14),1:$E(LRDTXT,1,14))
. D PL^LRLABELD(LRX,LRY,LRZ,LRFONT)
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^LH360,13",ETX
;
FONT ;
; Default font.
S LRFONT="^ADN"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLABELE 6405 printed Apr 09, 2024@21:06:25 Page 2
LRLABELE ;DALOI/JMC - Zebra Stripe 2.5x4 10 part label; 6/4/98
+1 ;;5.2;LAB SERVICE;**218**;Sep 27, 1994
+2 ;
EN ; Print 2.5x4 10 part label format
+1 ;
+2 NEW J,LRDTXT,LRFONT,LRFMT,LRLPNM,LRTXT,LRTUBE,LRX,LRZ,ETX,STX
+3 ;
+4 SET LRLPNM=$EXTRACT(PNM,1,14)
SET LRRB=$GET(LRRB)
+5 ;
+6 ; Determine collection sample text
+7 IF LRXL
IF N-I<LRXL
SET LRTUBE=LRTOP
+8 IF '$TEST
SET LRTUBE=LRPREF_LRTOP
+9 ;
+10 DO LH
+11 ;
+12 ; Set specific symbology.
+13 SET LRFMT=+$GET(LRBAR(+$GET(LRAA)))
+14 ;
+15 ; Setup test list
+16 SET LRTXT=$$LRTXT^LRLABLD(.LRTS,$SELECT(LRFMT<2:25,1:32))
+17 IF LRTXT[";"
SET LRDTXT=".............."
+18 IF '$TEST
SET LRDTXT=LRTXT
+19 ;
+20 IF LRFMT<2
DO BAR1
QUIT
+21 IF LRFMT>1
DO BAR2
+22 ;
+23 QUIT
+24 ;
BAR1 ; Print 2.5x4 10 part labels.
+1 ; Barcode identifier - use Code 39 with check-digit.
+2 ; Label length = 812 dots (8 dots/mm printhead).
+3 ;
+4 WRITE STX
+5 SET LRFONT="^ADN,36,10^FWR"
+6 ;
+7 ; Patient name
+8 DO PL^LRLABELD(433,90,$EXTRACT(PNM,1,21),LRFONT)
+9 DO FONT
SET LRFONT=LRFONT_"^FWR"
+10 ;
+11 ; Print patient identifier.
+12 DO PL^LRLABELD(418,90,SSN,LRFONT)
+13 ;
+14 ; Patient location/room-bed number
+15 DO PL^LRLABELD(418,260,$SELECT($LENGTH(LRRB):"B:"_LRRB,1:"W:"_LRLLOC),LRFONT)
+16 ;
+17 ; Print barcode.
+18 SET LRFONT="^BY2,2"
+19 IF $LENGTH(LRBARID)<7
SET LRFONT="^BY3,2,"
+20 SET LRFONT=LRFONT_",60^B3N,Y,,N,N^FWR"
+21 DO PL^LRLABELD(355,95,LRBARID,LRFONT)
+22 ;
+23 ; Print order number.
+24 DO FONT
SET LRFONT=LRFONT_"^FWR"
+25 DO PL^LRLABELD(330,90,"Order #"_LRCE,LRFONT)
+26 ;
+27 ; Print collection sample.
+28 DO PL^LRLABELD(315,90,$EXTRACT(LRTUBE,1,$SELECT($GET(LRURG0)=1:18,1:24)),LRFONT)
+29 ;
+30 ; Accession urgency
+31 IF $GET(LRURG0)=1
Begin DoDot:1
+32 ; Set up graphic box.
+33 DO GB^LRLABELD(320,317,"35,63,35")
+34 SET LRFONT="^ADN,36,10^FWR^FR"
+35 ; Print urgency
+36 DO PL^LRLABELD(315,322,"STAT",LRFONT)
End DoDot:1
+37 ;
+38 ; Print test list
+39 SET LRFONT="^ADN,36,10^FWR"
+40 DO PL^LRLABELD(280,90,LRTXT,LRFONT)
+41 ;
+42 ; Print accession.
+43 SET LRFONT="^ADN,36,10"
+44 DO PL^LRLABELD(280,0,$$CJ^XLFSTR(LRACC,16),LRFONT)
DO FONT
+45 ;
+46 ; Print accession date.
+47 DO PL^LRLABELD(280,40,$$CJ^XLFSTR(LRDAT,16),LRFONT)
+48 ;
+49 ; Print accession - 2nd 1x2.
+50 SET LRFONT="^ADN,36,10^FWR"
+51 DO PL^LRLABELD(433,406,LRACC,LRFONT)
+52 ;
+53 ; Print accession date - 2nd 1x2..
+54 DO FONT
SET LRFONT=LRFONT_"^FWR"
+55 DO PL^LRLABELD(418,406,LRDAT,LRFONT)
+56 ;
+57 ; Print collection sample - 2nd 1x2.
+58 DO PL^LRLABELD(400,406,$EXTRACT(LRTUBE,1,$SELECT($GET(LRURG0)=1:21,1:30)),LRFONT)
+59 ;
+60 ; Accession urgency - 2nd 1x2.
+61 IF $GET(LRURG0)=1
Begin DoDot:1
+62 ; Set up graphic box.
+63 DO GB^LRLABELD(410,666,"35,63,35")
+64 SET LRFONT="^ADN,36,10^FWR^FR"
+65 ; Print urgency
+66 DO PL^LRLABELD(405,671,"STAT",LRFONT)
DO FONT
End DoDot:1
+67 ;
+68 ; Patient name - 2nd 1x2.
+69 SET LRFONT="^ADN,36,10^FWR"
+70 DO PL^LRLABELD(360,444,$EXTRACT(PNM,1,21),LRFONT)
DO FONT
+71 ;
+72 ; Print patient identifier - 2nd 1x2.
+73 SET LRFONT=LRFONT_"^FWR"
+74 DO PL^LRLABELD(345,444,SSN,LRFONT)
+75 ;
+76 ; Print order number - 2nd 1x2.
+77 DO PL^LRLABELD(325,406,"Order #"_LRCE,LRFONT)
+78 ;
+79 ; Print test list - 2nd 1x2, redo test list for wider area on 2nd label
+80 SET LRFONT="^ADN,36,10^FWR"
+81 SET LRTXT=$$LRTXT^LRLABLD(.LRTS,32)
+82 IF LRTXT[";"
SET LRDTXT=".............."
+83 IF '$TEST
SET LRDTXT=LRTXT
+84 DO PL^LRLABELD(280,406,LRTXT,LRFONT)
+85 ;
+86 DO FONT
DO COMMON
+87 WRITE ETX
+88 QUIT
+89 ;
BAR2 ; Print 2.5x4 10 part labels.
+1 ; Barcode identifier using specified symbology for accession area.
+2 ; Label length = 812 dots (8 dots/mm printhead).
+3 ;
+4 WRITE STX
+5 SET LRFONT="^ADN,36,10^FWR"
+6 ;
+7 ; Patient name
+8 FOR LRY=0,406
DO PL^LRLABELD(433,LRY,$EXTRACT(PNM,1,21),LRFONT)
+9 ;
+10 ; Accession urgency
+11 IF $PIECE(LRURGA,"^",2)
Begin DoDot:1
+12 SET LRFONT="^ADN,36,10^FWR"
+13 IF $PIECE(LRURGA,"^",2)=2
Begin DoDot:2
+14 ; Set up graphic box.
+15 FOR LRY=295,699
DO GB^LRLABELD(437,LRY,"35,"_(15+($LENGTH($PIECE(LRURGA,"^"))*12))_",35")
+16 ; Field reverse.
+17 SET LRFONT=LRFONT_"^FR"
End DoDot:2
+18 ; Print urgency
+19 FOR LRY=300,704
DO PL^LRLABELD(433,LRY,$PIECE(LRURGA,"^"),LRFONT)
End DoDot:1
+20 ;
+21 ; Print patient identifier.
+22 DO FONT
SET LRFONT=LRFONT_"^FWR"
+23 FOR LRY=0,406
DO PL^LRLABELD(418,LRY,SSN,LRFONT)
+24 ;
+25 ; Patient location/room-bed number
+26 FOR LRY=170,576
DO PL^LRLABELD(418,LRY,"W:"_LRLLOC_$SELECT($LENGTH(LRRB):"/"_LRRB,1:""),LRFONT)
+27 ;
+28 ; Print barcode.
+29 SET LRFONT="^BY"_$SELECT($LENGTH(LRBARID)>10:1,1:2)_","_$SELECT($LENGTH(LRBARID)<7:3,1:2)_",60^"
+30 SET LRFONT=LRFONT_$SELECT(LRFMT=2:"B3N,N,,N,N",LRFMT=3:"B3N,Y,,N,N",LRFMT=4:"BCN,,N,N",1:"BCN,,N,N")
+31 SET LRFONT=LRFONT_"^FWR"
+32 FOR LRZ=10,416
Begin DoDot:1
+33 SET LRY=LRZ+$SELECT($LENGTH(LRBARID)<7:55,LRFMT=3:5,LRFMT=4:15,1:0)
+34 DO PL^LRLABELD(358,LRY,LRBARID,LRFONT)
End DoDot:1
+35 ;
+36 ; Print human-readable ID.
+37 DO FONT
SET LRFONT=LRFONT_"^FWR"
+38 FOR LRY=0,406
DO PL^LRLABELD(335,LRY,LRBARID,LRFONT)
+39 ;
+40 ; Print infection warning if present.
+41 IF $LENGTH(LRINFW)
Begin DoDot:1
+42 ; Set up graphic box.
+43 FOR LRY=140,544
DO GB^LRLABELD(337,LRY,"16,"_(10+($LENGTH(LRINFW)*12))_",16,")
+44 DO FONT
SET LRFONT=LRFONT_"^FWR^FR"
+45 ; Print infection warning.
+46 FOR LRY=145,549
DO PL^LRLABELD(335,LRY,LRINFW,LRFONT)
+47 DO FONT
SET LRFONT=LRFONT_"^FWR"
End DoDot:1
+48 ;
+49 ; Print accession date.
+50 FOR LRY=0,406
DO PL^LRLABELD(316,LRY,$PIECE(LRDAT," "),LRFONT)
+51 ;
+52 ; Print accession.
+53 FOR LRY=120,526
DO PL^LRLABELD(316,LRY,LRACC,LRFONT)
+54 ;
+55 ; Print order number.
+56 FOR LRY=0,406
DO PL^LRLABELD(298,LRY,"Order #"_LRCE,LRFONT)
+57 ;
+58 ; Print collection sample.
+59 FOR LRY=180,586
DO PL^LRLABELD(298,LRY,$EXTRACT(LRTUBE,1,17),LRFONT)
+60 ;
+61 ; Print test list
+62 FOR LRY=0,406
DO PL^LRLABELD(280,LRY,LRTXT,LRFONT)
+63 DO FONT
DO COMMON
+64 ;
+65 WRITE ETX
+66 QUIT
+67 ;
COMMON ; Print lower 8 sections of label - common to both formats.
+1 ;
+2 NEW LRJ
+3 ;
+4 SET LRTXT=$$LRTXT^LRLABLD(.LRTS,200)
+5 ;
+6 FOR LRY=0,203,406,609
Begin DoDot:1
+7 ; Print accession
+8 SET LRX=220
SET LRFONT="^ADN,36,10^FWR"
+9 DO PL^LRLABELD(LRX,LRY,LRACC,LRFONT)
+10 ;
+11 ; Print collection sample
+12 SET LRX=190
DO FONT
SET LRFONT=LRFONT_"^FWR"
+13 DO PL^LRLABELD(LRX,LRY,$EXTRACT(LRTUBE,1,15),LRFONT)
+14 ;
+15 ; Print accession
+16 SET LRX=130
SET LRFONT="^ADN,36,10^FWR"
+17 DO PL^LRLABELD(LRX,LRY,LRACC,LRFONT)
+18 ;
+19 ; Print patient name
+20 SET LRX=95
+21 DO PL^LRLABELD(LRX,LRY,LRLPNM,LRFONT)
+22 ;
+23 ; Print patient identifier.
+24 SET LRX=75
DO FONT
SET LRFONT=LRFONT_"^FWR"
+25 DO PL^LRLABELD(LRX,LRY,SSN,LRFONT)
+26 ;
+27 ; Print collection date/time
+28 SET LRX=50
+29 DO PL^LRLABELD(LRX,LRY,LRDAT,LRFONT)
+30 ;
+31 ; Print test list
+32 SET LRX=0
SET LRFONT="^ADN,36,10^FWR"
+33 SET LRJ=$SELECT(LRY=203:2,LRY=406:3,LRY=609:4,1:1)
+34 SET LRZ=$SELECT($PIECE(LRTXT,";",LRJ)'="":$EXTRACT($PIECE(LRTXT,";",LRJ),1,14),1:$EXTRACT(LRDTXT,1,14))
+35 DO PL^LRLABELD(LRX,LRY,LRZ,LRFONT)
End DoDot:1
+36 QUIT
+37 ;
+38 ;
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^LH360,13",ETX
+6 ;
FONT ;
+1 ; Default font.
+2 SET LRFONT="^ADN"
+3 QUIT
