Compucolor.org – Virtual Media

Listing of file='MAIL.BAS;01' on disk='vmedia/mailing_list-sector.ccvf'

1 REM  PERSONAL MAILING LIST PROGRAM
2 REM  PROGRAMMER: NINA ROVINSKI
3 REM  COPYRIGHT MARCH 9, 1981 BY COMPUWORLD, INC.
6 PLOT 15:POKE 33289,132
8 TM= 65535- 1800
10 BR= INT (TM/ 256):POKE 32941,BR:POKE 32940,TM- BR* 256
12 CLEAR 2000:PLOT 27,4:PRINT "LOAD IO.PRG;1":PLOT 27,27
13 POKE 33283,0:POKE 33284,249:POKE 33221,195:POKE 33222,164
14 POKE 33223,250:POKE 33247,31:POKE 33279,0:POKE 64182,0
15 ADR= 65470
16 FO= 0:REM  NO OPEN FILES
17 FA= - 1:REM  NO FORMS ALIGN
20 GOSUB 6400:PLOT 27,24
100 GOSUB 1000
125 GOSUB 1300
150 GOSUB 1600
200 GOSUB 6200
215 GOSUB 1125
225 GOSUB 1315
250 GOSUB 1400:GOSUB 2900
275 ON OGOTO 410,420,430,440,450,460,470,480,490,500,510,520,530
410 AN= 0:GOSUB 2200:IF AN= 0THEN 250
415 GOTO 410
420 AN= 0:GOSUB 2500:IF AN= 0THEN 250
425 GOTO 420
430 AN= 0:GOSUB 2400:IF AN= 0THEN 250
435 GOTO 430
440 AN= 0:GOSUB 3000:IF AN= 0THEN 250
445 GOTO 440
450 GOSUB  2700:GOTO  250
460 GOSUB  2800:GOTO  250
470 GOSUB 3200:GOTO 250
480 GOSUB 4000:GOTO 250
490 GOSUB 3200:GOTO 250
500 GOSUB 3400:GOTO 250
510 GOSUB 4200:GOTO 250
520 GOSUB 4300:GOTO 250
530 GOTO 6600
999 END
1000 REM  CRT DEFAULTS
1005 KB= 33278:KF= 33247
1010 CL$= CHR$ (26):REM  CURSOR LEFT
1015 EL$= CHR$ (11):REM  ERASE LINE
1020 ES$= CHR$ (12):REM  ERASE PAGE
1025 EB$= CHR$ (31)+ CHR$ (7):REM  BLINK+BEEP
1030 DB$= CHR$ (15):REM  DISABLE BLINK
1035 EE$= "":FOR I= 1TO 31:EE$= EE$+ EL$+ CHR$ (10):NEXT I
1040 I1= 40:DH$= "":SP$= "":DX$= "":FOR I= 1TO I1
1045 DH$= DH$+ "_":SP$= SP$+ " ":DX$= DX$+ CL$:NEXT I
1050 RETURN :REM  COPYRIGHT COMPUWORLD, INC. 1980
1052 REM  2ND ENTRY POINT CH=CHARACTER
1055 POKE ADR,1:POKE ADR+ 1,1
1060 H= CALL (0):CH= PEEK (ADR+ 4)
1070 RETURN
1100 REM  CURSOR CONTROL
1105 PLOT 3,X,Y:RETURN
1125 REM  OPEN FILES
1130 FILE "R",1,DS$+ "PDATA",1
1135 FILE "R",2,DS$+ "PTR",1
1152 FO= 1
1155 RETURN
1200 REM  GET DATA LINE RETURN D$,D,DD=LENGTH OF INPUT LIN
1205 D$= "":PRINT LEFT$ (DH$,DL);LEFT$ (DX$,DL);
1210 POKE ADR,DT:POKE ADR- 1,DL
1215 H= CALL (0):DD= PEEK (ADR- 2)
1220 D$= "":IF DD= 0THEN 1295
1225 FOR H= 1TO DD:D$= D$+ CHR$ (PEEK (65470+ H)):NEXT H
1230 IF DT> 1THEN D= VAL (D$)
1295 RETURN
1300 REM  TITLE
1305 PRINT ES$;:X= 16:Y= 0:GOSUB 1100
1310 PLOT 19,14:PRINT "PERSONAL MAILING LIST PROGRAM":PLOT 15
1312 RETURN
1315 Y= 0:X= 51:GOSUB 1100:PLOT 20
1318 PRINT "DATE-";
1320 PLOT 22:PRINT DZ$:RETURN
1400 REM  OPTIONS
1401 X= 0:Y= 0:GOSUB 1100:PRINT SPC( 15):GOSUB 1100
1402 PLOT 22:PRINT "MODE=";:PLOT 20:PRINT "OPTION   "
1403 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,60);
1405 Y= 6:GOSUB 1100:PLOT 18
1410 PRINT " 1 - INSERT A NEW RECORD"
1415 PRINT " 2 - DELETE A RECORD"
1420 PRINT " 3 - UPDATE A RECORD"
1423 PRINT " 4 - DISPLAY A RECORD"
1425 PRINT " 5 - DISPLAY ALL RECORDS"
1427 PRINT " 6 - PRINT ALL RECORDS"
1430 PRINT " 7 - DISPLAY RECORDS BY A SELECTIVE PARAMETER"
1435 PRINT " 8 - PRINT FORMS ALIGNMENT FOR MAILING LABELS
1440 PRINT " 9 - PRINT MAILING LABEL BY A SELECTIVE PARAMETER"
1445 PRINT " A - PRINT MAILING LABELS IN ALPHABETICAL ORDER"
1447 PRINT " B - SORT RECORDS IN ZIP CODE ORDER "
1450 PRINT " C - PRINT MAILING LABELS IN ZIP CODE ORDER "
1460 PRINT " D - EXIT"
1465 X= 0:Y= 22:GOSUB 1100:PLOT 18
1466 DT= 1:DL= 1
1470 PRINT "ENTER OPTION DESIRED * _"+ CL$;
1475 PLOT 23:D$= "":GOSUB 1210
1477 O$= D$:PRINT LEFT$ (EE$,4);
1480 IF DD= 0THEN 1465
1485 O= VAL (O$):IF  O$> = "A" THEN  O= ASC (O$)- 55
1490 IF O> 0AND O< 14THEN RETURN
1495 X= 0:Y= 23:GOSUB 1100:PLOT 17
1497 PRINT EB$+ "INVALID OPTION - TRY AGAIN"+ DB$:GOTO 1465
1499 END
1500 REM  PUT
1505 AA$= "":FOR I= 1TO 8:AA$= AA$+ ND$(I):NEXT I
1510 PUT 1,MR,1;AA$[128]
1515 FILE "D",1
1520 RETURN
1525 REM  GET
1530 GET 2,1,5;LA:IF LA= 0THEN MR= - 1:RETURN
1535 MR= LA
1540 GET 1,MR,1;AA$[128]
1550 IF O= 1THEN 1575
1555 I1= 1:FOR I= 1TO 8
1560 ND$(I)= MID$ (AA$,I1,NN(I)):I1= I1+ NN(I):NEXT I
1565 RETURN
1575 FOR I= 1TO 8:ND$(I)= LEFT$ (SP$,NN(I))
1576 NEXT I
1580 RETURN
1600 REM  INIT PARMS
1602 DIM LB$(3,6)
1605 DIM NN$(8)
1610 DATA "FIRST NAME","LAST NAME","STREET","CITY","STATE"
1615 DATA "ZIP CODE","TELEPHONE","COMMENTS"
1630 FOR I= 1TO 8:READ I$:I$= I$+ " -----------------"
1635 I$= LEFT$ (I$,12):NN$(I)= I$+ " "
1650 NEXT I
1652 DIM S$(13),S(13)
1655 DIM NN(8),N(8),N$(8)
1658 DATA 15,20,20,15,10,9,12,27
1660 FOR I= 1TO 8:READ NN(I):NEXT I
1665 DIM ZP$(500),ZP(500,1)
1670 DIM IL(8)
1675 DATA 6,7,8,9,10,11,12,13
1680 FOR I= 1TO 8:READ IL(I):NEXT I
1685 DIM QQ$(8),QQ(8)
1687 FOR I= 1TO 8:QQ$(I)= "EQ":QQ(I)= 1:NEXT I
1696 DATA 31,29,31,30,31,30,31,31,30,31,30,31
1697 DIM DF(12):FOR I= 1TO 12:READ DF(I):NEXT I
1699 RETURN
1700 REM  GET LEN NO BLANKS
1705 FOR I= NN(U)TO 1STEP - 1
1710 IF MID$ (ND$(U),I,1)= " "THEN NEXT I
1720 RETURN
1900 REM  UPDATE ND$ BY U
1905 X= 29:Y= IL(U):GOSUB 1100:PLOT 19
1910 DT= 1:DL= NN(U):GOSUB 1200
1911 IF O= 7THEN RETURN
1912 IF C= 1AND DD= 0THEN 1935
1915 IF O= 3AND C= 1AND DD= 0THEN 1935
1925 H= NN(U)- DD:IF H= 0THEN ND$(U)= D$:GOTO 1935
1930 ND$(U)= D$+ LEFT$ (SP$,H)
1935 PLOT 23:GOSUB 1100:PRINT ND$(U)
1940 RETURN
1950 REM  NO RECS
1955 Y= 5:X= 0:GOSUB 1100:PLOT 17
1960 PRINT EB$+ "NO RECORDS ON FILE ! "+ DB$;
1965 GOSUB 2150:RETURN
2000 REM  DISPLAY NN$ AND ND$ BY U
2005 X= 16:Y= IL(U):GOSUB 1100:PLOT 22
2010 PRINT NN$(U);
2013 IF O= 7OR O= 9THEN RETURN
2015 PLOT 23:PRINT ND$(U)
2020 RETURN
2100 REM  LETTERS FOR UPDATE
2105 X= 13:Y= IL(U):GOSUB 1100:PLOT 21
2120 I$= STR$ (U):I$= RIGHT$ (I$,1):PRINT I$;")"
2125 RETURN
2150 REM  SLEEP
2155 FOR  I= 1 TO  1000:NEXT  I:RETURN
2200 REM  ADD A NEW REC
2205 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
2210 GOSUB 1525
2215 IF MR> 0THEN 2230
2220 Y= 5:GOSUB 1100:PLOT 17
2225 PRINT EB$+ "NO MORE ROOM FOR ACCOUNTS !"+ DB$
2227 GOSUB 2150:RETURN
2230 FOR U= 1TO 8:GOSUB 2000:NEXT U
2235 FOR U= 1TO 8:GOSUB 1900
2238 IF U= 2AND LEFT$ (ND$(1),1)= " "AND LEFT$ (ND$(2),1)= " "THEN AN= 0:RETURN
2240 IF U< > 1THEN 2250
2245 IF DD= 0THEN AN= 0:RETURN
2250 NEXT U
2255 FOR U= 1TO 8:GOSUB 2100:NEXT U
2260 X= 10:Y= 20:GOSUB 1100:PLOT 19
2265 PRINT "ENTER OPTION NUMBER TO UPDATE (X=EXIT) * _"+ CL$;
2270 DT= 1:DL= 1:GOSUB 1200:IF DD= 0THEN PRINT :GOTO 2260
2273 IF D$= "X"THEN 2277
2274 C= 1:U= VAL (D$):IF U> 0AND U< 9THEN GOSUB 1900:GOTO 2260
2275 PRINT :GOTO 2260
2277 GOSUB 1100:PRINT EL$;:GOSUB 1100:PLOT 19:AN= 1
2278 IF O= 3THEN PRINT "PROCEED TO UPDATE RECORD (Y OR N) * _"+ CL$;:GOTO 2280
2279 PRINT "PROCEED TO INSERT RECORD (Y OR N) * _"+ CL$;
2280 DL= 1:DT= 1:GOSUB 1200:IF D$= "Y"THEN 2286
2281 IF D$= "N"THEN 2283
2282 PRINT :GOTO 2277
2283 PLOT 20:GOSUB 1100:PRINT EL$:X= 20:Y= 20:GOSUB 1100
2284 IF O= 3THEN PRINT "UPDATE DISREGARDED ";:GOSUB 2150:UD= - 1:RETURN
2285 PRINT "INSERT DISREGARDED";:GOSUB 2150:RETURN
2286 GOSUB 1100:PRINT EL$;:GOSUB 1100
2287 PRINT "RECORD BEING PROCESSED; PLEASE STAND BY ";
2288 PRINT :SR= - 1
2289 IF O= 3THEN RETURN
2292 GOSUB 2300
2295 RETURN
2300 REM  PUT POINTERS IN ORDER
2303 GET 2,1,5;LA
2305 MR= LA:GOSUB 1500:OL= LA:TD$= ND$(2)+ ND$(1)
2308 GET 2,OL,5;Y:LA= Y:PUT 2,1,5;LA
2310 GET 1,1;CT:IF CT= 0THEN Z= 1:GOTO 2370
2315 GET 2,CT;B:GET 1,B;ND$(1)[15],ND$(2)[20]
2318 ND$(0)= ND$(2)+ ND$(1)
2320 IF TD$> ND$(0)THEN Z= CT+ 1:GOTO 2370
2325 BF= 1:EF= CT
2328 OB= BF:BF= (EF+ BF)/ 2:BF= INT (BF)
2330 GET 2,BF;B:GET 1,B;ND$(1)[15],ND$(2)[20]
2332 ND$(0)= ND$(2)+ ND$(1)
2335 IF TD$= ND$(0)THEN 2380
2338 IF TD$> ND$(0)AND EF- BF= 0THEN Z= EF+ 1:GOTO 2360
2340 IF TD$< ND$(0)AND EF- BF= 0THEN Z= EF:GOTO 2360
2345 IF TD$> ND$(0)AND EF- BF= 1THEN BF= EF:GOTO 2330
2348 IF TD$> ND$(0)THEN 2328
2350 EF= BF:BF= OB:GOTO 2328
2360 TB= B:GET 2,Z+ 1;B
2363 IF B= 0THEN PUT 2,Z+ 1;TB:GOTO 2370
2365 L= 1:GET 2,((CT+ 1)- L);B:PUT 2,((CT+ 1)- (L- 1));B
2368 L= L+ 1:GET 2,((CT+ 1)- L);B:PUT 2,((CT+ 1)- (L- 1));B
2369 IF ((CT+ 1)- L)< > ZTHEN 2368
2370 PUT 2,Z;OL:CT= CT+ 1
2375 PUT 1,1;CT:FILE "D",1,2:RETURN
2380 GET 2,1,5;LA:PUT 2,OL,5;LA
2385 LA= OL:PUT 2,1,5;LA:FILE "D",2
2390 REM  NAME ALREADY ON FILE
2397 X= 10:Y= 20:GOSUB 1100:PRINT EL$;:GOSUB 1100
2398 PLOT 17:PRINT CHR$ (7)+ "    THIS RECORD IS ALREADY ON FILE ";
2399 GOSUB 2150:OF= - 1:RETURN
2400 REM  UPDATE
2402 UD= 1:GET 1,1;CT
2405 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
2406 IF CT= 0THEN 1950
2408 C= 0:NF= 1
2410 FOR U= 1TO 2:ND$(U)= "":GOSUB 2000:NEXT U
2415 X= 15:Y= 17:GOSUB 1100:PLOT 19
2420 PRINT "ENTER NAME YOU WISH TO UPDATE ";
2425 FOR U= 1TO 2:GOSUB 1900
2430 IF U< > 1THEN 2440
2435 IF DD= 0THEN AN= 0:RETURN
2440 NEXT U
2445 GOSUB 2600:AN= 1:IF NF= - 1THEN RETURN
2448 MR= B:GOSUB 1540
2450 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
2453 FOR U= 1TO 8:GOSUB 2000:NEXT U
2454 TZ$= ND$(6)
2455 TF$= ND$(1):TL$= ND$(2):GOSUB 2255
2456 IF UD= - 1THEN RETURN
2458 IF TF$= ND$(1)AND TL$= ND$(2)THEN 2485
2459 IF TZ$< > ND$(6)THEN SR= - 1
2460 GOSUB 2570:GOSUB 2300:RETURN
2485 GOSUB 1500
2490 RETURN
2500 REM  DELETE
2502 GET 1,1;CT
2505 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
2506 IF CT= 0THEN 1950
2510 FOR U= 1TO 2:ND$(U)= "":GOSUB 2000:NEXT U
2515 X= 15:Y= 17:GOSUB 1100:PLOT 17
2520 PRINT "ENTER NAME YOU WISH TO DELETE ";
2525 FOR U= 1TO 2:GOSUB 1900
2530 IF U< > 1THEN 2540
2535 IF DD= 0THEN AN= 0:RETURN
2540 NEXT U
2545 GOSUB 2600:AN= 1:IF NF= - 1THEN RETURN
2548 MR= B:GOSUB 1540:PRINT X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
2550 FOR U= 1TO 8:GOSUB 2000:NEXT U
2555 X= 14:Y= 20:GOSUB 1100:PLOT 17
2560 PRINT "PROCEED TO DELETE RECORD (Y OR N) * _"+ CL$;
2562 DT= 1:DL= 1:GOSUB 1200:IF D$= "Y"THEN 2570
2564 IF D$= "N"THEN GOSUB 1100:PRINT EL$;:GOTO 2568
2566 PRINT :GOTO 2555
2568 X= 20:Y= 20:GOSUB 1100:PLOT 20
2569 PRINT "DELETE DISREGARDED ";:GOSUB 2150:PRINT :RETURN
2570 GET 2,1,5;LA:Y= LA:PUT 2,B,5;Y
2575 LA= B:PUT 2,1,5;LA:N= (CT+ 1)- BF
2580 FOR T= 1TO N:GET 2,(BF+ T);B
2585 PUT 2,(BF+ (T- 1));B:NEXT T
2588 CT= CT- 1:PUT 1,1;CT
2590 FILE "D",1,2
2592 SR= - 1
2595 RETURN
2599 END
2600 REM  FIND NAME
2605 GET 1,1;CT:TD$= ND$(2)+ ND$(1)
2610 BF= 1:EF= CT
2615 OB= BF:BF= (EF+ BF)/ 2:BF= INT (BF)
2620 GET 2,BF;B:GET 1,B;ND$(1)[15],ND$(2)[20]
2623 ND$(0)= ND$(2)+ ND$(1)
2625 IF TD$= ND$(0)THEN NF= 1:RETURN
2630 IF (TD$> ND$(0)OR TD$< ND$(0))AND EF- BF= 0THEN 2680
2635 IF TD$> ND$(0)AND EF- BF= 1THEN BF= EF:GOTO 2620
2640 IF TD$> ND$(0)THEN 2615
2645 EF= BF:BF= OB:GOTO 2615
2680 X= 15:Y= 17:GOSUB 1100:PRINT EL$;:GOSUB 1100
2685 PLOT 17:PRINT "THIS RECORD IS NOT ON FILE ";:GOSUB 2150
2690 NF= - 1:RETURN
2700 REM  DISPLAY ALL RECORDS
2702 GET 1,1;CT
2705 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
2707 Y= Y+ 1:GOSUB 1100:PLOT 21
2710 PRINT "NAME/TELEPHONE            ADDRESS                   COMMENTS"
2715 Y= Y+ 1:GOSUB 1100:PLOT 20
2720 PRINT "------------------------- ------------------------- ------------"
2721 IF CT= 0THEN 2780
2723 Y= 5:GOSUB 1100
2725 FOR J= 1TO CT:GET 2,J;B:MR= B
2730 PLOT 23
2735 GOSUB 1540:U= 1:GOSUB 1700
2736 IF I= 0THEN I= 1
2737 IF I> 10THEN I= 10
2738 X= 0:GOSUB 1100:PRINT LEFT$ (ND$(1),I)+ " "+ LEFT$ (ND$(2),14)
2740 X= 26:GOSUB 1100:PRINT ND$(3)+ " ";
2745 X= 52:GOSUB 1100:PRINT LEFT$ (ND$(8),12)
2748 X= 0:Y= Y+ 1:GOSUB 1100
2750 PRINT ND$(7):X= 26:GOSUB 1100
2752 U= 4:GOSUB 1700:IF I= 0THEN I= 10
2755 PRINT LEFT$ (ND$(4),I)+ ","+ LEFT$ (ND$(5),2);
2760 PRINT " ";LEFT$ (ND$(6),5);
2765 X= 52:GOSUB 1100:PRINT MID$ (ND$(8),13,12)
2766 IF J= CTTHEN 2780
2770 IF J/ 8= INT (J/ 8)THEN 2790
2775 Y= Y+ 2:GOSUB 1100:NEXT J
2780 X= 13:Y= 30:GOSUB 1100:PLOT 19
2783 PRINT "END OF LIST - PRESS CR TO EXIT *  "+ CL$;
2785 DT= 1:DL= 1:GOSUB 1200:IF DD= 0THEN RETURN
2788 PRINT :GOTO 2780
2790 X= 13:Y= 30:GOSUB 1100:PLOT 19
2793 PRINT "PRESS CR TO CONTINUE (X=EXIT) * _"+ CL$;
2795 DT= 1:DL= 1:GOSUB 1200:IF DD= 0THEN 2798
2796 IF D$= "X"THEN RETURN
2797 GOTO 2790
2798 X= 0:Y= 5:GOSUB 1100:PRINT LEFT$ (EE$,54);
2799 Y= 3:GOTO 2775
2800 REM  PRINT ALL RECORDS
2803 GET 1,1;CT
2805 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
2807 IF CT= 0THEN 1950
2810 Y= 5:GOSUB 1100
2815 PRINT "PROCEED TO PRINT (Y OR N) ? _"+ CL$;
2820 DT= 1:DL= 1:GOSUB 1200:IF D$= "N"THEN RETURN
2825 IF D$< > "Y"THEN PRINT :GOTO 2810
2830 GOSUB 1100:PRINT EL$;:PLOT 22
2835 GOSUB 1100:PRINT "PLEASE WAIT WHILE PRINTING ";
2836 PG= 1
2840 PLOT 27,18,C3:POKE 33265,14:OUT 8,199
2845 PG= 1:GOSUB 2885:FOR J= 1TO CT:GET 2,J;B
2850 MR= B:GOSUB 1540:U= 1:GOSUB 1700
2852 IF I= 0THEN I= 1
2853 IF I> 10THEN I= 10
2855 PRINT LEFT$ (ND$(1),I)+ " "+ LEFT$ (ND$(2),14);TAB( 26);ND$(3);
2860 PRINT TAB( 56);LEFT$ (ND$(8),14)
2865 PRINT ND$(7);TAB( 26);:U= 4:GOSUB 1700:IF I= 0THEN I= 10
2870 PRINT LEFT$ (ND$(U),I)+ ","+ LEFT$ (ND$(5),2)+ " "+ ND$(6);TAB( 56);
2875 PRINT RIGHT$ (ND$(8),13):PRINT
2877 IF J/ 19= INT (J/ 19)THEN PRINT CHR$ (12):PG= PG+ 1:GOSUB 2885
2880 NEXT J
2882 PRINT CHR$ (12)
2883 WAIT 1,128,128:OUT 8,207:POKE 33265,0
2884 RETURN
2885 PRINT DZ$;SPC( 5);"********* MAILING LIST - ACTIVE RECORDS ";
2888 PRINT "*********";SPC( 5);"PAGE ";PG
2890 PRINT :PRINT :PRINT "NAME/TELEPHONE";SPC( 12);"ADDRESS";
2893 PRINT SPC( 23);"COMMENTS"
2895 PRINT "------------------------- ----------------------------";
2897 PRINT "  --------------"
2899 RETURN
2900 REM  DISPLAY MODE
2905 X= 0:Y= 0:GOSUB 1100:PRINT SPC( 15):GOSUB 1100
2910 PLOT 22:PRINT "MODE=";:PLOT 20
2915 ON OGOTO 2920,2925,2930,2935,2935,2940,2935,2942,2942,2942,2943,2942,2945
2920 PRINT "INSERT":GOTO 2960
2925 PRINT "DELETE":GOTO 2960
2930 PRINT "UPDATE":GOTO 2960
2935 PRINT "DISPLAY":GOTO 2960
2940 PRINT "PRINT ":GOTO 2960
2942 PRINT "LABELS":GOTO 2960
2943 PRINT "SORT":GOTO 2960
2945 PRINT "EXIT"
2960 PLOT 18:RETURN
3000 REM  DISPLAY REC
3002 GET 1,1;CT
3005 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
3007 IF CT= 0THEN 1950
3008 NF= 1
3010 FOR U= 1TO 2:ND$(U)= "":GOSUB 2000:NEXT U
3020 X= 15:Y= 17:GOSUB 1100:PLOT 18
3025 PRINT "ENTER NAME YOU WANT TO DISPLAY ";
3030 FOR U= 1TO 2:GOSUB 1900
3035 IF U< > 1THEN 3045
3040 IF DD= 0THEN AN= 0:RETURN
3045 NEXT U
3050 GOSUB 2600:AN= 1:IF NF= - 1THEN RETURN
3055 MR= B:GOSUB 1540
3060 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
3065 FOR U= 1TO 8:GOSUB 2000:NEXT U
3070 X= 20:Y= 20:GOSUB 1100:PLOT 18
3075 PRINT "PRESS (CR) TO EXIT ";
3080 DT= 1:DL= 1:GOSUB 1200:IF DD= 0THEN RETURN
3085 PRINT :GOTO 3070
3099 END
3100 REM  CHECK DATE DA$ DA=-1=ERROR
3102 GOSUB 5400:IF DA$= DZ$THEN DD= DL:DA= 0:RETURN
3103 IF DA$= ""THEN DA= 0:RETURN
3105 I1= LEN (DA$):IF I1< 6THEN DA= - 1:RETURN
3110 IF MID$ (DA$,2,1)= "/"THEN I2= 2:GOTO 3130
3115 IF MID$ (DA$,3,1)= "/"THEN I2= 3:GOTO 3130
3120 DA= - 1:RETURN
3130 I$= LEFT$ (DA$,I2- 1):IF I2= 2THEN I$= "0"+ I$
3135 I= VAL (I$):IF I< 1OR I> 12THEN DA= - 1:RETURN
3140 I$= I$+ "/":DA$= MID$ (DA$,I2+ 1)
3145 IF MID$ (DA$,2,1)= "/"THEN I2= 2:GOTO 3165
3150 IF MID$ (DA$,3,1)= "/"THEN I2= 3:GOTO 3165
3155 DA= - 1:RETURN
3165 I1$= LEFT$ (DA$,I2- 1)
3170 IF I2= 2THEN I1$= "0"+ I1$
3175 I3= VAL (I1$):IF I3> DF(1)THEN DA= - 1:RETURN
3180 I$= I$+ I1$+ "/":DA$= MID$ (DA$,I2+ 1)
3185 I= VAL (DA$):IF I< 60OR I> 99THEN DA= - 1:RETURN
3190 DA$= I$+ DA$:DA= 0:RETURN
3200 REM  DISPLAY BY SELECTIVE PARMS
3202 GET 1,1;CT:NC= - 1
3203 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
3204 IF CT= 0THEN 1950
3206 IF O= 9AND FA= - 1THEN GOTO 3380
3207 FOR U= 1TO 8:N$(U)= "":NEXT U
3208 GOSUB 3500
3210 FOR U= 1TO 8:GOSUB 2100:GOSUB 2000:NEXT U
3212 X= 11:Y= 20:GOSUB 1100:PLOT 19
3213 PRINT "ENTER SEARCH PARAMETER (X TO CONTINUE) * _"+ CL$;
3215 DT= 1:DL= 1:GOSUB 1200:IF DD= 0THEN RETURN
3218 IF D$= "X"THEN 3235
3219 U= VAL (D$):IF U> 0AND U< 9THEN 3225
3220 IF D$> = "A"THEN O1= ASC (D$)- 64
3221 IF O1> 0AND O1< 7THEN GOSUB 3550
3222 PRINT :GOTO 3212
3225 GOSUB 1900:N$(U)= D$:PLOT 23:GOSUB 1100:N(U)= LEN (N$(U))
3227 IF NN(U)= N(U)THEN PRINT N$(U):GOTO 3230
3228 PRINT N$(U)+ LEFT$ (SP$,NN(U)- N(U))
3230 GOTO 3212
3235 IF O= 9THEN PLOT 27,18,C3:POKE 33265,14:OUT 8,199:I3= 0
3236 FOR J= 1TO CT:GET 2,J;B:MR= B:GOSUB 1540
3237 SM= - 1
3240 FOR K= 1TO 8:IF N$(K)= ""THEN 3247
3241 IF K= 3OR K= 8THEN GOSUB 5000:GOTO 3245
3243 F1$= LEFT$ (ND$(K),N(K)):F2$= N$(K):EQ= QQ(K):GOSUB 3600
3245 IF SM= - 1THEN 3250
3247 NEXT K
3248 IF O= 9AND SM= 1THEN 3300
3249 IF SM= 1THEN 3275
3250 NEXT J
3252 FOR I= 1TO 8:QQ$(I)= "EQ":QQ(I)= 1:NEXT I
3255 IF O= 9AND I3< > 0THEN 3360
3260 IF O= 9THEN 3365
3262 IF NC= - 1THEN 3265
3263 RETURN
3265 Y= 20:GOSUB 1100:PRINT EL$;:X= 10:GOSUB 1100
3267 PLOT 17:PRINT "NO RECORDS FOUND FOR THE GIVEN PARAMETER(S) ";
3270 GOSUB 2150:RETURN
3275 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
3278 FOR U= 1TO 8:GOSUB 2000:GOSUB 2015:NEXT U
3280 Y= 20:X= 13:GOSUB 1100:PRINT EL$;:GOSUB 1100:PLOT 18
3283 NC= 1
3285 PRINT "PRESS CR TO CONTINUE (X=EXIT) * _"+ CL$;
3288 DT= 1:DL= 1:GOSUB 1200:IF DD= 0THEN 3250
3289 IF D$= "X"THEN FOR I= 1TO 8:QQ$(I)= "EQ":QQ(I)= 1:NEXT I:RETURN
3299 PRINT :GOTO 3280
3300 REM  PRINT BY SEL PARMS
3302 NC= 1
3305 I3= I3+ 1:FOR I4= 1TO 6
3310 LB$(I3,I4)= ND$(I4):NEXT I4
3315 IF I3< > LPTHEN 3250
3323 GOSUB 4100
3325 I3= 0:GOTO 3250
3360 LL= LP:LP= I3:GOSUB 4100:LP= LL
3362 PRINT CHR$ (12)
3365 WAIT 1,128,128:OUT 8,207:POKE 33265,0
3366 IF NC= - 1THEN 3265
3370 RETURN
3380 Y= 5:GOSUB 1100:PLOT 17
3385 PRINT EB$+ "YOU HAVE NOT DONE FORMS ALIGNMENT ! "+ DB$
3390 GOSUB 2150:RETURN
3400 REM  ? ALL LABELS
3402 I3= 0:GET 1,1;CT
3405 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50)
3407 IF CT= 0THEN 1950
3410 IF FA= - 1THEN 3380
3415 Y= 5:GOSUB 1100:PLOT 22
3420 PRINT "PROCEED TO PRINT MAILING LABELS (Y OR N) * _"+ CL$;
3425 DT= 1:DL= 1:GOSUB 1200:IF D$= "N"THEN RETURN
3430 IF D$< > "Y"THEN 3415
3432 GOSUB 1100:PRINT EL$;:GOSUB 1100:PLOT 21
3434 PRINT "PLEASE WAIT WHILE PRINTING ";
3435 PLOT 27,18,C3:POKE 33265,14:OUT 8,199
3440 FOR J= 1TO CT:GET 2,J;B:MR= B:GOSUB 1540
3445 I3= I3+ 1:FOR I4= 1TO 6
3450 LB$(I3,I4)= ND$(I4):NEXT I4
3455 IF I3= LPTHEN GOSUB 4100:I3= 0
3460 NEXT J
3465 IF I3= 0THEN 3480
3470 LL= LP:LP= I3:GOSUB 4100:LP= LL
3480 PRINT CHR$ (12)
3485 WAIT 1,128,128:OUT 8,207:POKE 33265,0
3490 RETURN
3500 REM  PUT UP SEARCH MODE
3505 X= 0:Y= 5:GOSUB 1100:PLOT 18
3510 PRINT "SEARCH MODE"
3512 SF= 64
3515 FOR I= 1TO 8:X= 2:Y= IL(I):PLOT 21
3520 IF I= 3OR I= 8THEN PRINT "     ";:GOTO 3530
3523 IF I> 3THEN SF= 63
3525 GOSUB 1100:PRINT CHR$ (I+ SF)+ ") ";
3530 PLOT 18:PRINT QQ$(I)
3535 NEXT I
3540 RETURN
3550 REM  GET QQ$,QQ BY O1
3552 IF O1> 2THEN O1= O1+ 1
3553 X= 5:Y= IL(O1):GOSUB 1100:DT= 1:DL= 2
3555 GOSUB 1200:PLOT 23:IF DD= 0THEN PRINT QQ$(O1):RETURN
3557 QQ$(O1)= D$:GOSUB 1100:PLOT 23:PRINT QQ$(O1)
3560 IF QQ$(O1)= "EQ"THEN QQ(O1)= 1:GOTO 3575
3561 IF QQ$(O1)= "GT"THEN QQ(O1)= 2:GOTO 3575
3563 IF QQ$(O1)= "LT"THEN QQ(O1)= 3:GOTO 3575
3565 IF QQ$(O1)= "GE"THEN QQ(O1)= 4:GOTO 3575
3567 IF QQ$(O1)= "LE"THEN QQ(O1)= 5:GOTO 3575
3570 IF QQ$(O1)= "NE"THEN QQ(O1)= 6:GOTO 3575
3573 IF O1> 2THEN O1= O1- 1:GOTO 3550
3575 RETURN
3580 RETURN
3600 REM  FIND MATCH -1=NO MATCH, 1=MATCH
3605 SM= - 1
3610 ON EQGOTO 3615,3625,3635,3645,3655,3665
3615 IF F1$< > F2$THEN RETURN
3620 SM= 1:RETURN
3625 IF F1$< = F2$THEN RETURN
3630 GOTO 3620
3635 IF F1$> = F2$THEN RETURN
3640 GOTO 3620
3645 IF F1$< F2$THEN RETURN
3650 GOTO 3620
3655 IF F1$> F2$THEN RETURN
3660 GOTO 3620
3665 IF F1$= F2$THEN RETURN
3670 GOTO 3620
4000 REM  FORMS ALIGNMENT
4005 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50);
4010 Y= 5:GOSUB 1100:PLOT 22
4015 PRINT "HOW MANY LABELS PER LINE (1,2,3) ?  _"+ CL$;
4020 DT= 1:DL= 1:GOSUB 1200:IF DD= 0THEN RETURN
4023 LP$= D$
4025 O1= VAL (D$):IF O1> 0AND O1< 4THEN 4035
4030 PRINT :GOTO 4010
4035 LP= O1
4040 Y= 7:GOSUB 1100:PLOT 21
4045 PRINT "PROCEED TO PRINT FORMS ALIGNMENT (Y OR N) * _"+ CL$;
4050 DT= 1:DL= 1:GOSUB 1200:IF D$= "N"THEN RETURN
4055 IF D$< > "Y"THEN PRINT :GOTO 4040
4060 ND$(1)= "FIRSTNAME      ":ND$(2)= "LASTNAME            "
4063 ND$(3)= "SOME STREET         "
4065 ND$(4)= "SOME CITY      ":ND$(5)= "STATE     "
4067 ND$(6)= "11111    "
4075 FOR I= 1TO LP:FOR I1= 1TO 6
4080 LB$(I,I1)= ND$(I1):NEXT I1:NEXT I
4083 PLOT 27,18,C3:POKE 33265,14:OUT 8,199
4085 FOR I2= 1TO 3:GOSUB 4100:NEXT I2
4090 WAIT 1,128,128:OUT 8,207:POKE 33265,0
4093 FA= 1:FOR U= 1TO 8:ND$(U)= "":NEXT U
4095 RETURN
4100 REM  PRINT FORMS
4102 PRINT
4105 FOR II= 1TO LP
4107 IF II= 2THEN PRINT TAB( 36);
4108 IF II= 3THEN PRINT TAB( 72);
4110 U= 1:ND$(U)= LB$(II,1):GOSUB 1700
4112 IF I= 0THEN I= 1
4115 PRINT LEFT$ (LB$(II,1),I)+ " "+ LEFT$ (LB$(II,2),19);
4118 NEXT II:PRINT
4120 FOR II= 1TO LP:IF II= 2THEN PRINT TAB( 36);
4122 IF II= 3THEN PRINT TAB( 72);
4124 PRINT LB$(II,3);:NEXT II:PRINT
4125 FOR II= 1TO LP
4130 IF II= 2THEN PRINT TAB( 36);
4135 IF II= 3THEN PRINT TAB( 72);
4140 U= 4:ND$(U)= LB$(II,4):GOSUB 1700
4142 IF I= 0THEN I= 1
4145 PRINT LEFT$ (LB$(II,4),I)+ ", "+ LB$(II,5);
4150 NEXT II
4155 PRINT
4160 FOR II= 1TO LP
4165 IF II= 2THEN PRINT TAB( 36);
4170 IF II= 3THEN PRINT TAB( 72);
4175 PRINT SPC( 10);LB$(II,6);
4180 NEXT II
4185 PRINT :PRINT
4190 RETURN
4200 REM  ZIP SORT
4201 E= 1:GET 1,1;CT
4203 X= 0:Y= 2:GOSUB  1100:PRINT LEFT$ (EE$,50);
4205 IF CT= 0THEN 1950
4207 Y= 5:GOSUB  1100:PLOT  22
4210 PRINT "PROCEED TO SORT IN ZIP CODE ORDER (Y OR N) * _"+ CL$;
4212 DT= 1:DL= 1:GOSUB  1200:IF  D$= "N" THEN  RETURN
4215 IF  D$= "Y" THEN  4226
4217 PRINT :GOTO 4207
4226 GOSUB  1100:PRINT  EL$;:GOSUB  1100:PLOT  21
4228 PRINT  "PLEASE WAIT WHILE I SORT THE RECORDS ";
4230 GOSUB 4400:IF E= - 1THEN RETURN
4235 SR= 1
4245 M= J1
4250 M= INT (M/ 2)
4255 IF M= 0THEN 4299
4260 K= J1- M
4263 J= 1
4265 I= J
4268 L= I+ M
4270 IF ZP$(I)< = ZP$(L)THEN 4290
4275 T$= ZP$(I):T= ZP(I,0):T1= ZP(I,1)
4277 ZP$(I)= ZP$(L):ZP(I,0)= ZP(L,0):ZP(I,1)= ZP(L,1)
4280 ZP$(L)= T$:ZP(L,0)= T:ZP(L,1)= T1
4282 I= I- M
4285 IF I> = 1THEN 4268
4290 J= J+ 1
4293 IF J> KTHEN 4250
4295 GOTO 4265
4299 RETURN
4300 REM  REM PRINT IN ZIP ORDER
4302 I3= 0:GET 1,1;CT
4305 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50)
4307 IF CT= 0THEN 1950
4310 IF SR= 1THEN 4323
4315 Y= 5:GOSUB 1100:PLOT 17
4320 PRINT EB$+ "YOU MUST SORT RECORDS IN ZIP CODE ORDER "+ DB$;
4322 GOSUB 2150:RETURN
4323 IF FA= - 1THEN 3380
4325 Y= 5:GOSUB 1100:PLOT 22
4327 PRINT "PROCEED TO PRINT MAILING LABELS (Y OR N) * _"+ CL$;
4328 DT= 1:DL= 1:GOSUB 1200:IF D$= "N"THEN RETURN
4329 IF D$= "Y"THEN 4331
4330 PRINT :GOTO 4325
4331 Y= 5:GOSUB 1100:PLOT 21
4333 PRINT EL$;:GOSUB 1100:PRINT "PLEASE WAIT WHILE I PRINT THE LABELS ";
4335 PLOT 27,18,C3:POKE 33265,14:OUT 8,199
4337 FOR G= 1TO J1:CC= 0
4339 FOR G1= ZP(G,1)TO CT:GET 2,G1;B:MR= B:GOSUB 1540
4342 IF ZP$(G)< > ND$(6)THEN 4355
4345 I3= I3+ 1:FOR I4= 1TO 6:LB$(I3,I4)= ND$(I4):NEXT I4
4350 IF I3= LPTHEN GOSUB 4100:I3= 0
4353 CC= CC+ 1:IF CC= ZP(G,0)THEN 4360
4355 NEXT G1
4360 NEXT G
4365 IF I3= 0THEN 4375
4370 LL= LP:LP= I3:GOSUB 4100:LP= LL
4375 PRINT CHR$ (12)
4380 WAIT 1,128,128:OUT 8,207:POKE 33265,0
4385 RETURN
4400 REM  GET ZIP AND # OF EACH
4405 J1= 0
4410 FOR J= 1TO CT:GET 2,J;B:GET 1,B,81;ZC$[9]
4415 IF J= 1THEN 4435
4420 FOR JJ= 1TO J1:IF ZP$(JJ)< > ZC$THEN 4430
4425 ZP(JJ,0)= ZP(JJ,0)+ 1:GOTO 4480
4430 NEXT JJ
4435 J1= J1+ 1
4437 IF J1> 500THEN 4494
4440 ZP(J1,0)= 0
4445 ZP(J1,1)= J
4470 ZP$(J1)= ZC$
4475 ZP(J1,0)= ZP(J1,0)+ 1
4480 NEXT J
4490 RETURN
4494 Y= 5:GOSUB 1100:PLOT 17
4496 PRINT "MORE THAN 500 DIFFERENT ZIP CODES - ";
4498 PRINT EB$+ "NOT ALLOWED "+ DB$;
4499 GOSUB 2150:E= - 1:RETURN
4700 GOSUB 3500:REM  ON = GOSUB 3200
5000 REM  GET STR IN STR
5002 N$(K)= N$(K)+ " "
5003 FOR L= 1TO 13:S$(L)= "":NEXT L
5005 T= 1:L2= 0
5010 L= 1
5015 FOR L1= 1TO N(K)+ 1
5020 IF MID$ (N$(K),L1,1)< > " "THEN L2= L2+ 1:GOTO 5040
5025 S(L)= T
5030 S$(L)= MID$ (N$(K),S(L),L2)
5035 T= L1+ 1
5037 L= L+ 1
5038 L2= 0
5040 NEXT L1
5045 SM= - 1
5050 FOR B= 1TO L:B1= LEN (S$(B))
5055 FOR M= 1TO NN(K)
5060 IF MID$ (ND$(K),M,B1)= S$(B)THEN SM= 1:GOTO 5080
5065 NEXT M:SM= - 1:GOTO 5085
5080 NEXT B
5085 RETURN
6200 REM  GET TODAYS DATE
6205 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,54)
6207 Y= 5:GOSUB 1100:PLOT 18:PRINT "ENTER TODAYS DATE ";:PLOT 22
6208 PRINT "__/__/__";:FOR I= 1TO 8:PRINT CL$;:NEXT I
6209 D$= ""
6210 DT= 1:DL= 8:GOSUB 1210:PRINT LEFT$ (EE$,6):IF DD= 0THEN 6207
6215 DA$= D$:GOSUB 3105:IF DA< > - 1THEN DZ$= DA$:RETURN
6220 Y= Y+ 1:GOSUB 1100:PLOT 17
6225 PRINT EB$+ "INVALID DATE - PLEASE TRY AGAIN!"+ DB$
6230 GOTO 6207
6400 REM  GET CONFIG FILE
6405 E= 0
6410 FILE "T",6450
6415 FILE "R",1,"CONFIG.DAT",1
6420 GET 1,1;C1,C2,C3,A,DS$[4]
6425 FILE "C",1
6426 LC= C2:POKE ADR- 3,LC
6431 IF DS$= "DM0:"OR DS$= "CD0:"THEN GOTO 6435
6432 RETURN
6435 PRINT CHR$ (12):GOSUB 1300:X= 0:Y= 5:GOSUB 6500:PLOT 19
6436 PRINT "REMOVE PROGRAM DISK AND INSERT DATA DISK, THEN PRESS (CR) ";
6437 GOSUB 6520:RETURN
6445 RETURN
6450 FILE "T":X= 0:Y= 5:GOSUB 6500:PLOT 17,32
6455 PRINT "MISSING SYSTEM CONFIGURATION DATA FILES! - GO BACK TO MENU"
6460 PLOT 15,18:END
6500 REM  FREDS CURS CONT
6510 PLOT 3,X,Y:RETURN
6520 DT= 1:DL= 1:GOSUB 1200:RETURN
6530 DD= LEN (NX$):IF DD= 0THEN NX$= "0":DD= 1
6532 FOR H= 1TO DD:POKE 65470+ H,ASC (MID$ (NX$,H,1)):NEXT H
6535 POKE 65468,DD:NX= CALL (2):NX$= "":FOR H= 1TO 4
6540 NX$= NX$+ CHR$ (PEEK (65462+ H)):NEXT H:RETURN
6550 FOR H= 1TO 4:I$= MID$ (NX$,H,1)
6552 POKE 65462+ H,ASC (I$):NEXT H
6555 NX= CALL (1):NX$= "":FOR H= 1TO 11
6560 NX$= NX$+ CHR$ (PEEK (65470+ H)):NEXT H
6565 RETURN
6600 REM  BACK TO MENU
6602 FILE "T",6300
6605 IF FO= 1THEN FILE "C",1,2
6610 IF DS$= "CD0:"OR DS$= "DM0:"THEN 6630
6620 LOAD "MENU":RUN
6630 X= 0:Y= 5:GOSUB 6500
6636 PLOT 12:PLOT 3,12,0:PLOT 6,3
6637 PRINT "COMPUWORLD INC. - MAILING LIST PROGRAM "
6638 PRINT "----------------------------------------------------------------"
6640 PRINT "REMOVE DATA DISK AND INSERT PROGRAM DISK, THEN PRESS (CR) ";
6645 GOSUB 6520:GOTO 6620
6699 END