Listing of file='BMAIL.BAS;01' on disk='vmedia/mailing_list-sector.ccvf'
1 REM BUSINESS 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$+ "BDATA",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 "BUSINESS 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( 14):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 9: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 9 1560 ND$(I)= MID$ (AA$,I1,NN(I)):I1= I1+ NN(I):NEXT I 1565 RETURN 1575 FOR I= 1TO 9:ND$(I)= LEFT$ (SP$,NN(I)) 1576 NEXT I 1580 RETURN 1600 REM INIT PARMS 1602 DIM LB$(3,9) 1605 DIM NN$(9) 1610 DATA "BUSINESS NAME","CODE","ADDRESS","CITY","STATE" 1615 DATA "ZIPCODE","ATTENTION","TELEPHONE","COMMENTS" 1630 FOR I= 1TO 9:READ I$:I$= I$+ " -----------------" 1635 I$= LEFT$ (I$,15):NN$(I)= I$+ " " 1650 NEXT I 1652 DIM S$(10),S(10) 1655 DIM NN(9),N(9),N$(9) 1658 DATA 24,2,30,15,2,9,14,12,20 1660 FOR I= 1TO 9:READ NN(I):NEXT I 1665 DIM ZP$(500),ZP(500,1) 1670 DIM IL(9) 1675 DATA 6,7,8,9,10,11,12,13,14 1680 FOR I= 1TO 9:READ IL(I):NEXT I 1685 DIM QQ$(9),QQ(9) 1687 FOR I= 1TO 9: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 1715 IF I= 0THEN I= 1 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= 13: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= 10: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 9:GOSUB 2000:NEXT U 2235 FOR U= 1TO 9:GOSUB 1900 2238 IF U= 1AND LEFT$ (ND$(1),1)= " "THEN AN= 0:RETURN 2240 IF U< > 1THEN 2250 2245 IF DD= 0THEN AN= 0:RETURN 2250 NEXT U 2255 FOR U= 1TO 9: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< 10THEN 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$(1)+ ND$(2) 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)[24],ND$(2)[2] 2318 ND$(0)= ND$(1)+ ND$(2) 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)[24],ND$(2)[2] 2332 ND$(0)= ND$(1)+ ND$(2) 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 9:GOSUB 2000:NEXT U 2454 TZ$= ND$(6) 2455 TF$= ND$(1):GOSUB 2255 2456 IF UD= - 1THEN RETURN 2458 IF TF$= ND$(1)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 9: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$(1)+ ND$(2) 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)[24],ND$(2)[2] 2623 ND$(0)= ND$(1)+ ND$(2) 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:ID= 0 2703 IF O= 6THEN PRINT TAB( 6); 2705 X= 0:Y= 2:GOSUB 1100:PRINT LEFT$ (EE$,50); 2707 IF CT= 0THEN 1950 2709 X= 0:Y= 4:GOSUB 1100: 2711 FOR J= 1TO CT:GET 2,J;B:MR= B:GOSUB 1540 2712 PLOT 23 2715 ID= ID+ 1:FOR JD= 1TO 9:LB$(ID,JD)= ND$(JD):NEXT JD 2718 IF ID= 2THEN GOSUB 2750:ID= 0 2720 IF J/ 8< > INT (J/ 8)THEN 2735 2724 X= 15:Y= 30:GOSUB 1100:PLOT 22 2726 PRINT "PRESS CR TO CONTINUE (X=EXIT) * _";+ CL$; 2730 DT= 1:DL= 1:GOSUB 1200:IF D$= "X"THEN RETURN 2732 IF DD< > 0THEN PRINT :GOTO 2724 2733 X= 0:Y= 4:GOSUB 1100:PRINT LEFT$ (EE$,28* 2); 2734 GOSUB 1100 2735 NEXT J:IF ID= 0THEN 2744 2737 ID= 1:GOSUB 2750 2744 X= 10:Y= 31:GOSUB 1100:PLOT 18 2746 PRINT "END OF LIST - PRESS CR TO RETURN TO MENU "; 2748 DT= 1:DL= 1:GOSUB 1200:IF DD= 0THEN RETURN 2749 PRINT :GOTO 2744 2750 REM PRINT OR DISPLAY ALL 2752 IF O= 6THEN PRINT TAB( 6); 2755 FOR KD= 1TO ID:PRINT LB$(KD,1)+ " "+ LB$(KD,2); 2760 PRINT SPC( 4);:NEXT KD:PRINT 2762 IF O= 6THEN PRINT TAB( 6); 2765 FOR KD= 1TO ID:PRINT LB$(KD,3);" ";:NEXT KD:PRINT 2766 IF O= 6THEN PRINT TAB( 6); 2770 FOR KD= 1TO ID:U= 4:ND$(U)= LB$(KD,4):GOSUB 1700 2774 PRINT LEFT$ (LB$(KD,4),I)+ ","+ LB$(KD,5)+ " "+ LB$(KD,6); 2780 PRINT SPC( NN(4)+ 3- I):NEXT KD:PRINT 2782 IF O= 6THEN PRINT TAB( 6); 2785 FOR KD= 1TO ID:PRINT LB$(KD,8);" ";LB$(KD,7); 2790 PRINT SPC( 4);:NEXT KD:PRINT 2792 IF O= 6THEN PRINT TAB( 6); 2795 FOR KD= 1TO ID:PRINT LB$(KD,9);SPC( 11);:NEXT KD:PRINT 2799 PRINT :RETURN 2800 REM PRINT ALL RECORDS 2803 GET 1,1;CT:ID= 0 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 2855 ID= ID+ 1:FOR JD= 1TO 9:LB$(ID,JD)= ND$(JD):NEXT JD 2860 IF ID= 2THEN GOSUB 2750:ID= 0 2877 IF J/ 18= INT (J/ 18)THEN PRINT CHR$ (12):PG= PG+ 1:GOSUB 2885 2880 NEXT J:IF ID= 0THEN 2882 2881 ID= 1:GOSUB 2750 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 2899 RETURN 2900 REM DISPLAY MODE 2905 X= 0:Y= 0:GOSUB 1100:PRINT SPC( 14):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 9: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 9:N$(U)= "":NEXT U 3208 GOSUB 3500 3210 FOR U= 1TO 9: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< 10THEN 3225 3220 IF D$> = "A"THEN O1= ASC (D$)- 64 3221 IF O1> 0AND O1< 8THEN 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 9:IF N$(K)= ""THEN 3247 3241 IF K= 3OR K= 9THEN 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 9:QQ$(I)= "EQ":QQ(I)= 1:NEXT I 3255 IF O= 9AND I3< > 0THEN 3360 3257 IF O= 9AND NC= - 1THEN 3365 3260 IF NC= - 1THEN 3265 3262 IF O= 9THEN 3362 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 9: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 9: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 7:IF I4= 2THEN 3312 3310 LB$(I3,I4)= ND$(I4) 3312 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 7:IF I4= 2THEN 3452 3450 LB$(I3,I4)= ND$(I4) 3452 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= 2:Y= 4:GOSUB 1100:PLOT 18 3510 PRINT "SEARCH":X= 3:Y= 5:GOSUB 1100:PRINT "MODE" 3512 SF= 64 3515 FOR I= 1TO 9:X= 2:Y= IL(I):PLOT 21 3520 IF I= 3OR I= 9THEN 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)= "BUSINESS NAME" 4061 ND$(2)= " " 4063 ND$(3)= "SOME STREET " 4065 ND$(4)= "SOME CITY ":ND$(5)= "SS" 4067 ND$(6)= "11111 ":ND$(7)= "VIP" 4075 FOR I= 1TO LP:FOR I1= 1TO 7: 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 9: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); 4115 PRINT LB$(II,1); 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)+ " "+ LB$(II,6); 4150 NEXT II 4155 PRINT :PRINT 4160 FOR II= 1TO LP 4165 IF II= 2THEN PRINT TAB( 36); 4170 IF II= 3THEN PRINT TAB( 72); 4172 IF LB$(II,7)= " "THEN 4177 4175 PRINT "ATTN: "; 4177 PRINT LB$(II,7); 4180 NEXT II 4185 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 7:IF I4= 2THEN 4349 4346 LB$(I3,I4)= ND$(I4) 4349 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,74;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 10: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$= "MD0:"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$= "MD0:"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