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-PRN.STB
< prev
next >
Wrap
Text File
|
1984-04-29
|
8KB
|
229 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)
30 Dim File$(73),Name$(34)
40 Endcommon
45 If Today$="" Then Run"date.sav"
50 Dim Sort'key$(39)
60 Dim Command$(10),Command2$(35),Name2$(34),Today$(5),Last'zip$(5)
70 Integer I,J,K,Item,To'printer,Zips,Row,Page,Print'item(3)
80 Set 0,-1
90 On Esc Goto Main'menu
150 On Error Gosub Create'file
160 Kopen\1\Data'file$
170 On Error Stop
180 Kclose\1\
190 @ Chr$(7)
200 *Print'options
210 Gosub Screen'erase
220 @"*******" : @
230 @" PRINTER OPTIONS" : @
240 @"1. Print mailing labels by zip code."
250 @"2. Print mailing labels alphabetically"
260 @"3. Print alphabetical membership list"
270 @"4. Print all membership information alphabetically"
280 @"5. Sort by zip code.";
290 @" Last sorted - ";Last'sorted$(0,1);"/";Last'sorted$(2,3);"/";Last'sorted$(4,5)
300 @"6. Set people to print now: ";
310 If Print'item(0)=0 Then @"(Non-members)";
320 If Print'item(1)=0 Then @"(Members)";
330 If Print'item(2)=0 Then @"(Institutions)";
340 @
350 @"7. Goto main index."
360 @ : Input" Type the number or your choice or RETURN to go on. ",Command2$
370 Item=Asc(Command2$) : If Item=0 Then Goto Print'options
380 If Item>48 And Item<53 Then Do
390 To'printer=0
400 @ : Input" Type 'P' to send to the printer. ",Command2$
410 Gosub Capitalize
420 If Command2$="P" Then To'printer=1
430 Enddo
440 On Item-48 Goto Print'by'zip,Printer,Membership,Printer,Zip'sort,Set'print'items,Main'menu
450 Goto Print'options
460 *Set'print'items
470 Gosub Screen'erase
480 Local I
490 @"1. Non-members ";
500 If Print'item(0)=0 Then Do : @"YES" : Else : @"NO" : Enddo
510 @"2. Members ";
520 If Print'item(1)=0 Then Do : @"YES" : Else : @"NO" : Enddo
530 @"3. Institutions ";
540 If Print'item(2)=0 Then Do : @"YES" : Else : @"NO" : Enddo
545 @ : @"Enter a number to change an item, press RETURN for the index. ";
550 Input"",Command2$
560 If Command2$="" Then Goto Print'options
561 I=Val(Command2$)-1
570 If I<0 Or I>2 Then Goto Set'print'items
580 If Print'item(I)=0 Then Do
581 Print'item(I)=1
582 Else
583 Print'item(I)=0
584 Enddo
585 Goto Set'print'items
590 *Record
600 Gosub Screen'erase
610 @ : @" 1. Name: ";Name$(0,14);", ";Name$(15,34)
620 @" 2. Street: ";File$(0,23)
630 @" 3. City: ";File$(24,43)
640 @" 4. State: ";File$(44,45)
650 @" 5. Zip: ";File$(46,50)
660 @" 6. Area Code: ";File$(51,53)
670 @" 7. Phone: ";File$(54,56);"-";File$(57,60)
680 @" 8. Date Joined: ";File$(61,62);"/";File$(63,64)
690 @" 9. Date Entered: ";File$(65,66);"/";File$(67,68);"/";File$(69,70)
700 @"10. Congressional District: ";File$(71,72)
710 @"11. Status: ";
720 If File$(73,73)="0" Then @"NON-MEMBER"
730 If File$(73,73)="1" Then @"MEMBER"
740 If File$(73,73)="2" Then @"INSTITUTION"
750 If File$(73,73)="" Then @"??????"
760 @ : @
770 Return
780 *Screen'erase
790 Out 1,126 : Out 1,28 : Return
800 *Bottom'lines
810 Out 1,126 : Out 1,17 : Out 1,0 : Out 1,22
820 Out 1,126 : Out 1,24 : Return
830 *Error1
840 Close
850 Gosub Bottom'lines
860 @"Error No. ";Sys(3);" has occured."
870 Input"Press RETURN to go on. ",Command2$
880 Goto Print'options
890 *Create'file
900 Kcreate\74,35\Data'file$
910 Retry
920 *Printer
930 I=0 : If To'printer Then @ Chr$(23);
940 Kopen\1\Data'file$
950 On Esc Goto Escape
960 On Error Goto 1050
970 Kgetfwd\1\File$(-1)
980 Kretrieve\1\Name$(-1)
1000 If File$(73,73)<>"" And Print'item(Val(File$(73,73)))=0 Then Do
1010 On Item-49 Gosub Label,Line,Record
1020 Enddo
1040 Goto 970
1050 Close
1060 @ Chr$(20);
1070 On Esc Stop
1080 Goto Print'options
1090 *Label
1100 If Item=49 Then Gosub Zip'number
1130 If Name$(15,15)="*" Then @"MR. & MRS."; : Name$(15,15)=" "
1140 @ Name$(15,34);" ";Name$(0,14)
1150 @ File$(0,23)
1160 @ File$(24,43);",";File$(44,45);" ";File$(46,50)
1170 @
1171 @
1172 @
1180 Return
1190 *Zip'number
1200 If Last'zip$=File$(46,50) Then Zips=Zips+1 : Return
1210 If Zips<10 Then Zips=1 : Last'zip$=File$(46,50) : Return
1240 @"Number of ";Last'zip$;" zip codes = ";Zips
1250 @
1260 @
1270 @
1271 @
1280 Zips=1
1290 Last'zip$=File$(46,50)
1300 Return
1310 *Zip'sort
1320 @ : @"Preparing to sort by zip code........"
1330 Open\1,6\Edit'file$
1340 Put\1,2\"??????"
1350 Close\1\
1360 Run"ZIPSORT.SAV"
1370 *Print'by'zip
1380 Zips=0
1390 Last'zip$(-1)=""
1400 @ : @"Printing labels sorted by zip code...."
1410 On Esc Goto Escape
1420 Kopen\1\Data'file$
1430 On Error Goto Error1
1440 Kopen\2\Sort'file$
1450 On Error Goto 1560
1460 If To'printer Then @ Chr$(23)
1470 Kgetfwd\2\
1480 Kretrieve\2\Sort'key$(-1)
1490 Name$=Sort'key$(5,39)
1510 Kgetkey\1,Name$(-1)\File$(-1)
1520 If File$(73,73)<>"" And Print'item(Val(File$(73,73)))=0 Then Do
1530 Gosub Label
1540 Enddo
1550 Goto 1470
1560 Close
1570 @ Chr$(20);
1580 On Esc Stop
1590 Goto Print'options
1600 *Capitalize
1610 K=Len(Command2$)
1620 For I=0 To K
1630 J=Asc(Command2$(I,I))
1640 If J>96 And J<123 Then Command2$(I,I)=Chr$(J-32)
1650 Next I
1660 Return
1670 *Escape
1680 Close
1690 @ Chr$(20);
1700 On Esc Goto Main'menu
1710 Goto Print'options
1720 *Main'menu
1730 Close
1740 Run"MMENU.SAV"
1750 *Membership
1760 Page=1
1770 If To'printer Then @ Chr$(23);
1780 @ : @ : @"Mailing List on ";Today$(0,1);"/";Today$(2,3);"/";Today$(4,5) : @ : @
1790 @ Chr$(20);
1800 Row=7
1810 Kopen\1\Data'file$
1820 On Esc Goto Escape
1830 On Error Goto 1920
1840 Kgetfwd\1\File$(-1)
1850 Kretrieve\1\Name$(-1)
1860 If File$(73,73)<>"" Then Do
1870 If Print'item(Val(File$(73,73)))=0 Then Call .Line
1880 Else
1890 Gosub Ok
1900 Enddo
1910 Goto 1840
1920 Close
1930 On Esc Stop
1940 Goto Print'options
1950 Procedure .Line
1960 Begincommon
1961 Dim Files$(59)
1970 Dim Address$(23),City$(19),State$(1),Zip$(4),Area$(2),Phone$(6)
1980 Dim Dates$(11),Member$(0),Last$(14),First$(19)
1990 Endcommon
2000 Set 0,-1
2010 Set 4,0
2020 Row=Row+1
2030 If To'printer Then @ Chr$(23);
2040 @ Last$;", ";
2050 If First$(0,0)="*" Then @"MR. & MRS."; : First$(0,0)=" "
2060 @ First$;Tab(37);Address$;" ";City$;", ";
2070 @ State$;" ";Zip$;Tab(85);
2080 If Area$="" Then @" ";" ";
2090 If Area$<>"" Then @ Area$;" ";
2100 If Phone$="" Then @" ";"-"
2110 If Phone$<>"" Then @ Phone$(0,2);"-";Phone$(3,6)
2120 If Row=60 Then @ : @ : @ : @ : @ : @ : @ : @ : @ : @ : @ : @ : Row=6
2130 @ Chr$(20);
2140 Endproc
2150 *Ok
2160 @ : @"Print ";Name$(0,14);", ";Name$(15,34);" ";"(Y/N)? ";
2170 Open\2\"$SY"
2180 Get\2\Command$(0,0)
2190 Close\2\
2200 Gosub Capitalize
2210 If Asc(Command$(0,0))=27 Then Goto Escape
2220 @ Command$
2230 If Command$(0,0)="N" Then Return
2240 If Command$(0,0)="Y" Then Call .Line : Return
2250 Goto Ok