home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / bus / aptcal.ba < prev    next >
Text File  |  2006-10-19  |  6KB  |  89 lines
  1. 0 'Club 100 Library - 415/939-1246 BBS     937-5039 NEWSLETTER, 932-8856 VOICE
  2. 2 ' APTCAL.BM HAS THE FOLLOWONG FEATURES     CURRENT MONTH DISPLAY WITH TIME
  3. 4 ' Inkey <6> or <7> to view files or to make entries
  4. 6 ' Menus for view and entry routines which enable switching from view to entry routine without going back to main program
  5. 8 ' Perpetual calendar with Inkey from main program:<t>return to current month
  6. 9 ' <n> next month;<p>previous month;<o>other month/year-prompted for input
  7. 10 ' current configuration allows for NOTE.DO;APPT.DO;AND ADRS.DO files
  8. 12 MAXFILES=2:CLEAR2000:DEFSTRA-G:DEFINTH-T:DEFDBLJ,U-Z
  9. 14 D=DATE$
  10. 16 L=VAL(MID$(D,4,2)):D=LEFT$(D,3)+RIGHT$(D,2):I=INSTR(D,"/")
  11. 18 W=VAL(LEFT$(D,I-1)):V=VAL(RIGHT$(D,LEN(D)-I)):X=1:V=V+1900:G=CHR$(27)+CHR$(112):E=CHR$(27)+CHR$(113):F=SPACE$(1)
  12. 20 GOSUB32:FORI=1TOW:READB,N:NEXT:IFW=2THENN=N-(0=VMOD4)+(0=VMOD100)-(0=VMOD400)
  13. 22 CLS:PRINTTAB(3);B;:PRINT@18,V:PRINT"   Su Mo Tu We Th Fr Sa":J%=J-7*INT(J/7):PRINTTAB(2);SPACE$(3*J%);
  14. 24 FORI=1TON:IFI=LTHENPRINTF;:PRINTG;ELSEPRINTF;
  15. 26 PRINTUSING"##";I;:IFI=LTHEN PRINTE;
  16. 28 J%=J%+1:IFJ%>6ANDI<>NTHENPRINT:PRINTTAB(2);:J%=0
  17. 30 NEXT:GOTO40
  18. 32 Y=-INT((14-W)/12):Z=X-32074+INT(1461*(V+4800+Y)/4)
  19. 34 Z=Z+INT(367*(W-2-12*Y)/12):J=Z-INT(3*INT((V+4900+Y)/100)/4):RETURN
  20. 36 DATAJanuary,31,February,28,March,31,April,30,May,31,June,30
  21. 38 DATAJuly,31,August,31,September,30,October,31,November,30,December,31,EOF,-1
  22. 40 LINE(157,4)-(219,58),1,B:LINE(159,6)-(217,16),1,B:LINE(159,18)-(217,56),1,BF
  23. 42 PRINT@149,G"-"DAY$"-"E:A=LEFT$(TIME$,5):PRINT@187,G"<6> view"E:PRINT@227,G"<7> enter"E:PRINT@267,G"<m> menu"E
  24. 44 LINE(166,10)-(168,12),1,BF:LINE(208,10)-(210,12),1,BF:PRINT@69,LEFT$(TIME$,5)
  25. 46 B1=INKEY$:IFB1=CHR$(54)THEN64ELSEIFB1="m"THEN172ELSEIFB1=CHR$(55)THEN94ELSEIFB1="n"THEN166
  26. 47 IFB1="p"THEN162ELSEIFB1="t"THEN12ELSEIFB1="o"THEN154
  27. 48 D1=LEFT$(DATE$,5):D2=LEFT$(TIME$,5)
  28. 50 CLOSE:OPEN"APPT.DO"FORINPUTAS1
  29. 52 IFEOF(1)THEN44ELSELINEINPUT#1,A1
  30. 54 IFINSTR(A1,D1)=0THEN52ELSEIFINSTR(A1,D2)=0THEN52
  31. 56 CLS:NF=LEN(A1)-12:A1=RIGHT$(A1,NF):Z=LEN(A1):IFZ>39THEN64
  32. 58 U=40:U=U-Z:K=U/2:PRINT@80,SPACE$(K);:PRINTA1:PRINT@248,"Press any key to silence"
  33. 60 B1=INKEY$:BEEP:FORY=1TO20:NEXT
  34. 62 J=J+1:IFJ=300THENPRINTPRINT110PRINTPRINTELSEIFB1=""THEN60ELSEFORY=1TO25000:NEXT:GOTO12
  35. 64 CLS:PRINT@40,"FILE TO BE VIEWED":PRINT@92,"<1> NOTE.DO":PRINT@132,"<2> APPT.DO":PRINT@172,"<3> ADRS.DO"
  36. 65 PRINT@201,">>> OR >>> <4> Make Entries":PRINT@252,"<5> RUN
  37. 66 B1=INKEY$:T=VAL(B1)
  38. 68 IFT=1THEN70ELSEIFT=2THEN74ELSEIFT=3THEN72ELSEIFT=4THEN94ELSEIFT=5THEN12ELSE66
  39. 70 CLOSE:OPEN"NOTE.DO"FOR INPUT AS1:GOTO76
  40. 72 CLOSE:OPEN"ADRS.DO"FOR INPUTAS1:GOTO76
  41. 74 CLOSE:OPEN"APPT.DO"FORINPUTAS1
  42. 76 OPEN"TEMP.DO"FORAPPENDAS2:CLS:PRINT@87,"Enter search string_________":PRINT@136,"OR"
  43. 78 PRINT@167,"<ENTER> to view each entry":PRINT@287,;:LINEINPUT"";A2
  44. 80 IFEOF(1)THEN130ELSELINEINPUT#1,A1
  45. 82 IFINSTR(A1,A2)<>0THEN84ELSEPRINT#2,A1:GOTO80        
  46. 84 CLS:Z=LEN(A1):IFZ>39THEN88ELSEU=40
  47. 86 U=U-Z:Y=U/2:PRINT@80,SPACE$(Y);:PRINTA1:BEEP:GOTO90
  48. 88 PRINT@80,A1:BEEP
  49. 90 PRINT@248,"Delete this entry (Y/N)"
  50. 92 B1=INKEY$:IFB1=""THEN92ELSEIFB1="Y"ORB1="y"THEN80ELSEPRINT#2,A1:CLS:GOTO80
  51. 94 CLEAR2000:DEFSTRA-L:DEFINTM-Z:K=CHR$(27)+CHR$(75):L=CHR$(138)
  52. 96 CLS:PRINT@40,"FILE TO BE ENTERED":PRINT@92,"<1> Message entry":PRINT@132,"<2> Appointment entry"
  53. 97 PRINT@172,"<3> Adresss entry":PRINT@201,">>> OR >>> <4> View Files":PRINT@252,"<5> Run
  54. 98 I=INKEY$:T=VAL(I):IFT=1THEN138ELSEIFT=2THEN100ELSEIFT=3THEN146ELSEIFT=4THEN64ELSEIFT=5THEN12ELSE98
  55. 100 CLOSE:OPEN"APPT.DO"FOR APPEND AS 1:CLS:PRINT@4,CHR$(27);CHR$(112)" APPT DATE(MM/DD) "CHR$(27);CHR$(113):LINE INPUT"";H
  56. 102 CLS:PRINT@4,CHR$(27);CHR$(112)" APPT TIME(HH/MM) "CHR$(27);CHR$(113):LINE INPUT"";A
  57. 104 CLS:PRINT@4,CHR$(27);CHR$(112)" Appt=.... "CHR$(27);CHR$(113):INPUT"";B:C=H+"  "+A+"  "+B
  58. 106 PRINT #1,C:CLS:PRINT@81,"Do You Want Another Appt Entered?"
  59. 108 I=INKEY$:IF I=""THEN108ELSEIFI="y"ORI="Y"THEN100
  60. 110 CLS:PRINT@134,"Reorganizing":PRINT@178,"File":CLOSE:OPEN"appt.do"FORINPUTAS1:U=1:V=11:N=0
  61. 112 N=N+1:LINEINPUT#1,D:IFEOF(1)THEN114ELSE112
  62. 114 CLOSE:DIME(N):OPEN"APPT.DO"FORINPUTAS1:FORY=1TON:LINEINPUT#1,E(Y):NEXT:CLOSE1:GOSUB118
  63. 116 KILL"APPT.DO":OPEN"APPT.DO"FOROUTPUTAS1:FORY=1TON:PRINT#1,E(Y):NEXT:CLOSE:GOTO96
  64. 118 O5=N
  65. 120 O5=INT(O5/2):IFO5=0THENRETURNELSEO2=1:O3=N-O5
  66. 122 O1=O2
  67. 124 O4=O1+O5:IF(MID$(E(O1),U,(V-U)+1))<(MID$(E(O4),U,(V-U)+1))THEN128
  68. 126 F=E(O1):E(O1)=E(O4):E(O4)=F:O1=O1-O5:IFO1<1THEN128ELSE124
  69. 128 O2=O2+1:IFO2>O3THEN120ELSE122
  70. 130 IFT=1THEN136ELSEIFT=3THEN134
  71. 132 CLOSE:KILL"APPT.DO":NAME"TEMP.DO"AS"APPT.DO":GOTO 64
  72. 134 CLOSE:KILL"adrs.DO":NAME"TEMP.DO"AS"adrs.DO":GOTO64
  73. 136 CLOSE:KILL"NOTE.DO":NAME"TEMP.DO"AS"NOTE.DO":GOTO64
  74. 138 CLS
  75. 140 CLOSE:OPEN"NOTE.DO" FOR APPEND AS 1
  76. 142 CLS:PRINT@4,CHR$(27);CHR$(112)"  Enter TO-DO Message  "CHR$(27);CHR$(113):INPUT"";G:PRINT @4,K
  77. 144 PRINT#1,">>>  ";G:GOTO96
  78. 146 CLS
  79. 148 CLOSE:OPEN"ADRS.DO" FOR APPEND AS 1
  80. 150 CLS:PRINT@4,CHR$(27);CHR$(112)"  Enter Name,Phone,etc. "CHR$(27);CHR$(113):LINEINPUT"";G
  81. 152 PRINT#1,G:GOTO96
  82. 154 RESTORE36:CLS:PRINT@170," ";:INPUT"mm/yy";D:GOTO16
  83. 162 TD$=STR$(VAL(LEFT$(D,2))-1):TD$=RIGHT$(TD$,2)+"/"+RIGHT$(D,2):D=TD$:L=0
  84. 164 IFVAL(LEFT$(D,2))=0THENTD$=STR$(12)+"/"+RIGHT$(STR$(VAL(RIGHT$(D,2))-1),2):D=RIGHT$(TD$,5):GOTO170ELSEGOTO170
  85. 166 TD$=STR$(VAL(LEFT$(D,2))+1):TD$=RIGHT$(TD$,2)+"/"+RIGHT$(D,2):D=TD$:L=0
  86. 168 IFVAL(LEFT$(D,2))=13THENTD$=STR$(1)+"/"+RIGHT$(STR$(VAL(RIGHT$(D,2))+1),2):D=RIGHT$(TD$,5)
  87. 170 RESTORE36:GOTO16
  88. 172 MAXFILES=0:MENU
  89.