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
/
SIMTEL
/
CPMUG
/
CPMUG080.ARK
/
REC-EDIT.STB
< prev
next >
Wrap
Text File
|
1984-04-29
|
10KB
|
263 lines
10 Rem Copyright 1981 by David E. Trachtenbarg
11 Dim Today$(5),Last'edited$(5),Last'sorted$(5)
12 Dim Edit'file$(13),Data'file$(13),Sort'file$(13)
20 Dim File$(73),Name$(34)
30 Endcommon
40 If Today$="" Then Run"DATE.SAV"
50 Dim Command$(10),Command2$(35),Name2$(34),In$(39)
60 Integer I,J,K,Item,Record,First,Last
70 Set 0,-1
80 On Esc Goto Main'menu
130 On Error Gosub Create'file
140 Kopen\1\Data'file$
150 Kclose\1\
160 On Error Stop
165 @ Chr$(7)
170 *Menu
180 Gosub Screen'erase
190 @ : @ : @"*********"
200 @ : @ : @"Program Functions." : @
210 @"1. Edit a record by number."
220 @"2. Edit a record by name."
230 @"3. Add a record."
240 @"4. Goto main index"
250 @ : @
260 Input"Enter the number of your choice. ",Command$
270 If Command$="" Then Goto Menu
280 I=Val(Command$)
290 Gosub Bottom'lines
300 On I Goto List'names,Find'name,Add'names,Main'menu
310 Goto Menu
320 *List'names
330 Last=0
340 Gosub Screen'erase
350 Set 3,0
360 @"NAMES" : @
370 Record=Last
380 On Error Goto 510
390 Kopen\1\Data'file$
400 If Record=Last Then Do
410 Kgetrec\1,Last\
420 Else
430 Kgetfwd\1\
440 Enddo
450 Kretrieve\1\Name$(-1)
460 If Last>(Record+15) Then Goto 510
470 Last=Last+1
480 @ Using"####. ",Last;
490 @ Name$(0,14);", ";Name$(15,34)
500 Goto 400
510 Kclose\1\
520 If Sys(3)=163 Then @" **** END ****";
530 @ : @
540 Gosub Bottom'lines
550 Input"F#,B#,# to display or E# to edit a record. ",Command2$(-1);
560 If Command2$="" Then Goto Menu
570 Record=Val(Command2$)
580 If Record>0 Then Last=Record-1 : Goto 340
590 Gosub Capitalize
600 If Command2$(0,0)<>"B" And Command2$(0,0)<>"F" And Command2$(0,0)<>"E" Then 540
610 First=Val(Command2$(1)) : If First=0 Then First=1
620 If Command2$(0,0)="B" Then @ Last : Last=Last-(16+First*16)
630 If Command2$(0,0)="F" Then @ Last : Last=Last+(First-1)*16
640 If Command2$(0,0)="E" Then Record=First : Goto Get'record
650 Goto 340
660 *Get'record
670 Kopen\1\Data'file$
680 On Error Goto Error1
690 Kgetrec\1,(Record-1)\File$(-1)
700 Kretrieve\1\Name$(-1)
710 Kclose\1\
720 Goto Edit'record
730 *Add'names
740 File$="" : Name$=""
750 Gosub Screen'erase
760 @ : @"ADD A NAME" : @
770 For Item=1 To 11
780 On Item Gosub 2400,2420,2430,2440,2450,2460,Enter'phone,Enter'joined
790 On Item-9 Gosub 2470,2480
800 Next Item
810 File$(65,70)=Today$
820 Kopen\1\Data'file$
830 On Error Goto Error1
840 Kadd\1,Name$(-1)\File$(-1)
850 Kclose\1\
860 Goto Edit'record
870 *Edit'record
880 Gosub Record
890 Gosub Bottom'lines
900 Input"A number to edit, 'F'orward, 'B'ack, 'D'elete. ",Command2$;
910 Gosub Capitalize
920 If Command2$="" Then Goto Menu
930 If Command2$="B" Then Goto Last'record
940 If Command2$="F" Then Goto Next'record
950 If Command2$="D" Then Goto Delete'record
960 Gosub Bottom'lines
970 Item=Val(Command2$)
980 If Item<=0 Or Item>11 Then 890
990 If Item=1 Then Gosub Change'name
1000 If Item>1 Then Call .Change
1010 Goto 870
1020 Procedure .Change
1030 Begincommon : Dim Files$(59),File2$(108) : Endcommon
1040 On Item Gosub 2400,2420,2430,2440,2450,2460,Enter'phone,Enter'joined,Change'entered,2470,2480
1050 If Command2$(0,Last-First)=File2$(First,Last) Then Gosub Update'record
1060 Endproc
1070 *Record
1080 Gosub Screen'erase
1090 @ : @" 1. Name: ";Name$(0,14);", ";Name$(15,34)
1100 @" 2. Street: ";File$(0,23)
1110 @" 3. City: ";File$(24,43)
1120 @" 4. State: ";File$(44,45)
1130 @" 5. Zip: ";File$(46,50)
1140 @" 6. Area Code: ";File$(51,53)
1150 @" 7. Phone: ";File$(54,56);"-";File$(57,60)
1160 @" 8. Date Joined: ";File$(61,62);"/";File$(63,64)
1170 @" 9. Date Entered: ";File$(65,66);"/";File$(67,68);"/";File$(69,70)
1180 @"10. Congressional District: ";File$(71,72)
1190 @"11. Status: ";
1200 If File$(73,73)="0" Then @"NON-MEMBER"
1210 If File$(73,73)="1" Then @"MEMBER"
1215 If File$(73,73)="2" Then @"INSTITUTION"
1220 If File$(73,73)="" Then @"??????"
1230 @ : @
1240 Return
1250 Procedure .Enter (In$,First,Last,Standard,Low,High)
1260 Begincommon : Dim Files$(59),File2$(108) : Endcommon
1270 @"ENTER THE ";In$;". "; : Input"",Command2$
1280 If Command2$="" Then Exitproc(First,Last)
1290 Gosub Capitalize
1300 I=Len(Command2$)
1310 If Standard>0 And I<>Standard Then Do
1320 If High=0 Then @"YOU MUST ENTER ";Standard;" LETTERS FOR THE ";In$;"."
1330 If High<>0 Then @"YOU MUST ENTER ";Standard;" DIGITS FOR THE ";In$;"."
1340 Enddo
1350 If Standard>0 And I<>Standard Then Goto 1270
1360 J=(Asc(Command2$)<47 Or Asc(Command2$)>58 Or Val(Command2$)<Low Or Val(Command2$)>High) And High<>0
1370 If J Then @"YOUR ENTRY MUST BE BETWEEN ";Low;" AND ";High;"." : Goto 1270
1380 J=Last-First+1
1390 If I>J Then @"YOUR ENTRY IS ";I-J;" LETTERS TOO LONG." : Goto 1270
1400 File2$(First,Last)=Command2$(-1)
1410 Endproc (First,Last)
1420 *Enter'phone
1430 Input"ENTER THE PHONE NUMBER. ",Command2$
1440 If Command2$="" Then Return
1450 If Len(Command2$)<7 Or Len(Command2$)>8 Then @"YOU MUST ENTER A 7 DIGIT NUMBER FOR THE PHONE." : Goto 1430
1460 I=Pos(Command2$,"-",0)
1470 If I>-1 And I<>3 Then @"YOU MUST ENTER A 7 DIGIT NUMBER FOR THE PHONE." : Goto 1430
1480 If I=3 Then Command$=Command2$(0,2)+Command2$(4,7) : Command2$=Command$
1490 File$(54,60)=Command2$
1500 First=54 : Last=60
1510 Return
1520 *Enter'joined
1530 Input"Enter the date joined in mo/yr format. ",Command2$
1540 If Command2$="" Then Return
1550 If Len(Command2$)<>5 Then @"Please enter in mo/yr format. " : Goto 1530
1560 File$(61,64)=Command2$(0,1)+Command2$(3,4)
1570 First=61 : Last=62
1580 Return
1590 *Change'name
1600 Name2$=Name$
1610 Input"Enter a new last name. ",Command2$
1620 If Command2$="" Then Goto Edit'record
1630 Gosub Capitalize
1640 Name$(0,14)=Command2$(-1)
1650 Input"Enter a new first name. ",Command2$
1660 If Command2$<>"" Then Gosub Capitalize : Name$(15,34)=Command2$(-1)
1670 Gosub Capitalize
1680 If Name2$=Name$ Then Goto Edit'record
1690 Kopen\1\Data'file$
1700 Kdel\1,Name2$(-1)\
1710 Kadd\1,Name$(-1)\File$(-1)
1720 Kclose\1\
1730 Goto Edit'record
1740 *Change'entered
1750 Input"Enter a new date of entry in mo/da/yr format. ",Command2$
1760 If Command2$="" Then Return
1770 If Len(Command2$)<>8 Then @"Please enter in mo/da/yr format. " : Goto 1750
1780 File$(65,70)=Command2$(0,1)+Command2$(3,4)+Command2$(6,7)
1790 First=65 : Last=66
1800 Return
1810 *Find'name
1820 Name$=""
1830 Gosub Bottom'lines
1840 Input"Enter a name to edit. ",Command2$
1850 Gosub Capitalize
1860 If Command2$="" Then Goto Menu
1870 Kopen\1\Data'file$
1880 On Error Goto 1910
1890 Kgetapp\1,Command2$\File$(-1)
1900 Kretrieve\1\Name$(-1)
1910 Kclose\1\
1920 If Name$<>"" Then Goto Edit'record
1930 Goto Menu
1940 *Delete'record
1950 Gosub Bottom'lines
1960 @"If you wish to delete ";Name$(0,14);", ";Name$(15,34);" type Y. ";
1970 Input"",Command2$;
1980 Gosub Capitalize
1990 If Command2$<>"Y" Then Goto Edit'record
2000 Kopen\1\Data'file$
2010 Kdel\1,Name$(-1)\
2020 Kclose\1\
2030 Goto Menu
2040 *Screen'erase
2050 Out 1,126 : Out 1,28 : Return
2060 *Bottom'lines
2070 Out 1,126 : Out 1,17 : Out 1,0 : Out 1,22
2080 Out 1,126 : Out 1,24 : Return
2090 *Error1
2100 Close
2110 Gosub Bottom'lines
2120 @"Error No. ";Sys(3);" has occured."
2130 Input"Press RETURN to go on. ",Command2$
2140 Goto Menu
2150 *Create'file
2160 Kcreate\74,35\Data'file$
2170 Retry
2180 *Update'record
2190 Kopen\1\Data'file$
2200 Kupdate\1,Name$(-1)\File$(-1)
2210 Kclose\1\
2220 Return
2230 *Next'record
2240 Kopen\1\Data'file$
2250 On Error Goto Error1
2260 Kgetkey\1,Name$(-1)\
2270 Kgetfwd\1\File$(-1)
2280 Kretrieve\1\Name$(-1)
2290 Kclose\1\
2300 Goto Edit'record
2310 *Last'record
2320 Kopen\1\Data'file$
2330 On Error Goto Error1
2340 Kgetkey\1,Name$(-1)\
2350 Kgetback\1\File$(-1)
2360 Kretrieve\1\Name$(-1)
2370 Kclose\1\
2380 Goto Edit'record
2390 *Entries
2400 In$="LAST NAME" : Call .Enter (In$,74,88,0,0,0;First,Last)
2410 In$="FIRST NAME" : Call .Enter (In$,89,108,0,0,0;First,Last) : Return
2420 In$="STREET ADDRESS" : Call .Enter (In$,0,23,0,0,0;First,Last) : Return
2430 In$="CITY" : Call .Enter (In$,24,43,0,0,0;First,Last) : Return
2440 In$="TWO LETTER STATE CODE" : Call .Enter (In$,44,45,2,0,0;First,Last) : Return
2450 In$="ZIP CODE" : Call .Enter (In$,46,50,5,0,99999.0;First,Last) : Return
2460 In$="AREA CODE" : Call .Enter (In$,51,53,3,0,999;First,Last) : Return
2470 In$="CONGRESSIONAL DISTRICT" : Call .Enter (In$,71,72,2,0,99;First,Last) : Return
2480 In$="0=NON-MEMBER 1=MEMBER 2=INSTITUTION" : Call .Enter (In$,73,73,1,0,2;First,Last) : Return
2490 *Capitalize
2500 K=Len(Command2$)
2510 For I=0 To K
2520 J=Asc(Command2$(I,I))
2530 If J>96 And J<123 Then Command2$(I,I)=Chr$(J-32)
2540 Next I
2550 Return
2560 *Main'menu
2570 Close
2580 Run"A:MMENU.SAV"
2590 On Esc Stop
2600 Goto Menu