10 ' ********************************
20 ' *            NOTICE            *
30 ' * COPYRIGHT (c) 1983 DAN DUGAN *
40 ' ********************************
50 '


				STANDALONE ENTRY


60 PRINT:PRINT "CHESHIR 1.03 November 2, 1983
70 PRINT:PRINT "This program prints 4-up Cheshire labels from a sequential data file.
80 PRINT 
90 DEFINT A-Z
100 WIDTH LPRINT 255
105 I=0
110 '


				OPEN SOURCE FILE


120 PRINT:INPUT"Name of source file";X$
130 IF X$="" THEN STOP
140 GOSUB 2430:F2$=Y$		'ucv
150 IF MID$(F2$,2,1)=":" THEN 170
160 F2$=DD$(5)+F2$
170 '


		TEST FOR EXISTENCE


180 ON ERROR GOTO 210
190	OPEN"I",3,F2$
200	ON ERROR GOTO 0:GOTO 260	'ok
210 '		LOCAL ERROR TRAP
220 CLOSE 3
230 IF ERR=53 THEN CLOSE 3:PRINT"File not found":RESUME 110
240 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 110
250 ON ERROR GOTO 0
260 '		SHOW AND ASK
270 PRINT:PRINT"Here's the first line of "F2$".
280 LINE INPUT#3,T$
290 PRINT:PRINT T$
300 CLOSE 3:OPEN"I",3,F2$
310 PRINT:

	INPUT"Please enter the total number of fields in the source file:  ",NC
320 IF NC=0 THEN CLOSE:STOP
330 DIM B$(NC),L$(4,NC)
340 DIMS=0				'switch for sequential file
350 GOTO 1090
1000 '


				DIMS ENTRY


1010 GOSUB 2130 'cs
1020 PRINT:PRINT TAB(16);"CHESHIRE 1.03 October 26, 1983
1030 PRINT"Prints Cheshire labels 4-up
1040 ' by Dan Dugan -- public domain
1050 PRINT
1060 DEFINT A-Z
1070 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,

	C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),

	SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
1080 DIMS=1			'switch for dims data file
1090 '


				INITIALIZATION FOR BOTH MODES


1100 DIM COLPOS(4)
1110 '		COLUMN PRINT POSITIONS
1120 COLPOS(1)=2:COLPOS(2)=43:COLPOS(3)=84:COLPOS(4)=124
1130 '		MAXIMUM FIELD LENGTH
1140 MAXLEN=34
1145 DONE=0			'EOF flag
1150 '


				SET-UP LABELS


1160 PRINT:PRINT"Please indicate the form that this list is in:
1170 PRINT:PRINT"     1.  Short form, (NAME, N2, ADDR, C-ST, ZIP)
1180 PRINT"     2.  Medium form, (LNAM, FNAM, N2, ADDR, C-ST, ZIP)
1190 PRINT"     3.  Long form, (LNAM, FNAM, TITL, ORG, ADDR etc.)
1200 PRINT:PRINT"Enter 1, 2 or 3:  ";
1210 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="1"
1220 PRINT A$: A=VAL(A$): IF A=0 THEN 1950
1230 IF A<1 OR A>3 THEN 1200
1240 FORM=A-1
1242 PRINT:PRINT"Set up printer:"
1244 PRINT"Print head on perforation.
1245 PRINT"Hit return when ready to print":A$=INPUT$(1)
1250 '




				RECORD WORK LOOP


1260 LC=0 ' count
1270 COL=0 ' print column
1280 '
1290 IF DIMS THEN FOR I=T1 TO T2 '		<==== FOR
1300 COL=COL+1:IF COL>4 THEN COL=1
1302 IF COL=1 THEN 1304 ELSE 1310
1304 FOR J=1 TO 4
1305	FOR K=1 TO 4
1306		L$(J,K)=""
1307	NEXT
1308 NEXT
1310 IF DIMS THEN GOSUB 2280 ELSE GOSUB 2520 ' get rec
1320 IF DIMS=0 THEN 1670
1330 IF ASC(T$)=0 THEN PRINT"0";:GOTO 1920
1340 PRINT"+";
1350 T1$=T$ ' save it
1360 IF SKIPPARSE=1 THEN 1380
1370 GOSUB 1990 ' parse record string
1380 IF SEARCH=0 THEN 1670
1390 '



				SEARCH


1400 IF SEARCH<>2 THEN 1450
1410 '


		FIND


1420 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1920
1430 GOSUB 1990 ' parse
1440 GOTO 1670
1450 '


		FIELD SEARCH


1460 J=0 '			check for skips first
1470 IF SKIPWORD$(J)="" THEN 1550 ' try search then
1480 IF LOOKFIELD(J)<>0 THEN 1520 ' look in field
1490 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 1920 ' whole rec search - skip it
1500 J=J+1
1510 GOTO 1470
1520 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 1920 ' field compare - skip
1530 J=J+1
1540 GOTO 1470
1550 IF SEARCHWORD$(0)="" THEN 1650 ' don't care so print it
1560 J=0: GOTO 1580 '		now search
1570 IF SEARCHWORD$(J)="" THEN 1920 ' hesitate no longer
1580 IF SEARCHFIELD(J)<>0 THEN 1620 ' field
1590 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 1650 ' found it
1600 J=J+1
1610 GOTO 1570
1620 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1650
1630 J=J+1
1640 GOTO 1570
1650 '


		GET READY TO DO IT


1660 IF SKIPPARSE=1 THEN GOSUB 1990 ' parse
1670 '



				PAUSE CONTROLS (TERM DEP IF UPPERCASE ONLY)


1680 GOSUB 2080:IF DIMS=0 THEN 1770	' exit returns A
1690 IF A=122 THEN 1770		' z means go on
1700 PRINT I;B$(1);TAB(14);"Ready (SPACE/z/r/n/ESC) >";
1710 A$=INPUT$(1):A=ASC(A$):

	IF A=27 THEN IF DIMS THEN CLOSE 3:GOTO 1950 ELSE GOTO 50
1720 PRINT A$:IF A=13 OR A=32 OR A=122 THEN 1770
1730 IF A=114 THEN I=IPREV:GOTO 1310 ' r
1740 IF A=110 THEN 1750 ELSE 1670 ' n or loop
1750 INPUT"Enter number of desired record:  ";I:GOTO 1310
1760 GOSUB 2080			' exit
1770 '



				STORE LABEL IN 4-UP ARRAY


1780 IF DIMS THEN IPREV=I ELSE I=I+1
1790 IF FORM=1 THEN GOSUB 2360	' reformat medium to short form
1800 IF FORM=2 THEN GOSUB 2160	' reformat long to short form
1810 PRINT "("I")"
1820 LIN=1
1830 FOR J=1 TO 3
1840	IF B$(J)="" THEN 1880
1850	IF LEN(B$(J))>MAXLEN THEN B$(J)=LEFT$(B$(J),MAXLEN)
1860	L$(COL,LIN)=B$(J)
1870	LIN=LIN+1
1880 NEXT J
1890 X=LEN(B$(5))+1
1900 IF LEN(B$(4))>MAXLEN-X THEN B$(4)=LEFT$(B$(4),MAXLEN-X)
1910 L$(COL,LIN)=B$(4)+" "+B$(5)
1920	GOSUB 2080 ' check exit
1930 IF COL=4 THEN GOSUB 2900:

	IF DONE THEN IF DIMS GOTO 1950 ELSE STOP 'print labels
1940 IF DIMS THEN NEXT I ELSE GOTO 1300 '	END OF RECORD WORK LOOP
1942 FOR J=COL+1 TO 4
1944	FOR K=1 TO 4
1945		L$(J,K)=""
1946	NEXT
1947 NEXT
1948 GOSUB 2900
1950 '


				GO HOME TO DIMS


1970 PRINT:PRINT:PRINT TAB(17)"Re-loading DEDIT.
1980 CHAIN DD$(1)+"DEDIT",1000
1990 '




				(SUB) PARSE STRING


2000 K=0
2010 M=INSTR(T$,CHR$(126)) ' delimiter
2020 IF M=0 THEN RETURN
2030 K=K+1
2040 B$(K)=""
2050 B$(K)=MID$(T$,1,M-1)
2060 T$=MID$(T$,M+1)
2070 GOTO 2010
2080 '



				(SUB) EXIT TEST (TERM DEP)


2090 X$=INKEY$			'use ESC to escape printing
2100 IF X$<>"" THEN A=ASC(X$)
2110 IF A=27 THEN CLOSE 3:IF DIMS GOTO 1970 ELSE GOTO 110 
2120 RETURN
2130 '



				(SUB) CLEAR SCREEN (TERM DEP)


2140 PRINT CHR$(26);
2150 RETURN
2160 '


				(SUB) LONG FORM LABEL RE-FORMAT


2170 IF B$(1)="" AND B$(2)="" OR B$(3)="" THEN 2260
2180 IF B$(2)="" THEN B$(1)=B$(1)+", "+B$(3): GOTO 2200
2190 B$(1)=B$(2)+" "+B$(1)+", "+B$(3)
2200	IF LEN(B$(1))>39 THEN B$(1)=LEFT$(B$(1),39)
2210 B$(2)=B$(4)
2220 B$(3)=B$(5)
2230 B$(4)=B$(6)
2240 B$(5)=B$(7)
2250 RETURN
2260 IF B$(2)+B$(1)="" THEN B$(1)=B$(3) ELSE

	IF B$(2)="" THEN B$(1)=B$(1) ELSE

	B$(1)=B$(2)+" "+B$(1)
2270 GOTO 2200
2280 '



				(SUB) GET DIMS RECORD "I" IN T$


2290 T$="" ' necessary!
2300 ON FT GOTO 2330,2310
2310	GET#1,FT*I+2 ' latter half
2320	T$=LEFT$(R$,127)
2330	GET#1,FT*I+1 ' whole or first half
2340	T$=R$+T$
2350 RETURN
2360 '


				(SUB) MEDIUM FORM RE-FORMAT


2370 IF B$(2)="" THEN 2380

	ELSE B$(1)=B$(2)+" "+B$(1)
2380 B$(2)=B$(3)
2390 B$(3)=B$(4)
2400 B$(4)=B$(5)
2410 B$(5)=B$(6)
2420 RETURN
2430 '


				(SUB) UCV


2440 Y$=""
2450 FOR K=1 TO LEN(X$)
2460	Y$=Y$+CHR$(32)
2470	X=ASC(MID$(X$,K,1))
2480	IF 96<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32):GOTO 2500
2490	MID$(Y$,K,1)=MID$(X$,K,1)
2500 NEXT
2510 RETURN
2520 '


				(SUB) GET NEXT SEQUENTIAL RECORD


2530 GOSUB 2080			'exit
2540 IF EOF(3) THEN DONE=1
2550 FOR K=1 TO NC:B$(K)="":NEXT
2555 IF DONE THEN RETURN
2560 LINE INPUT #3,T$
2570 GOSUB 2680 		'parse into B$ array j=fields found
2580 IF J<>NC THEN 2600 ELSE 2610
2600 PRINT"Input file line"INREC"defective."CHR$(7)
2610 FOR K=1 TO J		'recover quotes encoded by DPUT.BAS
2630	QUOTE=INSTR(B$(K),CHR$(126))
2640	IF QUOTE THEN MID$(B$(K),QUOTE,1)=CHR$(34):GOTO 2630
2660 NEXT
2670 RETURN
2680 '


			(SUB) PARSE COMMA-DELIM. RECORD T$ -> B$ ARRAY


2690 '				returns J = number of fields found
2700 FOR J=1 TO NC:B$(J)="":NEXT
2710 J=0
2720 ' process loop
2730	J=J+1:IF J=NC THEN 2830
2740	X=INSTR(T$,CHR$(44)) 	'comma
2750	IF X=0 THEN 2830	'must be last field
2760	Y=INSTR(T$,CHR$(34)) 	'quote
2770	IF Y=0 OR ( Y<>0 AND X<Y ) THEN 2800 ELSE 2780 'comma before quote
2780	Z=INSTR(Y+1,T$,CHR$(34))
2790	X=INSTR(Z+1,T$,CHR$(44))'loc of next comma after close quote
2800	B$(J)=MID$(T$,1,X-1):GOSUB 2860
2810 '		TRIM OFF USED PART
2820	T$=MID$(T$,X+1):GOTO 2720
2830 '		LAST FIELD
2840	B$(J)=T$:GOSUB 2860
2850 RETURN
2860 '


				(SUB) TRIM QUOTES OFF STRING


2870 IF LEFT$(B$(J),1)=CHR$(34) THEN B$(J)=RIGHT$(B$(J),LEN(B$(J))-1)
2880 IF RIGHT$(B$(J),1)=CHR$(34) THEN B$(J)=LEFT$(B$(J),LEN(B$(J))-1)
2890 RETURN
2900 '


				(SUB) PRINT LABELS


2910 LPRINT
2920 FOR LIN=1 TO 4
2930	FOR COL=1 TO 4
2940		X=COLPOS(COL):GOSUB 3000 'diablo tab
2950		LPRINT L$(COL,LIN);
2960	NEXT COL
2970	LPRINT
2980 NEXT LIN
2990 LPRINT
2995 RETURN
3000 '


				(SUB) TAB LPRINT (DIABLO)


3010 IF X>126 THEN LPRINT TAB(X);:GOTO 3030 ' Diablo abs. tab limit
3020 LPRINT CHR$(27);CHR$(137);CHR$(X+128);
3030 RETURN
3010 IF X>126 THEN LPRINT TAB(X);:GOTO 3030 ' D