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 / MBUG / MBUG059.ARC / INDEXPC.BAS < prev    next >
BASIC Source File  |  1979-12-31  |  6KB  |  163 lines
  1. 100 TITLE$ = "Update the Parent/Child Index Program"
  2. 105 TITLE$ = TITLE$ + " ON DISPLAY"
  3. 110 VERSION$ = "Version 1.3"
  4. 115 COPY1$ = "Copyright (c) 1983, by:"
  5. 120 COPY2$ = "Melvin O. Duke"
  6. 125 PRICE$ = "$35"
  7. 130 ADDR1$ = "Melvin O. Duke"
  8. 135 ADDR2$ = "P. O. Box 20836"
  9. 140 ADDR3$ = "San Jose, CA  95160"
  10. 145 REM Dimension Statements go here
  11. 150 DIM CH.ID(800), PA.ID(800), B.DATE(800)
  12. 170 REM Produce the first screen
  13. 175 KEY OFF : CLS
  14. 180 REM Draw the outer double box
  15. 185 R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  16. 190 REM Find the title location
  17. 195 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  18. 200 REM Draw the title box
  19. 205 R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  20. 210 REM Print the title
  21. 215 LOCATE 4,TITLE.POS : PRINT TITLE$
  22. 220 LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  23. 225 REM Draw the Contribution box
  24. 230 R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  25. 235 REM Request the Contribution
  26. 240 LOCATE 9,23 : PRINT "If you are using these programs, and"
  27. 245 LOCATE 10,21 : PRINT "finding them of value, your contribution"
  28. 250 LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be appreciated."
  29. 255 REM Draw the Mailing Label
  30. 260 R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  31. 265 REM Print the Name and Address
  32. 270 LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  33. 275 LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  34. 280 LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  35. 285 REM Draw the Copyright box
  36. 290 R1 = 19 : C1 = 27 : R2 = 22 : C2 = 53 : GOSUB 400
  37. 295 REM Print the Copyright
  38. 300 LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  39. 305 LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  40. 310 GOTO 740
  41. 400 REM subroutine to print a double box
  42. 410 FOR I = R1 + 1 TO R2 - 1
  43. 420  LOCATE I, C1 : PRINT CHR$(186);
  44. 430  LOCATE I, C2 : PRINT CHR$(186);
  45. 440 NEXT I
  46. 450 FOR J = C1 + 1 TO C2 - 1
  47. 460  LOCATE R1, J : PRINT CHR$(205);
  48. 470  LOCATE R2, J : PRINT CHR$(205);
  49. 480 NEXT J
  50. 490  LOCATE R1, C1 : PRINT CHR$(201);
  51. 500  LOCATE R1, C2 : PRINT CHR$(187);
  52. 510  LOCATE R2, C1 : PRINT CHR$(200);
  53. 520  LOCATE R2, C2 : PRINT CHR$(188);
  54. 530 RETURN
  55. 600 REM subroutine to print a single box
  56. 610 FOR I = R1 + 1 TO R2 - 1
  57. 620  LOCATE I, C1 : PRINT CHR$(179);
  58. 630  LOCATE I, C2 : PRINT CHR$(179);
  59. 640 NEXT I
  60. 650 FOR J = C1 + 1 TO C2 - 1
  61. 660  LOCATE R1, J : PRINT CHR$(196);
  62. 670  LOCATE R2, J : PRINT CHR$(196);
  63. 680 NEXT J
  64. 690  LOCATE R1, C1 : PRINT CHR$(218);
  65. 700  LOCATE R1, C2 : PRINT CHR$(191);
  66. 710  LOCATE R2, C1 : PRINT CHR$(192);
  67. 720  LOCATE R2, C2 : PRINT CHR$(217);
  68. 730 RETURN
  69. 740 REM ask user to press a key to continue
  70. 750 LOCATE 25,1
  71. 760 PRINT "Press any key to continue";
  72. 770 K$ = INKEY$ : IF K$ = "" THEN 770
  73. 780 CLS
  74. 1000 REM Parent/Child Index Program
  75. 1010 REM By:  Melvin O. Duke.  Updated 26 June, 1983.
  76. 1020 OPEN "a:persfile" AS #1 LEN = 256
  77. 1030 FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  78. 1040 REM Read all records, and create the index.
  79. 1050 CLS
  80. 1060 C = 0
  81. 1070 FOR I = 1 TO 400
  82. 1080  GET #1, I
  83. 1090  LOCATE 15,1 : PRINT "Processing Person Record:"; I;
  84. 1100  REM Extract information from the file
  85. 1110  T1 = CVS(F1$)  'Child-id
  86. 1120  IF T1 < 0 THEN 1450
  87. 1130  T6 = CVS(F6$)  'Father-id
  88. 1140  T7 = CVS(F7$)  'Mother-id
  89. 1150  T8$ = F8$  'Birthdate as dd mmm yyyy
  90. 1160  IF T8$ = "           " THEN BD = 0 : GOTO 1330
  91. 1170  REM convert Birthdate
  92. 1180  BD = VAL(RIGHT$(T8$,4))*10000!
  93. 1190  MO$ = MID$(T8$,4,3)
  94. 1200  IF MO$ = "Jan" THEN BD = BD +  100 : GOTO 1320
  95. 1210  IF MO$ = "Feb" THEN BD = BD +  200 : GOTO 1320
  96. 1220  IF MO$ = "Mar" THEN BD = BD +  300 : GOTO 1320
  97. 1230  IF MO$ = "Apr" THEN BD = BD +  400 : GOTO 1320
  98. 1240  IF MO$ = "May" THEN BD = BD +  500 : GOTO 1320
  99. 1250  IF MO$ = "Jun" THEN BD = BD +  600 : GOTO 1320
  100. 1260  IF MO$ = "Jul" THEN BD = BD +  700 : GOTO 1320
  101. 1270  IF MO$ = "Aug" THEN BD = BD +  800 : GOTO 1320
  102. 1280  IF MO$ = "Sep" THEN BD = BD +  900 : GOTO 1320
  103. 1290  IF MO$ = "Oct" THEN BD = BD + 1000 : GOTO 1320
  104. 1300  IF MO$ = "Nov" THEN BD = BD + 1100 : GOTO 1320
  105. 1310  IF MO$ = "Dec" THEN BD = BD + 1200 : GOTO 1320
  106. 1320  BD = BD + VAL(LEFT$(T8$,2))
  107. 1330  REM create the father/child index record
  108. 1340  IF T6 = 0 THEN 1390  'skip if zero
  109. 1350  C = C + 1
  110. 1360  CH.ID(C) = T1
  111. 1370  PA.ID(C) = T6
  112. 1380  B.DATE(C) = BD
  113. 1390  REM create the mother/child index record
  114. 1400  IF T7 = 0 THEN 1450  'skip if zero
  115. 1410  C = C + 1
  116. 1420  CH.ID(C) = T1
  117. 1430  PA.ID(C) = T7
  118. 1440  B.DATE(C) = BD
  119. 1450 NEXT I
  120. 1460 CLOSE #1
  121. 1470 LOCATE 18,1 : PRINT "There are:"; C; "Index Records";
  122. 1480 REM Sort the index into ascending sequence
  123. 1700 REM
  124. 1710 REM Sort by Parent
  125. 1720 FOR I = 1 TO 6
  126. 1730  B(I) = B(I-1)*4+1
  127. 1740  IF B(I) <= C/2 THEN K1 = I
  128. 1750 NEXT I
  129. 1760 B(K1) = INT(C/5)+1
  130. 1770 B(1) = 1
  131. 1775 LOCATE 22,1 : PRINT "Processing Parents     ";
  132. 1780 FOR I = K1 TO 1 STEP -1
  133. 1790 LOCATE 23,1 : PRINT "For Group:";I;
  134. 1800  K1 = B(I)
  135. 1810  FOR J = K1 TO C
  136. 1820   LOCATE 23,20 : PRINT "J:";J;
  137. 1830   K2=PA.ID(J) : B.TEMP = B.DATE(J) : TEMP3 = CH.ID(J)
  138. 1840   FOR K = J-K1 TO 0 STEP -K1
  139. 1850    LOCATE 23,30 : PRINT "K:";K, "Freespace:";FRE(0)
  140. 1860    IF K2 > PA.ID(K) THEN 1900
  141. 1870    IF K2 = PA.ID(K) AND B.TEMP > B.DATE(K) THEN 1900
  142. 1880    PA.ID(K+K1)=PA.ID(K) : CH.ID(K+K1)=CH.ID(K):B.DATE(K+K1)=B.DATE(K)
  143. 1890   NEXT K
  144. 1900   PA.ID(K+K1)=K2: CH.ID(K+K1)=TEMP3: B.DATE(K+K1)=B.TEMP
  145. 1910  NEXT J
  146. 1920 NEXT I
  147. 1930 REM Write the Parent/Child Index
  148. 1935 CLS : LOCATE 21,1
  149. 1936 PRINT "Writing the Parent/Child Index"
  150. 1940 OPEN "a:pcindex" FOR OUTPUT AS #2
  151. 1950 WRITE #2,C
  152. 1960 FOR I = 1 TO C
  153. 1970  WRITE #2, PA.ID(I)
  154. 1980  WRITE #2, CH.ID(I)
  155. 1990 NEXT I
  156. 2000 CLOSE #2
  157. 2010 CLS : LOCATE 21,1
  158. 2020 PRINT "End of Program"
  159. 2030 END
  160. y" OR LEFT$(REPLY$,1) = "Y" THEN 1760 ELSE 1070
  161. 1760 CLS
  162. 1780 REM Read the Parent/Child Index
  163. 1790 OPEN "a:pcin