- CIAUBCDA ;MSC/IND/PLS - Converts barcode CODABAR to HPCL-compatible format ;04-May-2006 08:19;DKM
- ;;1.2;CIA UTILITIES;;Mar 20, 2007
- ;;Copyright 2000-2006, Medsphere Systems Corporation
- ;=================================================================
- ; Inputs:
- ; TXT = Data string to print in bar code
- ; ORN = Orientation of bar code/Check digit
- ; 0 = portrait/no check digit(default)
- ; 1 = landscape/no check digit
- ; 2 = portrait/check digit
- ; 3 = landscape/check digit
- ; 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)
- ; SSC = Start/Stop characters (a/a = default)
- ; Purpose:
- ; Accepts a barcode CODABAR 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 upon exit.
- ;=================================================================
- BC(TXT,ORN,HGT,HOR,VER,WID,SSC) ;
- N DD,CHK,CH,ZDD,C,P,Z,Z1,Z2,Z3,Z4,Z5,X
- S X=0 X ^%ZOSF("RM")
- S CHK=$S($G(ORN)>1:1,1:0),ORN=$S($G(ORN)#2:1,1:0)
- S CH="0123456789-$:/.+"
- S DD="" F ZDD=1:1:$L(TXT) S DD=DD_$S(CH[$E(TXT,ZDD):$E(TXT,ZDD),1:"") ;STRIP UNPRINTABLE CHARACTERS
- S TXT=DD,TXT="a"_TXT_"a" ;ADD START AND STOP CODES
- I +$G(CHK) S TXT=$$CHK(TXT)
- S C=$C(27)_"*c",P=$C(27)_"*p+",WID=$G(WID,3),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=$S("AaTt"[$E(TXT,Z):$P($T(16),";",4),"BbNn"[$E(TXT,Z):$P($T(17),";",4),"Cc*"[$E(TXT,Z):$P($T(18),";",4),"DdEe"[$E(TXT,Z):$P($T(19),";",4),1:$P($T(@($F(CH,$E(TXT,Z))-2)),";",4)),Z4=13,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 P_(Z5+WID)_$E("XY",ORN)
- W $C(27),"&f1S" ;Pop cursor position
- Q ""
- CHK(X) ;CALCULATE CHECK DIGIT AND RETURN STRING TO PRINT
- Q:X="" ""
- N Z1,Y,CHK,XX
- S CHK=0,Y=X
- S XX=$E(X,1)_$E(X,$L(X)) ;STRIP OFF S/S CODES AND CALCULATE CHECKSUM
- F Z1=1:1:$L(XX) S CHK=CHK+$S("AaTt"[$E(XX,Z1):16,"BbNn"[$E(XX,Z1):17,"Cc*"[$E(XX,Z1):18,"DdEe"[$E(XX,Z1):19,1:0)
- ;ADD TO CHECKSUM THE VALUES OF THE DATA
- S X=$E(X,2,$L(X)-1) F Q:X="" S CHK=$F(CH,$E(X))-2+CHK,X=$E(X,2,255)
- S CHK=$E(CH,$S('CHK#16:1,1:16-CHK#16+1))
- Q $E(Y,1,$L(Y)-1)_CHK_$E(Y,$L(Y))
- 0 ;;0;1111133
- 1 ;;1;1111331
- 2 ;;2;1113113
- 3 ;;3;3311111
- 4 ;;4;1131131
- 5 ;;5;3111131
- 6 ;;6;1311113
- 7 ;;7;1311311
- 8 ;;8;1331111
- 9 ;;9;3113111
- 10 ;;-;1113311
- 11 ;;$;1133111
- 12 ;;:;3111313
- 13 ;;/;3131113
- 14 ;;.;3131311
- 15 ;;+;1131313
- 16 ;;AaTt;1133131
- 17 ;;BbNn;1313113
- 18 ;;Cc*;1113133
- 19 ;;DdEe;1113331
- CIAUBCDA ;MSC/IND/PLS - Converts barcode CODABAR to HPCL-compatible format ;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 ; TXT = Data string to print in bar code
- +6 ; ORN = Orientation of bar code/Check digit
- +7 ; 0 = portrait/no check digit(default)
- +8 ; 1 = landscape/no check digit
- +9 ; 2 = portrait/check digit
- +10 ; 3 = landscape/check digit
- +11 ; HGT = Height of bar code in dots (1/300 inch)
- +12 ; HOR = Horizontal position on page in dots
- +13 ; VER = Vertical position on page in dots
- +14 ; WID = Width of bar in dots (3=default)
- +15 ; SSC = Start/Stop characters (a/a = default)
- +16 ; Purpose:
- +17 ; Accepts a barcode CODABAR string and writes an HPCL-compatible
- +18 ; string that will display the barcode on an HP laser printer.
- +19 ; A barcode font cartridge is not required. The print position
- +20 ; on entry is restored upon exit.
- +21 ;=================================================================
- BC(TXT,ORN,HGT,HOR,VER,WID,SSC) ;
- +1 NEW DD,CHK,CH,ZDD,C,P,Z,Z1,Z2,Z3,Z4,Z5,X
- +2 SET X=0
- XECUTE ^%ZOSF("RM")
- +3 SET CHK=$SELECT($GET(ORN)>1:1,1:0)
- SET ORN=$SELECT($GET(ORN)#2:1,1:0)
- +4 SET CH="0123456789-$:/.+"
- +5 ;STRIP UNPRINTABLE CHARACTERS
- SET DD=""
- FOR ZDD=1:1:$LENGTH(TXT)
- SET DD=DD_$SELECT(CH[$EXTRACT(TXT,ZDD):$EXTRACT(TXT,ZDD),1:"")
- +6 ;ADD START AND STOP CODES
- SET TXT=DD
- SET TXT="a"_TXT_"a"
- +7 IF +$GET(CHK)
- SET TXT=$$CHK(TXT)
- +8 SET C=$CHAR(27)_"*c"
- SET P=$CHAR(27)_"*p+"
- SET WID=$GET(WID,3)
- SET HGT=$GET(HGT,60)
- SET ORN=''$GET(ORN)+1
- +9 ;Push cursor position
- WRITE $CHAR(27),"&f0S"
- +10 IF $DATA(HOR)
- WRITE $CHAR(27)_"*p"_+HOR_"X"
- +11 IF $DATA(VER)
- WRITE $CHAR(27)_"*p"_+VER_"Y"
- +12 WRITE C_HGT_$EXTRACT("BA",ORN)
- +13 FOR Z=1:1:$LENGTH(TXT)
- Begin DoDot:1
- +14 SET Z1=$SELECT("AaTt"[$EXTRACT(TXT,Z):$PIECE($TEXT(16),";",4),"BbNn"[$EXTRACT(TXT,Z):$PIECE($TEXT(17),";",4),"Cc*"[$EXTRACT(TXT,Z):$PIECE($TEXT(18),";",4),"DdEe"[$EXTRACT(TXT,Z):$PIECE($TEXT(19),";",4),1:$PIECE($TEXT(@($FIND(CH,...
- ... $EXTRACT(TXT,Z))-2)),";",4))
- SET Z4=13
- SET Z5=0
- +15 FOR Z2=1:1:$LENGTH(Z1)
- Begin DoDot:2
- +16 SET Z3=+$EXTRACT(Z1,Z2)
- SET Z4=Z4-Z3
- SET Z3=Z3*WID
- +17 IF 'Z3
- QUIT
- +18 IF Z2#2
- WRITE C_Z3_$EXTRACT("ab",ORN)_"0P"
- SET Z5=Z3
- +19 IF '$TEST
- WRITE P_(Z3+Z5)_$EXTRACT("XY",ORN)
- SET Z5=0
- End DoDot:2
- +20 SET Z4=Z4*WID+Z5
- +21 WRITE P_(Z5+WID)_$EXTRACT("XY",ORN)
- End DoDot:1
- +22 ;Pop cursor position
- WRITE $CHAR(27),"&f1S"
- +23 QUIT ""
- CHK(X) ;CALCULATE CHECK DIGIT AND RETURN STRING TO PRINT
- +1 IF X=""
- QUIT ""
- +2 NEW Z1,Y,CHK,XX
- +3 SET CHK=0
- SET Y=X
- +4 ;STRIP OFF S/S CODES AND CALCULATE CHECKSUM
- SET XX=$EXTRACT(X,1)_$EXTRACT(X,$LENGTH(X))
- +5 FOR Z1=1:1:$LENGTH(XX)
- SET CHK=CHK+$SELECT("AaTt"[$EXTRACT(XX,Z1):16,"BbNn"[$EXTRACT(XX,Z1):17,"Cc*"[$EXTRACT(XX,Z1):18,"DdEe"[$EXTRACT(XX,Z1):19,1:0)
- +6 ;ADD TO CHECKSUM THE VALUES OF THE DATA
- +7 SET X=$EXTRACT(X,2,$LENGTH(X)-1)
- FOR
- IF X=""
- QUIT
- SET CHK=$FIND(CH,$EXTRACT(X))-2+CHK
- SET X=$EXTRACT(X,2,255)
- +8 SET CHK=$EXTRACT(CH,$SELECT('CHK#16:1,1:16-CHK#16+1))
- +9 QUIT $EXTRACT(Y,1,$LENGTH(Y)-1)_CHK_$EXTRACT(Y,$LENGTH(Y))
- 0 ;;0;1111133
- 1 ;;1;1111331
- 2 ;;2;1113113
- 3 ;;3;3311111
- 4 ;;4;1131131
- 5 ;;5;3111131
- 6 ;;6;1311113
- 7 ;;7;1311311
- 8 ;;8;1331111
- 9 ;;9;3113111
- 10 ;;-;1113311
- 11 ;;$;1133111
- 12 ;;:;3111313
- 13 ;;/;3131113
- 14 ;;.;3131311
- 15 ;;+;1131313
- 16 ;;AaTt;1133131
- 17 ;;BbNn;1313113
- 18 ;;Cc*;1113133
- 19 ;;DdEe;1113331
