90 WIDTH "scrn:", 80
95 SCREEN 0,1,0,0
100 TITLE$ = "Update the Parent/Child Index Program"
105 TITLE$ = TITLE$ + " ON DISPLAY"
110 VERSION$ = "Version 2.0"
115 COPY1$ = "Copyright (c) 1983, 1984, by:"
120 COPY2$ = "Melvin O. Duke"
125 PRICE$ = "$35"
130 ADDR1$ = "Melvin O. Duke"
135 ADDR2$ = "P. O. Box 20836"
140 ADDR3$ = "San Jose, CA 95160"
145 REM Dimension Statements go here
150 DIM CH.ID(1000), PA.ID(1000), B.DATE(1000)
170 REM Produce the first screen
175 KEY OFF : CLS
180 REM Draw the outer double box
185 R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
190 REM Find the title location
195 TITLE.POS = 40 - INT(LEN(TITLE$)/2)
200 REM Draw the title box
205 R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
210 REM Print the title
215 LOCATE 4,TITLE.POS : PRINT TITLE$
220 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$;
225 REM Draw the Contribution box
230 R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
235 REM Request the Contribution
240 LOCATE 9,23 : PRINT "If you are using these programs, and"
245 LOCATE 10,21 : PRINT "finding them of value, your contribution"
250 LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
255 REM Draw the Mailing Label
260 R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
265 REM Print the Name and Address
270 LOCATE 13,40-INT(LEN(ADDR1$)/2) : PRINT ADDR1$;
275 LOCATE 14,40-INT(LEN(ADDR2$)/2) : PRINT ADDR2$;
280 LOCATE 15,40-INT(LEN(ADDR3$)/2) : PRINT ADDR3$;
285 REM Draw the Copyright box
290 R1 = 19 : C1 = 24 : R2 = 22 : C2 = 56 : GOSUB 400
295 REM Print the Copyright
300 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$;
305 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$;
310 GOTO 740
400 REM subroutine to print a double box
410 FOR I = R1 + 1 TO R2 - 1
420 LOCATE I, C1 : PRINT CHR$(186);
430 LOCATE I, C2 : PRINT CHR$(186);
440 NEXT I
450 FOR J = C1 + 1 TO C2 - 1
460 LOCATE R1, J : PRINT CHR$(205);
470 LOCATE R2, J : PRINT CHR$(205);
480 NEXT J
490 LOCATE R1, C1 : PRINT CHR$(201);
500 LOCATE R1, C2 : PRINT CHR$(187);
510 LOCATE R2, C1 : PRINT CHR$(200);
520 LOCATE R2, C2 : PRINT CHR$(188);
530 RETURN
600 REM subroutine to print a single box
610 FOR I = R1 + 1 TO R2 - 1
620 LOCATE I, C1 : PRINT CHR$(179);
630 LOCATE I, C2 : PRINT CHR$(179);
640 NEXT I
650 FOR J = C1 + 1 TO C2 - 1
660 LOCATE R1, J : PRINT CHR$(196);
670 LOCATE R2, J : PRINT CHR$(196);
680 NEXT J
690 LOCATE R1, C1 : PRINT CHR$(218);
700 LOCATE R1, C2 : PRINT CHR$(191);
710 LOCATE R2, C1 : PRINT CHR$(192);
720 LOCATE R2, C2 : PRINT CHR$(217);
730 RETURN
740 REM ask user to press a key to continue
750 LOCATE 25,1
760 PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
770 K$ = INKEY$ : IF K$ = "" THEN 770
780 CLS
1000 REM Parent/Child Index Program
1010 REM By: Melvin O. Duke. Last Updated: 02 December 1983.
1020 OPEN "a:persfile" AS #1 LEN = 256
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$
1040 REM Read all records, and create the index.
1050 CLS
1060 C = 0
1070 FOR I = 1 TO 500
1080 GET #1, I
1090 LOCATE 15,1 : PRINT "Processing Person Record:"; I;
1100 REM Extract information from the file
1110 T1 = CVS(F1$) 'Child-id
1120 IF T1 < 0 THEN 1450
1130 T6 = CVS(F6$) 'Father-id
1140 T7 = CVS(F7$) 'Mother-id
1150 T8$ = F8$ 'Birthdate as dd mmm yyyy
1160 IF T8$ = " " THEN BD = 0 : GOTO 1330
1170 REM convert Birthdate
1180 BD = VAL(RIGHT$(T8$,4))*10000!
1190 MO$ = MID$(T8$,4,3)
1200 IF MO$ = "Jan" THEN BD = BD + 100 : GOTO 1320
1210 IF MO$ = "Feb" THEN BD = BD + 200 : GOTO 1320
1220 IF MO$ = "Mar" THEN BD = BD + 300 : GOTO 1320
1230 IF MO$ = "Apr" THEN BD = BD + 400 : GOTO 1320
1240 IF MO$ = "May" THEN BD = BD + 500 : GOTO 1320
1250 IF MO$ = "Jun" THEN BD = BD + 600 : GOTO 1320
1260 IF MO$ = "Jul" THEN BD = BD + 700 : GOTO 1320
1270 IF MO$ = "Aug" THEN BD = BD + 800 : GOTO 1320
1280 IF MO$ = "Sep" THEN BD = BD + 900 : GOTO 1320
1290 IF MO$ = "Oct" THEN BD = BD + 1000 : GOTO 1320
1300 IF MO$ = "Nov" THEN BD = BD + 1100 : GOTO 1320
1310 IF MO$ = "Dec" THEN BD = BD + 1200 : GOTO 1320
1320 BD = BD + VAL(LEFT$(T8$,2))
1330 REM create the father/child index record
1340 IF T6 = 0 THEN 1390 'skip if zero
1350 C = C + 1
1360 CH.ID(C) = T1
1370 PA.ID(C) = T6
1380 B.DATE(C) = BD
1390 REM create the mother/child index record
1400 IF T7 = 0 THEN 1450 'skip if zero
1410 C = C + 1
1420 CH.ID(C) = T1
1430 PA.ID(C) = T7
1440 B.DATE(C) = BD
1450 NEXT I
1460 CLOSE #1
1470 LOCATE 18,1 : PRINT "There are:"; C; "Index Records";
1480 REM Sort the index into ascending sequence
1700 REM
1710 REM Sort by Parent
1720 FOR I = 1 TO 6
1730 B(I) = B(I-1)*4+1
1740 IF B(I) <= C/2 THEN K1 = I
1750 NEXT I
1760 B(K1) = INT(C/5)+1
1770 B(1) = 1
1775 LOCATE 22,1 : PRINT "Processing Parents ";
1780 FOR I = K1 TO 1 STEP -1
1790 LOCATE 23,1 : PRINT "For Group:";I;
1800 K1 = B(I)
1810 FOR J = K1 TO C
1820 LOCATE 23,20 : PRINT "J:";J;
1830 K2=PA.ID(J) : B.TEMP = B.DATE(J) : TEMP3 = CH.ID(J)
1840 FOR K = J-K1 TO 0 STEP -K1
1850 LOCATE 23,30 : PRINT "K:";K, "Freespace:";FRE(0)
1860 IF K2 > PA.ID(K) THEN 1900
1870 IF K2 = PA.ID(K) AND B.TEMP > B.DATE(K) THEN 1900
1880 PA.ID(K+K1)=PA.ID(K) : CH.ID(K+K1)=CH.ID(K):B.DATE(K+K1)=B.DATE(K)
1890 NEXT K
1900 PA.ID(K+K1)=K2: CH.ID(K+K1)=TEMP3: B.DATE(K+K1)=B.TEMP
1910 NEXT J
1920 NEXT I
1930 REM Write the Parent/Child Index
1935 CLS : LOCATE 21,1
1936 PRINT "Writing the Parent/Child Index"
1940 OPEN "a:pcindex" FOR OUTPUT AS #2
1950 WRITE #2,C
1960 FOR I = 1 TO C
1970 WRITE #2, PA.ID(I)
1980 WRITE #2, CH.ID(I)
1990 NEXT I
2000 CLOSE #2
2010 CLS : LOCATE 21,1
2020 PRINT "End of Program"
2030 RUN "a:menu"