0 'ONEDR.BA BY DICK ROUX N1AED VER 1.6 07/02/86
10 CLEAR1000:MAXFILES=6:LC$="":MM=0:UL=0:S=0:MW=0:MF=0:FL=0:MR=0:RQ=0:RD=0:C=0:L=0:MS=0:U=0:CR$="":B=0:M=0:CK=0:CK$="ON ":CALL16969
20 CA$="N1AED":NA$="Dick":T$="Merrimack NH":BE$="MAIL FOR: "
30 OPEN"ERRLOG.DO"FORAPPENDAS1:CLOSE1
40 GOSUB2160
50 MM=0:MS=0:ONERRORGOTO80:OPEN"MESLOG.DO"FORINPUTAS4
60 LINEINPUT#4,I$:IFLEN(I$)=>3THENMS=MS+1:IFI$=CA$THENMM=MM+1
70 IFEOF(4)THENCLOSE4:GOTO90ELSE60
80 IFERR=52THENOPEN"MESLOG.DO"FORAPPENDAS4:PRINT#4,CR$:CLOSE4
90 ONCOMGOSUB280:ONERRORGOTO930
100 IFUTHENGOSUB2150:U=0:GOSUB190ELSEGOSUB190
110 COMON
120 E$=INKEY$:GOSUB130:GOTO150
130 DA$=RIGHT$(DATE$,2)+LEFT$(DATE$,2)+MID$(DATE$,4,2)
140 TI$=LEFT$(TIME$,2)+MID$(TIME$,4,2):RETURN
150 IFE$=""THEN120
160 ONINSTR("EPRSGKBMC",E$)GOTO690,720,790,1690,870,1430,2145,5000,6000
170 ONINSTR("eprsgkbmc",E$)GOTO690,720,790,1690,870,1430,2145,5000,6000
180 GOTO120
190 IFCTHENRETURNELSECLS
200 PRINT"MAILBOX ACTIVE - WAITING ";MM;"/";MS;" Msgs"
210 PRINTFRE(0);" BYTES FREE    ";MR;"CONNECTS TODAY"
220 IFLEN(LC$)THENPRINT "Last User: ";LC$ELSEPRINT
225 IF B=0THENBB$="OFF"ELSEBB$="ON "
226 IF M=0THENMM$="OFF"ELSEMM$="ON "
230 '
235 PRINT"<P>rint Msgs <R>ead Msgs   <E>xit"
240 PRINT"<S>end Msg   <G>o Online   <K>ill Msgs"
250 PRINT"<B>eacon ";BB$;" <M>onitor ";MM$;"
260 PRINT"<C>onok ";CK$;"..SELECT.." 
270 RETURN
280 IFEOF(2)THENCLOSE2:OPEN"COM:58N1E"FORINPUTAS2:IFS=0THEN360ELSEPRINT#4,Z$:Z$="":S=0:FL=1:FORI=1TO500:NEXT:COMON:IFULTHEN2320ELSEGOSUB1570:GOSUB1600:GOTO360
290 C$=INPUT$(1,2):PRINTC$;:IFC$=CHR$(10)THENRETURN
300 IFC$=CHR$(13)THEN330
310 Z$=Z$+C$
320 IFLEN(Z$)=>78THEN330ELSERETURN
330 IFNOTCTHEN380
340 FG=INSTR(Z$,"*** conn"):IFFGTHENRQ$=MID$(Z$,20+FG,8):RQ=1:GOTO360
350 IFCTHEN430
360 IFRD=0ANDS=0ANDRQANDCTHENO$=RQ$+" Just Tried to Connect":GOSUB980:RQ=0
370 Z$="":RETURN
380 R=INSTR(Z$,"*** CON"):IFNOTLANDR>0THENCLS:C=-1:GOSUB2090:GOSUB2096ELSEGOTO360
390 IFFL=0THENGOSUB1060
400 COMSTOP
410 GOSUB1580
420 COMON:IFMFTHEN360ELSEGOSUB1310:GOSUB1600:GOTO360
430 IFINSTR(Z$,"*** DIS")THENC=0:GOSUB2092:GOTO670
440 IFINSTR(Z$,"retry")THEN370
450 IFSTHEN640
460 IFMFTHEN570
470 IFLTHEN360
480 IFZ$<>CR$THENZ=ASC(LEFT$(Z$,1)):IFZ>96ANDZ<123THENGOSUB2110:Z$=ZX$:ZX$=""
490 IFLEN(Z$)>1THEN570
500 IFZ$="T"THEN1220
510 IFZ$="R"THENGOSUB1350:GOSUB1600:GOTO360
520 IFZ$="H"THENGOSUB1810:GOSUB1600:GOTO360
530 IFZ$="I"THENGOSUB1880:GOSUB1600:GOTO360
540 IFZ$="B"THENGOSUB1630:GOSUB660:GOSUB2098:GOSUB2070:GOTO360
550 IFZ$="W"THENCOMSTOP:GOSUB2180:GOSUB1600:GOTO360
555 IFZ$="K"THENMW=2:O$="*** YOUR MESSAGE WILL BE KILLED ON DISK ***":GOSUB980:GOSUB1600:GOTO360
560 IFZ$<>CR$THENO$="*** NON FUNCTIONAL CMD ***":GOSUB980:GOSUB1600:GOTO360
570 IFLEFT$(Z$,1)="S"ANDMID$(Z$,2,1)=" "ANDINSTR(Z$,"<")=0THEN1460:COMSTOP
580 IFLEFT$(Z$,1)="S"ANDMID$(Z$,3,1)=" "THEN1470:COMSTOP
590 IFLEFT$(Z$,1)="S"ANDMID$(Z$,2,2)="  "THEN1470:COMSTOP
600 IFLEFT$(Z$,2)="D "THENCOMSTOP:GOSUB2170:GOSUB1600:GOSUB3000:GOTO360
610 IFLEFT$(Z$,2)="U "THENCOMSTOP:GOTO2240
620 IFZ$<>CR$THENGOSUB2110:Z$=ZX$:ZX$="":IFZ$="R ALL"THENZA$="ALL":MW=1:GOSUB1360:MW=0:GOSUB1600:GOTO360
630 IFZ$<>CR$THENO$="*** WHAT?...Type <H>elp if you need it":GOSUB980:GOSUB1600
640 IFSTHENPRINT#4,Z$
650 GOTO360
660 O$=ZC$+" de "+CA$+": 73 ,CUL":GOSUB980:RETURN
670 COMSTOP:GOSUB2080:IFSTHENCLOSE4:S=0:GOSUB1920ELSEGOSUB1920:GOSUB2090:GOSUB1630:IFBTHENO$="BT "+BT$:GOSUB980
680 FL=0:L=0:MF=0:MR=MR+1:RD=0:GOSUB360:GOSUB1790:IFMW=2THEN1440ELSEGOSUB2094:GOSUB1630:GOTO100
690 COMOFF:CLOSE
700 DATE$=LEFT$(DATE$,6)+"86"
710 MENU
720 COMSTOP:CLS
730 PRINT:INPUT"CHECK PRINTER - PRESS ENTER.. ";X$
735 CLS:INPUT"Print Your Mail";ZE$:IF ZE$="N"ORZE$="n"THENINPUT"Print Whose";ZC$ELSEZC$=CA$
740 OPEN"0:"+ZC$+".DO"FORINPUTAS3:OPEN"LPT:"FOROUTPUTAS4
750 LINEINPUT#3,C$
760 IFEOF(3)THENCLOSE3,4:GOTO100
770 FORI=1TO250:NEXT:PRINTC$:PRINT#4,C$
780 GOTO750
790 COMSTOP:CLS:ONERRORGOTO860
800 MS=0:INPUT"Read Your Mail";ZE$:IF ZE$="N"ORZE$="n"THENINPUT"Read Whose";ZC$ELSEZC$=CA$
810 OPEN"0:"+ZC$+".DO"FORINPUTAS3
820 LINEINPUT#3,C$
830 IFEOF(3)THENCLOSE3:PRINTCR$:PRINT"*** END OF MESSAGES ":FORI=1TO1000:NEXT:GOTO50
840 FORI=1TO500:NEXT:PRINTC$
850 GOTO820
860 IFERR=52THENPRINT"*** NO MESSAGES":GOSUB1630:RESUME50
870 CLS:L=-1:PRINT"*** ONLINE *** ":PRINT"^D To cmd:":PRINT"<ESC> to Return"
880 E$=INKEY$:IFE$=""THEN880
890 IFE$=CHR$(27)THENL=0:Z$="":IFCTHENGOSUB1600:GOTO100ELSEGOTO100
900 IFE$=CHR$(8)THENPRINTCHR$(8);CHR$(32);
910 PRINT#1,E$;:IFE$=CHR$(13)THENPRINTE$ELSEPRINTE$;
920 GOTO880
930 CLOSE:BEEP:OPEN"ERRLOG.DO"FORAPPENDAS6
940 PRINT#6,"ERROR ";ERR;" IN LINE ";ERL;" WHILE ";ZC$;" WAS ON AT ";TI$;" ON ";DA$
950 IFCANDERR=57THENCLOSE6:S=0:Z$="":O$="*** SORRY, CAN'T DO IT, RAN OUT OF FILE SPACE !!! ***":GOSUB2160:GOSUB980:MF=0:RESUME1600
960 IFCANDERR=63THENCLOSE6:CLOSE4:S=0:Z$="":O$="*** SORRY, CAN'T DO IT, RAN OUT OF DISK SPACE !!! ***":GOSUB2160:GOSUB980:MF=0:RESUME1600
970 IFCANDERR=52THENCLOSE6:RD=0:MW=0:Z$="":O$="*** NONE FOUND":GOSUB2160:GOSUB980:RESUME360ELSECLOSE6:Z$="":RESUME40
980 FORX=1TOLEN(O$)
990 S$=MID$(O$,X,1)
1000 FORI=1TO3:NEXT
1010 PRINT#1,S$;
1020 PRINTS$;
1030 NEXT
1040 PRINT#1,CHR$(13);:PRINT
1050 RETURN
1060 IFMID$(Z$,21+R,1)="-"THENZC$=MID$(Z$,17+R,4):GOTO1110
1070 IFMID$(Z$,21+R,1)=" "THENZC$=MID$(Z$,17+R,4):GOTO1110
1080 IFMID$(Z$,22+R,1)="-"THENZC$=MID$(Z$,17+R,5):GOTO1110
1090 IFMID$(Z$,22+R,1)=" "THENZC$=MID$(Z$,17+R,5):GOTO1110
1100 ZC$=MID$(Z$,17+R,6)
1110 RESTORE
1120 READZF$,N$,MF
1130 IFINSTR(ZF$,ZC$)THENRETURN
1140 IFZF$="END"THENN$=ZC$:RETURN
1150 GOTO1120
1160 DATA"AB1Q","Dan",0,"WB2JCU","Fred",0,"WB1GXM","Butch",0
1170 DATA"K1OIQ","Al",0,"WA1HUM","Dana",0,"KA1MCD","Chris",0
1180 DATA"WA1OMM","Paul",0,"N1AHH","Ron",0,"W1TF","Ty",0
1190 DATA"WB1DSW","Herb",1,"KE1G","Bill",1,"W4PAS","Dick",0
1200 DATA"KG6LC","Paul",0,"W0RLI","Hank",1,"K1MRK","Carl",0
1210 DATA"K1UGM","Jim",1,"N1DL","Karl",1,"END","END",0
1220 PG=VAL(LEFT$(TIME$,2)):IFPG>5ANDPG<14THENO$="Sorry...Paging is disabled untill after 9 A.M. >":GOSUB980:GOSUB1610:GOTO360
1230 CLS:O$="Paging "+NA$+"...(for about 30 Sec.) >":GOSUB980
1240 PRINT:PRINTZC$;" Wants to Chat..."
1250 PRINT:PRINT"hit <G> to go online"
1260 FORI=1TO175
1270 FORP=1TO10:NEXT:BEEP
1280 E$=INKEY$:IFE$="G"ORE$="g"THENO$=NA$+" is at the keyboard...Standby! >":GOSUB980:COMON:GOTO870
1290 NEXT:O$="Guess "+NA$+" is not around...Sorry":GOSUB980
1300 O$="Feel free to leave "+NA$+" a message...73 & TNX >":GOSUB980:GOSUB1610:GOTO360
1310 ONERRORGOTO1330:O$="*** CHECKING MAIL...":GOSUB980:OPEN"0:"+ZC$+".DO"FORINPUTAS5
1320 O$="*** YOU HAVE MAIL *** HIT 'R' TO READ":ONERRORGOTO930:GOSUB980:MW=1:CLOSE5:RETURN
1330 IFERR=52THENO$="*** SORRY..NO MAIL":RESUME1340
1340 GOSUB980:ONERRORGOTO930:RETURN
1350 ZA$=ZC$
1360 IFMW=0THENO$="*** SORRY...NO MAIL":GOSUB980:RETURNELSERD=1:OPEN"0:"+ZA$+".DO"FORINPUTAS5
1370 LINEINPUT#5,ZD$
1380 O$=CR$:GOSUB980:LINEINPUT#5,O$:DB$=LEFT$(O$,6):TB$=RIGHT$(O$,4)
1390 GOSUB1640
1400 LINEINPUT#5,O$:IFINSTR(O$,"<")THENZD$=O$:GOTO1380ELSEGOSUB980
1410 IFEOF(5)THENCLOSE5:IFZA$<>"ALL"THENO$="*** PLEASE KILL YOUR MAIL WITH THE 'K' CMD BEFORE YOU DISCONNECT ***":GOSUB980:RD=0:RETURNELSERD=0:RETURN
1420 GOTO1400
1430 CLS:INPUT"Kill Your Mail";ZE$:IFZE$="N"ORZE$="n"THENINPUT"Kill Whose";ZD$:GOSUB2100:ZC$=ZX$:ZX$="":U=1ELSEZC$=CA$:U=1
1440 MW=0:KILL"0:"+ZC$+".DO":GOSUB1990:GOSUB2160:GOSUB2094:GOTO50
1450 ZD$=MID$(Z$,4,6):Z$=Z$+" < "+ZC$:GOTO1500
1460 ZD$=MID$(Z$,3,6):Z$=Z$+" < "+ZC$:GOTO1500
1470 IFINSTR(Z$,"<")=0THEN1450
1480 IFINSTR(Z$,"@")=0THEN1490ELSEZD$=MID$(Z$,4,INSTR(Z$,"@")-5):GOTO1500
1490 ZD$=MID$(Z$,4,INSTR(Z$,"<")-5)
1500 S=1:ONERRORGOTO1560:OPEN"0:"+ZD$+".DO"FORAPPENDAS4
1510 ONERRORGOTO930:PRINT#4,Z$
1520 PRINT#4,DA$;" ";TI$
1530 IFMFTHENZ$="":COMON:GOTO90
1540 COMON:O$="Enter Message, Cntl-z to end:":GOSUB980
1550 Z$="":GOTO100
1560 OPEN"0:"+ZD$+".DO"FOROUTPUTAS4:CLOSE4:RESUME1500
1570 CLOSE4:OPEN"MESLOG.DO"FORAPPENDAS4:GOSUB2100:ZD$=ZX$:ZX$="":PRINT#4,ZD$:CLOSE4:MS=MS+1:GOSUB2062:IFMF=1THENRETURNELSEO$="*** DONE":GOSUB980:RETURN
1580 IFMFTHEN1600ELSEO$="Hello "+N$+", Welcome to the "+CA$+" MINI-PBBS in "+T$:GOSUB980
1590 O$="H for HELP, I For System Info; There are"+STR$(MS)+" Msgs On the System":GOSUB980:RETURN
1600 IFFRE(0)<1000THENO$=" *** CAUTION - THE MEMORY IS FULL..PLEASE DO NOT ATTEMPT TO LEAVE ANY MESSAGES ***":GOSUB980
1610 GOSUB130:O$=ZC$+" de "+CA$+" at "+TI$+"z on "+DA$+"  B,D,H,I,K,R,S,T,U,W >":GOSUB980:IFMFTHEN1620ELSERETURN
1620 O$="*":GOSUB980:O$="*":GOSUB980:RETURN
1630 FORI=1TO500:NEXT:RETURN
1640 IFINSTR(ZD$,"@")=0THEN1670
1650 O$=" TR  "+" TO  "+" @ BBS  "+"  From"+"    Date  "+"   Time":GOSUB980
1660 O$=" "+ZD$+"   "+DB$+"   "+TB$:GOSUB980:RETURN
1670 O$=" TR  "+" TO  "+"  From"+"     Date  "+"   Time":GOSUB980
1680 O$=" "+ZD$+"   "+DB$+"   "+TB$:GOSUB980:RETURN
1690 CLS:LINEINPUT"Call sign of Receiver ";ZD$:GOSUB2100:ZD$=ZX$:ZX$=""
1700 ONERRORGOTO1780:OPEN"0:"+ZD$+".DO"FORAPPENDAS4
1710 ONERRORGOTO930:PRINT#4,"S  "+ZD$+" < "+CA$
1720 PRINT#4,DA$;" ";TI$
1730 PRINT"Input Message.../EX to End (ON A BLANK LINE)"
1740 LINEINPUTI$
1750 IFINSTR(I$,"/EX")>0ORINSTR(I$,"/ex")>0THEN1770
1760 PRINT#4,I$:GOTO1740
1770 PRINT#4,CR$:CLOSE4:OPEN"MESLOG.DO"FORAPPENDAS4:GOSUB2100:ZD$=ZX$:ZX$="":PRINT#4,ZD$:CLOSE4:PRINT"*** DONE":FORI=1TO500:NEXT:MS=MS+1:GOSUB2062:U=1:GOSUB2150:U=0:GOTO100
1780 OPEN"0:"+ZD$+".DO"FOROUTPUTAS4:CLOSE4:RESUME1700
1790 OPEN"USELOG.DO"FORAPPENDAS4
1800 LC$=ZC$+" AT "+TI$+" ON "+DA$:PRINT#4,LC$:CLOSE4:RETURN
1810 RD=1:O$="The command Syntax is:":GOSUB980
1820 O$="B<CR> - Bye (DISC)           D filename.ext<CR> - Download a file":GOSUB980
1830 O$="H<CR> - This HELP File       I<CR> - System Information":GOSUB980
1840 O$="R<CR> - Read YOUR mail       R ALL<CR> - Read mail addressed to 'ALL'":GOSUB980
1845 O$="K<CR> - Kill Your Mail":GOSUB980
1850 O$="S 'CALL'<CR> - Send mail     T<CR> - Pages "+NA$+" for 30 sec":GOSUB980
1860 O$="U 'filename.ext'<CR> - Upload a file - MAX 6 Char Filename..3 Char.Ext.":GOSUB980
1870 O$="W<CR> - What's Available To Download":GOSUB980:RD=0:RETURN
1880 RD=1:O$="This MINI-PBBS is run on a 32K TRS80 Model 100...It lacks the complete":GOSUB980
1890 O$="repertoire of a full PBBS; It was written to work within the memory":GOSUB980
1900 O$="restraints of the Model 100.  It's main purpose is to be able to":GOSUB980
1910 O$="store and retrieve messages....73  "+NA$+" "+CA$:GOSUB980:RD=0:RETURN
1920 COMSTOP:OPEN"MESLOG.DO"FORINPUTAS4
1930 LINEINPUT#4,O$:GOSUB1960
1940 IFEOF(4)THENCLOSE4:GOTO1980
1950 GOTO1930
1960 IFINSTR(O$,ZC$)THENRETURN
1970 IFINSTR(BE$,O$)THENRETURNELSEBE$=BE$+O$+" ":RETURN
1980 O$=BE$:BT$=BE$:COMON:IFLEN(BE$)=<10THENRETURNELSEGOSUB980:BE$="MAIL FOR: ":RETURN
1990 MM=0:MS=0:OPEN"MESLOG.DO"FORINPUTAS4
2000 OPEN"MESLO.DO"FOROUTPUTAS5
2010 PRINT#5,CR$
2020 LINEINPUT#4,I$:IFEOF(4)ANDI$=ZC$THENGOTO2050
2030 IFI$=ZC$THENI$="":GOTO2020
2040 IFI$=CR$THEN2050ELSEPRINT#5,I$:MS=MS+1:IFZD$=CA$THENMM=MM+1
2050 IFEOF(4)THENCLOSE4,5:KILL"MESLOG.DO":NAME"MESLO.DO"AS"MESLOG.DO":RETURN
2060 GOTO2020
2062 IFZD$=CA$THENMM=MM+1:RETURNELSERETURN
2070 GOSUB1630:O$="D":GOSUB980:RETURN
2080 GOSUB1630:O$="CONV":GOSUB980:RETURN
2090 GOSUB1630:O$=CHR$(4):GOSUB980:RETURN
2092 GOSUB1630:O$="CONOK OFF":GOSUB980:CK$="OFF":CK=1:RETURN
2094 GOSUB1630:O$="CONOK ON ":GOSUB980:CK$="ON":CK=0:RETURN
2096 GOSUB1630:O$="TRANS":GOSUB980:RETURN
2098 GOSUB1630:GOSUB1630:FORI=1TO3:PRINT#1,CHR$(4);:NEXT:GOSUB1630:GOSUB1630:RETURN
2100 Z$=ZD$
2110 FORX=1TOLEN(Z$)
2120 S$=MID$(Z$,X,1)
2130 IFASC(S$)>96ANDASC(S$)<123THENS$=CHR$(ASC(S$)-32)
2140 ZX$=ZX$+S$:NEXT:RETURN
2145 IF B=0 THEN 2150 ELSE 2165
2150 ZC$="XXX":BE$="BT MAIL FOR: ":CLS:GOSUB1920:GOSUB1630:IFUTHENZC$="":RETURNELSEO$="BE EV 90":B=1:GOSUB980:ZC$="":GOSUB1630:GOTO100
2160 OPEN"COM:58N1E"FOROUTPUTAS1:OPEN"COM:58N1E"FORINPUTAS2:RETURN
2165 GOSUB1630: O$="BE 0":GOSUB980:GOSUB1630:B=0:GOTO100
2170 ONERRORGOTO2220:F$=MID$(Z$,3,10):OPEN"0:"+F$FORINPUTAS5:GOTO2190
2180 ONERRORGOTO2230:OPEN"0:INDEX.DO"FORINPUTAS5
2190 IFEOF(5)THENCLOSE5:GOTO2200ELSE2210
2200 O$=CR$:GOSUB980:ONERRORGOTO930:COMON:RETURN
2210 LINEINPUT#5,O$:GOSUB980:GOTO2190
2220 O$="*** FILE NOT FOUND":GOSUB980:ONERRORGOTO930:RESUME2200
2230 IFERR=52THENOPEN"0:INDEX.DO"FOROUTPUTAS4:O$="*** DOWNLOAD DIRECTORY ***":PRINT#4,O$:CLOSE4:RESUME2180
2240 ONERRORGOTO2280:FN$=MID$(Z$,3,10)
2250 S=1:UL=1:OPEN"0:"+FN$FOROUTPUTAS4:ONERRORGOTO930
2260 COMON:O$="Send The File, Cntl-z to End":GOSUB980
2270 GOTO360
2280 IFERR=55THENO$="*** BAD FILENAME ...TRY AGAIN":GOSUB980:GOSUB1600:GOTO2310
2290 IFERR=63THENO$="*** SORRY...UPLOAD DISK IS FULL":GOSUB980:GOSUB1600:GOTO2310
2300 O$="*** Syntax Error..Try Again":GOSUB980:GOSUB1600:GOTO2310
2310 S=0:UL=0:ONERRORGOTO930:RESUME360
2320 CLOSE4:GOSUB2330:O$="*** DONE":GOSUB980:GOSUB1600:UL=0:GOSUB4000:GOTO360
2330 ONERRORGOTO2340:OPEN"0:INDEX.DO"FORAPPENDAS4:PRINT#4,FN$:CLOSE4:ONERRORGOTO930:RETURN
2340 IFERR=52THENOPEN"0:INDEX.DO"FOROUTPUTAS4:O$="*** DOWNLOAD DIRECTORY ***":PRINT#4,O$:CLOSE4:RESUME2330
3000 OPEN"DWNLOG.DO"FORAPPENDAS5
3010 PRINT#5,ZC$;" DOWNLOADED '";F$;"' AT ";TI$;" ON ";DA$
3020 CLOSE5:RETURN
4000 OPEN"UPLOG.DO"FORAPPENDAS5
4010 PRINT#5,ZC$;" UPLOADED '";FN$;"' AT ";TI$;" ON ";DA$
4020 CLOSE5:RETURN
5000 IFM=0THEN5010ELSE5020
5010 O$="MON ON":GOSUB980:M=1:GOSUB1630:GOTO100
5020 O$="MON OFF":GOSUB980:M=0:GOSUB1630:GOTO100
6000 IFCK=0THENGOSUB2092:GOSUB1630:CK=1:CK$="OFF":GOTO100
6010 IFCK<>0THENGOSUB2094:GOSUB1630:CK=0:CK$="ON ":GOTO100