!*************************** 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