source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRBARA.m@ 1742

Last change on this file since 1742 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1LRBARA ;DALOI/JMC - INTERMEC 3000/4000 SERIES 1x2 LABEL FORMAT ;8/29/94 12:36
2 ;;5.2;LAB SERVICE;**161,218**;Sep 27, 1994
3 ;
4 ; This routine will program the Intermec 3000/4000 for 1X2 label formats
5 ; which can be used with LRLABELA routine to print either one normal
6 ; label or one with the accesion # barcoded if the BARCODE LABEL field
7 ; in file 68 (Accession area) is set to YES. If this field is set to a
8 ; specific symbology then a third format is utilized which will bar
9 ; code either the accession or UID.
10 ;
11 Q
12 ; Called by LRBARCF
13 ;
14FMT ;
15 U IO
16 D INIT^LRBARA
17 I LRFMT=3 D NOBAR
18 I LRFMT=4 D BAR
19 I LRFMT=5 D BAR1
20 D TERM^LRBARA
21 Q
22 ;
23NOBAR ;programs format for plain label /no barcoded accession # (old style).
24 ;
25 ; Test
26 W STX,"F",LRFMT,";H0;o150,390;f1;c2;h2;w1;d0,32;",ETX
27 ;
28 ; Order#
29 W STX,"F",LRFMT,";H1;o133,390;f1;c2;h1;w1;d0,14;",ETX
30 ;
31 ; Location
32 W STX,"F",LRFMT,";H2;o133,200;f1;c2;h1;w1;d0,12",ETX
33 ;
34 ; Patient identifier - SSN
35 W STX,"F",LRFMT,";H3;o105,350;f1;c2;h1;w1;d0,11;",ETX
36 ;
37 ; Patient name
38 W STX,"F",LRFMT,";H4;o75,350;f1;c2;h2;w1;d0,21;",ETX
39 ;
40 ; Collection sample - tube top/specimen
41 W STX,"F",LRFMT,";H5;o50,390;f1;c2;h1;w1;d0,14;",ETX
42 ;
43 ; Date
44 W STX,"F",LRFMT,";H6;o33,390;f1;c2;h1;w1;d0,14;",ETX
45 ;
46 ; Accession
47 W STX,"F",LRFMT,";H7;o0,390;f1;c2;h2;w1;d0,21;",ETX
48 ;
49 ; Urgency
50 W STX,"F",LRFMT,";H8;o30,155;f1;c0;h3;w3;b1;d0,4;",ETX
51 ;
52 Q
53 ;
54 ;
55BAR ; Programs format 1x2 label with the accession # barcoded (old style).
56 ;
57 ; Tests
58 W STX,"F",LRFMT,";H0;o150,310;f1;c2;h2;w1;d0,25;",ETX
59 ;
60 ; Collection sample - tube top/specimen
61 W STX,"F",LRFMT,";H1;o133,310;f1;c2;h1;w1;d0,14;",ETX
62 ;
63 ; Order#
64 W STX,"F",LRFMT,";H2;o116,310;f1;c2;h1;w1;d0,14;",ETX
65 ;
66 ; Accession
67 W STX,"F",LRFMT,";H3;o160,390;f2;c2;h2;w1;d0,14;",ETX
68 ;
69 ; Date
70 W STX,"F",LRFMT,";H4;o175,350;f2;c2;h1;w1;d0,14;",ETX
71 ;
72 ; SSN
73 W STX,"F",LRFMT,";H5;o30,310;f1;c2;h1;w1;d0,11;",ETX
74 ;
75 ; Location
76 W STX,"F",LRFMT,";H6;o30,150;f1;c2;h1;w1;d0,9;",ETX
77 ;
78 ; Patient name
79 W STX,"F",LRFMT,";H7;o0,310;f1;c2;h2;w1;d0,21;",ETX
80 ;
81 ; Urgency
82 W STX,"F",LRFMT,";H8;o115,140;f1;c0;h3;w3;b1;d0,4;",ETX
83 ;
84 ; Bar code
85 W STX,"F",LRFMT,";B9;o50,300;f1;c0,1;h60;w2;d0,5;",ETX
86 ;
87 Q
88 ;
89BAR1 ; Programs format for 1X2 label using multiple barcode symbologies.
90 ;
91 ; Patient name
92 W STX,"F",LRFMT,";H0;o0,380;f1;c2;h2;w1;d0,19;",ETX
93 ;
94 ; SSN
95 W STX,"F",LRFMT,";H1;o31,380;f1;c2;h1;w1;d0,12;",ETX
96 ;
97 ; Location
98 W STX,"F",LRFMT,";H2;o31,230;f1;c2;h1;w1;d0,15;",ETX
99 ;
100 ; Human-readable ID
101 W STX,"F",LRFMT,";H3;o114,380;f1;c2;h1;w1;d0,15;",ETX
102 ;
103 ; Patient Info (Infection Warning)
104 W STX,"F",LRFMT,";H4;o114,240;f1;c2;h1;w1;b1;d0,20;",ETX
105 ;
106 ; Date
107 W STX,"F",LRFMT,";H5;o134,380;f1;c2;h1;w1;d0,8;",ETX
108 ;
109 ; Accession
110 W STX,"F",LRFMT,";H6;o134,270;f1;c2;h1;w1;d0,20;",ETX
111 ;
112 ; Order #
113 W STX,"F",LRFMT,";H7;o151,380;f1;c2;h1;w1;d0,14;",ETX
114 ;
115 ; Collection sample - tube top/specimen
116 W STX,"F",LRFMT,";H8;o151,200;f1;c2;h1;w1;d0,15;",ETX
117 ;
118 ; Tests
119 W STX,"F",LRFMT,";H9;o168,380;f1;c2;h1;w1;d0,35;",ETX
120 ;
121 ; Urgency - black letters on white background
122 W STX,"F",LRFMT,";H10;o0,135;f1;c0;h3;w3;b0;d0,5;",ETX
123 ;
124 ; Urgency - white letters on black background
125 W STX,"F",LRFMT,";H11;o0,135;f1;c0;h3;w3;b1;d0,5;",ETX
126 ;
127 ; Code 39 bar code
128 W STX,"F",LRFMT,";B12;o50,355;f1;c0,3;h60;i0;r2;w2;d0,10;",ETX
129 ;
130 ; Code 39 with check digit bar code
131 W STX,"F",LRFMT,";B13;o50,360;f1;c0,4;h60;i0;r2;w2;d0,10;",ETX
132 ;
133 ; Code 128 bar code
134 W STX,"F",LRFMT,";B14;o50,360;f1;c6,0,0;h60;i0;r2;w2;d0,15;",ETX
135 ;
136 Q
137 ;
138INIT ; Put printer into programming mode.
139 ; Called by above, LRBARB, LRBARC
140 ;
141 N X
142 S X=0 X ^%ZOSF("RM")
143 ;
144 S STX=$C(2),ETX=$C(3)
145 ;
146 ; Put printer in advanced mode.
147 W STX,$C(27),"C",ETX
148 ;
149 ; Set into program mode.
150 W STX,$C(27),"P",ETX
151 ;
152 ; Erase stored format.
153 W STX,"E",LRFMT,";F",LRFMT,";",ETX
154 ;
155 Q
156 ;
157TERM ; Terminate programming function, return to print mode.
158 ; Called by above, LRBARB, LRBARC
159 ;
160 W STX,"R",ETX
161 ;
162 K ETX,STX
163 ;
164 Q
165 ;
166 ;
167CLRFMT ; Clear all existing label formats programmmed in Intermec 4100 printer.
168 ; Called by LRBARCF
169 ;
170 N I
171 ;
172 U IO
173 ;
174 D INIT
175 ;
176 F I=1:1:19 D
177 . I '$D(ZTQUEUED) U IO(0) D EN^DDIOL("Erasing format F"_I,"","!")
178 . U IO
179 . W STX,"E",I,";",ETX ; Erase stored format.
180 . H .5
181 ;
182 D TERM
183 ;
184 Q
Note: See TracBrowser for help on using the repository browser.