5 ' ***** DIMS ***** 6 ' 7 ' 10 ' INITIALIZATION 20 DEFINT A-Z 30 GOSUB 3420 'cs 40 PRINT:PRINT TAB(31);"DIMS March 20, 1982 45 'ACT-5A TERMINAL 50 PRINT 80 ' Dan's Information Management System 85 ' for Basic-80 and CP/M 90 ' originates from PIMS written by Madan L. Gupta 95 ' which comes from A People's Data Base System 96 ' by Gupta and Brent Lander (1977) 100 ' re-written by Dan Dugan, 1979, 1980, 1981, 1982 110 ' Release 1.0 -- public domain 120 ' makes random disk records of 128 or 255 bytes 130 ' allows 15 or 30 data fields in record 140 ' makes automatic duplicate file 150 CLEAR,,1000 ' stack space for MBASIC 5.x 155 DEFINT A-Z 160 WIDTH LPRINT 255 170 ' init vars in this order for speed 180 I=0:J=0:K=0:X=0:Y=0:T$="":R$="":T1$="":SKIPPARSE=0:T=0:FT=0:SEARCH=0 190 ' then these for COMMON 200 C=0:N=0:NC=0:P6=0:P7=0:P8=0:P9=0:PI=0:S=0:T1=0:T2=0:F$="":FT$="":S$="" 210 DIM DD$(5) 220 DIM C$(10) ' commands 230 DIM N$(31), B$(32), C(30) ' 30 names + stop + N 240 DIM SEARCHWORD$(10), SEARCHFIELD(10), SKIPWORD$(10), LOOKFIELD(10) 243 NDRIVES=3:GOSUB 1360 ' init disk name strings 245 PRINT TAB(33);NDRIVES"disk system. 250 GOTO 1050 1000 ' WARM ENTRY 1010 DEFINT A-Z 1020 GOSUB 3420'cs 1023 IF C THEN GOSUB 1970 ' save header 1025 IF T=7 THEN CLOSE:GOTO 1650 ' goto 1030 IF T=8 THEN 4200 ' reopen 1033 IF T=9 THEN CLOSE:T=0:GOTO 1050 ' done 1035 IF T=11 THEN 2100 ' backup 1040 IF T=12 THEN 3000 ' renumber 1050 'some not needed but commoned to keep places for speed 1060 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1070 ON ERROR GOTO 3290 1080 ' NO-FILE MENU 1100 WIDTH 70 :RESET 'RESET here for floppy system 1105 IF E$<>"" THEN PRINT E$:PRINT 1110 PRINT:PRINT TAB(22)"Here are the data files on this disk: 1120 PRINT:FILES DD$(3)+"*.D?" 1125 WIDTH 255 1130 PRINT:PRINT:PRINT TAB(16);"************* DIMS NO-FILE MENU ************** 1140 PRINT:PRINT TAB(16);"Open any data file shown above ............... 1 1150 PRINT TAB(16);"Install new disks ............................ 2 1160 PRINT 1170 PRINT TAB(16);"Design structure of a new file (DCREATE) ..... 3 1180 PRINT TAB(16);"Change number of disk drives for this session. 4 1190 PRINT 1200 PRINT TAB(16);"Exit DIMS to Basic ........................... 9 1210 PRINT TAB(16);"Exit DIMS to CP/M ............................ 0 1220 PRINT:PRINT TAB(16);STRING$(48,42):PRINT 1230 PRINT TAB(16);: PRINT"To continue enter a number ................... "; 1240 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="1" 1250 PRINT A$ 1255 RESET ' safety for floppies 1260 IF A$="0" THEN SYSTEM 1270 IF A$="1" THEN GOTO 1650 1280 IF A$="2" THEN GOTO 1000 1290 IF A$="3" THEN CHAIN DD$(2)+"DCREATE" 1300 IF A$="4" THEN GOSUB 1330:GOTO 1000 1310 IF A$="9" THEN GOSUB 3420:STOP 1320 GOTO 1230 1330 ' (SUB) ASK # DISKS 1340 PRINT:PRINT TAB(27);:INPUT"Number of disks in system";NDRIVES 1345 PRINT:IF NDRIVES<1 THEN 1000 1350 IF NDRIVES>4 THEN 1340 1360 ' (SUB) INSTALL DISK NAMES 1370 RESTORE 1390 1380 ' DD$(1) (2) (3) (4) (5) ' file groups 1382 ' main trans data dupe misc 1383 ' pgms pgms file file files 1390 DATA 1,"A:","A:","A:","A:","A:" 1400 DATA 2,"A:","B:","A:","B:","B:" 1410 DATA 3,"A:","A:","B:","C:","A:" 1420 DATA 4,"A:","A:","B:","C:","D:" 1430 READ J 1440 FOR K=1 TO 5 1450 READ DD$(K) 1460 NEXT 1470 IF J<>NDRIVES THEN 1430 1480 IF A$<>"4" THEN RETURN 1490 ON NDRIVES GOTO 1500,1510,1540,1580 1500 PRINT"One disk system - all files and programs on A.":GOTO 1630 1510 PRINT"Two disk system: A: = main program and main data files 1520 PRINT TAB(19)"B: = transient programs, backup data files, aux. data files 1530 GOTO 1630 1540 PRINT "Three disk system: A: = main program, transient programs, aux data files 1550 PRINT TAB(21)"B: = main data files 1560 PRINT TAB(21)"C: = backup data files 1570 GOTO 1630 1580 PRINT"Four disk system: A: = main and transient programs 1590 PRINT TAB(20)"B: = main data files 1600 PRINT TAB(20)"C: = backup data files 1610 PRINT TAB(20)"D: = aux. data files 1630 PRINT:PRINT TAB(29)"Hit return to continue.":A$=INPUT$(1) 1640 RETURN 1650 ' LOAD HEADER 1660 GOSUB 3480 ' get name & open up files 1670 GOSUB 3420 'cs 1690 GOSUB 3750 ' get record 1700 GOSUB 1880 'parse into B$'s 1710 FOR I=1 TO 31 1720 N$(I)=B$(I) 'load names 1730 IF LEFT$(N$(I),4)="stop" GOTO 1760 1740 C(I)=1 1750 NEXT I 1760 N=VAL(B$(I+1)) 1770 NC=I-1 ' # cols 1780 PRINT TAB(20)"File "F$" is open. It has"N"records." 1790 ' EXIT TO DEDIT 1795 PRINT:PRINT TAB(24)"Waiting while DEDIT is loading." 1800 CHAIN DD$(1)+"DEDIT",1000 1810 ' (SUB) WRITE T$ AS RECORD # I 1820 ON FT GOTO 1850,1830 1830 LSET R$=MID$(T$,129) ' latter half 1840 PUT #1,FT*I+2 1850 LSET R$=LEFT$(T$,128) ' first half 1860 PUT #1,FT*I+1 1870 RETURN 1880 ' (SUB) PARSE STRING 1890 K=0 1900 J=INSTR(T$,CHR$(126)) ' delimiter 1910 IF J=0 THEN RETURN 1920 K=K+1 1930 B$(K)=MID$(T$,1,J-1) 1940 T$=MID$(T$,J+1) 1950 GOTO 1900 1970 ' (SUB) SAVE HEADERS 1990 PRINT:PRINT TAB(31)"Saving file header":PRINT TAB(39); 2000 T$="" 2010 FOR I=1 TO 31: T$=T$+N$(I)+CHR$(126): T1$=LEFT$(N$(I),4): IF T1$="stop" THEN 2030 2020 NEXT I 2030 T$=T$+STR$(N)+CHR$(126) 'add N at end 2040 I=0 2050 GOSUB 1810 ' put rec 0 2060 PRINT "*"; 2062 NR=0:T1$=T$:GOSUB 3960 'put dupe head 2064 PRINT"!" 2070 RETURN 2100 ' BACKUP makes dupe file 2110 CLOSE 2:KILL DD$(4)+F$+".DD"+FT$ 2120 GOSUB 3720 ' open up .DD on 2 2130 PRINT"Copying main file to dupe file, same numbers.":PRINT 2140 FOR I=0 TO N 2150 IF INKEY$=CHR$(27) THEN PRINT:PRINT:PRINT"Copy aborted.":GOTO 3260 2160 GOSUB 3750: PRINT"+"; ' get record I in T$ 2170 NR=I:T1$=T$:GOSUB 3960:PRINT"*"; ' put record NR 2180 NEXT 2190 PRINT:GOTO 3260 ' to DEDIT 3000 ' RENUMBER COPY MAIN TO DUPE 3010 CLOSE 2:KILL DD$(4)+F$+".DD"+FT$ 3020 GOSUB 3720 ' open 2 3030 PRINT"Copying main file to dupe file, renumbering.":PRINT 3040 NR=0 3050 FOR I=1 TO N 3060 IF INKEY$=CHR$(27) THEN PRINT:PRINT:PRINT"Renumber aborted.":GOTO 3260 3070 GOSUB 3750 ' get rec I in T$ 3080 IF ASC(T$)=0 THEN PRINT"0";:GOTO 3100' skip it 3090 PRINT"+";:NR=NR+1:T1$=T$:GOSUB 3960:PRINT"!"; ' put rec NR 3100 NEXT 3110 GOSUB 4030 ' save header (NR) 3120 ' ERASE MAIN FILE AND COPY DUPE TO MAIN 3130 CLOSE 3140 PRINT:PRINT"The following operation removes space from deleted records: 3150 PRINT: PRINT"Erasing main file. 3160 KILL DD$(3)+F$+".D"+FT$ 3170 PRINT:PRINT:PRINT"Copying dupe to main file.":PRINT 3180 GOSUB 3680 ' open both files 3190 FOR J=1 TO FT*(NR+1) 3200 GET #2,J 3210 PRINT"&"; 3220 LSET R$=S$ 3230 PUT #1,J 3240 PRINT"*"; 3250 NEXT J 3251 N=NR 3252 PRINT:GOSUB 1970 'put header 3255 ' RETURN TO DEDIT 3260 GOTO 1790 3280 ' GENERAL ERROR ROUTINES 3290 IF ERL=1120 AND ERR=53 THEN RESUME 1130 ' if disk empty 3300 IF ERL=1740 AND ERR=9 THEN CLOSE:E$="CAN'T READ HEADER PROPERLY":RESUME 1000 3310 IF ERR=61 THEN PRINT:PRINT"Out of disk space.":PRINT:CLOSE:RESUME 1000 3312 IF ERR=53 THEN E$="FILE NOT FOUND":RESUME 1080 3320 ON ERROR GOTO 0 3330 ' UCV 3340 Y$="" 3350 FOR K=1 TO LEN(X$) 3360 Y$=Y$+" " 3370 X=ASC(MID$(X$,K, 1)) 3380 IF 96