0 CLS
1 CLS:PRINT"SHORT WAIT FOR DATA TO BE READ IN"
10 CLEAR 1000:POKE 16526,0:
POKE16527,127
20 DEFSTRA-H
:DEFINT I-Z
:DIM A(150),X(2)
:Z=0:J=0:NF=0   
30 '....GOSUB3000
210 CLS:PRINT"TYPE IN THE NUMBER OF YOUR SELECTION."
220 PRINT"1 - ENTER NEW RECORD              2 - STORE RECORDS"
230 PRINT"3 - READ IN TAPE                  4 - SORT DATA"
240 PRINT"5 - PRINT DATA                    6 - END PROGRAM"
245 PRINT"                  7 - RECORD SEARCH"
250 INPUT ZZ
260 IF ZZ<1OR ZZ>7 THEN250
270 ON ZZ GOSUB 1000,2000,3000,4000,5000,6000,7000
280 ZZ=0:GOTO210:'     RETURN TO MENU
1000 'INPUT ROUTINE
1010 F$="":FL$="":'      INITIALIZE WORKING STRINGS
1040 CLS:PRINT:INPUT "LAST NAME   ";F$:'     15 CHAR. MAX
1045 IF F$=""PRINT"NOTHING ENTERED":FOR ZZ=0TO500:NEXT:GOTO1010
1050 IF LEN(F$)=>15THENF$=LEFT$(F$,15):'  IF NAME EXCEEDS 15 CHRS.,IT WILL BE SHORTENED TO =15.
1060 KL=15-LEN(F$):'     COMPUTES BLANKS IN NAME STRING IF NEEDED
1070 F$=F$+STRING$(KL, " "):' F$ NOW HAS 15 CHRS.
1080 FL$=FL$+F$:F$="":'  ADD F$ TO FL$ THEN REINITIALIZE F$
1090 PRINT:INPUT"FIRST NAME (MIDDLE INITIAL OPTIONAL)";F$
1095 IF F$=""PRINT"NOTHING ENTERED":FORZ=0TO500:NEXT:GOTO1090
1100 IF LEN(F$)>12PRINT"TOO LONG - LIMIT TO 12 CHRS.":GOTO1090
1110 KL=12-LEN(F$):F$=F$+STRING$(KL," "):' NOW HAS 12 CHRS
1120 FL$=FL$+F$:F$=""
1130 PRINT:INPUT"STREET ADDRESS  ";F$:'  20 CHR MAX
1135 IF F=""PRINT"NOTHING ENTERED:FORZZ=0TO500:NEXT:GOTO1130
1140 IF LEN(F$)>20PRINT"UP TO 20 CHRS - REDO":GOTO1130
1150 KL=20-LEN(F$):'     COMPUTE REMAINING BLANKS
1160 F=F+STRING$(KL," "):'      NOW HAS 20 CHRS
1170 FL$=FL$+F$:F$=""
1180 PRINT:INPUT "CITY/TOWN/ETC  ";F$
1185 IFF=""PRINT"NOTHING ENTERED":FOR ZZ=0TO500:NEXT:GOTO1180
1190 IFLEN(F$)>15 THENPRINT"UP TO 15 CHARACTERS - REDO":GOTO1180
1200 KL=15-LEN(F$):'     COMPUTE BLANKS
1210 F$=F$+STRING$(KL," "):'      NOW HAS 15 CHRS
1220 FL$=FL$+F$:F$=""
1230 PRINT:INPUT"STATE (2 LETTER ABBREV.)  ";F$
1240 IF LEN(F$)<>2THEN PRINT"ERROR - REDO":GOTO1230
1250 FL$=FL$+F$:F$=""
1260 PRINT:INPUT"ZIP CODE   ";F$
1270 IF LEN(F$)<>5THENPRINT"ERROR - REDO":GOTO1260
1280 FL$=FL$+F$:F$=""
1470 PRINT:PRINT"IF THIS IS LAST ENTRY, ENTER 'YES'"
1475 INPUT"OTHERWISE ENTER 'NO'";F$
1480 A(J)=FL$:J=J+1:IF F$="NO"GOTO1010
1490 RETURN 'END OF INPUT - RETURNS TO MENU
1999 END
2000 '  * ROUTINE TO STORE RECORDS ON TAPE
2010 PRINT"READY CASSETTE FOR STORAGE":INPUT"PRESS ENTER TO BEGIN";ZZ
2020 PRINT #-1, J-1:'       J-1 = TOTAL RECORDS
2030 FOR X=0 TO J-1
2040 PRINT #-1,A(X)
2050 NEXTX
2060 RETURN:'   RETURN TO MENU
2999 END
3000 '   *  ROUTINE TO READ FILE FROM TAPE
3010 PRINT"READY CASSETTE TO READ IN DATA FROM TAPE"
3020 INPUT "PRESS ENTER WHEN READY";ZZ
3030 INPUT#-1, J:'      J=RECORD COUNT (STORED AS 1ST DATA ITEM FOR USE IN SETTING UP ARRAY A(0) TO A(J) )
3040 FORX=0TOJ
3050 INPUT #-1, A(X)
3060 NEXTX
3070 RETURN:'  TO MENU
3999 END:'      SORTING ROUTINE FOLLOWS
4000 CLS:PRINT"TYPE IN YOUR CHOICE"
4010 PRINT:INPUT"1. SORT BY LAST NAME       2. SORT BY ZIP CODE";SS
4020 IFSS<1ORSS>2THEN4000
4030 IFSS=1GOTO4070ELSEGOSUB8000
4040 RETURN:'   TO MENU
4060 ' SORT ROUTINE FROM TRS-80 NEWSLETTER 7/80
4070 X(0)=J
4080 X(1)=VARPTR(A(0))
4090 Z=USR(VARPTR(X(0))
4100 RETURN:'   TO MENU
4999 END :'     PRINT ROUTINE BEGINS HERE
5000 CLS:FORJJ=0TOJ-1
5010 C=A(JJ):' C IS TEMPORARY STRING USED TO SIMPLIFY
5020 PRINTMID$(C,16,12);LEFT$(C,15):'        FIRST NAME   LAST NAME
5030 PRINTMID$(C,28,20):'                   STREET ADDRESS
5040 PRINTMID$(C,48,15);"  ";MID$(C,63,2);"  ";MID$(C,65,5):
' CITY/STATE/ZIP
5130 PRINT:INPUT"PRESS ENTER TO CONTINUE";ZZ:CLS:' THIS DISPLAYS ONE RECORD AT A TIME
5135 IFNF=1THEN NF=0:RETURN:'   BREAK OUT OF LOOP RE SEARCH--NF  IS SEARCH ROUTINE FLAG AND IS RESET ON EXIT
5140 NEXT JJ
5150 RETURN
5999 END
6000 PRINT"PROGRAM ENDED - TO RECOVER TYPE IN 'GOTO 210'":END
6999 END
7000 ' SBRT TO SEARCH BY NAME
7005 NF=1:'    SET FLAG TO BREAK OUT OF PRINT LOOP (5135)
7010 CLS:INPUT "TYPE IN LAST NAME";F
7015 IF F=""THEN PRINT"NOTHING ENTERED:GOTO7080
7020 IFLEN(F)>15THEN GOTO7070
7025 KL=15-LEN(F)
7030 F=F+STRING$(KL," "):'      PAD OUT TO 12 SPACES
7040 FORJJ=0TOJ
7050 IF F=LEFT$(A(JJ),15):CLS:GOSUB5010:RETURN
7060 NEXTJJ
7070 PRINT:PRINT"NO SUCH LISTING"
7080 NF=0:FORZZ=0TO500:NEXTZZ:RETURN
7999 END
8000 ' SBRT TO MAKE ZIP CODE THE SORT POINTER
8010 CLS:PRINT"PROCESSING"
8020 FOR JJ=0 TO J-1:C=A(JJ)
8030 A(JJ)=MID$(C,65,5)+C :' ZIP CODE PLACED IN FRONT HERE TO BE USED AS KEY. ORIGINAL ZIP CODE IS STILL IN PLACE ALSO!
8040 NEXTJJ
8050 GOSUB4070:' SORT BY ZIP AND RETURN TO 8060 TO RESTORE
8060 FOR JJ=0 TO J-1:C=A(JJ):'  RESTORE ORIGINAL ORDER
8070 A(JJ)=MID$(C,6):'  STRIP OFF ZIP CODE FROM FRONT
8080 NEXTJJ:RETURN:'            TO MENU
29999 END:' ALLAN EMERT'S MACHINE LANGUAGE SORT FOLLOWS
30000 ' LIST FOR 16K (ENTRY =&H7F00)
30010 ' MEMORY SIZE = 32512
30020 DATA 205,127,10,94,35,86,237,83,19,191,35,94,35,86,237,83
30030 DATA213,191,33,0,0,34,211,191,237,91,211,191,203,59,175
30040 DATA203,58,48,2,203,251,237,83,211,191,122,179,200,42,19
30050 DATA191,237,82,34,207,191,33,0,0,34,205,191,42,205,191,34
30060 DATA203,191,42,203,191,237,91,211,191,25,34,209,191,235,33
30070 DATA0,0,25,25,25,229,237,91,203,191,33,0,0,25,25,25,237
30080 DATA75,213,191,9,235,225,9,229,213,14,0,126,71,26,184,48
30090 DATA3,14,1,71,175,176,40,25,197,19,35,78,35,70,197,225
30100 DATA235,78,35,70,197,225,193,26,150,56,10,32,39,19,35,16
30110 DATA246,203,65,32,31,209,225,6,3,78,235,126,113,235,119
30120 DATA35,19,16,246,42,211,191,235,42,203,191,175,237,82,34
30125 '
30126 '
30127 '
30150 '-------25 NOV 82: PROGRAM EDITED THRU LINE 1200. ERROR IN STRING VARIABLES NEEDING $ ADDED AFTER EACH F, ETC.
