LRBARA ;DALOI/JMC - INTERMEC 3000/4000 SERIES 1x2 LABEL FORMAT ;8/29/94 12:36
;;5.2;LAB SERVICE;**161,218**;Sep 27, 1994
;
; This routine will program the Intermec 3000/4000 for 1X2 label formats
; which can be used with LRLABELA routine to print either one normal
; label or one with the accesion # barcoded if the BARCODE LABEL field
; in file 68 (Accession area) is set to YES. If this field is set to a
; specific symbology then a third format is utilized which will bar
; code either the accession or UID.
;
Q
; Called by LRBARCF
;
FMT ;
U IO
D INIT^LRBARA
I LRFMT=3 D NOBAR
I LRFMT=4 D BAR
I LRFMT=5 D BAR1
D TERM^LRBARA
Q
;
NOBAR ;programs format for plain label /no barcoded accession # (old style).
;
; Test
W STX,"F",LRFMT,";H0;o150,390;f1;c2;h2;w1;d0,32;",ETX
;
; Order#
W STX,"F",LRFMT,";H1;o133,390;f1;c2;h1;w1;d0,14;",ETX
;
; Location
W STX,"F",LRFMT,";H2;o133,200;f1;c2;h1;w1;d0,12",ETX
;
; Patient identifier - SSN
W STX,"F",LRFMT,";H3;o105,350;f1;c2;h1;w1;d0,11;",ETX
;
; Patient name
W STX,"F",LRFMT,";H4;o75,350;f1;c2;h2;w1;d0,21;",ETX
;
; Collection sample - tube top/specimen
W STX,"F",LRFMT,";H5;o50,390;f1;c2;h1;w1;d0,14;",ETX
;
; Date
W STX,"F",LRFMT,";H6;o33,390;f1;c2;h1;w1;d0,14;",ETX
;
; Accession
W STX,"F",LRFMT,";H7;o0,390;f1;c2;h2;w1;d0,21;",ETX
;
; Urgency
W STX,"F",LRFMT,";H8;o30,155;f1;c0;h3;w3;b1;d0,4;",ETX
;
Q
;
;
BAR ; Programs format 1x2 label with the accession # barcoded (old style).
;
; Tests
W STX,"F",LRFMT,";H0;o150,310;f1;c2;h2;w1;d0,25;",ETX
;
; Collection sample - tube top/specimen
W STX,"F",LRFMT,";H1;o133,310;f1;c2;h1;w1;d0,14;",ETX
;
; Order#
W STX,"F",LRFMT,";H2;o116,310;f1;c2;h1;w1;d0,14;",ETX
;
; Accession
W STX,"F",LRFMT,";H3;o160,390;f2;c2;h2;w1;d0,14;",ETX
;
; Date
W STX,"F",LRFMT,";H4;o175,350;f2;c2;h1;w1;d0,14;",ETX
;
; SSN
W STX,"F",LRFMT,";H5;o30,310;f1;c2;h1;w1;d0,11;",ETX
;
; Location
W STX,"F",LRFMT,";H6;o30,150;f1;c2;h1;w1;d0,9;",ETX
;
; Patient name
W STX,"F",LRFMT,";H7;o0,310;f1;c2;h2;w1;d0,21;",ETX
;
; Urgency
W STX,"F",LRFMT,";H8;o115,140;f1;c0;h3;w3;b1;d0,4;",ETX
;
; Bar code
W STX,"F",LRFMT,";B9;o50,300;f1;c0,1;h60;w2;d0,5;",ETX
;
Q
;
BAR1 ; Programs format for 1X2 label using multiple barcode symbologies.
;
; Patient name
W STX,"F",LRFMT,";H0;o0,380;f1;c2;h2;w1;d0,19;",ETX
;
; SSN
W STX,"F",LRFMT,";H1;o31,380;f1;c2;h1;w1;d0,12;",ETX
;
; Location
W STX,"F",LRFMT,";H2;o31,230;f1;c2;h1;w1;d0,15;",ETX
;
; Human-readable ID
W STX,"F",LRFMT,";H3;o114,380;f1;c2;h1;w1;d0,15;",ETX
;
; Patient Info (Infection Warning)
W STX,"F",LRFMT,";H4;o114,240;f1;c2;h1;w1;b1;d0,20;",ETX
;
; Date
W STX,"F",LRFMT,";H5;o134,380;f1;c2;h1;w1;d0,8;",ETX
;
; Accession
W STX,"F",LRFMT,";H6;o134,270;f1;c2;h1;w1;d0,20;",ETX
;
; Order #
W STX,"F",LRFMT,";H7;o151,380;f1;c2;h1;w1;d0,14;",ETX
;
; Collection sample - tube top/specimen
W STX,"F",LRFMT,";H8;o151,200;f1;c2;h1;w1;d0,15;",ETX
;
; Tests
W STX,"F",LRFMT,";H9;o168,380;f1;c2;h1;w1;d0,35;",ETX
;
; Urgency - black letters on white background
W STX,"F",LRFMT,";H10;o0,135;f1;c0;h3;w3;b0;d0,5;",ETX
;
; Urgency - white letters on black background
W STX,"F",LRFMT,";H11;o0,135;f1;c0;h3;w3;b1;d0,5;",ETX
;
; Code 39 bar code
W STX,"F",LRFMT,";B12;o50,355;f1;c0,3;h60;i0;r2;w2;d0,10;",ETX
;
; Code 39 with check digit bar code
W STX,"F",LRFMT,";B13;o50,360;f1;c0,4;h60;i0;r2;w2;d0,10;",ETX
;
; Code 128 bar code
W STX,"F",LRFMT,";B14;o50,360;f1;c6,0,0;h60;i0;r2;w2;d0,15;",ETX
;
Q
;
INIT ; Put printer into programming mode.
; Called by above, LRBARB, LRBARC
;
N X
S X=0 X ^%ZOSF("RM")
;
S STX=$C(2),ETX=$C(3)
;
; Put printer in advanced mode.
W STX,$C(27),"C",ETX
;
; Set into program mode.
W STX,$C(27),"P",ETX
;
; Erase stored format.
W STX,"E",LRFMT,";F",LRFMT,";",ETX
;
Q
;
TERM ; Terminate programming function, return to print mode.
; Called by above, LRBARB, LRBARC
;
W STX,"R",ETX
;
K ETX,STX
;
Q
;
;
CLRFMT ; Clear all existing label formats programmmed in Intermec 4100 printer.
; Called by LRBARCF
;
N I
;
U IO
;
D INIT
;
F I=1:1:19 D
. I '$D(ZTQUEUED) U IO(0) D EN^DDIOL("Erasing format F"_I,"","!")
. U IO
. W STX,"E",I,";",ETX ; Erase stored format.
. H .5
;
D TERM
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBARA 4463 printed Sep 23, 2025@19:45:30 Page 2
LRBARA ;DALOI/JMC - INTERMEC 3000/4000 SERIES 1x2 LABEL FORMAT ;8/29/94 12:36
+1 ;;5.2;LAB SERVICE;**161,218**;Sep 27, 1994
+2 ;
+3 ; This routine will program the Intermec 3000/4000 for 1X2 label formats
+4 ; which can be used with LRLABELA routine to print either one normal
+5 ; label or one with the accesion # barcoded if the BARCODE LABEL field
+6 ; in file 68 (Accession area) is set to YES. If this field is set to a
+7 ; specific symbology then a third format is utilized which will bar
+8 ; code either the accession or UID.
+9 ;
+10 QUIT
+11 ; Called by LRBARCF
+12 ;
FMT ;
+1 USE IO
+2 DO INIT^LRBARA
+3 IF LRFMT=3
DO NOBAR
+4 IF LRFMT=4
DO BAR
+5 IF LRFMT=5
DO BAR1
+6 DO TERM^LRBARA
+7 QUIT
+8 ;
NOBAR ;programs format for plain label /no barcoded accession # (old style).
+1 ;
+2 ; Test
+3 WRITE STX,"F",LRFMT,";H0;o150,390;f1;c2;h2;w1;d0,32;",ETX
+4 ;
+5 ; Order#
+6 WRITE STX,"F",LRFMT,";H1;o133,390;f1;c2;h1;w1;d0,14;",ETX
+7 ;
+8 ; Location
+9 WRITE STX,"F",LRFMT,";H2;o133,200;f1;c2;h1;w1;d0,12",ETX
+10 ;
+11 ; Patient identifier - SSN
+12 WRITE STX,"F",LRFMT,";H3;o105,350;f1;c2;h1;w1;d0,11;",ETX
+13 ;
+14 ; Patient name
+15 WRITE STX,"F",LRFMT,";H4;o75,350;f1;c2;h2;w1;d0,21;",ETX
+16 ;
+17 ; Collection sample - tube top/specimen
+18 WRITE STX,"F",LRFMT,";H5;o50,390;f1;c2;h1;w1;d0,14;",ETX
+19 ;
+20 ; Date
+21 WRITE STX,"F",LRFMT,";H6;o33,390;f1;c2;h1;w1;d0,14;",ETX
+22 ;
+23 ; Accession
+24 WRITE STX,"F",LRFMT,";H7;o0,390;f1;c2;h2;w1;d0,21;",ETX
+25 ;
+26 ; Urgency
+27 WRITE STX,"F",LRFMT,";H8;o30,155;f1;c0;h3;w3;b1;d0,4;",ETX
+28 ;
+29 QUIT
+30 ;
+31 ;
BAR ; Programs format 1x2 label with the accession # barcoded (old style).
+1 ;
+2 ; Tests
+3 WRITE STX,"F",LRFMT,";H0;o150,310;f1;c2;h2;w1;d0,25;",ETX
+4 ;
+5 ; Collection sample - tube top/specimen
+6 WRITE STX,"F",LRFMT,";H1;o133,310;f1;c2;h1;w1;d0,14;",ETX
+7 ;
+8 ; Order#
+9 WRITE STX,"F",LRFMT,";H2;o116,310;f1;c2;h1;w1;d0,14;",ETX
+10 ;
+11 ; Accession
+12 WRITE STX,"F",LRFMT,";H3;o160,390;f2;c2;h2;w1;d0,14;",ETX
+13 ;
+14 ; Date
+15 WRITE STX,"F",LRFMT,";H4;o175,350;f2;c2;h1;w1;d0,14;",ETX
+16 ;
+17 ; SSN
+18 WRITE STX,"F",LRFMT,";H5;o30,310;f1;c2;h1;w1;d0,11;",ETX
+19 ;
+20 ; Location
+21 WRITE STX,"F",LRFMT,";H6;o30,150;f1;c2;h1;w1;d0,9;",ETX
+22 ;
+23 ; Patient name
+24 WRITE STX,"F",LRFMT,";H7;o0,310;f1;c2;h2;w1;d0,21;",ETX
+25 ;
+26 ; Urgency
+27 WRITE STX,"F",LRFMT,";H8;o115,140;f1;c0;h3;w3;b1;d0,4;",ETX
+28 ;
+29 ; Bar code
+30 WRITE STX,"F",LRFMT,";B9;o50,300;f1;c0,1;h60;w2;d0,5;",ETX
+31 ;
+32 QUIT
+33 ;
BAR1 ; Programs format for 1X2 label using multiple barcode symbologies.
+1 ;
+2 ; Patient name
+3 WRITE STX,"F",LRFMT,";H0;o0,380;f1;c2;h2;w1;d0,19;",ETX
+4 ;
+5 ; SSN
+6 WRITE STX,"F",LRFMT,";H1;o31,380;f1;c2;h1;w1;d0,12;",ETX
+7 ;
+8 ; Location
+9 WRITE STX,"F",LRFMT,";H2;o31,230;f1;c2;h1;w1;d0,15;",ETX
+10 ;
+11 ; Human-readable ID
+12 WRITE STX,"F",LRFMT,";H3;o114,380;f1;c2;h1;w1;d0,15;",ETX
+13 ;
+14 ; Patient Info (Infection Warning)
+15 WRITE STX,"F",LRFMT,";H4;o114,240;f1;c2;h1;w1;b1;d0,20;",ETX
+16 ;
+17 ; Date
+18 WRITE STX,"F",LRFMT,";H5;o134,380;f1;c2;h1;w1;d0,8;",ETX
+19 ;
+20 ; Accession
+21 WRITE STX,"F",LRFMT,";H6;o134,270;f1;c2;h1;w1;d0,20;",ETX
+22 ;
+23 ; Order #
+24 WRITE STX,"F",LRFMT,";H7;o151,380;f1;c2;h1;w1;d0,14;",ETX
+25 ;
+26 ; Collection sample - tube top/specimen
+27 WRITE STX,"F",LRFMT,";H8;o151,200;f1;c2;h1;w1;d0,15;",ETX
+28 ;
+29 ; Tests
+30 WRITE STX,"F",LRFMT,";H9;o168,380;f1;c2;h1;w1;d0,35;",ETX
+31 ;
+32 ; Urgency - black letters on white background
+33 WRITE STX,"F",LRFMT,";H10;o0,135;f1;c0;h3;w3;b0;d0,5;",ETX
+34 ;
+35 ; Urgency - white letters on black background
+36 WRITE STX,"F",LRFMT,";H11;o0,135;f1;c0;h3;w3;b1;d0,5;",ETX
+37 ;
+38 ; Code 39 bar code
+39 WRITE STX,"F",LRFMT,";B12;o50,355;f1;c0,3;h60;i0;r2;w2;d0,10;",ETX
+40 ;
+41 ; Code 39 with check digit bar code
+42 WRITE STX,"F",LRFMT,";B13;o50,360;f1;c0,4;h60;i0;r2;w2;d0,10;",ETX
+43 ;
+44 ; Code 128 bar code
+45 WRITE STX,"F",LRFMT,";B14;o50,360;f1;c6,0,0;h60;i0;r2;w2;d0,15;",ETX
+46 ;
+47 QUIT
+48 ;
INIT ; Put printer into programming mode.
+1 ; Called by above, LRBARB, LRBARC
+2 ;
+3 NEW X
+4 SET X=0
XECUTE ^%ZOSF("RM")
+5 ;
+6 SET STX=$CHAR(2)
SET ETX=$CHAR(3)
+7 ;
+8 ; Put printer in advanced mode.
+9 WRITE STX,$CHAR(27),"C",ETX
+10 ;
+11 ; Set into program mode.
+12 WRITE STX,$CHAR(27),"P",ETX
+13 ;
+14 ; Erase stored format.
+15 WRITE STX,"E",LRFMT,";F",LRFMT,";",ETX
+16 ;
+17 QUIT
+18 ;
TERM ; Terminate programming function, return to print mode.
+1 ; Called by above, LRBARB, LRBARC
+2 ;
+3 WRITE STX,"R",ETX
+4 ;
+5 KILL ETX,STX
+6 ;
+7 QUIT
+8 ;
+9 ;
CLRFMT ; Clear all existing label formats programmmed in Intermec 4100 printer.
+1 ; Called by LRBARCF
+2 ;
+3 NEW I
+4 ;
+5 USE IO
+6 ;
+7 DO INIT
+8 ;
+9 FOR I=1:1:19
Begin DoDot:1
+10 IF '$DATA(ZTQUEUED)
USE IO(0)
DO EN^DDIOL("Erasing format F"_I,"","!")
+11 USE IO
+12 ; Erase stored format.
WRITE STX,"E",I,";",ETX
+13 HANG .5
End DoDot:1
+14 ;
+15 DO TERM
+16 ;
+17 QUIT
