source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SBC.m@ 738

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1LA7SBC ;DALISC/JMC - HP-PCL Compatible Barcode 128 Utility ; 12/3/1997
2 ;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
3 ; Extensively borrowered from Douglas K. Martin, M.D.
4 ;
5BC128(D,O,H,XX,YY,W) ;
6 ; Inputs:
7 ; D = Data string to print in bar code
8 ; O = Orientation of bar code
9 ; 0=portrait (default)
10 ; 1=landscape
11 ; H = Height of bar code in dots (1/300 inch)
12 ; XX = Horizontal position on page in dots
13 ; YY = Vertical position on page in dots
14 ; W = Width of bar in dots (3=default)
15 ; Purpose:
16 ; Accepts a barcode 128 string and writes an HPCL-compatible
17 ; string that will display the barcode on an HP laser printer.
18 ; A barcode font cartridge is not required.
19 ; The current cursor position is stored upon entry and restored before exiting.
20 N %,LA71,LA72,LA73,LA74,LA75,C,P,X
21 S X=0 X ^%ZOSF("RM")
22 S D=$$DATA(D)
23 S C=$C(27)_"*c",P=$C(27)_"*p+"
24 S W=$G(W,3),H=$G(H,60),O='$G(O)+1
25 W $C(27),"&f0S" ;Push cursor position
26 W:$G(XX) $C(27)_"*p"_+XX_"X"
27 W:$G(YY) $C(27)_"*p"_+YY_"Y"
28 W C_H_$E("BA",O)
29 F %=1:1:$L(D) D
30 . S LA71=$P($T(@$A(D,%)),";;",2),LA74=11,LA75=0
31 . F LA72=1:1:$L(LA71) D
32 . . S LA73=+$E(LA71,LA72),LA74=LA74-LA73,LA73=LA73*W
33 . . Q:'LA73
34 . . I LA72#2 W C_LA73_$E("ab",O)_"0P" S LA75=LA73
35 . . E W P_(LA73+LA75)_$E("XY",O) S LA75=0
36 . S LA74=LA74*W+LA75
37 . W:LA74>0 P_LA74_$E("XY",O)
38 W $C(27),"&f1S" ;Pop cursor position
39 Q ""
40 ;
41DATA(X) ;
42 Q:X="" ""
43 N CD,T,Y,LA71,LA72,T1
44 S T=0,T=$$T(X),CD=T,Y=$C(T+8)
45 F Q:X="" D
46 . S T1=$$T(X)
47 . I T1'=T D CD(6-T1) S T=T1
48 . S LA71=$E(X,1,T=2+1),X=$E(X,T=2+2,255),LA72=$A(LA71)
49 . I T=2 D CD($S(LA71>95:LA71-95,LA71:LA71+32,1:31))
50 . E D CD($S(LA72<32:LA72+96,LA72=32:31,1:LA72))
51 S CD=CD#103,CD=$S('CD:31,CD>95:CD-95,1:CD+32)
52 Q Y_$C(CD,11)
53 ;
54T(X) Q $S(X?2N.E:2,$A(X)<32:0,$A(X)>95:1,T=2:0,1:T)
55 ;
56CD(X) S CD=$S(X=31:0,X<11:X+95,1:X-32)*$L(Y)+$G(CD),Y=Y_$C(X)
57 Q
58 ;
591 ;;11431
602 ;;41111
613 ;;41131
624 ;;11314
635 ;;11413
646 ;;31114
657 ;;41113
668 ;;21141
679 ;;21121
6810 ;;21123
6911 ;;2331112
7031 ;;21222
7133 ;;22212
7234 ;;22222
7335 ;;12122
7436 ;;12132
7537 ;;13122
7638 ;;12221
7739 ;;12231
7840 ;;13221
7941 ;;22121
8042 ;;22131
8143 ;;23121
8244 ;;11223
8345 ;;12213
8446 ;;12223
8547 ;;11322
8648 ;;12312
8749 ;;12322
8850 ;;22321
8951 ;;22113
9052 ;;22123
9153 ;;21321
9254 ;;22311
9355 ;;31213
9456 ;;31122
9557 ;;32112
9658 ;;32122
9759 ;;31221
9860 ;;32211
9961 ;;32221
10062 ;;21212
10163 ;;21232
10264 ;;23212
10365 ;;11132
10466 ;;13112
10567 ;;13132
10668 ;;11231
10769 ;;13211
10870 ;;13231
10971 ;;21131
11072 ;;23111
11173 ;;23131
11274 ;;11213
11375 ;;11233
11476 ;;13213
11577 ;;11312
11678 ;;11332
11779 ;;13312
11880 ;;31312
11981 ;;21133
12082 ;;23113
12183 ;;21311
12284 ;;21331
12385 ;;21313
12486 ;;31112
12587 ;;31132
12688 ;;33112
12789 ;;31211
12890 ;;31231
12991 ;;33211
13092 ;;31411
13193 ;;22141
13294 ;;43111
13395 ;;11122
13496 ;;11142
13597 ;;12112
13698 ;;12142
13799 ;;14112
138100 ;;14122
139101 ;;11221
140102 ;;11241
141103 ;;12211
142104 ;;12241
143105 ;;14211
144106 ;;14221
145107 ;;24121
146108 ;;22111
147109 ;;41311
148110 ;;24111
149111 ;;13411
150112 ;;11124
151113 ;;12114
152114 ;;12124
153115 ;;11421
154116 ;;12411
155117 ;;12421
156118 ;;41121
157119 ;;42111
158120 ;;42121
159121 ;;21214
160122 ;;21412
161123 ;;41212
162124 ;;11114
163125 ;;11134
164126 ;;13114
165127 ;;11411
Note: See TracBrowser for help on using the repository browser.