- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7SBC 3257 printed Feb 18, 2025@23:05:42 Page 2
- LA7SBC ;DALISC/JMC - HP-PCL Compatible Barcode 128 Utility ; 12/3/1997
- +1 ;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
- +2 ; Extensively borrowered from Douglas K. Martin, M.D.
- +3 ;
- BC128(D,O,H,XX,YY,W) ;
- +1 ; Inputs:
- +2 ; D = Data string to print in bar code
- +3 ; O = Orientation of bar code
- +4 ; 0=portrait (default)
- +5 ; 1=landscape
- +6 ; H = Height of bar code in dots (1/300 inch)
- +7 ; XX = Horizontal position on page in dots
- +8 ; YY = Vertical position on page in dots
- +9 ; W = Width of bar in dots (3=default)
- +10 ; Purpose:
- +11 ; Accepts a barcode 128 string and writes an HPCL-compatible
- +12 ; string that will display the barcode on an HP laser printer.
- +13 ; A barcode font cartridge is not required.
- +14 ; The current cursor position is stored upon entry and restored before exiting.
- +15 NEW %,LA71,LA72,LA73,LA74,LA75,C,P,X
- +16 SET X=0
- XECUTE ^%ZOSF("RM")
- +17 SET D=$$DATA(D)
- +18 SET C=$CHAR(27)_"*c"
- SET P=$CHAR(27)_"*p+"
- +19 SET W=$GET(W,3)
- SET H=$GET(H,60)
- SET O='$GET(O)+1
- +20 ;Push cursor position
- WRITE $CHAR(27),"&f0S"
- +21 if $GET(XX)
- WRITE $CHAR(27)_"*p"_+XX_"X"
- +22 if $GET(YY)
- WRITE $CHAR(27)_"*p"_+YY_"Y"
- +23 WRITE C_H_$EXTRACT("BA",O)
- +24 FOR %=1:1:$LENGTH(D)
- Begin DoDot:1
- +25 SET LA71=$PIECE($TEXT(@$ASCII(D,%)),";;",2)
- SET LA74=11
- SET LA75=0
- +26 FOR LA72=1:1:$LENGTH(LA71)
- Begin DoDot:2
- +27 SET LA73=+$EXTRACT(LA71,LA72)
- SET LA74=LA74-LA73
- SET LA73=LA73*W
- +28 if 'LA73
- QUIT
- +29 IF LA72#2
- WRITE C_LA73_$EXTRACT("ab",O)_"0P"
- SET LA75=LA73
- +30 IF '$TEST
- WRITE P_(LA73+LA75)_$EXTRACT("XY",O)
- SET LA75=0
- End DoDot:2
- +31 SET LA74=LA74*W+LA75
- +32 if LA74>0
- WRITE P_LA74_$EXTRACT("XY",O)
- End DoDot:1
- +33 ;Pop cursor position
- WRITE $CHAR(27),"&f1S"
- +34 QUIT ""
- +35 ;
- DATA(X) ;
- +1 if X=""
- QUIT ""
- +2 NEW CD,T,Y,LA71,LA72,T1
- +3 SET T=0
- SET T=$$T(X)
- SET CD=T
- SET Y=$CHAR(T+8)
- +4 FOR
- if X=""
- QUIT
- Begin DoDot:1
- +5 SET T1=$$T(X)
- +6 IF T1'=T
- DO CD(6-T1)
- SET T=T1
- +7 SET LA71=$EXTRACT(X,1,T=2+1)
- SET X=$EXTRACT(X,T=2+2,255)
- SET LA72=$ASCII(LA71)
- +8 IF T=2
- DO CD($SELECT(LA71>95:LA71-95,LA71:LA71+32,1:31))
- +9 IF '$TEST
- DO CD($SELECT(LA72<32:LA72+96,LA72=32:31,1:LA72))
- End DoDot:1
- +10 SET CD=CD#103
- SET CD=$SELECT('CD:31,CD>95:CD-95,1:CD+32)
- +11 QUIT Y_$CHAR(CD,11)
- +12 ;
- T(X) QUIT $SELECT(X?2N.E:2,$ASCII(X)<32:0,$ASCII(X)>95:1,T=2:0,1:T)
- +1 ;
- CD(X) SET CD=$SELECT(X=31:0,X<11:X+95,1:X-32)*$LENGTH(Y)+$GET(CD)
- SET Y=Y_$CHAR(X)
- +1 QUIT
- +2 ;
- 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
