home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / DATABASE / HANDY21S.LBR / AGGENDAS.BZS / AGGENDAS.BAS
BASIC Source File  |  2000-06-30  |  16KB  |  545 lines
  1. rem 12/13/86 common used for terminal characteristics
  2. common today$,warm$,trmtyp$,clear$,bell$,clreol$
  3. common escape$,poscmd$,posofs%,rowcol$
  4. rem - program AGGENDAS.BAS
  5. rem - copyright 1982, by Peter C. Hawxhurst
  6. rem - revised 11/14/1982
  7. rem - variable tabulation ************************
  8. rem   a$       = appointment file field
  9. rem   appoint$ = appointment input
  10. rem   check$   = time check variable
  11. rem   command$ = user command
  12. rem   d        = number of day in week
  13. rem   d$       = file date field
  14. rem   d1$      = month of file date field
  15. rem   d2$      = day of file date field
  16. rem   date0$    = transaction date
  17. rem   date1$   = month of transaction date
  18. rem   date2$   = day of transaction date
  19. rem   day$     = logical day of week
  20. rem   f        = factor for determining d
  21. rem   i%       = for/next loop counter
  22. rem   m$       = number of logical month
  23. rem   month$   = logical month of year
  24. rem   p1       = day for determining d from date0$
  25. rem   p2       = month for   "       "   "   "
  26. rem   p3       = year for    "       "   "   "
  27. rem   q$       = continue input dummy
  28. rem   q1$      = printout question input
  29. rem   q2$      = continue search input
  30. rem   s1       = end switch
  31. rem   s2       = first pass switch
  32. rem   s3       = executed switch
  33. rem   s4       = change found/error switch
  34. rem   s5       = file pass thru stop switch
  35. rem   search%  = search counter
  36. rem   spot%    = cursor spotting point
  37. rem   t$       = file time field
  38. rem   t1$      = time to be changed/deleted
  39. rem   t2$      = time to be matched
  40. rem   time0$   = appointment times available
  41. rem   x%       = dummy value for file rename
  42. rem   xpos%    = horizontal cursor location
  43. rem   ypos%    = vertical cursor location
  44. rem - program structure **************************
  45. gosub 100 : rem - housekeeping
  46. 10 if s1=1 then 20
  47. gosub 200 : rem - process
  48. goto 10
  49. 20 gosub 300 : rem - end of job
  50. %chain 100,10000,50,500
  51. print clear$
  52. chain "HANDYSYS.COM" : rem - needed by CB80
  53. 100 rem - housekeeping subroutine ****************
  54. let s2=1
  55. date0$=today$
  56. open "APPOINTS.DAT" as 1
  57. if end #1 then 120
  58. read #1;d$,t$,a$
  59. 120 return
  60. 200 rem - process subroutine *********************
  61. if s2=1 then gosub 500 : rem - screen
  62. 210 s2=0:s3=0:gosub 600 : rem - cursor 1
  63. print bell$;
  64. print "> ";
  65. while not constat%:wend:cmnd$=ucase$(chr$(conchar%))
  66. ypos%=51-31:xpos%=77-31:gosub 14000
  67. if cmnd$="" then print bell$;
  68. if cmnd$="" then 210
  69. cmnd$=ucase$(cmnd$)
  70. if cmnd$="A" then gosub 700 : rem - add
  71. if cmnd$="N" then gosub 800 : rem - change
  72. if cmnd$="D" then gosub 900 : rem - delete
  73. if cmnd$="E" then s1=1
  74. if cmnd$="E" then 220
  75. if cmnd$="F" then gosub 1000 : rem - future
  76. if cmnd$="P" then gosub 2500 : rem - printout 2
  77. if cmnd$="R" then gosub 2600 : rem - reschedule
  78. if cmnd$="S" then gosub 2700 : rem - search
  79. if s3=1 then 220
  80. gosub 1100 : rem - bell:goto 210
  81. 220 return
  82. 300 rem - end of job subroutine ******************
  83. close 1
  84. print clear$
  85. return
  86. 500 rem - screen subroutine **********************
  87. gosub 1700 : rem - day
  88. gosub 1800 : rem - month
  89. print clear$
  90. gosub 16000: rem - tone on
  91. print tab(2);" AGENDA for ";:gosub 18000:rem - tone off
  92. print day$;", ";month$;val(mid$(date0$,4,2));"- ";
  93. print right$(date0$,4):gosub 16000:rem - tone on
  94. print:print
  95. for i%=1 to 6
  96. read time0$
  97. if len(time0$)>4 then 510
  98. print tab(3);time0$
  99. goto 520
  100. 510 print tab(2);time0$
  101. 520 print tab(4);":30"
  102. next i%
  103. 530 for i%=1 to 6
  104. read time0$
  105. ypos%=34-31+2*i%:xpos%=59-31:gosub 15000
  106. print time0$
  107. ypos%=35-31+2*i%:xpos%=60-31:gosub 15000
  108. print ":30"
  109. next i%
  110. restore
  111. ypos%=49-31:xpos%=33-31:gosub 15000
  112. for i%=1 to 49:print "-";:next i%:print
  113. print tab(2);"(A)dd";tab(9);"(D)elete";
  114. print tab(19);"(E)xit";tab(26);"(F)uture";
  115. print tab(36);"(N)ext day";
  116. print tab(2);"(P)rintout";tab(14);"(R)eschedule";
  117. print tab(28);"(S)earch for entry"
  118. gosub 18000 : rem tone off
  119. gosub 2000 : rem - post
  120. return
  121. 600 rem - cursor 1 subroutine ********************
  122. ypos%=51-31:xpos%=78-31:gosub 14000
  123. ypos%=51-31:xpos%=78-31:gosub 15000
  124. return
  125. 700 rem - add subroutine *************************
  126. 710 if end #1 then 720
  127. read #1;d$,t$,a$
  128. goto 710
  129. 720 gosub 1300 : rem - cursor 2
  130. input "Enter appointment time >";line t$
  131. if t$="" then print bell$;
  132. if t$="" then 720
  133. if t$=escape$ then 740
  134. check$=t$
  135. gosub 1900 : rem - check time
  136. if e1=0 then 725
  137. gosub 1100:goto 720
  138. 725 gosub 2400 : rem - check exist
  139. if e1=0 then 730
  140. goto 720
  141. 730 gosub 1300 : rem - cursor 2
  142. input "Enter name/reason >";line a$
  143. if a$="" then print bell$;
  144. if a$="" then 730
  145. if a$=escape$ then 740
  146. if len(a$)<19 then 735
  147. gosub 1100 : rem - bell
  148. gosub 1300 : rem - cursor 2
  149. print bell$;
  150. input "Only space for 18 characters. Press - RETURN >"; line q$
  151. goto 730
  152. 735 gosub 2100 : rem - post 2
  153. print #1;date0$,t$,a$
  154. 740 close 1
  155. open "APPOINTS.DAT" as 1
  156. gosub 1300 : rem - cursor 2
  157. s3=1
  158. return
  159. 800 rem - next subroutine **********************
  160. nd$=str$(val(mid$(date0$,4,2))+1)
  161. if val(nd$)<10 then nd$="0"+str$(val(mid$(date0$,4,2))+1)
  162. future$=left$(date0$,3)+nd$+right$(date0$,5)
  163. date0$=future$
  164. gosub 10000 : rem - date check
  165. if e1=0 then 820
  166. nd$="01"
  167. nm$=str$(val(left$(date0$,2))+1)
  168. if val(nm$)<13 then 810
  169. nm$="01"
  170. ny$=str$(val(right$(date0$,4))+1)
  171. date0$=nm$+"/"+nd$+"/"+ny$
  172. goto 820
  173. 810 future$=nm$+"/"+nd$+right$(date0$,5)
  174. date0$=future$
  175. 820 gosub 1020 : rem - future
  176. return
  177. 900 rem - delete subroutine **********************
  178. 910 gosub 1300 : rem - cursor 2
  179. input "Enter time of appointment to delete >";line t1$
  180. if t1$="" then print bell$;
  181. if t1$="" then 910
  182. if t1$=escape$ then 995
  183. check$=t1$
  184. gosub 1900 : rem - check time
  185. if e1=0 then 920
  186. gosub 1100:goto 910
  187. 920 create "TRANS" as 2
  188. 930 close 1
  189. open "APPOINTS.DAT" as 1
  190. 940 if end #1 then 970
  191. read #1;d$,t$,a$
  192. if d$=date0$ then 960
  193. 950 print #2;d$,t$,a$
  194. goto 940
  195. 960 if t1$=t$ then s4=1
  196. if t1$=t$ then 940
  197. goto 950
  198. 970 delete 1
  199. close 2
  200. x%=rename("APPOINTS.DAT","TRANS")
  201. if s4=1 then 980
  202. gosub 1100 : rem - bell
  203. gosub 1300 : rem - cursor 2
  204. input "Appointment does not exist; press - RETURN >";line q$
  205. goto 990
  206. 980 gosub 2200 : rem - unpost 1
  207. 990 open "APPOINTS.DAT" as 1
  208. 995 gosub 1300 : rem - cursor 2
  209. s3=1
  210. s4=0
  211. return
  212. 1000 rem - future subroutine *********************
  213. 1010 gosub 1300 : rem - cursor 2
  214. input "Enter future date as MM/DD/YYYY >";line date0$
  215. if date0$="" then print bell$;
  216. if date0$="" then 1010
  217. if date0$=escape$ then 1030
  218. gosub 10000 : rem - date check
  219. if e1=0 then 1020
  220. gosub 1100: goto 1010
  221. 1020 close 1
  222. open "APPOINTS.DAT" as 1
  223. gosub 2300 : rem - unpost 2
  224. ypos%=33-31:xpos%=45-31:gosub 14000
  225. gosub 1700 : rem - day
  226. gosub 1800 : rem - month
  227. ypos%=33-31:xpos%=45-31:gosub 15000
  228. print day$;", ";month$;val(mid$(date0$,4,2));"- ";right$(date0$,4)
  229. gosub 2000 : rem - post 1
  230. 1030 gosub 1300 : rem - cursor 2
  231. s3=1
  232. return
  233. 1100 rem - bell subroutine ***********************
  234. print bell$
  235. return
  236. 1200 rem - create trans subroutine
  237. create "TRANS" as 1
  238. close 1
  239. return
  240. 1300 rem - cursor 2 subroutine *******************
  241. ypos%=53-31:xpos%=33-31:gosub 14000
  242. ypos%=53-31:xpos%=33-31:gosub 15000
  243. return
  244. 1700 rem - day subroutine ************************
  245. p1$=left$(date0$,2):p2$=mid$(date0$,4,2)
  246. p3$=right$(date0$,4)
  247. p1=val(p1$):p2=val(p2$):p3=val(p3$)
  248. if p1>2 then 1710
  249. f=365*p3+p2+31*(p1-1)+int((p3-1)/4)-int(.75*int((p3-1)/100)+1)
  250. goto 1720
  251. 1710 f=365*p3+p2+31*(p1-1)-int(.4*p1+2.3)+int(p3/4)-int(.75*(int(p3/100)+1))
  252. 1720 d=f-(int(f/7)*7)
  253. if d=0 then let day$="Saturday"
  254. if d=1 then let day$="Sunday"
  255. if d=2 then let day$="Monday"
  256. if d=3 then let day$="Tuesday"
  257. if d=4 then let day$="Wednesday"
  258. if d=5 then let day$="Thursday"
  259. if d=6 then let day$="Friday"
  260. return
  261. 1800 rem - month subroutine **********************
  262. let m$=left$(date0$,2)
  263. if val(m$)=1 then let month$="January"
  264. if val(m$)=2 then let month$="February"
  265. if val(m$)=3 then let month$="March"
  266. if val(m$)=4 then let month$="April"
  267. if val(m$)=5 then let month$="May"
  268. if val(m$)=6 then let month$="June"
  269. if val(m$)=7 then let month$="July"
  270. if val(m$)=8 then let month$="August"
  271. if val(m$)=9 then let month$="September"
  272. if val(m$)=10 then let month$="October"
  273. if val(m$)=11 then let month$="November"
  274. if val(m$)=12 then let month$="December"
  275. return
  276. 1900 rem - check time subroutine *****************
  277. e1=0
  278. for i%=1 to 13
  279. read time0$
  280. if time0$=check$ then let i%=13
  281. if check$=left$(time0$,2)+":30" then let i%=13
  282. if check$=left$(time0$,1)+":30" then let i%=13
  283. next i%
  284. if time0$="END" then let e1=1
  285. restore
  286. return
  287. 2000 rem - post 1 subroutine *********************
  288. 2010 if a$="Today's date" then 2015
  289. if d$=date0$ then 2020
  290. 2015 if end #1 then 2060
  291. read #1;d$,t$,a$
  292. goto 2010
  293. 2020 for i%=1 to 12
  294. read time0$
  295. if t$=time0$ then 2040
  296. if len(t$)=5 then 2030
  297. if len(time0$)<5 and t$=left$(time0$,1)+":30" then 2040
  298. goto 2050
  299. 2030 if t$=left$(time0$,2)+":30" then 2040
  300. goto 2050
  301. 2040 if right$(t$,3)=":30" then ypos%=35-31+2*i%
  302. if right$(t$,3)=":00" then ypos%=34-31+2*i%
  303. 2050 next i%
  304. restore
  305. if ypos%>47-31 then ypos%=ypos%-12
  306. if val(left$(t$,2))<7 then xpos%=64-31
  307. if val(left$(t$,2))>=7 then xpos%=39-31
  308. gosub 15000
  309. print a$
  310. goto 2015
  311. 2060 return
  312. 2100 rem - post 2 subroutine *********************
  313. for i%=1 to 12
  314. read time0$
  315. if t$=time0$ then 2120
  316. if len(t$)=5 then 2110
  317. if len(time0$)<5 and t$=left$(time0$,1)+":30" then 2120
  318. goto 2130
  319. 2110 if t$=left$(time0$,2)+":30" then 2120
  320. goto 2130
  321. 2120 if right$(t$,3)=":00" then ypos%=34-31+2*i%
  322. if right$(t$,3)=":30" then ypos%=35-31+2*i%
  323. i%=12
  324. 2130 next i%
  325. restore
  326. if ypos%>47-31 then let ypos%=ypos%-12
  327. if val(left$(t$,2))<7 then xpos%=64-31
  328. if val(left$(t$,2))>=7 then xpos%=39-31
  329. gosub 15000
  330. print a$
  331. return
  332. 2200 rem - unpost 1 subroutine *******************
  333. let a$="                   "
  334. t$=t1$
  335. gosub 2100
  336. return
  337. 2300 rem - unpost 2 subroutine *******************
  338. for i%=1 to 12
  339. ypos%=35-31+i%
  340. xpos%=39-31
  341. gosub 15000
  342. print "                   "
  343. next i%
  344. for i%=1 to 12
  345. ypos%=35-31+i%
  346. xpos%=64-31
  347. gosub 15000
  348. print "                 "
  349. next i%
  350. return
  351. 2400 rem - check exist subroutine ******************
  352. e1=0
  353. close 1
  354. open "APPOINTS.DAT" as 1
  355. 2410 if end # 1 then 2430
  356. read #1;d$,t1$,a$
  357. if d$=date0$ then 2420
  358. goto 2410
  359. 2420 if t$=t1$ then 2425
  360. goto 2410
  361. 2425 gosub 1100 : rem - bell
  362. gosub 1300 : rem - cursor 2
  363. input "Overlaps another appointment; press - RETURN >";line q$
  364. e1=1
  365. 2430 return
  366. 2500 rem - printout 2 subroutine *****************
  367. gosub 1300 : rem - cursor 2
  368. input "Ready printer and press - RETURN >";line q$
  369. if q$=escape$ then 2570
  370. lprinter
  371. print
  372. print
  373. print tab(10);"APPOINTMENTS for ";day$;", ";month$;
  374. print val(mid$(date0$,4,2));"- ";right$(date0$,4)
  375. print
  376. close 1
  377. open "APPOINTS.DAT" as 1
  378. for i%=1 to 12
  379. read time0$
  380. 2505 print tab(15-len(time0$));time0$;
  381. 2510 if end #1 then 2520
  382. goto 2530
  383. 2520 close 1
  384. open "APPOINTS.DAT" as 1
  385. if s5=1 then print
  386. if s5=1 then 2555
  387. s5=1
  388. 2530 read #1;d$,t$,a$
  389. if d$=date0$ then 2540
  390. goto 2510
  391. 2540 if t$=time0$ then 2550
  392. goto 2510
  393. 2550 print tab(20);a$
  394. 2555 if right$(time0$,3)=":30" then 2560
  395. if len(time0$)=4 then time0$=left$(time0$,1)+":30"
  396. if len(time0$)=5 then time0$=left$(time0$,2)+":30"
  397. s5=0
  398. goto 2505
  399. 2560 s5=0
  400. next i%
  401. restore
  402. console
  403. 2570 gosub 1300 : rem - cursor 2
  404. s3=1
  405. return
  406. 2600 rem - reschedule subroutine *****************
  407. 2610 gosub 1300 : rem - cursor 2
  408. input "Enter time to be rescheduled >";line t1$
  409. if t1$="" then print bell$;
  410. if t1$="" then 2610
  411. if t1$=escape$ then 2680
  412. check$=t1$
  413. gosub 1900 : rem - check time
  414. if e1=0 then 2620
  415. gosub 1100 : rem - bell
  416. goto 2610
  417. 2620 close 1
  418. open "APPOINTS.DAT" as 1
  419. 2630 if end #1 then 2650
  420. read #1;d$,t$,a$
  421. if d$=date0$ then 2640
  422. goto 2630
  423. 2640 if t$=t1$ then 2660
  424. goto 2630
  425. 2650 gosub 1100 : rem - bell
  426. gosub 1300 : rem - cursor 2
  427. input "Appointment does not exist; press - RETURN >";line q$
  428. goto 2610
  429. 2660 gosub 920 : rem - delete
  430. 2665 gosub 1300 : rem - cursor 2
  431. input "Enter reschedule date as MM/DD/YYYY >";line date0$
  432. if date0$="" then print bell$;
  433. if date0$="" then 2665
  434. if date0$=escape$ then 2680
  435. gosub 10000 : rem - date check
  436. if e1=0 then 2670
  437. gosub 1100:goto 2665
  438. 2670 gosub 1020 : rem - future
  439. gosub 700 : rem - add
  440. 2680 return
  441. 2700 rem - search subroutine *********************
  442. 2710 gosub 1300 : rem - cursor 2
  443. input "Enter key word for search >";line appoint$
  444. if appoint$="" then print bell$;
  445. if appoint$="" then 2710
  446. if appoint$=escape$ then 2750
  447. if len(appoint$)<19 then 2720
  448. gosub 1100 : rem - bell
  449. gosub 1300 : rem - cursor 2
  450. input "Only 18 characters please; press - RETURN >";line q$
  451. goto 2710
  452. 2720 close 1
  453. search%=0 : rem - initialize search counter...
  454. open "APPOINTS.DAT" as 1
  455. 2730 if end #1 then 2740
  456. read #1;d$,t$,a$
  457. if match(ucase$(appoint$),ucase$(a$),1)=0 then 2730
  458. date0$=d$
  459. gosub 1020
  460. search%=search%+1
  461. 2735 gosub 1300 : rem - cursor 2
  462. print "Continue search (y/n) > ";
  463. while not constat%:wend:q2$=ucase$(chr$(conchar%))
  464. if q2$="" then print bell$;
  465. if q2$="" then 2735
  466. if q2$=escape$ then 2750
  467. q2$=ucase$(q2$)
  468. if q2$<>"Y" and q2$<>"N" then gosub 1100
  469. if q2$<>"Y" and q2$<>"N" then 2735
  470. if q2$="N" then 2750
  471. close 1
  472. open "APPOINTS.DAT" as 1
  473. for i%=1 to search%
  474. 2736 if end #1 then 2738
  475. goto 2737
  476. 2738 i%=search%:goto 2739
  477. 2737 read #1;d$,t$,a$
  478. if match(ucase$(appoint$),ucase$(a$),1)>0 then 2739
  479. goto 2736
  480. 2739 next i%
  481. goto 2730
  482. 2740 gosub 1100 : rem - bell
  483. gosub 1300 : rem - cursor 2
  484. input "Match not found; press - RETURN >";line q$
  485. 2750 gosub 1300 : rem - cursor 2
  486. return
  487. 10000 rem - date check subroutine ******************
  488. 10010 rem
  489. 10020 rem - variables to check
  490. 10030 rem   date0$ = date being checked
  491. 10040 rem   e1    = error switch
  492. 10050 rem   i%    = for/next loop counter
  493. 10060 rem   p$    = substitute for date to be checked
  494. 10070 rem   p1$   = month
  495. 10080 rem   p2$   = day
  496. 10090 rem   p3$   = year
  497. 10100 rem   x     = numeric counter
  498. 10110 rem
  499. 10120 e1=0 
  500. 10130 p$=date0$ 
  501. 10140 if len(p$)>10 then 10340
  502. 10150 x=0
  503. 10160 for i%=1 to 10:x=x+match("#",p$,i%):next i%
  504. 10170 if x<>57 then 10340
  505. 10180 p1$=left$(p$,2):p2$=mid$(p$,4,2):p3$=right$(p$,4)
  506. 10190 if val(p1$)<1 then 10340
  507. 10200 if val(p1$)>12 then 10340
  508. 10210 if val(p2$)<1 then 10340
  509. 10215 if val(p2$)>31 then 10340
  510. 10220 if val(p3$)<1 then 10340
  511. 10230 if val(p1$)<>int(val(p1$)) then 10340
  512. 10240 if val(p2$)<>int(val(p2$)) then 10340
  513. 10250 if val(p3$)<>int(val(p3$)) then 10340
  514. 10260 if val(p1$)=9 and val(p2$)>30 then 10340
  515. 10270 if val(p1$)=4 and val(p2$)>30 then 10340
  516. 10280 if val(p1$)=6 and val(p2$)>30 then 10340
  517. 10290 if val(p1$)=11 and val(p2$)>30 then 10340
  518. 10300 if val(p1$)=2 and val(p2$)>29 then 10340
  519. 10310 if val(p3$)/4=int(val(p3$)/4) then 10350
  520. 10320 if val(p1$)=2 and val(p2$)>28 then 10340
  521. 10330 goto 10350
  522. 10340 let e1=1
  523. 10350 return
  524. 14000 rem - rubout subroutine ********************
  525. 14010 gosub 15000
  526. 14020 print clreol$;:gosub 15000
  527. 14030 return
  528. 15000 rem - cursor subroutine ********************
  529. 15020 rem - variables to check
  530. 15030 rem   xpos% = horizontal cursor position (1-52, L to R)
  531. 15040 rem   ypos% = vertical cursor position (1-24, T to B)
  532. 15060 if rowcol$=chr$(01) then 15090
  533. 15070 print poscmd$+chr$(xpos%+posofs%-1)+chr$(ypos%+posofs%-1);
  534. 15080 go to 15100
  535. 15090 print poscmd$+chr$(ypos%+posofs%-1)+chr$(xpos%+posofs%-1);
  536. 15100 return
  537. 16000 rem - tone on subroutine *******************
  538. 16020 return
  539. 18000 rem - tone off subroutine ******************
  540. 18020 return
  541. data "7:00","8:00","9:00","10:00","11:00","12:00"
  542. data "1:00","2:00","3:00","4:00","5:00","6:00","END"
  543. ******
  544. 18020 return
  545. data "7:00","8:00","9:00",