VistA-WorldVistAEHR/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SBC.m

166 lines
3.0 KiB
Mathematica

LA7SBC ;DALISC/JMC - HP-PCL Compatible Barcode 128 Utility ; 12/3/1997
;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
; Extensively borrowered from Douglas K. Martin, M.D.
;
BC128(D,O,H,XX,YY,W) ;
; Inputs:
; D = Data string to print in bar code
; O = Orientation of bar code
; 0=portrait (default)
; 1=landscape
; H = Height of bar code in dots (1/300 inch)
; XX = Horizontal position on page in dots
; YY = Vertical position on page in dots
; W = Width of bar in dots (3=default)
; Purpose:
; Accepts a barcode 128 string and writes an HPCL-compatible
; string that will display the barcode on an HP laser printer.
; A barcode font cartridge is not required.
; The current cursor position is stored upon entry and restored before exiting.
N %,LA71,LA72,LA73,LA74,LA75,C,P,X
S X=0 X ^%ZOSF("RM")
S D=$$DATA(D)
S C=$C(27)_"*c",P=$C(27)_"*p+"
S W=$G(W,3),H=$G(H,60),O='$G(O)+1
W $C(27),"&f0S" ;Push cursor position
W:$G(XX) $C(27)_"*p"_+XX_"X"
W:$G(YY) $C(27)_"*p"_+YY_"Y"
W C_H_$E("BA",O)
F %=1:1:$L(D) D
. S LA71=$P($T(@$A(D,%)),";;",2),LA74=11,LA75=0
. F LA72=1:1:$L(LA71) D
. . S LA73=+$E(LA71,LA72),LA74=LA74-LA73,LA73=LA73*W
. . Q:'LA73
. . I LA72#2 W C_LA73_$E("ab",O)_"0P" S LA75=LA73
. . E W P_(LA73+LA75)_$E("XY",O) S LA75=0
. S LA74=LA74*W+LA75
. W:LA74>0 P_LA74_$E("XY",O)
W $C(27),"&f1S" ;Pop cursor position
Q ""
;
DATA(X) ;
Q:X="" ""
N CD,T,Y,LA71,LA72,T1
S T=0,T=$$T(X),CD=T,Y=$C(T+8)
F Q:X="" D
. S T1=$$T(X)
. I T1'=T D CD(6-T1) S T=T1
. S LA71=$E(X,1,T=2+1),X=$E(X,T=2+2,255),LA72=$A(LA71)
. I T=2 D CD($S(LA71>95:LA71-95,LA71:LA71+32,1:31))
. E D CD($S(LA72<32:LA72+96,LA72=32:31,1:LA72))
S CD=CD#103,CD=$S('CD:31,CD>95:CD-95,1:CD+32)
Q Y_$C(CD,11)
;
T(X) Q $S(X?2N.E:2,$A(X)<32:0,$A(X)>95:1,T=2:0,1:T)
;
CD(X) S CD=$S(X=31:0,X<11:X+95,1:X-32)*$L(Y)+$G(CD),Y=Y_$C(X)
Q
;
1 ;;11431
2 ;;41111
3 ;;41131
4 ;;11314
5 ;;11413
6 ;;31114
7 ;;41113
8 ;;21141
9 ;;21121
10 ;;21123
11 ;;2331112
31 ;;21222
33 ;;22212
34 ;;22222
35 ;;12122
36 ;;12132
37 ;;13122
38 ;;12221
39 ;;12231
40 ;;13221
41 ;;22121
42 ;;22131
43 ;;23121
44 ;;11223
45 ;;12213
46 ;;12223
47 ;;11322
48 ;;12312
49 ;;12322
50 ;;22321
51 ;;22113
52 ;;22123
53 ;;21321
54 ;;22311
55 ;;31213
56 ;;31122
57 ;;32112
58 ;;32122
59 ;;31221
60 ;;32211
61 ;;32221
62 ;;21212
63 ;;21232
64 ;;23212
65 ;;11132
66 ;;13112
67 ;;13132
68 ;;11231
69 ;;13211
70 ;;13231
71 ;;21131
72 ;;23111
73 ;;23131
74 ;;11213
75 ;;11233
76 ;;13213
77 ;;11312
78 ;;11332
79 ;;13312
80 ;;31312
81 ;;21133
82 ;;23113
83 ;;21311
84 ;;21331
85 ;;21313
86 ;;31112
87 ;;31132
88 ;;33112
89 ;;31211
90 ;;31231
91 ;;33211
92 ;;31411
93 ;;22141
94 ;;43111
95 ;;11122
96 ;;11142
97 ;;12112
98 ;;12142
99 ;;14112
100 ;;14122
101 ;;11221
102 ;;11241
103 ;;12211
104 ;;12241
105 ;;14211
106 ;;14221
107 ;;24121
108 ;;22111
109 ;;41311
110 ;;24111
111 ;;13411
112 ;;11124
113 ;;12114
114 ;;12124
115 ;;11421
116 ;;12411
117 ;;12421
118 ;;41121
119 ;;42111
120 ;;42121
121 ;;21214
122 ;;21412
123 ;;41212
124 ;;11114
125 ;;11134
126 ;;13114
127 ;;11411