| [613] | 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
 | 
|---|