home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug080.ark / REC-EDIT.STB < prev    next >
Encoding:
Text File  |  1984-04-29  |  9.6 KB  |  263 lines
  1.  
  2.    10   Rem Copyright 1981 by David E. Trachtenbarg
  3.    11   Dim Today$(5),Last'edited$(5),Last'sorted$(5)
  4.    12   Dim Edit'file$(13),Data'file$(13),Sort'file$(13)
  5.    20   Dim File$(73),Name$(34)
  6.    30   Endcommon
  7.    40   If Today$="" Then Run"DATE.SAV"
  8.    50   Dim Command$(10),Command2$(35),Name2$(34),In$(39)
  9.    60   Integer I,J,K,Item,Record,First,Last
  10.    70   Set 0,-1
  11.    80   On Esc Goto Main'menu
  12.   130   On Error Gosub Create'file
  13.   140   Kopen\1\Data'file$
  14.   150   Kclose\1\
  15.   160   On Error Stop
  16.   165   @ Chr$(7)
  17.   170 *Menu
  18.   180   Gosub Screen'erase
  19.   190   @ : @ : @"*********"
  20.   200   @ : @ : @"Program Functions." : @
  21.   210   @"1. Edit a record by number."
  22.   220   @"2. Edit a record by name."
  23.   230   @"3. Add a record."
  24.   240   @"4. Goto main index"
  25.   250   @ : @
  26.   260   Input"Enter the number of your choice. ",Command$
  27.   270   If Command$="" Then Goto Menu
  28.   280   I=Val(Command$)
  29.   290   Gosub Bottom'lines
  30.   300   On I Goto List'names,Find'name,Add'names,Main'menu
  31.   310   Goto Menu
  32.   320 *List'names
  33.   330   Last=0
  34.   340   Gosub Screen'erase
  35.   350   Set 3,0
  36.   360   @"NAMES" : @
  37.   370   Record=Last
  38.   380   On Error Goto 510
  39.   390   Kopen\1\Data'file$
  40.   400   If Record=Last Then  Do
  41.   410     Kgetrec\1,Last\
  42.   420     Else
  43.   430     Kgetfwd\1\
  44.   440     Enddo
  45.   450   Kretrieve\1\Name$(-1)
  46.   460   If Last>(Record+15) Then Goto 510
  47.   470   Last=Last+1
  48.   480   @ Using"####. ",Last;
  49.   490   @ Name$(0,14);", ";Name$(15,34)
  50.   500   Goto 400
  51.   510   Kclose\1\
  52.   520   If Sys(3)=163 Then @"       **** END ****";
  53.   530   @ : @
  54.   540   Gosub Bottom'lines
  55.   550   Input"F#,B#,# to display or E# to edit a record. ",Command2$(-1);
  56.   560   If Command2$="" Then Goto Menu
  57.   570   Record=Val(Command2$)
  58.   580   If Record>0 Then Last=Record-1 : Goto 340
  59.   590   Gosub Capitalize
  60.   600   If Command2$(0,0)<>"B" And Command2$(0,0)<>"F" And Command2$(0,0)<>"E" Then 540
  61.   610   First=Val(Command2$(1)) : If First=0 Then First=1
  62.   620   If Command2$(0,0)="B" Then @ Last : Last=Last-(16+First*16)
  63.   630   If Command2$(0,0)="F" Then @ Last : Last=Last+(First-1)*16
  64.   640   If Command2$(0,0)="E" Then Record=First : Goto Get'record
  65.   650   Goto 340
  66.   660 *Get'record
  67.   670   Kopen\1\Data'file$
  68.   680   On Error Goto Error1
  69.   690   Kgetrec\1,(Record-1)\File$(-1)
  70.   700   Kretrieve\1\Name$(-1)
  71.   710   Kclose\1\
  72.   720   Goto Edit'record
  73.   730 *Add'names
  74.   740   File$="" : Name$=""
  75.   750   Gosub Screen'erase
  76.   760   @ : @"ADD A NAME" : @
  77.   770     For Item=1 To 11
  78.   780     On Item Gosub 2400,2420,2430,2440,2450,2460,Enter'phone,Enter'joined
  79.   790     On Item-9 Gosub 2470,2480
  80.   800     Next Item
  81.   810   File$(65,70)=Today$
  82.   820   Kopen\1\Data'file$
  83.   830   On Error Goto Error1
  84.   840   Kadd\1,Name$(-1)\File$(-1)
  85.   850   Kclose\1\
  86.   860   Goto Edit'record
  87.   870 *Edit'record
  88.   880   Gosub Record
  89.   890   Gosub Bottom'lines
  90.   900   Input"A number to edit, 'F'orward, 'B'ack, 'D'elete. ",Command2$;
  91.   910   Gosub Capitalize
  92.   920   If Command2$="" Then Goto Menu
  93.   930   If Command2$="B" Then Goto Last'record
  94.   940   If Command2$="F" Then Goto Next'record
  95.   950   If Command2$="D" Then Goto Delete'record
  96.   960   Gosub Bottom'lines
  97.   970   Item=Val(Command2$)
  98.   980   If Item<=0 Or Item>11 Then 890
  99.   990   If Item=1 Then Gosub Change'name
  100.  1000   If Item>1 Then Call .Change 
  101.  1010   Goto 870
  102.  1020 Procedure .Change 
  103.  1030   Begincommon : Dim Files$(59),File2$(108) : Endcommon
  104.  1040   On Item Gosub 2400,2420,2430,2440,2450,2460,Enter'phone,Enter'joined,Change'entered,2470,2480
  105.  1050   If Command2$(0,Last-First)=File2$(First,Last) Then Gosub Update'record
  106.  1060   Endproc 
  107.  1070 *Record
  108.  1080   Gosub Screen'erase
  109.  1090   @ : @" 1. Name: ";Name$(0,14);", ";Name$(15,34)
  110.  1100   @" 2. Street: ";File$(0,23)
  111.  1110   @" 3. City: ";File$(24,43)
  112.  1120   @" 4. State: ";File$(44,45)
  113.  1130   @" 5. Zip: ";File$(46,50)
  114.  1140   @" 6. Area Code: ";File$(51,53)
  115.  1150   @" 7. Phone: ";File$(54,56);"-";File$(57,60)
  116.  1160   @" 8. Date Joined: ";File$(61,62);"/";File$(63,64)
  117.  1170   @" 9. Date Entered: ";File$(65,66);"/";File$(67,68);"/";File$(69,70)
  118.  1180   @"10. Congressional District: ";File$(71,72)
  119.  1190   @"11. Status: ";
  120.  1200   If File$(73,73)="0" Then @"NON-MEMBER"
  121.  1210   If File$(73,73)="1" Then @"MEMBER"
  122.  1215   If File$(73,73)="2" Then @"INSTITUTION"
  123.  1220   If File$(73,73)="" Then @"??????"
  124.  1230   @ : @
  125.  1240   Return
  126.  1250 Procedure .Enter (In$,First,Last,Standard,Low,High)
  127.  1260   Begincommon : Dim Files$(59),File2$(108) : Endcommon
  128.  1270   @"ENTER THE ";In$;". "; : Input"",Command2$
  129.  1280   If Command2$="" Then Exitproc(First,Last)
  130.  1290   Gosub Capitalize
  131.  1300   I=Len(Command2$)
  132.  1310   If Standard>0 And I<>Standard Then  Do
  133.  1320     If High=0 Then @"YOU MUST ENTER ";Standard;" LETTERS FOR THE ";In$;"."
  134.  1330     If High<>0 Then @"YOU MUST ENTER ";Standard;" DIGITS FOR THE ";In$;"."
  135.  1340     Enddo
  136.  1350   If Standard>0 And I<>Standard Then Goto 1270
  137.  1360   J=(Asc(Command2$)<47 Or Asc(Command2$)>58 Or Val(Command2$)<Low Or Val(Command2$)>High) And High<>0
  138.  1370   If J Then @"YOUR ENTRY MUST BE BETWEEN ";Low;" AND ";High;"." : Goto 1270
  139.  1380   J=Last-First+1
  140.  1390   If I>J Then @"YOUR ENTRY IS ";I-J;" LETTERS TOO LONG." : Goto 1270
  141.  1400   File2$(First,Last)=Command2$(-1)
  142.  1410   Endproc (First,Last)
  143.  1420 *Enter'phone
  144.  1430   Input"ENTER THE PHONE NUMBER. ",Command2$
  145.  1440   If Command2$="" Then Return
  146.  1450   If Len(Command2$)<7 Or Len(Command2$)>8 Then @"YOU MUST ENTER A 7 DIGIT NUMBER FOR THE PHONE." : Goto 1430
  147.  1460   I=Pos(Command2$,"-",0)
  148.  1470   If I>-1 And I<>3 Then @"YOU MUST ENTER A 7 DIGIT NUMBER FOR THE PHONE." : Goto 1430
  149.  1480   If I=3 Then Command$=Command2$(0,2)+Command2$(4,7) : Command2$=Command$
  150.  1490   File$(54,60)=Command2$
  151.  1500   First=54 : Last=60
  152.  1510   Return
  153.  1520 *Enter'joined
  154.  1530   Input"Enter the date joined in mo/yr format. ",Command2$
  155.  1540   If Command2$="" Then Return
  156.  1550   If Len(Command2$)<>5 Then @"Please enter in mo/yr format. " : Goto 1530
  157.  1560   File$(61,64)=Command2$(0,1)+Command2$(3,4)
  158.  1570   First=61 : Last=62
  159.  1580   Return
  160.  1590 *Change'name
  161.  1600   Name2$=Name$
  162.  1610   Input"Enter a new last name. ",Command2$
  163.  1620   If Command2$="" Then Goto Edit'record
  164.  1630   Gosub Capitalize
  165.  1640   Name$(0,14)=Command2$(-1)
  166.  1650   Input"Enter a new first name. ",Command2$
  167.  1660   If Command2$<>"" Then Gosub Capitalize : Name$(15,34)=Command2$(-1)
  168.  1670   Gosub Capitalize
  169.  1680   If Name2$=Name$ Then Goto Edit'record
  170.  1690   Kopen\1\Data'file$
  171.  1700   Kdel\1,Name2$(-1)\
  172.  1710   Kadd\1,Name$(-1)\File$(-1)
  173.  1720   Kclose\1\
  174.  1730   Goto Edit'record
  175.  1740 *Change'entered
  176.  1750   Input"Enter a new date of entry in mo/da/yr format. ",Command2$
  177.  1760   If Command2$="" Then Return
  178.  1770   If Len(Command2$)<>8 Then @"Please enter in mo/da/yr format. " : Goto 1750
  179.  1780   File$(65,70)=Command2$(0,1)+Command2$(3,4)+Command2$(6,7)
  180.  1790   First=65 : Last=66
  181.  1800   Return
  182.  1810 *Find'name
  183.  1820   Name$=""
  184.  1830   Gosub Bottom'lines
  185.  1840   Input"Enter a name to edit. ",Command2$
  186.  1850   Gosub Capitalize
  187.  1860   If Command2$="" Then Goto Menu
  188.  1870   Kopen\1\Data'file$
  189.  1880   On Error Goto 1910
  190.  1890   Kgetapp\1,Command2$\File$(-1)
  191.  1900   Kretrieve\1\Name$(-1)
  192.  1910   Kclose\1\
  193.  1920   If Name$<>"" Then Goto Edit'record
  194.  1930   Goto Menu
  195.  1940 *Delete'record
  196.  1950   Gosub Bottom'lines
  197.  1960   @"If you wish to delete ";Name$(0,14);", ";Name$(15,34);" type Y. ";
  198.  1970   Input"",Command2$;
  199.  1980   Gosub Capitalize
  200.  1990   If Command2$<>"Y" Then Goto Edit'record
  201.  2000   Kopen\1\Data'file$
  202.  2010   Kdel\1,Name$(-1)\
  203.  2020   Kclose\1\
  204.  2030   Goto Menu
  205.  2040 *Screen'erase
  206.  2050   Out 1,126 : Out 1,28 : Return
  207.  2060 *Bottom'lines
  208.  2070   Out 1,126 : Out 1,17 : Out 1,0 : Out 1,22
  209.  2080   Out 1,126 : Out 1,24 : Return
  210.  2090 *Error1
  211.  2100   Close
  212.  2110   Gosub Bottom'lines
  213.  2120   @"Error No. ";Sys(3);" has occured."
  214.  2130   Input"Press RETURN to go on. ",Command2$
  215.  2140   Goto Menu
  216.  2150 *Create'file
  217.  2160   Kcreate\74,35\Data'file$
  218.  2170   Retry
  219.  2180 *Update'record
  220.  2190   Kopen\1\Data'file$
  221.  2200   Kupdate\1,Name$(-1)\File$(-1)
  222.  2210   Kclose\1\
  223.  2220   Return
  224.  2230 *Next'record
  225.  2240   Kopen\1\Data'file$
  226.  2250   On Error Goto Error1
  227.  2260   Kgetkey\1,Name$(-1)\
  228.  2270   Kgetfwd\1\File$(-1)
  229.  2280   Kretrieve\1\Name$(-1)
  230.  2290   Kclose\1\
  231.  2300   Goto Edit'record
  232.  2310 *Last'record
  233.  2320   Kopen\1\Data'file$
  234.  2330   On Error Goto Error1
  235.  2340   Kgetkey\1,Name$(-1)\
  236.  2350   Kgetback\1\File$(-1)
  237.  2360   Kretrieve\1\Name$(-1)
  238.  2370   Kclose\1\
  239.  2380   Goto Edit'record
  240.  2390 *Entries
  241.  2400   In$="LAST NAME" : Call .Enter (In$,74,88,0,0,0;First,Last)
  242.  2410   In$="FIRST NAME" : Call .Enter (In$,89,108,0,0,0;First,Last) : Return
  243.  2420   In$="STREET ADDRESS" : Call .Enter (In$,0,23,0,0,0;First,Last) : Return
  244.  2430   In$="CITY" : Call .Enter (In$,24,43,0,0,0;First,Last) : Return
  245.  2440   In$="TWO LETTER STATE CODE" : Call .Enter (In$,44,45,2,0,0;First,Last) : Return
  246.  2450   In$="ZIP CODE" : Call .Enter (In$,46,50,5,0,99999.0;First,Last) : Return
  247.  2460   In$="AREA CODE" : Call .Enter (In$,51,53,3,0,999;First,Last) : Return
  248.  2470   In$="CONGRESSIONAL DISTRICT" : Call .Enter (In$,71,72,2,0,99;First,Last) : Return
  249.  2480   In$="0=NON-MEMBER  1=MEMBER  2=INSTITUTION" : Call .Enter (In$,73,73,1,0,2;First,Last) : Return
  250.  2490 *Capitalize
  251.  2500   K=Len(Command2$)
  252.  2510     For I=0 To K
  253.  2520     J=Asc(Command2$(I,I))
  254.  2530     If J>96 And J<123 Then Command2$(I,I)=Chr$(J-32)
  255.  2540     Next I
  256.  2550   Return
  257.  2560 *Main'menu
  258.  2570   Close
  259.  2580   Run"A:MMENU.SAV"
  260.  2590   On Esc Stop
  261.  2600   Goto Menu
  262.