1000 '*****  PICKNUMS.BAS - version 1.06a - a MEX utility by Bill Norris
1010 OFILE$ = "MEX-TEMP.PHN": GOSUB 2270: PRINT: Q$ = CHR$(34)
1020 PRINT "PICKNUMS, Version 1.06a, running under "; SYS$: PRINT
1030 DIM PHONE$(500), MEXFIL$(50)
1040 NUMBERS = 0: FALSE = 0: TRUE = NOT FALSE: VERBOSE = TRUE
1042 AUTO.OUTFILE = FALSE: IF AUTO.OUTFILE = FALSE THEN GOSUB 2070
1050 AN.OLD.TIMER = TRUE  '***** Change to TRUE to avoid initial menu *****
1060 IF NOT AN.OLD.TIMER THEN GOSUB 1810 '***** For Sign-On/Info *****
1070 NL$ = CHR$(13)+CHR$(10): BNL$ = CHR$(7)+NL$
1080 PRINT NL$; "Enter default input drive: ";: GOSUB 1580 'Get uppercase char
1090 IF C$>="A" AND C$<="P" THEN DRI$=C$+":": PRINT ": selected": GOTO 1140
1100 IF C$ = "" THEN PRINT "Default drive selected": GOTO 1140
1110 PRINT " ***** ILLEGAL DRIVE *****"; BNL$;: GOTO 1080
1120 '
1130 '**** New method: Input filenames stored in PHONFILE.LST ****
1140 GOSUB 5000
1150 '
1160 NEXMEX = NEXMEX + 1: XFIL$ = MEXFIL$(NEXMEX): IF XFIL$ = ".end." THEN GOTO 1360 ELSE FIRST$ = LEFT$(XFIL$,1)
1170 IF FIRST$ >= "0" AND FIRST$ <= "9" THEN EXT$ = "@" ELSE EXT$ = ""
1180 IF EXT$ <> "" THEN EXT$ = CHR$(ASC(EXT$)+1)
1190 ON ERROR GOTO 1200: GOTO 1330 REM $ = "" THEN GOTO 1320 ELSE GOTO 1240
1200 RESUME 1210
1210 CLOSE: PRINT BEL$
1220 IF VERBOSE THEN PRINT "*****  "; FIL$; " not found  *****"
1230 GOTO 1160
1240 '***** F command entry point...
1250 REM ORIG.FIL$ = FIL$
1260 FIL$ = NEWFIL$: REM
1270 ON ERROR GOTO 1280: GOTO 1310
1280 RESUME 1290
1290 IF VERBOSE THEN PRINT "*****  "; FIL$; " not found  *****"
1300 ON ERROR GOTO 1200: GOTO 1330
1310 GOSUB 1620: REM
1320 REM
1330 FIL$ = DRI$ + XFIL$ + EXT$ + ".PHN"
1340 GOSUB 1620: IF EXT$ = "" THEN GOTO 1160 ELSE GOTO 1180
1350 '
1360 '***** Time to save output file if any names selected *****
1370 IF NUMBERS THEN GOTO 1390 ELSE PRINT BNL$
1380 PRINT "No phone numbers selected!"; BNL$: GOTO 1470
1390 PRINT BNL$; "No more library files: saving"; NUMBERS; "numbers..."
1400 CLOSE: GOSUB 1500: OPEN "o",#1,OFILE$: PRINT #1,""
1410 FOR I=1 TO NUMBERS
1420    PRINT #1, PHONE$(I)
1430    NEXT I
1440 PRINT #1,"": REM These 'null' prints aren't really necessary, but makes
1450              REM for a '.PHN' file that is similar to what MEX saves.
1460 CLOSE: PRINT "File saved as "; OFILE$
1470 FOR I = 1 TO 1000: NEXT I
1480 SYSTEM
1490 '
1500 '*****  Rename temp file if possible  *****
1510 ON ERROR GOTO 0: BAKFILE$ = LEFT$(OFILE$,LEN(OFILE$)-3) + "BAK": PRINT
1520 ON ERROR GOTO 1530: KILL BAKFILE$: PRINT BAKFILE$;" deleted": GOTO 1540
1530 RESUME 1540
1540 ON ERROR GOTO 1550: NAME OFILE$ AS BAKFILE$: PRINT BAKFILE$; " created": GOTO 1560
1550 RESUME 1560
1560 PRINT: RETURN
1570 '
1580 C$=INPUT$(1): C=ASC(C$): IF C$ >= "a" AND C$ <= "z" THEN C$ = CHR$(C-32)
1590 IF C > 31 THEN PRINT C$;: RETURN
1600 IF C = 10 OR C = 13 THEN C$ = "": RETURN ELSE RETURN
1610 '
1620 '*****
1630 CLOSE
1640 OPEN "i", #1, FIL$: PRINT NL$; "Opening "; FIL$: OVERRIDE = FALSE
1650 WHILE INKEY$<>"": WEND '***** Ignore ancient console characters *****
1660 IF WARNING = FALSE AND NUMBERS >= 30 THEN WARNING = TRUE: PRINT:                 PRINT BNL$; "**  WARNING  **  MEX capacity reached (unless duplicate";:         PRINT " names selected)"; NL$
1670 LINE INPUT #1,X$: IF EOF(1) THEN CLOSE: RETURN ELSE IF X$ = "" THEN GOTO 1670
1680 PRINT X$; "? ";: IF OVERRIDE THEN Y$ = "Y" ELSE Y$ = INPUT$(1)
1690 IF Y$ >= "a" AND Y$ <= "z" THEN Y$ = CHR$( ASC(Y$) - 32 )
1700 IF Y$ = "O" THEN OVERRIDE = TRUE: Y$ = "Y": PRINT BNL$;"**** override ****"
1710 IF Y$ = "Y" THEN NUMBERS = NUMBERS + 1: PHONE$(NUMBERS) = X$: PRINT "YES":      GOTO 1650
1720 IF Y$ = "F" THEN PRINT Y$; BNL$;: GOSUB 2240: GOTO 1240
1730 IF Y$ = "S" THEN PRINT Y$; BNL$; "Skipping "; FIL$: PRINT: RETURN
1740 IF Y$ = "Q" THEN PRINT Y$: GOTO 1370
1750 IF Y$ = "T" THEN PRINT Y$: PRINT BNL$; "back to Top..."; BNL$: GOTO 1140
1760 IF Y$ = "B" THEN PRINT Y$; BNL$; "back to Beginning of current file";NL$:       CLOSE: GOTO 1190 '***** Goto 1040 will additionally go back to the first        file in an area code group, if you prefer doing it that way... *****
1770 IF Y$ = "L" THEN PRINT Y$:

     IF NUMBERS = 0 THEN PRINT BNL$;"**** NONE ****"; NL$: GOTO 1680

     ELSE PRINT NL$; "Selected names:":

     FOR Y = 1 TO NUMBERS: PRINT PHONE$(Y): NEXT Y: PRINT NUMBERS;

     "names selected";NL$: GOTO 1680
1780 IF Y$ = "H" OR Y$ = "?" THEN GOSUB 1810: PRINT: GOTO 1680
1790 PRINT "no": GOTO 1650
1800 '
1810 PRINT NL$
1820 PRINT "PICKNUMS: A utility for selecting numbers from various MEX phone"
1830 PRINT "          libraries by Bill Norris.  Output is written to the file"
1840 PRINT "          defined by OFILE$, currently 'MEX-TEMP.PHN', which will"
1850 PRINT "          then be loaded if MEX is executing 'PICKNUMS.MEX'."
1860 PRINT "OPTIONS:"
1870 PRINT "    'y' = Yes - select the listed number."
1880 PRINT "    't' = Top - start from first .PHN file - no loss of numbers"
1890 PRINT "    's' = Skip - go to the next .PHN phone library."
1900 PRINT "    'q' = Quit - Quit reading numbers - save "; OFILE$
1910 PRINT "    'o' = Override - select remaining numbers in current library"
1920 PRINT "    'l' = List - display selected numbers"
1930 PRINT "    'h' = Help - reprint this screen of information ('?' also)"
1940 PRINT "    'b' = Back - like Top, but only to top of current .PHN file"
1950 PRINT "    'f' = File - allows console entry of input filename."
1960 PRINT "          Other characters skip the listed number and continue."
1970 PRINT "    Names of the '.PHN' files are stored in DATA statements at the"
1980 PRINT "    beginning of this program.  They are limited to 8 characters"
1990 PRINT "    unless the first character is numeric, in which case the limit"
2000 PRINT "    is 7 characters.  In this case an extra letter is appended."
2010 PRINT "    Example:
2020 PRINT "            1020 DATA 'LIB1', '212', 'LIB2'
2030 PRINT "    would result in the following files being searched:"
2040 PRINT "            LIB1.PHN, 212A.PHN, 212B.PHN, ..., LIB2.PHN"
2050 RETURN
2060 '
2070 OF$=OFILE$: IF OFILE$<>"" THEN PRINT "Default output file is '"; OFILE$; "'
2080 PRINT "Enter the output filename (<cr> for 'MEX-TEMP.PHN'): ";
2090 INPUT OFILE$: IF OFILE$ = "" THEN OFILE$ = "MEX-TEMP.PHN"
2100 LOUP$ = OFILE$: GOSUB 2140: OFILE$ = LOUP$
2110 IF OFILE$<>OF$ THEN PRINT "New output filename is '"; OFILE$; "'"
2120 RETURN
2130 '
2140 '***** Change LOUP$ to uppercase *****
2150 UPTMP$ = "": IF LOUP$ = "" THEN PRINT "NULL STRING at line 3510": STOP
2160 FOR UPX% = 1 TO LEN(LOUP$)
2170    UP$ = MID$(LOUP$,UPX%,1)
2180    IF UP$>="a" AND UP$<="z" THEN UP$ = CHR$(ASC(UP$)-32)
2190    UPTMP$ = UPTMP$ + UP$
2200    NEXT UPX%
2210 SWAP LOUP$, UPTMP$
2220 RETURN
2230 '
2240 INPUT "Enter new filename: ", NEWFIL$
2250 IF NEWFIL$ = "" THEN PRINT "*****  Newfile search cancelled": PRINT
2260 RETURN
2270 ON ERROR GOTO 2280: WIDTH 255: SYS$ = "CP/M": ON ERROR GOTO 0: RETURN
2280 RESUME 2290
2290 ON ERROR GOTO 0: WIDTH 80: SYS$ = "MSDOS": RETURN
2300 '*****  WARNING  *****  This program was created with GWBASIC - It is

        not known if this line (or 2068) will be read properly if you are

        using BASIC or BASICA.  If not, use an editor or DEBUG to replace
2310 '  the embedded <line feed> <carriage return> pair with 2 space

        characters ( 20 hex if using DEBUG ).  All you'll lose it the attempt

        to format the line.
5000 '***** Search for PHONFILE.LST *****
5002 IF WUZHERE THEN NEXMEX = 0: RETURN
5010 ON ERROR GOTO 5050: OPEN "i", #2,"PHONFILE.LST": ON ERROR GOTO 0
5020 IF EOF(2) THEN PRINT: PRINT "***** ERROR *****  PHONFILE.LST is empty"
5030 IF EOF(2) THEN PRINT: GOTO 5060 ELSE GOTO 5200
5040 '
5050 RESUME 5052
5052 PRINT: PRINT CHR$(7);"***** ERROR *****"
5060 PRINT: PRINT "Use a text editor to create your ????????.PHN entries in a file"
5070 PRINT "called 'PHONFILE.LST'.  It must have one name per line and resemble:"
5072 PRINT
5080 PRINT "    "; Q$; "212"; Q$; ", Comment for the '212?.PHN' files."
5090 PRINT "    "; Q$; "201"; Q$; ", Comment for the '212?.PHN' files."
5100 PRINT "    "; Q$; "OHIO"; Q$; ", Comment for the 'OHIO.PHN'.
5110 PRINT
5120 PRINT "and so on...": PRINT: CLOSE
5130 END
5140 '
5200 '***** Read phone file names *****
5210 WUZHERE = -1
5220 WW = 0
5230 WW=WW + 1: IF EOF(2) THEN CLOSE #2: MEXFIL$(WW)=".end.": NEXMEX=0: RETURN
5240	INPUT #2, LOUP$: GOSUB 2140: MEXFIL$(WW) = LOUP$
5250	LINE INPUT #2, WW$: PRINT MEXFIL$(WW), WW$
5260	GOTO 5230