|2005 DIM ST(10,10),C$(|06)
|2010 FOR J=1 TO |02
2015 IF ZS%(J,1)=2 OR ZS%(J,4)=0 THEN GOTO 2040
2020 FOR K=2 TO ZS%(J,4)+1
|2025 FOR L=J+1 TO |02
2030 IF ZS$(J,K)=ZS$(L,1) THEN ST(J,K-1)=L
2035 NEXT L:NEXT K
2040 NEXT 'J
|2110 CLS:PRINT TAB(21)"PDS*BASE Data Base Utility Program For":PRINT:PRINT TAB(INT((80-LEN("|11"))/2));"|11":PRINT
2120 PRINT TAB(17);"Main Menu"
*23 2130 PRINT:PRINT "1 - Reset Detail 'Next Vacant Record' Pointers"
2140 PRINT:PRINT "2 - Reset Master 'Quantity Assigned' Records"
*23 2150 PRINT:PRINT "3 - Verify Master/Detail Relationships For Broken Detail Chains"
2155 PRINT:PRINT "4 - Serial Print The Files"
2160 PRINT:PRINT "5 - Hard Modify A Record"
2165 PRINT:PRINT "    Enter Code ? ";:ZQ$=INPUT$(1):PRINT ZQ$:ZK=VAL(ZQ$):IF ZK=0 THEN GOTO 400
2170 IF ZK < 0 OR ZK > 5 THEN GOTO 2110
*28 2175 IF ZK=1 OR ZK=3 THEN GOTO 2110
2180 ON ZK GOTO 2200,2300,2400,3000,3500
*28 2200 GOTO 2110 'No Detail Files
*23 2200 ' reset detail vacant record pointers
*23 2205 PRINT:PRINT "File * Record * Last Vacant":PRINT:PRINT
*23 |2210 FOR ZA=1 TO |02:IF ZS%(ZA,1)<>2 THEN GOTO 2280
*23 2220 ZL=ZS%(ZA,2)+1:Y2=0:FOR ZR=ZS%(ZA,2) TO 1 STEP -1
*23 2225 LOCATE ,2,1:PRINT ZA;TAB(9)ZR;" ";
*23 2230 GOSUB 600:Y11=0:FOR ZJ=1 TO ZS%(ZA,7):IF Y$(ZJ,ZA)<>STRING$(ZSIZE%(ZA,ZJ),32) THEN Y11=1
*23 2240 NEXT:IF Y11=1 THEN Y2=Y2+1:GOTO 2260
*23 2250 ZF=ZL:GOSUB 700:ZL=ZR 'set the forward pointer to the next higher vacant record
*23 2255 LOCATE ,2,1:PRINT ZA;TAB(9)ZR;SPC(1);TAB(20)ZL;" ";:ZL=ZR
*23 2260 NEXT ZR:PRINT:PRINT
*23 2270 ZS%(ZA,6)=Y2:ZS%(ZA,8)=ZL 'reset the housekeeping pointers
*23 2280 NEXT 'ZA
*23 2290 GOTO 2375
2300 'RESET THE MASTER QUANTITY ASSIGNED
2305 PRINT:PRINT "File * Record * Active Records":PRINT:PRINT
|2310 FOR ZA=1 TO |02:IF ZS%(ZA,1)<>1 THEN GOTO 2370
2320 Y22=0:FOR ZR=1 TO ZS%(ZA,2)
2330 ZZ=1:GOSUB 610:IF ZL$<>STRING$(ZSIZE%(ZA,1),32) THEN Y22=Y22+1
2340 LOCATE ,2,1:PRINT ZA;TAB(9)ZR;TAB(20);Y22;
2350 NEXT ZR:PRINT:PRINT
2360 ZS%(ZA,6)=Y22 'update records assigned
2370 NEXT 'ZA
2375 PRINT:PRINT TAB(25)"(Press any key to continue) ";:ZQ$=INPUT$(1):PRINT
2380 GOTO 2110
*28 2400 GOTO 2110 'no detail files
*23 2400 'check for broken detail chains
*23 2410 BEEP:PRINT "Turn On The Printer For Error List"
*23 |2420 FOR Y11=1 TO |02:IF ZS%(Y11,1)<>1 OR ZS%(Y11,4)=0 THEN GOTO 2500
*23 2430 Y3=0:FOR Y2=1 TO ZS%(Y11,2)
*23 2440 ZZ=1:ZR=Y2:GOSUB 610
*23 2450 IF ZL$=STRING$(VAL(MID$(ZN$(ZA,1,2),3)),32) THEN 2480
*23 2460 Y3=Y3+1:FOR Y4=1 TO ZS%(Y11,4):IF ZH(Y4)<>0 THEN GOSUB 2600 'check the chain head
*23 2470 NEXT 'Y4
*23 2480 NEXT 'Y2
*23 2490 ZS%(Y11,6)=Y3 'reset assigned records counter
*23 2500 NEXT 'Y11
*23 2510 GOTO 2110
*23 2520 '
*23 2600 'Subroutine to check out the chain for MASTER Y2 and the Y4th associated set
*23 2610 ZA=ST(Y11,Y4):ZR=ZH(Y4):GOSUB 600 'read chain head record
*23 2620 IF ZH(Y4)=0 AND ZE(Y4)=0 AND ZB=0 AND ZF=0 THEN RETURN ' 1 Detail - all ok
*23 2630 IF ZB=0 THEN GOTO 2670
*23 2640 '
*23 2650 LPRINT:LPRINT "Master File ";Y11;"  Record ";Y2;"  Detail File ";ZA;"  Record ";ZR:LPRINT "1st Detail has ";ZB;" as backward pointer"
*23 2670 IF ZF>0 THEN GOTO 2710
*23 2690 LPRINT:LPRINT "Master File ";Y11;"  Record ";Y2;"  Detail File ";ZA;"  Record ";ZR:LPRINT "1st Detail has zero forward ptr but chain end in master not the same number"
*23 2710 IF ZF=0 THEN RETURN
*23 2720 Y5=ZR:ZR=ZF:GOSUB 600 'read next Detail
*23 2730 IF ZB=Y5 THEN GOTO 2770 'back ptr=last record number
*23 2750 LPRINT:LPRINT "Master File ";Y11;"  Record ";Y2;"  Detail File ";ZA;"  Record ";ZR:LPRINT "Backward pointer not equal last Detail record number (broken chain)"
*23 2760 RETURN
*23 2770 IF ZF>0 THEN GOTO 2720
*23 2780 IF ZE(Y4)=ZR THEN RETURN 'reached chain end and it is = chain end in master
*23 2800 LPRINT:LPRINT "Master file ";Y11;"  Record ";Y2;"  Detail file ";ZA;"  Record ";ZR:LPRINT "Last in chain not equal to chain end in Master (broken chain)"
*23 2810 RETURN
3000 'Serial list the files
*36 3010 CLS:PRINT "File List Menu":PRINT:PRINT "File #   File Name      Records":PRINT
*37 3010 CLS:PRINT "File Listing For ";ZS$(1,1):PRINT:ZA=1:GOTO 3045
*36 |3020 FOR ZJ=1 TO |02:PRINT TAB(2)ZJ;TAB(10)ZS$(ZJ,1);TAB(26)ZS%(ZJ,2):PRINT:NEXT:PRINT
*36 3030 INPUT "Enter File Number ";ZQ$:IF ZQ$="" GOTO 2110
*36 |3040 ZA=VAL(ZQ$):IF ZA<0 OR ZA>|02 THEN GOTO 3000
3045 ZBLK=1:IF ZS%(ZA,1)<>1 THEN 3050 ELSE PRINT "Do you wish to print blank records ? ";:COLOR 0,7:PRINT "N";:LOCATE ,POS(0)-1,1:ZANS$="":WHILE ZANS$="":ZANS$=INKEY$:WEND
3047 PRINT ZANS$;:COLOR 7,0:PRINT:IF ZANS$<>"Y" AND ZANS$<>"y" THEN ZBLK=0
3050 PRINT:PRINT "Turn on the printer - Strike any key when ready - Esc=STOP printing":ZQ$=INPUT$(1):PRINT
3060 LPRINT "Serial (Raw) Listing Of The '";ZS$(ZA,1);" File.":LPRINT:LPRINT "Record":LPRINT
3070 FOR ZJ=1 TO ZS%(ZA,2)
3075 ZQ$=INKEY$:IF ZQ$<>"" THEN IF ASC(ZQ$)=27 THEN ZJ=ZS%(ZA,2):GOTO 3130
3080 ZR=ZJ:ZZ=1:GOSUB 610
3082 IF ZBLK=0 AND Y$(1,ZA)=STRING$(ZSIZE%(ZA,1),32) THEN 3130
3085 LPRINT USING "######";ZR;:LPRINT SPC(2);
3090 IF ZS%(ZA,1)=1 THEN LPRINT ZC;ZP;ZN;:IF ZS%(ZA,4)>0 THEN FOR ZK=1 TO ZS%(ZA,4):LPRINT ZH(ZA);ZE(ZA);:NEXT 'ZK
3100 IF ZS%(ZA,1)=2 THEN LPRINT ZB;ZF;
3120 FOR ZK=1 TO ZS%(ZA,7):LPRINT Y$(ZK,ZA);:NEXT:LPRINT
3130 NEXT 'ZJ
*36 3140 GOTO 3000
*37 3140 GOTO 2110
3500 'Hard modify a record
3510 CLS:PRINT "Section 5 To Hard Modify A Record.":PRINT:PRINT "You can modify both the data and the pointers in any record.":PRINT
*36 |3520 FOR ZJ=1 TO |02:PRINT:PRINT ZJ;" - ";ZS$(ZJ,1):NEXT:PRINT:INPUT "    Enter File Number ";ZQ$:ZA=VAL(ZQ$):IF ZA=0 THEN GOTO 2110
*37 3520 ZA=1
*36 |3530 IF ZA<1 OR ZA >|02 THEN GOTO 3510
3540 PRINT:INPUT "    Enter Record Number ";ZR$:ZR=VAL(ZR$):IF ZR=0 THEN GOTO 2110
3550 IF ZR<1 OR ZR>ZS%(ZA,2) THEN BEEP:PRINT:PRINT "Record number greater than the record capacity of ";ZS%(ZA,2);" for this file.":PRINT:GOTO 3520
3555 ZCHGFLAG(ZA)=1 'change the Date/Time stamp for the file
3560 PRINT:PRINT "Code**Field Type**Value":PRINT
3570 ZZ=1:GOSUB 610 'read the selected record
3580 IF ZS%(ZA,1)=2 THEN PRINT " BP -  BACK PTR. = ";ZB:PRINT:PRINT " FP -  FOWD PTR. = ";ZF:GOTO 3610
3590 PRINT " AR -  ADDR RECS = ";ZC:PRINT " PR -  PREV REC. = ";ZP:PRINT " NR -  NEXT REC. = ";ZN
3600 IF ZS%(ZA,4)>0 THEN FOR ZJ=1 TO ZS%(ZA,4):PRINT "CH";ZJ;" -  CHAIN HEAD= ";ZH(ZJ):PRINT "CE";ZJ;" -  CHAIN END = ";ZE(ZJ):NEXT
3610 PRINT:PRINT "Do you wish to see the data ? ";:COLOR 0,7:PRINT "N";:COLOR 7,0:LOCATE ,POS(0)-1,1
3620 ZQ$=INPUT$(1)
3630 PRINT ZQ$:PRINT:IF ZQ$<>"Y" AND ZQ$<>"y" THEN GOTO 3650
3640 FOR ZJ=1 TO ZS%(ZA,7):PRINT ZJ;" - ";ZN$(ZA,ZJ,1);" = ";Y$(ZJ,ZA):NEXT
3650 PRINT:INPUT "Enter Feild Num. Or Pointer Code ";ZQ$:IF ZQ$="" THEN GOSUB 700:GOTO 3540
3660 ZJ=VAL(ZQ$):IF ZJ>0 THEN PRINT:PRINT "Enter New ";ZN$(ZA,ZJ,1);:INPUT ZI$(ZJ,ZA):LSET Y$(ZJ,ZA)=ZI$(ZJ,ZA):GOTO 3580
3670 IF ZQ$="BP" OR ZQ$="bp" THEN INPUT "Enter New Backward Pointer ";ZQ$:ZB=VAL(ZQ$):GOTO 3580
3680 IF ZQ$="FP" OR ZQ$="fp" THEN INPUT "Enter New Forward Pointer ";ZQ$:ZF=VAL(ZQ$):GOTO 3580
3690 IF ZQ$="AR" OR ZQ$="ar" THEN INPUT "Enter New Quan Of Masters With This Calculated Record Number ";ZQ$:ZC=VAL(ZQ$):GOTO 3580
3700 IF ZQ$="PR" OR ZQ$="pr" THEN INPUT "Enter New Previous Master Num. ";ZQ$:ZP=VAL(ZQ$):GOTO 3580
3710 IF ZQ$="NR" OR ZQ$="nr" THEN INPUT "Enter New Next Record Number ";ZQ$:ZN=VAL(ZQ$):GOTO 3580
3720 IF LEN(ZQ$)<>3 THEN GOTO 3580
3730 ZJ=VAL(RIGHT$(ZQ$,1)):IF ZJ < 1 OR ZJ > ZS%(ZA,4) THEN GOTO 3580
3740 IF LEFT$(ZQ$,2) = "CH" OR LEFT$(ZQ$,2)="ch" THEN PRINT "Enter New Chain Head ";ZJ;:INPUT ZQ$:ZH(ZJ)=VAL(ZQ$):GOTO 3580
3750 IF LEFT$(ZQ$,2) = "CE" OR LEFT$(ZQ$,2)="ce" THEN PRINT "Enter New Chain End ";ZJ;:INPUT ZQ$:ZE(ZJ)=VAL(ZQ$):GOTO 3580
3760 BEEP:PRINT No such code or number":FOR ZJ=1 TO 1000:NEXT:PRINT:GOTO 3580
*31 Copyright 1987 by PRO DEV Software
