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 / FMLYTRE2.LBR / LOADTREE.BQS / LOADTREE.BAS
BASIC Source File  |  2000-06-30  |  3KB  |  77 lines
  1. 10 REM ---ADDNAME---  JOHN J. ARMSTRONG - MOBILE, AL
  2. 20 CLEAR 1000
  3. 21 INPUT "WHICH FAMILY TREE (3 CHARACTERS)?";TR$
  4. 30 OPEN "R", #1, "FAMILY  ."+TR$
  5. 40 OPEN "R",#2,"FAMILY2 ."+TR$
  6. 50 DIM C$(13):BL$=STRING$(24,32)
  7. 60 CH$=" CHANGE ":CH$(1)="LAST NAME AT BIRTH":CH$(2)="FIRST NAME(S)"
  8. 70 CH$(3)="MARRIED LAST NAME":T$=" TO :"
  9. 80 C=0:C1=0:CH=0:GOSUB 730
  10. 90 PRINT "(1) ADD A NAME": PRINT "(2) CHANGE A NAME": PRINT "(3) EXIT PROGRAM"
  11. 100 INPUT "CHOICE";C: IF C<1 OR C>3 THEN 100
  12. 110 ON C GOTO 130, 270, 740
  13. 120 REM
  14. 130 REM ROUTINE: ADD-A-NAME
  15. 140 REM
  16. 150 X=LOF(1)+1:GOSUB 680: GET 1,X
  17. 160 U=LOF(2)+1: GET #2,U
  18. 170 GOSUB 480: GOSUB 510: GOSUB 540: PUT #1,X
  19. 180 PUT #2,U
  20. 190 GOSUB 580: GET #1,X
  21. 200 GOSUB 630: GET #2,U
  22. 210 LSET BD$="????????":LSET PB$="?":LSET MD$(1)=BL$:LSET S1$=MKI$(0):LSET MS$(1)="SINGLE":LSET MD$(2)=BL$:LSET S2$=MKI$(0):LSET PM$(2)=BL$:LSET MS$(2)=BL$:LSET DD$="LIVING":LSET PD$="?"
  23. 220 PUT #1,X
  24. 230 FOR Z=10 TO 13: LSET C$(Z)=MKI$(0):LSET F$=MKI$(0): NEXT Z
  25. 240 PUT #2,U
  26. 250 GOTO 80
  27. 260 REM
  28. 270 REM ROUTINE: CHANGE-A-NAME
  29. 280 REM
  30. 290 INPUT "PERSON'S ID # ";X
  31. 300 IF X<1 OR X>LOF(1) THEN PRINT "BETWEEN 1 AND " LOF(1): GOTO 290
  32. 310 U=X
  33. 320 GOSUB 680: GET #1,X
  34. 330 GET #2,U:PRINT CHR$(12);: PRINT NF$;" ";NL$;" "NM$
  35. 340 INPUT "IS THIS THE CORRECT ONE TO CHANGE (Y/N)";YN$
  36. 350 IF LEFT$(YN$,1)="Y" THEN 360 ELSE 80
  37. 360 PRINT CHR$(12);:PRINT NF$;" ";NL$;" "NM$
  38. 370 FOR Y=1 TO 3: PRINT CH$;"(";Y;")";CH$(Y): NEXT Y
  39. 380 INPUT "HOW MANY CHANGES";CH: IF CH<0 OR CH>3 THEN 380
  40. 390 IF CH=0 THEN 80
  41. 400 FOR Y=1 TO CH
  42. 410 PRINT CH$"ITEM # ";: INPUT C1
  43. 420 IF C1<1 OR C1>3 THEN 410
  44. 430 CH(Y)=C1:NEXT Y
  45. 440 FOR Y=1 TO CH
  46. 450 ON CH(Y) GOSUB 480, 510, 540
  47. 460 NEXT Y
  48. 470 PUT #1,X: PUT #2,U: GOTO 80
  49. 480 PRINT CH$(1)
  50. 490 IF C=2 THEN PRINT CH$; NL$; T$
  51. 500 INPUT A$:LSET NL$=A$: GOSUB 720: RETURN
  52. 510 PRINT CH$(2)
  53. 520 IF C=2 THEN PRINT CH$; NF$; T$
  54. 530 INPUT A$: LSET NF$=A$: GOSUB 720: RETURN
  55. 540 PRINT CH$(3)
  56. 550 IF C=2 THEN PRINT CH$; NM$; T$
  57. 560 INPUT A$: LSET NM$=A$: GOSUB 720: RETURN
  58. 570 REM
  59. 580 REM SUBROUTINE--FIELD DATA BUFFER TO INITIALIZE DATA
  60. 590 REM
  61. 600 FIELD #1,8 AS BD$,24 AS PB$,8 AS MD$(1),2 AS S1$,24 AS PM$(1),9 AS MS$(1),8 AS MD$(2),2 AS S2$,24 AS PM$(2),9 AS MS$(2),8 AS DD$
  62. 610 RETURN
  63. 620 REM
  64. 630 REM SUBROUTINE--FIELD DATA BUFFER TO INITIALIZE DATA
  65. 640 REM
  66. 650 FIELD #2,24 AS PD$,2 AS CN$,2 AS C$(1),2 AS C$(2),2 AS C$(3),2 AS C$(4),2 AS C$(5),2 AS C$(6),2 AS C$(7),2 AS C$(8),2 AS C$(9),2 AS C$(10),2 AS C$(11),2 AS C$(12),2 AS C$(13),2 AS M$,2 AS F$
  67. 660 RETURN
  68. 670 REM
  69. 680 REM SUBROUTINE--FIELD DATA BUFFER FOR NAMES
  70. 690 REM
  71. 700 FIELD #1,126 AS DU$
  72. 710 FIELD #2,56 AS D$,16 AS NL$,24 AS NF$,16 AS NM$: RETURN
  73. 720 A$=BL$:RETURN
  74. 730 PRINT CHR$(12);:PRINT "THERE ARE "LOF(1)" NAMES ON FILE":RETURN
  75. 740 PRINT CHR$(12);:GOSUB 730:CLOSE:PRINT "AND THE FILE HAS BEEN CLOSED.":END
  76. RINT "THERE ARE "LOF(1)" NAMES ON FILE":RETURN
  77. 740 PRINT CHR$(12);:GOS