1 '	ELECTRONIC CARD FILE
2 ' By Joe Wiellette    617-731-3178
3 ' Permission is granted to use, but not to sell,
4 '  these programs.
5 ON ERROR GOTO 3260
8 WIDTH 52
10 '            ********    PROGRAM   MENU   **********
20 '
30 '
50 DEFINT S,L,D,I,J,K,T
100 '************  VARIABLES  USED  ***************
110 'DLR$       Format for PRINT-USING when printing dollar amounts
130 'TYPE(I,J)  Type of field for sector I, field # J
140 'LENGTH(I,J)   Length of field as above
150 'LABEL$(I,J)   Name assigned by you to each field
160 'DTA$(I,J)  The actual data saved within the field
170 'FILE.NAME$    General name of the file
180 'HEADER$    Name of the file containing field headings and other data
190 'CLSCR$     Function to clear the screen and beep terminal
200 'PURPOSE$   Purpose of the file saved in HEADER file
210 'MENU$      Function to print menu of major DEFAULTs
220 'DRIVE$     Drive selected for data and programs
230 'A$(I),A(I)    6 possible headings from heading file - only few used
240 'RECORD$    String of A(1) bytes of raw data loaded from a disk sector
250 'A$(1)      File name
260 'A$(2)      Notes
270 'A(1)       Number of bytes per sector
280 'A(2)       Number of disk sectors used for each record
290 'PROGRAM$   Program names branched to from this program
300 'FILECOUNT  Total number of fields used on label
310 'FIELDS     Temporary input for field number
320 'LINENUM    Line number on label
330 'LINES(LINENUM)   Fields within line
340 'REPORT$    Name of file containing report form
350 'G(FIELDCOUNT),H(FIELDCOUNT)    I,J, identification of fields used
360 'L1,L2      I,J of limit field
370 'DATE$,DATE    date entered as limit 
380 'L3,L3$     limit as number or string
390 'L4         type of limit (high, low, or exact)
400 'LIMIT$     Yes or No on Limit
410 'SORTFILE$  Sort flag Yes or No
420 'SORT$      Name of sort key file
430 'HIGH,LOW   High and low record #'s 
440 'F(I)       Number of fields  for each sector
450 'MONTH, YEAR, JULIAN, DAY     Used in date conversion
460 'LN         Length of field
470 'D1         Temp used in date conversion
471 'COUNT      Current record number counter
472 'M,MM       Temp in get record
473 'M$,M$(I)   Packed record just retrieved
474 'DELETED$   First character of packed record
475 'F(I),F     Temp in record conversion
476 'K          Temp counter in print fields
477 'S$(I)      Temp packed record
478 'DRIVE$     Drive containing data
500 'L          Temporary counter in input subroutine
510 'DEFAULT$   Input choice on return
520 'ALLOWED$   responses allowed on an input
530 'ALLOWED    Flag for input    allowed=1  not allowed=0
540 'BELL$      Bell
550 'REVERSE$   Turn on reverse video
560 'REVERSE.OFF$  Turn off reverse video
570 'HOME$      Send the cursor to home position
580 'XD		Counter for line display on input in operate program
590 'PRT		Printer flag(1) for printer or screen (0)
1000 '
1010 '*****************    INITIALIZATION   *****************
1020 '
1040 DLR$="$$###,###,###.##"
1050 DIM TYPE(10,20), LENGTH(10,20), LABEL$(10,20), DTA$(10,20) 
1060 DIM M$(20),S$(10),G(20),H(20)
1070 '
1080 '   ********    FUNCTIONS USED IN PROGRAM  *******
1090 '
1100 CLSCR$=CHR$(26)
1120 BELL$=CHR$(7)
1130 REVERSE$=CHR$(27)+CHR$(41)
1140 REVERSE.OFF$=CHR$(27)+CHR$(40)
1150 HOME$=CHR$(30)
1152 UNDER$=CHR$(27)+CHR$(108)
1154 STOP.UNDER$=CHR$(27)+CHR$(109)
1160 '
1170 '  *************   OPEN FILES NEEDED - GET INITIAL INFORMATION  ********
1180 '
1190 PRINT CLSCR$
1200 PRINT UNDER$"1) Old file "STOP.UNDER$"2) New file 3) Skip to HELP ";
1202 DEFAULT$="1":ALLOWED$="123":GOSUB 3130:IF ALLOWED=0 THEN 1200
1204 IF Q$="2" THEN 2000
1206 IF Q$="3" THEN CHAIN"HELP",50,ALL
1210 INPUT"Enter file Name ",FILE.NAME$
1220 PRINT"Which drive (A or "UNDER$"B"STOP.UNDER$")"
1230 DEFAULT$="B":ALLOWED$="AB":GOSUB 3130
1240 IF ALLOWED=0 THEN PRINT"MUST BE A,B OR C ":GOTO 1220
1260 DRIVE$=Q$+":"
1280 HEADER$=DRIVE$+FILE.NAME$+"X"
1290 OPEN"I",#1,HEADER$
1300 FOR I= 1 TO 10
1310 INPUT#1,A$(I),A(I)
1320 NEXT I
1330 FOR I= 1 TO A(2) :' **  FOR THE NUMBER OF A(1) BYTE DISK SECTORS **
1340 INPUT#1,F(I)  :'  **  GET FIELD #'S FOR EACH SECTOR  **
1350 FOR J= 1 TO F(I) :'  ** FOR THE NUMBER OF FIELDS  **
1360 INPUT#1,TYPE(I,J),LENGTH(I,J),LABEL$(I,J)
1370 NEXT J
1380 NEXT I
1390 CLOSE 1
1400 FILE.NAME$=DRIVE$+A$(1)
1410 OPEN"R",#2,FILE.NAME$,A(1)
1420 FIELD#2,A(1) AS RECORD$
1430 '
1440 '
1450 '
1460 '
1470 '          *******    MAIN  PROGRAM  ******
1480 '
1490 PRINT CLSCR$
1500 PRINT"1) Report
1501 PRINT"2) Enter report form
1502 PRINT"3) Labels
1503 PRINT"4) Sort
1504 PRINT UNDER$"5) View, change, add or delete "STOP.UNDER$
1505 PRINT"6) Merge
1506 PRINT"7) Help
1509 PRINT:PRINT"9)    END
1510 PRINT:PRINT"Which ";
1520 DEFAULT$="5":ALLOWED$="12345679":GOSUB 3130:IF ALLOWED=0 THEN 1490
1530 '
1540 '   **********    EXIT TO ANOTHER PROGRAM  **********
1550 '
1560 ON Q GOSUB 1600,1610,1620,1630,1640,1650,1660
1570 IF Q=9 THEN END
1580 CHAIN PROGRAM$,50,ALL
1590 STOP
1600 PROGRAM$="REPORT":RETURN
1610 PROGRAM$="REPT-FRM":RETURN
1620 PROGRAM$="MAIL":RETURN
1630 PROGRAM$="SORT":RETURN
1640 PROGRAM$="OPERATE":RETURN
1650 PROGRAM$="MERGE":RETURN
1660 PROGRAM$="HELP":RETURN
2000 '
2020 CLOSE
2030 PRINT CLSCR$
2040 PRINT UNDER$"1) Create a new file"STOP.UNDER$
2050 PRINT"2) Return to MENU 
2060 DEFAULT$="1":ALLOWED$="12":GOSUB 3130:IF ALLOWED=0 THEN 2030
2070 IF Q$="2" THEN 1170
2080 PRINT"Which drive (A or "UNDER$"B"STOP.UNDER$")";
2090 DEFAULT$="B":ALLOWED$="AB":GOSUB 3130:IF ALLOWED=0 THEN 2080
2100 DRIVE$=Q$+":"
2110 PRINT CLSCR$
2120 INPUT"Enter a name for the file ";A$(1)
2130 IF LEN(A$(1))<1 THEN PRINT"You really must enter something ":GOTO 2120
2140 IF LEN(A$(1))>7 THEN PRINT"Name too long. Use 7 letters or less.":GOTO 2120
2150 FOR I=1 TO LEN(A$(1))
2160 IF ASC(MID$(A$(1),I,1))>95 THEN PRINT"You must use upper case letters."

        :GOTO 2120
2170 NEXT I
2190 PRINT"A) 20 B) 40 C) 80 "UNDER$"D) 127 "STOP.UNDER$"E) other size "
2200 PRINT"   How many places per card ";
2210 DEFAULT$="D":ALLOWED$="AaBbCcDdEe":GOSUB 3130:IF ALLOWED=0 THEN 2200
2220 IF Q$="A" OR Q$="a" THEN A(1)=21
2230 IF Q$="B" OR Q$="b" THEN A(1)=41
2240 IF Q$="C" OR Q$="c" THEN A(1)=81
2250 IF Q$="D" OR Q$="d" THEN A(1)=128
2260 IF Q$="E" OR Q$="e" THEN INPUT"Size ";A(1):

        IF A(1)<1 OR A(1)>127 THEN 2260 ELSE A(1)=A(1)+1
2270 '  ****   ENTER THE FIELDS  *****
2280 PRINT CLSCR$
2290 I=1:J=1
2300 LENGTH(1,1)=2:TYPE(1,1)=1:LABEL$(1,1)="DATE ENTERED":LN=2
2310 PRINT"Type of field(Date, Number, $ollar, "UNDER$"String"STOP.UNDER$")";
2320 ALLOWED$="DdNn$Ss":DEFAULT$="S":GOSUB 3130:IF ALLOWED=0 THEN 2310
2330 IF Q$="S" OR Q$="s" THEN INPUT"Field length ";L:

        T=4:IF L=0 THEN 2330
2340 IF L>A(1)-1 THEN PRINT"Field length maximum = "A(1)-1:GOTO 2330
2350 IF Q$="D" OR Q$="d" THEN T=1:L=2
2360 IF Q$="N" OR Q$="n" THEN T=2:L=4
2370 IF Q$="$" THEN T=3:L=8
2380 IF LN+L>A(1)-1 THEN F(I)=J:J=1:LN=L:I=I+1:GOTO 2410
2390 LN=LN+L
2400 J=J+1
2410 LENGTH(I,J)=L:TYPE(I,J)=T
2420 INPUT"Field name ";LABEL$(I,J):IF LEN(LABEL$(I,J))<1 THEN 2420
2430 PRINT REVERSE$A(1)-1-LN" left on this card "REVERSE.OFF$
2440 PRINT"Any more fields (*** = yes) ";
2450 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 3130:IF ALLOWED =0 THEN 2440
2460 IF Q$="Y" OR Q$="y" THEN 2310
2470 A(2)=I
2480 F(I)=J
2490 '          *******   REVIEW CHOICES  *******
2500 PRINT CLSCR$
2510 FOR K=1 TO I
2520 PRINT"Here are the fields in card "K
2530 FOR L=1 TO F(K)
2540 PRINT LENGTH(K,L)" Spaces"TAB(15)LABEL$(K,L)
2550 USED=USED+LENGTH(K,L)
2560 NEXT L
2570 PRINT"Spaces not used in this card = "A(1)-1-USED
2578 PRINT REVERSE$;
2580 PRINT"Tap return for next card ";:Q$=INPUT$(1):USED =0
2582 PRINT REVERSE.OFF$;
2590 PRINT:NEXT K
2600 PRINT"Are these correct ("UNDER$"Y"STOP.UNDER$"/N)";
2610 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 3130:IF ALLOWED=0 THEN 2600
2620 IF Q$<>"Y" AND Q$<>"y" THEN 2030
2630 PRINT:PRINT"Do you want to pick a field for
2632 PRINT"INSTANT ACCESS ( "UNDER$"Y"STOP.UNDER$"/N)";
2640 DEFAULT$="Y":ALLOWED$="YyNn":GOSUB 3130:IF ALLOWED=0 THEN 2630
2650 IF Q$<>"Y" AND Q$<>"y" THEN 3000
2660 PRINT
2670 INPUT"Enter field name for access ";NAM$
2680 FOR N=1 TO 10
2690 FOR P=1 TO 20
2700 IF LABEL$(N,P)=NAM$ THEN 2730
2710 NEXT P,N
2720 PRINT"Can't find it. Try again ":GOTO 2630
2730 A(5)=(N*100)+P
2732 INPUT"Enter the max. # of files ";MAX
2740 R$=DRIVE$+A$(1)+"Z"
2750 N=A(5)
2760 I=INT(N/100):J=N-(I*100)
2770 X=LENGTH(I,J)
2780 OPEN"R",#3,R$,X+4
2790 FIELD#3,X AS S1$,2 AS S2$,2 AS S3$
2800 LSET S1$="":LSET S2$=MKI$(0):LSET S3$=MKI$(0)
2810 FOR I=1 TO MAX+100
2820 PUT#3,I
2830 NEXT I
3000 R$=DRIVE$+A$(1)+"X"
3010 OPEN"O",#1,R$
3020 FOR I=1 TO 10
3030 WRITE#1,A$(I),A(I)
3040 NEXT I
3050 FOR I=1 TO A(2)
3060 PRINT#1,F(I)
3070 FOR J=1 TO F(I)
3080 WRITE#1,TYPE(I,J),LENGTH(I,J),LABEL$(I,J)
3090 NEXT J
3100 NEXT I
3110 CLOSE
3120 GOTO 1170
3130 '
3140 '  * *********   ENTER RESPONSE  *******
3150 '
3160 PRINT BELL$;
3170 ALLOWED=0
3180 Q$=INPUT$(1)
3190 PRINT Q$
3200 IF Q$=CHR$(13) THEN Q$=DEFAULT$
3210 Q=VAL(Q$)
3220 FOR L=1 TO LEN(ALLOWED$)
3230 IF MID$(ALLOWED$,L,1)=Q$ THEN ALLOWED=1
3240 NEXT L
3250 RETURN
3260 '
3270 '         ERROR TRAPPING
3280 '
3290 IF ERL=1290 THEN CLOSE:

        PRINT"File not found ":FOR P=1 TO 500:NEXT P:

        GOTO 2000
3300 IF ERR=5 OR ERR=62 THEN PRINT"File error - try again":CLOSE:GOTO 1200
3310 ON ERROR GOTO 0
:NEXT P:

        GOTO 2000
3300 IF ERR=5 OR ERR=62 THEN PRINT"File error - try again":CLOSE:GOTO 1200
3310