- 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 Feb 18, 2025@23:41:53 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