home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug080.ark / REC-PRN.STB < prev    next >
Encoding:
Text File  |  1984-04-29  |  7.5 KB  |  229 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.    30   Dim File$(73),Name$(34)
  6.    40   Endcommon
  7.    45   If Today$="" Then Run"date.sav"
  8.    50   Dim Sort'key$(39)
  9.    60   Dim Command$(10),Command2$(35),Name2$(34),Today$(5),Last'zip$(5)
  10.    70   Integer I,J,K,Item,To'printer,Zips,Row,Page,Print'item(3)
  11.    80   Set 0,-1
  12.    90   On Esc Goto Main'menu
  13.   150   On Error Gosub Create'file
  14.   160   Kopen\1\Data'file$
  15.   170   On Error Stop
  16.   180   Kclose\1\
  17.   190   @ Chr$(7)
  18.   200 *Print'options
  19.   210   Gosub Screen'erase
  20.   220   @"*******" : @
  21.   230   @"   PRINTER OPTIONS" : @
  22.   240   @"1. Print mailing labels by zip code."
  23.   250   @"2. Print mailing labels alphabetically"
  24.   260   @"3. Print alphabetical membership list"
  25.   270   @"4. Print all membership information alphabetically"
  26.   280   @"5. Sort by zip code.";
  27.   290   @"  Last sorted - ";Last'sorted$(0,1);"/";Last'sorted$(2,3);"/";Last'sorted$(4,5)
  28.   300   @"6. Set people to print now: ";
  29.   310   If Print'item(0)=0 Then @"(Non-members)";
  30.   320   If Print'item(1)=0 Then @"(Members)";
  31.   330   If Print'item(2)=0 Then @"(Institutions)";
  32.   340   @
  33.   350   @"7. Goto main index."
  34.   360   @ : Input"  Type the number or your choice or RETURN to go on. ",Command2$
  35.   370   Item=Asc(Command2$) : If Item=0 Then Goto Print'options
  36.   380   If Item>48 And Item<53 Then  Do
  37.   390     To'printer=0
  38.   400     @ : Input"  Type 'P' to send to the printer. ",Command2$
  39.   410     Gosub Capitalize
  40.   420     If Command2$="P" Then To'printer=1
  41.   430     Enddo
  42.   440   On Item-48 Goto Print'by'zip,Printer,Membership,Printer,Zip'sort,Set'print'items,Main'menu
  43.   450   Goto Print'options
  44.   460 *Set'print'items
  45.   470   Gosub Screen'erase
  46.   480   Local I
  47.   490   @"1. Non-members ";
  48.   500   If Print'item(0)=0 Then  Do : @"YES" : Else : @"NO" : Enddo
  49.   510   @"2. Members ";
  50.   520   If Print'item(1)=0 Then  Do : @"YES" : Else : @"NO" : Enddo
  51.   530   @"3. Institutions ";
  52.   540   If Print'item(2)=0 Then  Do : @"YES" : Else : @"NO" : Enddo
  53.   545   @ : @"Enter a number to change an item, press RETURN for the index. ";
  54.   550   Input"",Command2$
  55.   560   If Command2$="" Then Goto Print'options
  56.   561   I=Val(Command2$)-1
  57.   570   If I<0 Or I>2 Then Goto Set'print'items
  58.   580   If Print'item(I)=0 Then  Do
  59.   581     Print'item(I)=1
  60.   582     Else
  61.   583     Print'item(I)=0
  62.   584     Enddo
  63.   585   Goto Set'print'items
  64.   590 *Record
  65.   600   Gosub Screen'erase
  66.   610   @ : @" 1. Name: ";Name$(0,14);", ";Name$(15,34)
  67.   620   @" 2. Street: ";File$(0,23)
  68.   630   @" 3. City: ";File$(24,43)
  69.   640   @" 4. State: ";File$(44,45)
  70.   650   @" 5. Zip: ";File$(46,50)
  71.   660   @" 6. Area Code: ";File$(51,53)
  72.   670   @" 7. Phone: ";File$(54,56);"-";File$(57,60)
  73.   680   @" 8. Date Joined: ";File$(61,62);"/";File$(63,64)
  74.   690   @" 9. Date Entered: ";File$(65,66);"/";File$(67,68);"/";File$(69,70)
  75.   700   @"10. Congressional District: ";File$(71,72)
  76.   710   @"11. Status: ";
  77.   720   If File$(73,73)="0" Then @"NON-MEMBER"
  78.   730   If File$(73,73)="1" Then @"MEMBER"
  79.   740   If File$(73,73)="2" Then @"INSTITUTION"
  80.   750   If File$(73,73)="" Then @"??????"
  81.   760   @ : @
  82.   770   Return
  83.   780 *Screen'erase
  84.   790   Out 1,126 : Out 1,28 : Return
  85.   800 *Bottom'lines
  86.   810   Out 1,126 : Out 1,17 : Out 1,0 : Out 1,22
  87.   820   Out 1,126 : Out 1,24 : Return
  88.   830 *Error1
  89.   840   Close
  90.   850   Gosub Bottom'lines
  91.   860   @"Error No. ";Sys(3);" has occured."
  92.   870   Input"Press RETURN to go on. ",Command2$
  93.   880   Goto Print'options
  94.   890 *Create'file
  95.   900   Kcreate\74,35\Data'file$
  96.   910   Retry
  97.   920 *Printer
  98.   930   I=0 : If To'printer Then @ Chr$(23);
  99.   940   Kopen\1\Data'file$
  100.   950   On Esc Goto Escape
  101.   960   On Error Goto 1050
  102.   970   Kgetfwd\1\File$(-1)
  103.   980   Kretrieve\1\Name$(-1)
  104.  1000   If File$(73,73)<>"" And Print'item(Val(File$(73,73)))=0 Then  Do
  105.  1010     On Item-49 Gosub Label,Line,Record
  106.  1020     Enddo
  107.  1040   Goto 970
  108.  1050   Close
  109.  1060   @ Chr$(20);
  110.  1070   On Esc Stop
  111.  1080   Goto Print'options
  112.  1090 *Label
  113.  1100   If Item=49 Then Gosub Zip'number
  114.  1130   If Name$(15,15)="*" Then @"MR. & MRS."; : Name$(15,15)=" "
  115.  1140   @ Name$(15,34);" ";Name$(0,14)
  116.  1150   @ File$(0,23)
  117.  1160   @ File$(24,43);",";File$(44,45);"  ";File$(46,50)
  118.  1170   @
  119.  1171   @
  120.  1172   @
  121.  1180   Return
  122.  1190 *Zip'number
  123.  1200   If Last'zip$=File$(46,50) Then Zips=Zips+1 : Return
  124.  1210   If Zips<10 Then Zips=1 : Last'zip$=File$(46,50) : Return
  125.  1240   @"Number of ";Last'zip$;" zip codes = ";Zips
  126.  1250   @
  127.  1260   @
  128.  1270   @
  129.  1271   @
  130.  1280   Zips=1
  131.  1290   Last'zip$=File$(46,50)
  132.  1300   Return
  133.  1310 *Zip'sort
  134.  1320   @ : @"Preparing to sort by zip code........"
  135.  1330   Open\1,6\Edit'file$
  136.  1340   Put\1,2\"??????"
  137.  1350   Close\1\
  138.  1360   Run"ZIPSORT.SAV"
  139.  1370 *Print'by'zip
  140.  1380   Zips=0
  141.  1390   Last'zip$(-1)=""
  142.  1400   @ : @"Printing labels sorted by zip code...."
  143.  1410   On Esc Goto Escape
  144.  1420   Kopen\1\Data'file$
  145.  1430   On Error Goto Error1
  146.  1440   Kopen\2\Sort'file$
  147.  1450   On Error Goto 1560
  148.  1460   If To'printer Then @ Chr$(23)
  149.  1470   Kgetfwd\2\
  150.  1480   Kretrieve\2\Sort'key$(-1)
  151.  1490   Name$=Sort'key$(5,39)
  152.  1510   Kgetkey\1,Name$(-1)\File$(-1)
  153.  1520   If File$(73,73)<>"" And Print'item(Val(File$(73,73)))=0 Then  Do
  154.  1530     Gosub Label
  155.  1540     Enddo
  156.  1550   Goto 1470
  157.  1560   Close
  158.  1570   @ Chr$(20);
  159.  1580   On Esc Stop
  160.  1590   Goto Print'options
  161.  1600 *Capitalize
  162.  1610   K=Len(Command2$)
  163.  1620     For I=0 To K
  164.  1630     J=Asc(Command2$(I,I))
  165.  1640     If J>96 And J<123 Then Command2$(I,I)=Chr$(J-32)
  166.  1650     Next I
  167.  1660   Return
  168.  1670 *Escape
  169.  1680   Close
  170.  1690   @ Chr$(20);
  171.  1700   On Esc Goto Main'menu
  172.  1710   Goto Print'options
  173.  1720 *Main'menu
  174.  1730   Close
  175.  1740   Run"MMENU.SAV"
  176.  1750 *Membership
  177.  1760   Page=1
  178.  1770   If To'printer Then @ Chr$(23);
  179.  1780   @ : @ : @"Mailing List on ";Today$(0,1);"/";Today$(2,3);"/";Today$(4,5) : @ : @
  180.  1790   @ Chr$(20);
  181.  1800   Row=7
  182.  1810   Kopen\1\Data'file$
  183.  1820   On Esc Goto Escape
  184.  1830   On Error Goto 1920
  185.  1840   Kgetfwd\1\File$(-1)
  186.  1850   Kretrieve\1\Name$(-1)
  187.  1860   If File$(73,73)<>"" Then  Do
  188.  1870     If Print'item(Val(File$(73,73)))=0 Then Call .Line 
  189.  1880     Else
  190.  1890     Gosub Ok
  191.  1900     Enddo
  192.  1910   Goto 1840
  193.  1920   Close
  194.  1930   On Esc Stop
  195.  1940   Goto Print'options
  196.  1950 Procedure .Line 
  197.  1960   Begincommon
  198.  1961   Dim Files$(59)
  199.  1970   Dim Address$(23),City$(19),State$(1),Zip$(4),Area$(2),Phone$(6)
  200.  1980   Dim Dates$(11),Member$(0),Last$(14),First$(19)
  201.  1990   Endcommon
  202.  2000   Set 0,-1
  203.  2010   Set 4,0
  204.  2020   Row=Row+1
  205.  2030   If To'printer Then @ Chr$(23);
  206.  2040   @ Last$;", ";
  207.  2050   If First$(0,0)="*" Then @"MR. & MRS."; : First$(0,0)=" "
  208.  2060   @ First$;Tab(37);Address$;"  ";City$;", ";
  209.  2070   @ State$;"  ";Zip$;Tab(85);
  210.  2080   If Area$="" Then @"   ";"  ";
  211.  2090   If Area$<>"" Then @ Area$;"  ";
  212.  2100   If Phone$="" Then @"   ";"-"
  213.  2110   If Phone$<>"" Then @ Phone$(0,2);"-";Phone$(3,6)
  214.  2120   If Row=60 Then @ : @ : @ : @ : @ : @ : @ : @ : @ : @ : @ : @ : Row=6
  215.  2130   @ Chr$(20);
  216.  2140   Endproc 
  217.  2150 *Ok
  218.  2160   @ : @"Print ";Name$(0,14);", ";Name$(15,34);"  ";"(Y/N)?  ";
  219.  2170   Open\2\"$SY"
  220.  2180   Get\2\Command$(0,0)
  221.  2190   Close\2\
  222.  2200   Gosub Capitalize
  223.  2210   If Asc(Command$(0,0))=27 Then Goto Escape
  224.  2220   @ Command$
  225.  2230   If Command$(0,0)="N" Then Return
  226.  2240   If Command$(0,0)="Y" Then Call .Line  : Return
  227.  2250   Goto Ok
  228.