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 '
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<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32): GOTO 3400
3390 MID$(Y$,K,1)=MID$(X$,K,1)
3400 NEXT
3410 RETURN
3420 '
(SUB) CLEAR SCREEN (TERM DEP)
3430 PRINT CHR$(12);
3440 RETURN
3480 '
(SUB) OPEN UP FILES
GET NAME
3490 F$=""
3500 C=0 ' clear change flag
3505 IF T=7 THEN F$=B$(0):T=0:GOTO 3525 ' goto commmand
3510 PRINT: PRINT TAB(17);: INPUT"Name of the file you want to open"; F$
3525 IF F$="" THEN 1000
3530 X$=F$
3540 GOSUB 3330 ' UCverter
3550 F$=Y$ ' make UC
3560 '
TEST NAME, EXTRACT FILE TYPE
3570 CLOSE
3580 ON ERROR GOTO 3610
3590 OPEN"I",1,DD$(3)+F$+".D"
3600 FT=1: FT$=" ": GOTO 3690 ' file is type 1
3610 IF ERR=64 THEN 3612 ELSE 3620
3612 E$="BAD FILE NAME":PRINT E$:IF T=7 THEN T=0:RESUME 1000
3614 RESUME 3480
3620 IF ERR=53 THEN CLOSE:RESUME 3630'not found
3630 ON ERROR GOTO 3660
3640 OPEN"I",1,DD$(3)+F$+".D2"
3650 FT=2: FT$="2": GOTO 3690 ' file is type 2
3660 IF ERR=53 THEN 3662 ELSE 3670
3662 E$="FILE NOT FOUND":PRINT E$:IF T=7 THEN T=0:RESUME 1000
3664 RESUME 3480
3670 ON ERROR GOTO 0
3680 '
OPEN UP FILES FOR REAL
3690 CLOSE:I=0:ON ERROR GOTO 3280
3700 OPEN "R",1,DD$(3)+F$+".D"+FT$
3710 FIELD #1,128 AS R$
3720 OPEN "R",2,DD$(4)+F$+".DD"+FT$
3730 FIELD #2, 128 AS S$
3740 RETURN
3750 '
(SUB) GET REC. I IN T$
3760 T$=""
3770 ON FT GOTO 3800,3780
3780 GET#1,FT*I+2 ' latter half
3790 T$=LEFT$(R$,127)
3800 GET#1,FT*I+1 ' whole or first half
3810 T$=R$+T$
3820 RETURN
3830 '
(SUB) SHOW FIELDS
3840 FOR J=1 TO NC
3850 IF C(J)=0 THEN 3880
3860 PRINT TAB(29);
3870 PRINT USING"##";J;:PRINT". "LEFT$(N$(J),4)" "RIGHT$(N$(J),1)
3880 NEXT
3890 PRINT
3900 RETURN
3960 '
(SUB) PUT T1$ AS REC NR
3970 ON FT GOTO 4000,3980
3980 LSET S$=MID$(T1$,129)
3990 PUT#2,FT*NR+2
4000 LSET S$=LEFT$(T1$,128)
4010 PUT#2,FT*NR+1
4020 RETURN
4030 '
(SUB) CLOSE DUPE FILE
4040 IF F2$=F$ THEN C=1:N=NR:GOTO 4130
4050 PRINT:PRINT:PRINT"Closing dupe file,"NR"records.
4060 T$=""
4070 FOR I=1 TO 31
4080 T$=T$+N$(I)+CHR$(126)
4090 IF LEFT$(N$(I),4)="stop" THEN 4110
4100 NEXT
4110 T1$=T$+STR$(NR)+CHR$(126)
4120 N1=NR:NR=0:GOSUB 3960:NR=N1
4130 CLOSE 2
4140 RETURN
4200 '
