- CIAUBC28 ;MSC/IND/DKM/PLS - Convert 128 barcode to HPCL-compatible form ;04-May-2006 08:19;DKM
- ;;1.2;CIA UTILITIES;;Mar 20, 2007
- ;;Copyright 2000-2006, Medsphere Systems Corporation
- ;=================================================================
- ; Inputs:
- ; TX = Text to encode.
- ; Outputs:
- ; Returns encoded text.
- ; Purpose:
- ; Performs bar code 128 encoding on a text string.
- ;=================================================================
- EN(TX) Q:TX="" ""
- N CD,TP,TP1,EN,Z1,Z2
- S TP=0,TP=$$TP(TX),CD=TP,EN=$C(TP+8)
- F Q:TX="" D
- .S TP1=$$TP(TX)
- .I TP1'=TP D CD(6-TP1) S TP=TP1
- .S Z1=$E(TX,1,TP=2+1),TX=$E(TX,TP=2+2,255),Z2=$A(Z1)
- .I TP=2 D CD($S(Z1>95:Z1-95,Z1:Z1+32,1:31))
- .E D CD($S(Z2<32:Z2+96,Z2=32:31,1:Z2))
- S CD=CD#103,CD=$S('CD:31,CD>95:CD-95,1:CD+32)
- Q EN_$C(CD,11)
- TP(X) Q $S(X?2N.E:2,$A(X)<32:0,$A(X)>95:1,TP=2:0,1:TP)
- CD(X) S CD=$S(X=31:0,X<11:X+95,1:X-32)*$L(EN)+$G(CD),EN=EN_$C(X)
- Q
- ;=================================================================
- ; Inputs:
- ; TXT = Data string to print in bar code
- ; ORN = Orientation of bar code
- ; 0 = portrait (default)
- ; 1 = landscape
- ; HGT = Height of bar code in dots (1/300 inch)
- ; HOR = Horizontal position on page in dots
- ; VER = Vertical position on page in dots
- ; WID = 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 print position
- ; on entry is restored on exit.
- ;=================================================================
- BC(TXT,ORN,HGT,HOR,VER,WID) ;
- N Z,Z1,Z2,Z3,Z4,Z5,C,P,X
- S X=0 X ^%ZOSF("RM")
- S TXT=$$EN(TXT),C=$C(27)_"*c",P=$C(27)_"*p+",WID=$G(WID,3.5),HGT=$G(HGT,60),ORN=''$G(ORN)+1
- W $C(27),"&f0S" ;Push cursor position
- W:$D(HOR) $C(27)_"*p"_+HOR_"X"
- W:$D(VER) $C(27)_"*p"_+VER_"Y"
- W C_HGT_$E("BA",ORN)
- F Z=1:1:$L(TXT) D
- .S Z1=$P($T(@$A(TXT,Z)),";;",2),Z4=11,Z5=0
- .F Z2=1:1:$L(Z1) D
- ..S Z3=+$E(Z1,Z2),Z4=Z4-Z3,Z3=Z3*WID
- ..Q:'Z3
- ..I Z2#2 W C_Z3_$E("ab",ORN)_"0P" S Z5=Z3
- ..E W P_(Z3+Z5)_$E("XY",ORN) S Z5=0
- .S Z4=Z4*WID+Z5
- .W:Z4>0 P_Z4_$E("XY",ORN)
- W $C(27),"&f1S" ;Pop cursor position
- 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
- CIAUBC28 ;MSC/IND/DKM/PLS - Convert 128 barcode to HPCL-compatible form ;04-May-2006 08:19;DKM
- +1 ;;1.2;CIA UTILITIES;;Mar 20, 2007
- +2 ;;Copyright 2000-2006, Medsphere Systems Corporation
- +3 ;=================================================================
- +4 ; Inputs:
- +5 ; TX = Text to encode.
- +6 ; Outputs:
- +7 ; Returns encoded text.
- +8 ; Purpose:
- +9 ; Performs bar code 128 encoding on a text string.
- +10 ;=================================================================
- EN(TX) IF TX=""
- QUIT ""
- +1 NEW CD,TP,TP1,EN,Z1,Z2
- +2 SET TP=0
- SET TP=$$TP(TX)
- SET CD=TP
- SET EN=$CHAR(TP+8)
- +3 FOR
- IF TX=""
- QUIT
- Begin DoDot:1
- +4 SET TP1=$$TP(TX)
- +5 IF TP1'=TP
- DO CD(6-TP1)
- SET TP=TP1
- +6 SET Z1=$EXTRACT(TX,1,TP=2+1)
- SET TX=$EXTRACT(TX,TP=2+2,255)
- SET Z2=$ASCII(Z1)
- +7 IF TP=2
- DO CD($SELECT(Z1>95:Z1-95,Z1:Z1+32,1:31))
- +8 IF '$TEST
- DO CD($SELECT(Z2<32:Z2+96,Z2=32:31,1:Z2))
- End DoDot:1
- +9 SET CD=CD#103
- SET CD=$SELECT('CD:31,CD>95:CD-95,1:CD+32)
- +10 QUIT EN_$CHAR(CD,11)
- TP(X) QUIT $SELECT(X?2N.E:2,$ASCII(X)<32:0,$ASCII(X)>95:1,TP=2:0,1:TP)
- CD(X) SET CD=$SELECT(X=31:0,X<11:X+95,1:X-32)*$LENGTH(EN)+$GET(CD)
- SET EN=EN_$CHAR(X)
- +1 QUIT
- +2 ;=================================================================
- +3 ; Inputs:
- +4 ; TXT = Data string to print in bar code
- +5 ; ORN = Orientation of bar code
- +6 ; 0 = portrait (default)
- +7 ; 1 = landscape
- +8 ; HGT = Height of bar code in dots (1/300 inch)
- +9 ; HOR = Horizontal position on page in dots
- +10 ; VER = Vertical position on page in dots
- +11 ; WID = Width of bar in dots (3=default)
- +12 ; Purpose:
- +13 ; Accepts a barcode 128 string and writes an HPCL-compatible
- +14 ; string that will display the barcode on an HP laser printer.
- +15 ; A barcode font cartridge is not required. The print position
- +16 ; on entry is restored on exit.
- +17 ;=================================================================
- BC(TXT,ORN,HGT,HOR,VER,WID) ;
- +1 NEW Z,Z1,Z2,Z3,Z4,Z5,C,P,X
- +2 SET X=0
- XECUTE ^%ZOSF("RM")
- +3 SET TXT=$$EN(TXT)
- SET C=$CHAR(27)_"*c"
- SET P=$CHAR(27)_"*p+"
- SET WID=$GET(WID,3.5)
- SET HGT=$GET(HGT,60)
- SET ORN=''$GET(ORN)+1
- +4 ;Push cursor position
- WRITE $CHAR(27),"&f0S"
- +5 IF $DATA(HOR)
- WRITE $CHAR(27)_"*p"_+HOR_"X"
- +6 IF $DATA(VER)
- WRITE $CHAR(27)_"*p"_+VER_"Y"
- +7 WRITE C_HGT_$EXTRACT("BA",ORN)
- +8 FOR Z=1:1:$LENGTH(TXT)
- Begin DoDot:1
- +9 SET Z1=$PIECE($TEXT(@$ASCII(TXT,Z)),";;",2)
- SET Z4=11
- SET Z5=0
- +10 FOR Z2=1:1:$LENGTH(Z1)
- Begin DoDot:2
- +11 SET Z3=+$EXTRACT(Z1,Z2)
- SET Z4=Z4-Z3
- SET Z3=Z3*WID
- +12 IF 'Z3
- QUIT
- +13 IF Z2#2
- WRITE C_Z3_$EXTRACT("ab",ORN)_"0P"
- SET Z5=Z3
- +14 IF '$TEST
- WRITE P_(Z3+Z5)_$EXTRACT("XY",ORN)
- SET Z5=0
- End DoDot:2
- +15 SET Z4=Z4*WID+Z5
- +16 IF Z4>0
- WRITE P_Z4_$EXTRACT("XY",ORN)
- End DoDot:1
- +17 ;Pop cursor position
- WRITE $CHAR(27),"&f1S"
- +18 QUIT ""
- 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
