1 '	ELECTRONIC CARD FILE
2 ' BY  Joe Wiellette
3 ' Permission is granted to use, but not to sell,
4 ' these programs.
10 '**********     PROGRAM   MAIL   ****************
20 '
30 '
50 DEFINT S,L,D,I,J,K,T
60 DEFDBL C
100 '
110 '           *******   MAIN  PROGRAM  **********
120 '
200 PRINT CLSCR$
210 PRT=0
220 PRINT"1) *** Print labels on printer
222 PRINT"2) Print labels on screen
224 PRINT"3) Return to MENU
230 DEFAULT$="1":ALLOWED$="123":GOSUB 5000:

	IF ALLOWED=0 THEN 200
240 IF Q=3 THEN CLOSE:RUN"MENU
250 IF Q=1 THEN PRT=1
260 GOSUB 2000
300 GOTO 200
2000 '
2010 '     *********    MAJOR ROUTINE FOR LABEL PRINTING  *********
2020 '
2030 PRINT CLSCR$
2100 PRINT"Use prepared form (*** YES) ";
2110 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:

	IF ALLOWED=0 THEN 2100
2120 IF Q$="Y" THEN GOSUB 12000 ELSE GOSUB 13000
2130 PRINT CLSCR$
2200 INPUT"Enter low record number ",LOW
2210 INPUT"Enter high record # (0 for highest)",HIGH
2212 IF HIGH=0 THEN HIGH=INT(A(6)/A(2))-1
2220 IF LOW<1 THEN 2200
2230 FOR IV=LOW TO HIGH
2240 IF SORTFILE$<>"Y" THEN I=IV:GOTO 2250
2242 INPUT#1,I,FAKE$:IF I<LOW OR I>HIGH THEN 2242
2250 GOSUB 16000 :'  *********  GET RECORD  **********
2260 GOSUB 17000 :'   ****** CONVERT RECORD TO FIELDS  ********
2270 IF DELETED$<>"A" THEN 2450
2280 '    ***   LIMIT  CHECK  ****
2290 IF LIMIT$<>"Y" THEN 2350
2292 CDTA=VAL(DTA$(L1,L2))
2300 IF L4=1 AND TYPE(L1,L2)=4

        AND LEFT$(L3$,4)=LEFT$(DTA$(L1,L2),4) THEN 2350
2310 IF L4=1 AND TYPE(L1,L2)<>4

        AND L3=CDTA THEN 2350
2320 IF L4=2 AND L3<CDTA THEN 2350
2330 IF L4=3 AND L3>CDTA THEN 2350
2340 GOTO 2450
2350 '          *******   PRINT FIELDS CHOSEN  *********
2360 LINENUM=1:K=1
2370 FOR I=1 TO FIELDCOUNT
2380 GOSUB 18000
2390 IF PRT=1 THEN IF LINES(LINENUM)=K THEN

        LPRINT:LINENUM=LINENUM+1:K=1:GOTO 2410
2392 IF PRT=0 THEN IF LINES(LINENUM)=K THEN

	PRINT:LINENUM=LINENUM+1:K=1:GOTO 2410
2400 K=K+1
2410 NEXT I
2420 FOR J=1 TO 7-LINENUM
2430 IF PRT=1 THEN LPRINT ELSE PRINT
2440 NEXT J
2450 NEXT IV
2452 INPUT"Tap return to continue ";FAKE$
2460 CLOSE(1):RETURN
3000 '
3010 '  ***********   END OF MAJOR SECTION  **********
3020 '
5000 '
5010 '		***  INPUT  ***
5020 '
5030 PRINT BELL$;
5040 ALLOWED=0
5050 Q$=INPUT$(1)
5060 PRINT Q$
5070 IF Q$="y" THEN Q$="Y"
5080 IF Q$=CHR$(13) THEN Q$=DEFAULT$
5090 Q=VAL(Q$)
5100 FOR L=1 TO LEN(ALLOWED$)
5110 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1
5120 NEXT L
5130 RETURN
5140 '
5150 '
12000 '
12010 ' **************   GET FORM FROM A FILE  *****************
12020 '
12030 '
12100 PRINT CLSCR$;
12110 INPUT"Enter the name of the report form ",REPORT$
12120 REPORT$=DRIVE$+REPORT$
12130 OPEN"I",#3,REPORT$
12132 INPUT#3,MAIL$
12140 FIELDCOUNT = 0: LINENUM = 1: LINES(1) =0: Q$="Y": R$="Y"
12200 WHILE R$="Y"
12210   WHILE Q$="Y"
12212           LINES(LINENUM)= LINES(LINENUM)+1
12214           FIELDCOUNT = FIELDCOUNT +1
12220           INPUT#3,FIELDS
12230           G(FIELDCOUNT) = INT(FIELDS/100):

                   H(FIELDCOUNT)= FIELDS-(G(FIELDCOUNT)*100)
12240           INPUT#3,Q$
12270   WEND :'  ****  END OF Q LOOP FOR ONE LINE  ****
12280 INPUT#3,R$
12300 LINENUM=LINENUM + 1
12310 LINES(LINENUM)=0
12320 Q$="Y"
12330 WEND :'   ****  LAST LINE OF LABEL  *****
12400 '
12410 '   ********  CHECK FOR LIMITS  ********
12420 '
12430 INPUT#3,LIMIT$
12440 LIMIT$=LEFT$(LIMIT$,1)
12442 IF LIMIT$<>"Y" THEN 12600
12450 INPUT#3,FIELDS
12460 L1=INT(FIELDS/100)
12470 L2=FIELDS-(L1*100)
12480 IF TYPE(L1,L2)=1 THEN

                INPUT"Enter date ",DATE$:GOSUB 20000:L3=DATE:INPUT#3,L4

        ELSE IF T(L1,L2)<>4 THEN

                INPUT"Enter limit ",L3:INPUT#3,L4

        ELSE INPUT"Enter target ",L3$:L4=1
12600 '
12610 ' *********   CHECK FOR SORT  ***********
12620 '
12630 INPUT#3,SORTFILE$
12642 IF SORTFILE$<>"Y" THEN 12730
12650 INPUT#3,SORT$
12660 OPEN"I",#1,SORT$
12730 RETURN
12800 '
12810 '************   END OF LOAD FOR FORMATTED LABEL INPUT  *********
12820 '
13000 '
13010 ' ***********   ENTER  FORMAT FOR LABEL  *************
13020 '
13030 Q$="Y":R$="Y"
13100 GOSUB 14000: '  **  PRINT HEADER LISTING TO SHOW CHOICES **
13110 FIELDCOUNT=0:LINENUM=1:LINES(1)=0:Q$="Y":R$="Y"
13120 WHILE R$="Y"
13130   WHILE Q$="Y"
13132           LINES(LINENUM)=LINES(LINENUM)+1
13134           FIELDCOUNT = FIELDCOUNT +1
13140           PRINT"Enter field choice for line "LINENUM;
13142           FIELDS=0
13150           WHILE FIELDS<100 : INPUT FIELDS : WEND
13160           G(FIELDCOUNT)=INT(FIELDS/100)
13170           H(FIELDCOUNT)=FIELDS-(G(FIELDCOUNT)*100)
13180		PRINT"Any more this line (** YES) ";
13190		DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:

			IF ALLOWED=0 THEN 13180
13220   WEND  :'  *** END OF Q LOOP FOR ONE LINE  ***
13230 PRINT"Any more lines (*** YES) ";
13240 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:

	IF ALLOWED=0 THEN 13230
13250 R$=Q$
13260 LINENUM=LINENUM + 1
13270 LINES(LINENUM)=0
13280 WEND :'   ***  LAST LINE OF LABEL  ****
13300 '
13310 '         *******   ENTER LIMITS  *********
13320 '
13330 PRINT CLSCR$
13340 PRINT"Do you wish to set limits (** NO) ";
13350 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:

	IF ALLOWED=0 THEN 13340
13352 LIMIT$=Q$
13360 IF Q$<>"Y" THEN 13500
13370 INPUT"Enter field to limit (99 to re-list fields) ",FIELDS
13380 IF FIELDS=99 THEN GOSUB 14000:GOTO 13370
13390 L1=INT(FIELDS/100):L2=FIELDS-(L1*100)
13400 IF TYPE(L1,L2)=1 THEN

	INPUT"Enter target date ",DATE$:GOSUB 20000:L3=DATE:GOTO 13410
13402 IF TYPE(L1,L2)<>4 THEN INPUT"Enter target for field ",L3 ELSE INPUT"Enter target for field ",L3$:L4=1:GOTO 13500
13410 INPUT"1) Equal 2) Low limit 3) High limit ",L4
13500 '
13510 '         ******  CHECK FOR SORT  ********
13520 '
13530 PRINT"Want a sort key file (** NO) ";
13540 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:

	IF ALLOWED=0 THEN 13530
13550 IF Q$<>"Y" THEN RETURN ELSE SORTFILE$="Y"
13560 INPUT"Enter name of sort key  file ",SORT$
13562 SORT$=DRIVE$+SORT$
13570 OPEN"I",#1,SORT$
13640 RETURN
14000 '
14010 ' *********   DISPLAY HEADER LISTINGS  ***********
14020 '
14030 PRINT CLSCR$
14040 FOR I=1 TO A(2)
14050   FOR J= 1 TO F(I)
14060           FIELDS=(I*100)+J
14070   PRINT FIELDS"   "LABEL$(I,J)
14080   NEXT J
14090 NEXT I
14100 RETURN
16000 '
16100 '     ******   GET CORRECT RECORD  **********
16110 '
16200 I=(I*A(2))-A(2)+1
16210 FOR M=I TO I+A(2)-1
16220 IF M=0 THEN 16260
16230 GET#2,M
16240 MM=M-I+1
16250 S$(MM)=RECORD$
16260 NEXT M
16270 RETURN
17000 '
17100 '     *********   CONVERT RECORD INTO FIELDS  *********
17110 '
17200 LN=2
17210 DELETED$=LEFT$(S$(1),1)
17220 FOR F=1 TO A(2)
17230   M$=S$(F)
17240   IF M$="" THEN 17300
17250           FOR J=1 TO F(F)
17260           ON TYPE(F,J) GOSUB 17320,17360,17380,17400
17270           LN=LN+LENGTH(F,J)
17280           NEXT J
17290   LN=2
17300 NEXT F
17310 RETURN
17320 ' ***  DATE CONVERT **
17322 DATE$=M$
17330 GOSUB 20200
17340 DTA$(F,J)=STR$(CVI(MID$(M$,LN,LENGTH(F,J))))
17350 RETURN
17360 DTA$(F,J)=STR$(CVS(MID$(M$,LN,LENGTH(F,J))))
17370 RETURN
17380 DTA$(F,J)=STR$(CVD(MID$(M$,LN,LENGTH(F,J))))
17390 RETURN
17400 DTA$(F,J)=MID$(M$,LN,LENGTH(F,J))
17410 RETURN
18000 '
18010 '         ******    ACTUAL FIELD PRINTING  *******
18020 '
18030 ON TYPE(G(I),H(I)) GOSUB 18050,18090,18120,18150
18040 RETURN
18050 JULIAN = VAL(DTA$(G(I),H(I))):GOSUB 20250
18060 IF VAL(DTA$(G(I),H(I)))>0 THEN IF PRT=1 THEN

        LPRINT USING"###";MONTH,DAY,YEAR;:LPRINT" ";

	ELSE PRINT USING"###";MONTH,DAY,YEAR;:PRINT" ";
18070 RETURN
18080 '
18090 IF PRT=1 THEN LPRINT VAL(DTA$(G(I),H(I)));:LPRINT"  ";

	ELSE PRINT VAL(DTA$(G(I),H(I)));:PRINT"  ";
18100 RETURN
18110 '
18120 IF PRT=1 THEN LPRINT USING DLR$;VAL(DTA$(G(I),H(I)));:LPRINT" ";

	ELSE PRINT USING DLR$;VAL(DTA$(G(I),H(I)));:PRINT" ";
18130 RETURN
18140 '
18150 IF PRT=1 THEN LPRINT DTA$(G(I),H(I))" ";

	ELSE PRINT DTA$(G(I),H(I))" ";
18160 RETURN
20000 '
20010 ' ***********   CONVERT CALANDAR TO JULIAN  ***********
20020 '
20030 MONTH=VAL(LEFT$(DATE$,2))
20040 DAY=VAL(MID$(DATE$,3,2))
20050 YEAR=VAL(RIGHT$(DATE$,2))
20060 DATE=INT(30.57*MONTH)+INT(365.25*YEAR-395.25)+DAY
20070 IF(INT(YEAR/4)*4)+1=YEAR THEN DATE=DATE-1
20080 IF MONTH<3 THEN DATE=DATE+1

        ELSE IF INT(YEAR/4)*4=YEAR THEN 20090

        ELSE DATE=DATE-1
20090 IF DATE>32500 THEN DATE=32500-DATE
20100 RETURN
20200 '
20210 '      *********   CONVERT JULIAN TO CALANDAR  ***********
20220 IF DATE$="" OR VAL(DATE$)=0 THEN RETURN
20230 JULIAN=CVI(MID$(DATE$,LN,LENGTH(F,J)))
20240 IF JULIAN<0 THEN JULIAN=32500-JULIAN
20250 YEAR=INT(JULIAN/365.26)+1
20260 DAY=JULIAN+INT(395.25-365.25*YEAR)
20270 D1=2:IF INT(YEAR/4)*4=YEAR THEN D1=1
20280 IF DAY>91 THEN DAY=DAY+D1
20290 MONTH=INT(DAY/30.57):DAY=DAY-INT(30.57*MONTH)
20300 RETURN
(YEAR/4)*4=YEAR THEN D1=1
20280