1 '	ELECTRONIC CARD FILE
2 ' BY Joe Wiellette  617-731-3178
3 ' Permission is granted to use, but not to sell,
4 ' these programs.
50 DEFINT S,D,L,I,J,K,T,N
60 DEFDBL C
70 WIDTH LPRINT 80
100 '
110 '           *********   REPORT **********
120 '
140 '
1000 PRINT CLSCR$;
1010 PRINT"1) *** SCREEN  2) PRINTER";
1020 DEFAULT$="1":ALLOWED$="12":GOSUB 5000:IF ALLOWED=0 THEN 1000
1030 IF Q=2 THEN PRT=1 ELSE PRT=0
2000 '
2100 '   *******  MAJOR ROUTINE  ********
2110 '
2120 PRINT CLSCR$
2122 NUM=1
2124 CALTOT=0
2130 PRINT"Use prepared form (*** NO) ",
2140 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 2130
2150 IF Q$="Y" THEN GOSUB 12000 ELSE GOSUB 13000
2200 INPUT"Enter low record number ",LOW
2210 INPUT"Enter high # (0 for highest) ";HIGH
2212 IF HIGH=0 THEN HIGH=INT(A(6)/A(2))
2220 PRINT CLSCR$
2222 '
2224 '   ******   PRINT HEADING  *****
2226 '
2230 IF REC$="Y" OR NUM$="Y" THEN IF PRT=1 THEN LPRINT TAB(7); ELSE PRINT TAB(7);
2240 FOR I= 1 TO CH
2242 IF PRT<>1 THEN 2263
2250 IF TYPE(G(I),H(I))<>3  THEN LPRINT LABEL$(G(I),H(I));
2252 IF TYPE(G(I),H(I))=3 THEN LPRINT SPC(9) LABEL$(G(I),H(I));
2260 IF TYPE(G(I),H(I))=4 THEN

        LPRINT SPC(LENGTH(G(I),H(I))-LEN(LABEL$(G(I),H(I)))+1);

        ELSE LPRINT SPC(9-LEN(LABEL$(G(I),H(I))));
2261 GOTO 2270
2263 IF TYPE(G(I),H(I))<>3 THEN PRINT LABEL$(G(I),H(I));
2264 IF TYPE(G(I),H(I))=3 THEN PRINT SPC(9) LABEL$(G(I),H(I));
2265 IF TYPE(G(I),H(I))=4 THEN

	PRINT SPC(LENGTH(G(I),H(I))-LEN(LABEL$(G(I),H(I)))+1);

	ELSE PRINT SPC(9-LEN(LABEL$(G(I),H(I))));
2270 NEXT I
2280 IF PRT=1 THEN LPRINT ELSE PRINT
2290 IF PRT=1 THEN FOR T=1 TO FLEN+1:LPRINT"-";:NEXT T ELSE 

	FOR T=1 TO FLEN+1:PRINT"-";:NEXT T
2292 '
2294 ' *******   PRINT DATA  *****
2295 IF PRT=1 THEN LPRINT ELSE PRINT
2296 '
2300 FOR IV=LOW TO HIGH
2310 IF SORTFILE$<>"Y" THEN I=IV:GOTO 2320
2312 INPUT#1,I,FAKE$:IF I<LOW OR I>HIGH THEN 2312
2320 GOSUB 16000 :'  **** GET RECORD  **
2330 GOSUB 17000 :'  **** CONVERT TO FIELDS  ***
2340 IF DELETED$<>"A" THEN 2400
2341 GOSUB 15000 :  '  ****  LIMIT CHECK  ***
2342 IF LIMIT.FLAG=1 THEN 2400
2343 IF REC$="Y" THEN IF PRT=1 THEN LPRINT INT((M-1)/A(2)+1)-1;

	 ELSE PRINT INT((M-1)/A(2)+1)-1;
2344 IF NUM$="Y" THEN IF PRT=1 THEN LPRINT NUM;:NUM=NUM+1 ELSE

	PRINT NUM;:NUM=NUM+1
2390 GOSUB 18000
2392 IF TOTALS$="Y" OR CALC$="Y" THEN GOSUB 4000:'*** SUMS OR CALC ****
2394 IF PRT=1 THEN LPRINT ELSE PRINT
2400 NEXT IV
2500 IF PRT=1 THEN LPRINT:LPRINT ELSE PRINT:PRINT
2510 IF CALC$="Y" THEN IF PRT=1 THEN LPRINT"TOTAL = "CALTOT ELSE

	PRINT"TOTAL = "CALTOT
2512 IF TOTALS$<>"Y" THEN 2520
2513 FOR R=1 TO TT
2514 IF PRT=1 THEN LPRINT LABEL$(T1(R),T2(R)),CTT(R) ELSE

	PRINT LABEL$(T1(R),T2(R)),CTT(R)
2516 NEXT R
2520 CLOSE(1)
2540 PRINT:PRINT"1)  Return to MENU  ****
2550 PRINT"2)  Run Report again
2580 DEFAULT$="1":ALLOWED$="12":GOSUB 5000:IF ALLOWED=0 THEN 2540
2590 CLOSE(3)
2600 IF Q=1 THEN RUN"MENU
2620 GOTO 1000
4000 '
4100 '       *********  SUMS OR CALCULATIONS  ************
4110 '
4120 IF CALC$<>"Y" THEN 4420
4200 CALC1=VAL(DTA$(C1,C2)):T1=TYPE(C1,C2)
4220 CALC2=VAL(DTA$(C3,C4)):T2=TYPE(C3,C4)
4240 IF FUNC=1 THEN CALC3=CALC1 + CALC2
4260 IF FUNC=2 THEN CALC3=CALC1 - CALC2
4280 IF FUNC=3 THEN CALC3=CALC1 * CALC2
4300 IF FUNC=4 THEN CALC3=CALC1 / CALC2
4320 IF PRT=1 THEN IF TYPE(C1,C2)=3 OR TYPE(C3,C4)=3 THEN

	 LPRINT USING DLR$;CALC3; ELSE LPRINT CALC3;
4322 IF PRT=0 THEN IF TYPE(C1,C2)=3 OR TYPE(C3,C4)=3 THEN

	PRINT USING DLR$;CALC3; ELSE PRINT CALC3;
4330 CALTOT=CALTOT+CALC3
4400 IF TOTALS$<>"Y" THEN 4600
4420 FOR I=1 TO CH
4430 FOR R=1 TO TT
4450 IF T1(R)=G(I) AND T2(R)=H(I) THEN CTT(R)=CTT(R)+VAL(DTA$(G(I),H(I)))
4460 NEXT R
4470 NEXT I
4600 RETURN
5000 '
5010 '		****** ENTRY ROUTINE *****
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 '
12000 '
12100 '    **********  GET PRE-DEFINED REPORT FORM  *******
12110 '
12120 PRINT CLSCR$;
12200 CH=0:N=1
12220 INPUT"Enter the name of the report file ";REPORT$
12240 REPORT$=DRIVE$+REPORT$
12260 OPEN"I",#3,REPORT$
12270 WHILE N<>0:'  *****  GET FIELDS  *****
12272   CH=CH+1
12280   INPUT#3,N
12300   G(CH)=INT(N/100):H(CH)=N-(G(CH)*100)
12330 WEND
12350 INPUT#3,NUM$
12360 IF NUM$<>"Y" THEN INPUT#3,REC$
12370 IF NUM$="Y" THEN REC$="N"
12380 IF PRT=1 THEN FLEN=79 ELSE FLEN=51
12400 INPUT#3,LIMIT$
12420 IF LIMIT$<>"Y" THEN 12600
12440 INPUT#3,N
12450 L1=INT(N/100):L2=N-(L1*100)
12460 IF TYPE(L1,L2)=1 THEN

        INPUT"Enter target date ",DATE$:GOSUB 20000:L3=DATE:GOTO 12500
12470 IF TYPE(L1,L2)<>4 THEN INPUT"Enter target for field ",L3

        ELSE INPUT"Enter target for field ",L3$:L4=1:GOTO 12520
12500 INPUT#3,L4
12520 '  ***** SORT CHECK ***
12600 INPUT#3,SORTFILE$
12620 IF SORTFILE$<>"Y" THEN 12700
12630 INPUT#3,SORT$
12640 SORT$=DRIVE$+SORT$
12650 OPEN"I",#1,SORT$
12700 '  ***** CALCULATIONS  ****
12710 INPUT#3,CALC$
12720 IF CALC$<>"Y" THEN 12800
12730 INPUT#3,N
12740 C1=INT(N/100):C2=N-(C1*100)
12750 INPUT#3,N
12760 C3=INT(N/100):C4=N-(C3*100)
12770 INPUT#3,FUNC
12800 '  *****  TOTALS  ****
12820 INPUT#3,TOTALS$
12830 IF TOTALS$<>"Y" THEN 12990
12840 TT=1
12850 INPUT#3,N
12860 T1(TT)=INT(N/100):T2(TT)=N-(T1(TT)*100)
12870 IF T1(TT)=0 THEN TT=TT-1:GOTO 12910
12890 TT=TT+1
12900 GOTO 12850
12910 '
12920 '
12990 RETURN
13000 '
13010 '         *******   ENTER FORMAT FOR PRINTING  *********
13020 '
13100 GOSUB 14000 :'  ** PRINT HEADER LISTING TO SHOW CHOICES **
13110 '  CH=COUNTER  ...  G(CH),H(CH)
13120 CH=0
13130 PRINT"        ENTER  FIELD  CHOICES
13132 N=1
13140 WHILE N<>0
13142   CH=CH+1
13150   PRINT"(0 to end..99 to re-display choices) # "CH" ";
13152   INPUT N
13160   IF N=99 THEN GOSUB 14000:CH=CH-1
13170   G(CH)=INT(N/100):H(CH)=N-(G(CH)*100)
13180 WEND
13200 '
13210 '         ********   FIND TOTAL LINE WIDTH  ***********
13220 '
13230 PRINT"Do you want numbering of the list (*** YES) ";
13240 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13230
13242 NUM$=Q$
13250 IF NUM$<>"Y" THEN PRINT"Do you want record #'s printed (*** YES) ";:

	DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:PRINT Q$:REC$=Q$:IF ALLOWED=0 THEN 13250
13260 IF NUM$="Y" THEN REC$="N"
13270 IF PRT<>1 THEN FLEN=51 ELSE FLEN=79
13300 '
13310 '         *******  ESTABLISH FIELD LIMITS  ********
13320 '
13330 PRINT"Do you wish to set limits (*** NO)  ";
13340 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13330
13350 LIMIT$=Q$
13360 IF LIMIT$<>"Y" THEN 13500
13370 GOSUB 14000
13380 INPUT"Enter field to limit ",N
13390 L1=INT(N/100):L2=N-(L1*100)
13400 IF TYPE(L1,L2)=1 THEN

        INPUT"Enter target date ",DATE$:GOSUB 20000:L3=DATE:GOTO 13430
13410 IF TYPE(L1,L2)<>4 THEN INPUT"Enter target for field ",L3

        ELSE INPUT"Enter target for field ",L3$:L4=1:GOTO 13450
13430 PRINT"1) Equal to 2) Low limit 3) High limit (** 1) ";
13440 DEFAULT$="1":ALLOWED$="123":GOSUB 5000:IF ALLOWED=0 THEN 13430
13442 L4=Q
13450 '
13500 '         ******   SORT  CHECK  ********
13510 '
13520 PRINT"Do you wish to use a sort key file (*** NO) ";
13530 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13520
13540 IF Q$<>"Y" THEN 13700 ELSE SORTFILE$="Y"
13550 INPUT"Enter name of sort key file ",SORT$
13552 SORT$=DRIVE$+SORT$
13560 OPEN"I",#1,SORT$
13630 '
13700 '         *****   CALCULATIONS  OPTION  ******
13710 '
13720 PRINT"Do you wish to calculate within records (** NO)";
13730 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13720
13740 IF Q$<>"Y" THEN 13800 ELSE CALC$="Y"
13750 INPUT"Enter first field for calculation ",N
13760 C1=INT(N/100):C2=N-(C1*100)
13770 INPUT"Enter second field for calculation ",N
13780 C3=INT(N/100):C4=N-(C3*100)
13790 PRINT"1) Add 2) Subtract 3) Multiply 4) Divide
13792 PRINT"      (first by/from second)   (*** 1) ";
13794 DEFAULT$="1":ALLOWED$="1234":GOSUB 5000:IF ALLOWED=0 THEN 13790
13796 FUNC=Q
13800 PRINT"Do you want to total any fields (*** NO) ";
13810 DEFAULT$="N":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13800
13820 TOTALS$=Q$
13830 IF TOTALS$<>"Y" THEN 13990
13840 TT=1
13850 PRINT"Enter field to be totaled
13852 INPUT"   (0 to end, 99 to re-list fields) ";N
13860 T1(TT)=INT(N/100):T2(TT)=N-(T1(TT)*100)
13870 IF T1(TT)=0 THEN TT=TT-1:GOTO 13920
13880 IF T1(TT)=99 THEN GOSUB 14000:GOTO 13850
13890 TT=TT+1
13892 GOTO 13850
13900 PRINT CLSCR$
13920 FOR I=1 TO TT
13930 PRINT I,LABEL$(T1(I),T2(I))
13940 NEXT I
13950 PRINT"Are these correct (*** YES) ";
13960 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 5000:IF ALLOWED=0 THEN 13950
13970 IF Q$="Y" THEN 13990 ELSE 13800
13990 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
15000 '
15100 '   ********   LIMIT CHECK  *********
15110 '
15120 LIMIT.FLAG=0
15130 CDTA=VAL(DTA$(L1,L2))
15200 IF LIMIT$<>"Y" THEN 15500
15220 IF L4=1 AND TYPE(L1,L2)=4 AND LEFT$(L3$,4)=LEFT$(DTA$(L1,L2),4) THEN 15500
15240 IF L4=1 AND TYPE(L1,L2)<>4 AND L3=CDTA THEN 15500
15260 IF L4=2 AND L3<CDTA THEN 15500
15280 IF L4=3 AND L3>CDTA THEN 15500
15300 LIMIT.FLAG=1:'   1=do not PRINT THE DATA
15500 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$(MM),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  *******
18012 IF REC$="Y" OR NUM$="Y" THEN IF PRT=1 THEN LPRINT TAB(7);

	ELSE PRINT TAB(7);
18020 '
18022 FOR I=1 TO CH
18030 ON TYPE(G(I),H(I)) GOSUB 18050,18090,18120,18150
18032 NEXT I
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$="" 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 