source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRLABELD.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1LRLABELD ;DALOI/JMC - ZEBRA STRIPE 1X2 label printer ; 6/4/98
2 ;;5.2;LAB SERVICE;**218**;Sep 27, 1994
3 ;
4EN ; Print 1x2 label formats
5 ;
6 N ETX,LRFONT,LRFMT,LRTXT,LRX,LRZ,STX
7 ;
8 S LRRB=$G(LRRB)
9 ;
10 ; Set specific symbology.
11 S LRFMT=+$G(LRBAR(+$G(LRAA)))
12 ;
13 ; Set up list of tests
14 S LRTXT=$$LRTXT^LRLABLD(.LRTS,30)
15 ;
16 D LH
17 ;
18 I 'LRFMT D NOBAR Q
19 I LRFMT=1 D BAR1 Q
20 I LRFMT>1 D BAR2
21 Q
22 ;
23NOBAR ; Print Lab 25mm X 50mm (1 X 2) labels.
24 ; Plain label, no barcode identifier.
25 ; Label length = 200 dots (8 dots/mm printhead).
26 ;
27 W STX
28 S LRFONT="^ADN,36,10"
29 ;
30 ; Print accession.
31 D PL(0,5,LRACC,LRFONT)
32 D FONT
33 ;
34 ; Print accession date.
35 D PL(0,40,LRDAT,LRFONT)
36 ;
37 ; Print collection sample.
38 I LRXL,N-I<LRXL S LRZ=LRTOP
39 E S LRZ=LRPREF_LRTOP
40 D PL(0,60,$E(LRZ,1,17),LRFONT)
41 ;
42 ; Accession urgency
43 I $P(LRURGA,"^",2) D
44 . S LRFONT="^ADN,36,10"
45 . I $P(LRURGA,"^",2)=2 D
46 . . ; Set up graphic box.
47 . . D GB(285,40,15+($L($P(LRURGA,"^"))*12)_",35,35")
48 . . S LRFONT=LRFONT_"^FR" ; Field reverse.
49 . D PL(295,45,$P(LRURGA,"^"),LRFONT)
50 . D FONT
51 ;
52 ; Patient name
53 S LRFONT="^ADN,36,10"
54 D PL(40,80,$E(PNM,1,21),LRFONT),FONT
55 ;
56 ; Print patient identifier.
57 D PL(40,115,SSN,LRFONT)
58 ;
59 ; Print order number.
60 D PL(0,143,"Order #"_LRCE,LRFONT)
61 ;
62 ; Patient location/room-bed number
63 D PL(200,143,"W:"_LRLLOC_$S($L(LRRB):" B:"_LRRB,1:""),LRFONT)
64 ;
65 ; Print test list
66 S LRFONT="^ADN,36,10"
67 D PL(0,161,LRTXT,LRFONT)
68 D FONT
69 ;
70 W ETX
71 Q
72 ;
73BAR1 ; Print Lab 25mm X 50mm (1 X 2) labels.
74 ; Barcode identifier - use Code 39 with check-digit.
75 ; Label length = 200 dots (8 dots/mm printhead).
76 ;
77 W STX
78 S LRFONT="^ADN,36,10"
79 ;
80 ; Patient name
81 D PL(75,5,$E(PNM,1,18),LRFONT)
82 D FONT
83 ;
84 ; Accession urgency
85 I $P(LRURGA,"^",2) D
86 . S LRFONT="^ADN,36,10"
87 . ; Set up graphic box.
88 . I $P(LRURGA,"^",2)=2 D
89 . . D GB(295,0,15+($L($P(LRURGA,"^"))*12)_",35,35")
90 . . S LRFONT=LRFONT_"^FR" ; Field reverse.
91 . D PL(305,5,$P(LRURGA,"^"),LRFONT)
92 . D FONT
93 ;
94 ; Print patient identifier.
95 D PL(75,40,SSN,LRFONT)
96 ;
97 ; Patient location/room-bed number
98 D PL(230,40,$S($L(LRRB):"B:"_LRRB,1:"W:"_LRLLOC),LRFONT)
99 ;
100 ; Print barcode.
101 S LRX=$S($L(LRBARID)<7:75,$L(LRBARID)>10:80,1:85)
102 S LRFONT="^BY2,"_$S($L(LRBARID)<7:3,1:2)_",60^"
103 S LRFONT=LRFONT_"B3N,Y,,N,N"
104 D PL(LRX,60,LRBARID,LRFONT)
105 ;
106 ; Print order number.
107 D FONT
108 D PL(75,125,"Order #"_LRCE,LRFONT)
109 ;
110 ; Print collection sample.
111 I LRXL,N-I<LRXL S LRZ=LRTOP
112 E S LRZ=LRPREF_LRTOP
113 D PL(75,143,$E(LRZ,1,16),LRFONT)
114 ;
115 ; Print test list
116 S LRFONT="^ADN,36,10"
117 D PL(75,161,LRTXT,LRFONT)
118 ;
119 ; Print accession.
120 D FONT S LRFONT="^ADN,36,10^FWB"
121 D PL(0,0,$$CJ^XLFSTR(LRACC,16),LRFONT)
122 ;
123 ; Print accession date.
124 D FONT S LRFONT=LRFONT_"^FWB"
125 D PL(40,0,$$CJ^XLFSTR(LRDAT,16),LRFONT)
126 ;
127 W ETX
128 Q
129 ;
130BAR2 ; Print Lab 25mm X 50mm (1 X 2) labels.
131 ; Barcode identifier using specified symbology for accession area.
132 ; Label length = 200 dots (8 dots/mm printhead).
133 ;
134 W STX
135 S LRFONT="^ADN,36,10"
136 ;
137 ; Patient name
138 D PL(0,5,$E(PNM,1,22),LRFONT),FONT
139 ;
140 ; Accession urgency
141 I $P(LRURGA,"^",2) D
142 . S LRFONT="^ADN,36,10"
143 . ; Set up graphic box.
144 . I $P(LRURGA,"^",2)=2 D
145 . . D GB(275,0,15+($L($P(LRURGA,"^"))*12)_",35,35")
146 . . S LRFONT=LRFONT_"^FR" ; Field reverse.
147 . D PL(285,5,$P(LRURGA,"^"),LRFONT),FONT
148 ;
149 ; Print patient identifier.
150 D PL(0,40,SSN,LRFONT)
151 ;
152 ; Patient location/room-bed number
153 D PL(150,40,"W:"_LRLLOC_$S($L(LRRB):"/"_LRRB,1:""),LRFONT)
154 ;
155 ; Print barcode.
156 S LRX=$S($L(LRBARID)<7:75,LRFMT=4:35,1:20)
157 S LRFONT="^BY"_$S($L(LRBARID)>10:1,1:2)_","_$S($L(LRBARID)<7:3,1:2)_",60^"
158 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")
159 D PL(LRX,60,LRBARID,LRFONT),FONT
160 ;
161 ; Print human-readable ID.
162 D PL(0,125,LRBARID,LRFONT)
163 ;
164 ; Print infection warning if present.
165 I $L(LRINFW) D
166 . D GB(135,123,10+($L(LRINFW)*12)_",16,16") ; make box
167 . S LRFONT=LRFONT_"^FR"
168 . D PL(140,124,LRINFW,LRFONT)
169 ;
170 ; Print accession date.
171 D PL(0,143,$P(LRDAT," "),LRFONT)
172 ;
173 ; Print accession.
174 D PL(120,143,LRACC,LRFONT)
175 ;
176 ; Print order number.
177 D PL(0,161,"Order #"_LRCE,LRFONT)
178 ;
179 ; Print collection sample.
180 I LRXL,N-I<LRXL S LRZ=LRTOP
181 E S LRZ=LRPREF_LRTOP
182 D PL(180,161,$E(LRZ,1,16),LRFONT)
183 ;
184 ; Print test list
185 D PL(0,179,LRTXT,LRFONT)
186 ;
187 W ETX
188 ;
189 Q
190 ;
191 ;
192PL(LRX,LRY,LRZ,LRFONT) ; Send print command to printer.
193 ; Call with LRX = column position (in dots).
194 ; LRY = row position (in dots).
195 ; LRZ = text to print.
196 ; LRFONT = font to use.
197 ;
198 W "^FO",+$G(LRX),",",+$G(LRY),$G(LRFONT),"^FD",$G(LRZ),"^FS"
199 Q
200 ;
201 ;
202GB(LRGBX,LRGBY,LRGBZ) ; Send print command to printer for graphic box.
203 ; Call with LRGBX = column position (in dots).
204 ; LRGBY = row position (in dots).
205 ; LRGBZ = graphic box to print.
206 ;
207 W "^FO",+$G(LRGBX),",",+$G(LRGBY),"^GB",$G(LRGBZ),"^FS"
208 Q
209 ;
210 ;
211LH ; Set Label Home ("LH") parameters.
212 ;
213 S STX=$C(2),ETX=$C(3)
214 ;
215 ; Set Print Orientation ("PO") to Inverted and Label Home ("LH") parameters.
216 W STX,"^POI^LH450,0",ETX
217 ;
218FONT ; Default font
219 S LRFONT="^ADN"
220 Q
Note: See TracBrowser for help on using the repository browser.