Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7SBC

LA7SBC.m

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