| 1 | LA7SBC ;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 | ; | 
|---|
| 5 | BC128(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 | ; | 
|---|
| 41 | DATA(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 | ; | 
|---|
| 54 | T(X) Q $S(X?2N.E:2,$A(X)<32:0,$A(X)>95:1,T=2:0,1:T) | 
|---|
| 55 | ; | 
|---|
| 56 | CD(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 | ; | 
|---|
| 59 | 1 ;;11431 | 
|---|
| 60 | 2 ;;41111 | 
|---|
| 61 | 3 ;;41131 | 
|---|
| 62 | 4 ;;11314 | 
|---|
| 63 | 5 ;;11413 | 
|---|
| 64 | 6 ;;31114 | 
|---|
| 65 | 7 ;;41113 | 
|---|
| 66 | 8 ;;21141 | 
|---|
| 67 | 9 ;;21121 | 
|---|
| 68 | 10 ;;21123 | 
|---|
| 69 | 11 ;;2331112 | 
|---|
| 70 | 31 ;;21222 | 
|---|
| 71 | 33 ;;22212 | 
|---|
| 72 | 34 ;;22222 | 
|---|
| 73 | 35 ;;12122 | 
|---|
| 74 | 36 ;;12132 | 
|---|
| 75 | 37 ;;13122 | 
|---|
| 76 | 38 ;;12221 | 
|---|
| 77 | 39 ;;12231 | 
|---|
| 78 | 40 ;;13221 | 
|---|
| 79 | 41 ;;22121 | 
|---|
| 80 | 42 ;;22131 | 
|---|
| 81 | 43 ;;23121 | 
|---|
| 82 | 44 ;;11223 | 
|---|
| 83 | 45 ;;12213 | 
|---|
| 84 | 46 ;;12223 | 
|---|
| 85 | 47 ;;11322 | 
|---|
| 86 | 48 ;;12312 | 
|---|
| 87 | 49 ;;12322 | 
|---|
| 88 | 50 ;;22321 | 
|---|
| 89 | 51 ;;22113 | 
|---|
| 90 | 52 ;;22123 | 
|---|
| 91 | 53 ;;21321 | 
|---|
| 92 | 54 ;;22311 | 
|---|
| 93 | 55 ;;31213 | 
|---|
| 94 | 56 ;;31122 | 
|---|
| 95 | 57 ;;32112 | 
|---|
| 96 | 58 ;;32122 | 
|---|
| 97 | 59 ;;31221 | 
|---|
| 98 | 60 ;;32211 | 
|---|
| 99 | 61 ;;32221 | 
|---|
| 100 | 62 ;;21212 | 
|---|
| 101 | 63 ;;21232 | 
|---|
| 102 | 64 ;;23212 | 
|---|
| 103 | 65 ;;11132 | 
|---|
| 104 | 66 ;;13112 | 
|---|
| 105 | 67 ;;13132 | 
|---|
| 106 | 68 ;;11231 | 
|---|
| 107 | 69 ;;13211 | 
|---|
| 108 | 70 ;;13231 | 
|---|
| 109 | 71 ;;21131 | 
|---|
| 110 | 72 ;;23111 | 
|---|
| 111 | 73 ;;23131 | 
|---|
| 112 | 74 ;;11213 | 
|---|
| 113 | 75 ;;11233 | 
|---|
| 114 | 76 ;;13213 | 
|---|
| 115 | 77 ;;11312 | 
|---|
| 116 | 78 ;;11332 | 
|---|
| 117 | 79 ;;13312 | 
|---|
| 118 | 80 ;;31312 | 
|---|
| 119 | 81 ;;21133 | 
|---|
| 120 | 82 ;;23113 | 
|---|
| 121 | 83 ;;21311 | 
|---|
| 122 | 84 ;;21331 | 
|---|
| 123 | 85 ;;21313 | 
|---|
| 124 | 86 ;;31112 | 
|---|
| 125 | 87 ;;31132 | 
|---|
| 126 | 88 ;;33112 | 
|---|
| 127 | 89 ;;31211 | 
|---|
| 128 | 90 ;;31231 | 
|---|
| 129 | 91 ;;33211 | 
|---|
| 130 | 92 ;;31411 | 
|---|
| 131 | 93 ;;22141 | 
|---|
| 132 | 94 ;;43111 | 
|---|
| 133 | 95 ;;11122 | 
|---|
| 134 | 96 ;;11142 | 
|---|
| 135 | 97 ;;12112 | 
|---|
| 136 | 98 ;;12142 | 
|---|
| 137 | 99 ;;14112 | 
|---|
| 138 | 100 ;;14122 | 
|---|
| 139 | 101 ;;11221 | 
|---|
| 140 | 102 ;;11241 | 
|---|
| 141 | 103 ;;12211 | 
|---|
| 142 | 104 ;;12241 | 
|---|
| 143 | 105 ;;14211 | 
|---|
| 144 | 106 ;;14221 | 
|---|
| 145 | 107 ;;24121 | 
|---|
| 146 | 108 ;;22111 | 
|---|
| 147 | 109 ;;41311 | 
|---|
| 148 | 110 ;;24111 | 
|---|
| 149 | 111 ;;13411 | 
|---|
| 150 | 112 ;;11124 | 
|---|
| 151 | 113 ;;12114 | 
|---|
| 152 | 114 ;;12124 | 
|---|
| 153 | 115 ;;11421 | 
|---|
| 154 | 116 ;;12411 | 
|---|
| 155 | 117 ;;12421 | 
|---|
| 156 | 118 ;;41121 | 
|---|
| 157 | 119 ;;42111 | 
|---|
| 158 | 120 ;;42121 | 
|---|
| 159 | 121 ;;21214 | 
|---|
| 160 | 122 ;;21412 | 
|---|
| 161 | 123 ;;41212 | 
|---|
| 162 | 124 ;;11114 | 
|---|
| 163 | 125 ;;11134 | 
|---|
| 164 | 126 ;;13114 | 
|---|
| 165 | 127 ;;11411 | 
|---|