! Filename: UPC.BAS Date: 06/29/89

!*************************** AMUS Program Label ******************************
! Filename: UPC.BAS Date: 06/29/89
! Category: UTIL Hash Code: 027-670-200-364 Version: 2.0(100)
! Initials: ATH/AM Name: ALAN J. CAVALLARO
! Company: FINEX MANAGEMENT SERVICES Telephone #: 2127255666
! Related Files:
! Min. Op. Sys.: Expertise Level: INT
! Special:
! Description: Program to illustrate how to print zero-suppressed (6 digit)
! version 'E' UPC barcode labels on an Okidata 182 (possibly 292) printer.
! Output file is UPCLAB.PRT. Enter 'E' to break out of program loop.
!*****************************************************************************
PROGRAM UPC,2.0(100)
!! Finex Management Services !! !!
!! 15 West 26th Street !!
!! New York City, New York 10010 !!
!! [212] - 725 - 5666 !!

!! This is a sample program to illustrate how to print zero-suppressed
!! version 'E' UPC barcode labels on an OkiDATA 182 printer. Using a
!! hand held CCD type scanner or a counter-top laser scanner provides
!! first time readability 99% of the time.

!! I also have a version for "CODE 39" labels which includes all alphabetic
!! characters, if any one is interested.

MAP1 GR'ON,S,1,CHR(3) ! Turn on graphics mode
MAP1 GR'OFF,S,2,CHR(3)+CHR(2) ! Turn off graphics mode
MAP1 GR'RET,S,2,CHR(3)+CHR(14) ! Do CR with 1/144" line feed
MAP1 CPI'16,S,4,CHR(27)+CHR(66)+CHR(27)+CHR(90) ! Set text to 16 CPI
MAP1 CPI'12,S,4,CHR(27)+CHR(65)+CHR(27)+CHR(90) ! Set text to 12 CPI
MAP1 DENSITY,S,2,CHR(27)+CHR(81) ! Set double pass graphics

MAP1 START'BARS,S,3,CHR(127)+CHR(128)+CHR(127)
MAP1 END'BARS,S,6,CHR(128)+CHR(127)+CHR(128)+CHR(127)+CHR(128)+CHR(127)

MAP1 O0,S,7,CHR(128)+CHR(128)+CHR(128)+CHR(127)+CHR(127)+CHR(128)+CHR(127)
MAP1 O1,S,7,CHR(128)+CHR(128)+CHR(127)+CHR(127)+CHR(128)+CHR(128)+CHR(127)
MAP1 O2,S,7,CHR(128)+CHR(128)+CHR(127)+CHR(128)+CHR(128)+CHR(127)+CHR(127)
MAP1 O3,S,7,CHR(128)+CHR(127)+CHR(127)+CHR(127)+CHR(127)+CHR(128)+CHR(127)
MAP1 O4,S,7,CHR(128)+CHR(127)+CHR(128)+CHR(128)+CHR(128)+CHR(127)+CHR(127)
MAP1 O5,S,7,CHR(128)+CHR(127)+CHR(127)+CHR(128)+CHR(128)+CHR(128)+CHR(127)
MAP1 O6,S,7,CHR(128)+CHR(127)+CHR(128)+CHR(127)+CHR(127)+CHR(127)+CHR(127)
MAP1 O7,S,7,CHR(128)+CHR(127)+CHR(127)+CHR(127)+CHR(128)+CHR(127)+CHR(127)
MAP1 O8,S,7,CHR(128)+CHR(127)+CHR(127)+CHR(128)+CHR(127)+CHR(127)+CHR(127)
MAP1 O9,S,7,CHR(128)+CHR(128)+CHR(128)+CHR(127)+CHR(128)+CHR(127)+CHR(127)

MAP1 E0,S,7,CHR(128)+CHR(127)+CHR(128)+CHR(128)+CHR(127)+CHR(127)+CHR(127)
MAP1 E1,S,7,CHR(128)+CHR(127)+CHR(127)+CHR(128)+CHR(128)+CHR(127)+CHR(127)
MAP1 E2,S,7,CHR(128)+CHR(128)+CHR(127)+CHR(127)+CHR(128)+CHR(127)+CHR(127)
MAP1 E3,S,7,CHR(128)+CHR(127)+CHR(128)+CHR(128)+CHR(128)+CHR(128)+CHR(127)
MAP1 E4,S,7,CHR(128)+CHR(128)+CHR(127)+CHR(127)+CHR(127)+CHR(128)+CHR(127)
MAP1 E5,S,7,CHR(128)+CHR(127)+CHR(127)+CHR(127)+CHR(128)+CHR(128)+CHR(127)
MAP1 E6,S,7,CHR(128)+CHR(128)+CHR(128)+CHR(128)+CHR(127)+CHR(128)+CHR(127)
MAP1 E7,S,7,CHR(128)+CHR(128)+CHR(127)+CHR(128)+CHR(128)+CHR(128)+CHR(127)
MAP1 E8,S,7,CHR(128)+CHR(128)+CHR(128)+CHR(127)+CHR(128)+CHR(128)+CHR(127)
MAP1 E9,S,7,CHR(128)+CHR(128)+CHR(127)+CHR(128)+CHR(127)+CHR(127)+CHR(127)

MAP1 QUIET,S,30
MAP1 PARITY(10),S,6
MAP1 UPC,S,6
MAP1 S'CD,S,2
MAP1 UPC(6),F
MAP1 SCAN'CODE,S,11
MAP1 TOT'S,S,3

PARITY(1) = "221211"
PARITY(2) = "221121"
PARITY(3) = "221112"
PARITY(4) = "212211"
PARITY(5) = "211221"
PARITY(6) = "211122"
PARITY(7) = "212121"
PARITY(8) = "212112"
PARITY(9) = "211212"
PARITY(10) = "222111"

FOR QZ = 1 TO 30
QUIET[QZ,QZ]=CHR(128)
NEXT QZ

OPEN #1,"UPCLAB.PRT",OUTPUT

START:

INPUT "ENTER ZERO SUPPRESSED CODE ";CODE$

IF UCS(CODE$) = "E" GOTO SPOOL

UPC = CODE$ USING "#ZZZZZ"

SCAN'CODE=""
SCAN'CODE[1,1]="0"
SCAN'CODE[2,7]=UPC

CALL FIX'CODE

PRINT #1,CPI'12;
PRINT #1,DENSITY;
PRINT #1,GR'ON;

UPC(1) = VAL(UPC[1,1])
UPC(2) = VAL(UPC[2,2])
UPC(3) = VAL(UPC[3,3])
UPC(4) = VAL(UPC[4,4])
UPC(5) = VAL(UPC[5,5])
UPC(6) = VAL(UPC[6,6])

IF CD = 0 CD = 10

FOR REPETITIONS = 1 TO 6

PRINT #1,QUIET;
PRINT #1,START'BARS;

FOR POSITION = 1 TO 6

IF UPC(POSITION) = 0 UPC(POSITION) = 10

VALUE = VAL(PARITY(CD)[POSITION,POSITION])*10 + UPC(POSITION)

ON VALUE-10 CALL ODD'1,ODD'2,ODD'3,ODD'4,ODD'5,ODD'6,ODD'7,ODD'8,ODD'9,ODD'0

ON VALUE-20 CALL EVEN'1,EVEN'2,EVEN'3,EVEN'4,EVEN'5,EVEN'6,EVEN'7,EVEN'8,EVEN'9,EVEN'0

NEXT POSITION

PRINT #1,END'BARS;
PRINT #1,GR'RET;

NEXT REPETITIONS

PRINT #1,GR'OFF;
PRINT #1,CPI'16;
PRINT #1,UPC USING "#ZZZZZ";CD
PRINT #1
GOTO START
SPOOL:
CLOSE #1
! XCALL SPOOL,"UPCLAB.PRT","A",128
END

ODD'0: PRINT #1,O0; : RETURN
ODD'1: PRINT #1,O1; : RETURN
ODD'2: PRINT #1,O2; : RETURN
ODD'3: PRINT #1,O3; : RETURN
ODD'4: PRINT #1,O4; : RETURN
ODD'5: PRINT #1,O5; : RETURN
ODD'6: PRINT #1,O6; : RETURN
ODD'7: PRINT #1,O7; : RETURN
ODD'8: PRINT #1,O8; : RETURN
ODD'9: PRINT #1,O9; : RETURN

EVEN'0: PRINT #1,E0; : RETURN
EVEN'1: PRINT #1,E1; : RETURN
EVEN'2: PRINT #1,E2; : RETURN
EVEN'3: PRINT #1,E3; : RETURN
EVEN'4: PRINT #1,E4; : RETURN
EVEN'5: PRINT #1,E5; : RETURN
EVEN'6: PRINT #1,E6; : RETURN
EVEN'7: PRINT #1,E7; : RETURN
EVEN'8: PRINT #1,E8; : RETURN
EVEN'9: PRINT #1,E9; : RETURN

FIX'CODE:

A = SCAN'CODE[2,2]
B = SCAN'CODE[3,3]
C = SCAN'CODE[4,4]
D = SCAN'CODE[5,5]
E = SCAN'CODE[6,6]
F = SCAN'CODE[7,7]

IF F = 0 OR F = 1 OR F = 2 SCAN'CODE = A+B+F+"0000"+C+D+E

IF F = 3 SCAN'CODE = A+B+C+"00000"+D+E

IF F = 4 SCAN'CODE = A+B+C+D+"00000"+E

IF F >=5 SCAN'CODE = A+B+C+D+E+"0000"+F

SCAN'CODE = "0"+SCAN'CODE

X = 0 : Y = 0 : Z = 0 : ZZ =0 : XX = 0 : YY = 0 : TOT = 0 : CD = 0
TOT'S = SPACE(3) : LOOP = 0

FOR LOOP = 1 TO 11 STEP 2

X = SCAN'CODE[LOOP,LOOP] : XX = XX + X

NEXT LOOP
Y = XX * 3
FOR LOOP = 2 TO 10 STEP 2

Z = SCAN'CODE[LOOP,LOOP] : ZZ = ZZ + Z

NEXT LOOP

TOT = Y + ZZ
TOT'S = TOT USING "###"
CD = 10 - VAL(TOT'S[3,3])

RETURN