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 / CPMUG041.ARK / BREPORT.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  12KB  |  467 lines
  1. REM    JIM's VERSION OF WARD's MAILING LIST REPORT PROGRAM
  2. REM    4/7/78 ADD LETTER WRITING CAPABILITY IN WHICH A    \
  3.     FILE MAY CONTAIN LINES TO BE SENT TO EACH    \
  4.     MEMBER.  THE LINES ARE READ INTO A MATRIX.    \
  5.     EACH LINE SHOULD BE CONTAINED IN DOUBLE QUOTES.    \
  6.     LOAD FORMAT IS:    \
  7.         LOAD FILENAME.FILETYPE        \
  8.     RUN FORMAT IS: LETTER
  9.  
  10. REM    9/2/79 MODIFIED BY JAMES K. MILLS \
  11.  
  12.     PRINT    CHR$(26);CHR$(0);
  13.     PRINT    "REPORT VERSION AS OF 12/05/79"
  14.     SPACES$="                         "
  15.     UP = 2
  16.     WIDTH = 35
  17.     LENGTH = 6
  18.     FILE.NAME$ = "BARSLIST"
  19.     FILE.SIZE = 512
  20.     INDEX.SIZE = FILE.SIZE
  21.     LETTER.LINES=40
  22.     REC.LENG = 128
  23.     CHART.ONLY = 0 :REM SHOW ALL MEMBERS LABELS TO BE PRINTED
  24.     INDEX.READ = 0 :REM SHOW NO INDEX READ
  25.     LETTER.READ = 0 :REM SHOW NO LETTER READ
  26.     KB = 5 :REM KEYBOARD INPUT
  27.     ABORT = 32  :REM KB VALUE TO ABORT = SPACE BAR
  28.     LF = 10 :REM LINEFEED FROM KB
  29.     FIELD.COUNT = 10 :REM # FIELDS IN RECORD
  30.     FILE FILE.NAME$(REC.LENG),\
  31.         FILE.NAME$(REC.LENG),\
  32.         FILE.NAME$(REC.LENG),\
  33.         FILE.NAME$(REC.LENG)
  34.     DIM FIELD.NAME$(FIELD.COUNT)
  35.     DIM RECORD$(FIELD.COUNT)
  36.     DIM INDEX(INDEX.SIZE)
  37.     DIM LINE$(4,4)
  38.     DIM LETTER$(LETTER.LINES)
  39.     TITLE$=CHR$(14)+"B.A.R.S. MAILING LIST"
  40. REM    READ FIELD NAMES
  41.     DATA SORT,CALL,NAME,STREET,CITY,ZIP,\
  42.         PHONE,CLASS,PAID,TYPE
  43.     FOR I = 1 TO FIELD.COUNT
  44.     READ FIELD.NAME$(I)
  45.     NEXT I
  46.  
  47. REM    MAIN PROCESSING LOOP
  48. 100    INPUT "COMMAND--->";C$
  49.     IF C$ = "HELP" OR C$ = "help" THEN 200
  50.     IF LEFT$ (C$,6) = "INDEX " OR LEFT$ (C$,6) = "index " THEN 1000
  51.     IF LEFT$ (C$,9) = "POSITION " OR LEFT$ (C$,9) = "position " THEN 1100
  52.     IF LEFT$ (C$,6) = "TITLE " OR LEFT$ (C$,6) = "title " THEN 1300
  53.     IF C$ = "PRINT" OR C$ = "print" THEN 1400
  54.     IF LEFT$(C$,6)="WIDTH " OR LEFT$(C$,6) = "width " THEN 1500
  55.     IF LEFT$(C$,7)="LENGTH " OR LEFT$(C$,7) = "length " THEN 1550
  56.      IF C$="TAGS" OR C$ = "tags" THEN 1600
  57.     IF C$="LABELS" OR C$ = "labels" THEN 1600
  58.     IF C$="CHECK" OR C$ = "check" THEN 1700
  59.     IF LEFT$(C$,3)="UP " OR LEFT$(C$,3) = "up " THEN 1800
  60.     IF LEFT$(C$,5)="LOAD " OR LEFT$(C$,5) = "load " THEN 1900
  61.     IF C$="LETTER" OR C$ = "letter" THEN 2000
  62.     IF C$="END" OR C$ = "end" THEN 9999
  63. 199    PRINT "INVALID COMMAND - ";C$
  64.  
  65. REM    HELP
  66. 200    PRINT "END              TO EXIT PROGRAM"
  67.     PRINT "INDEX FN.FT      READ INDEX FILE"
  68.     PRINT "POSITION NN      TO MOVE FILE POINTER"
  69.     PRINT "TAGS             FOR NAME TAGS"
  70.     PRINT "LABELS           FOR MAILING LABELS"
  71.     PRINT "PRINT            FOR LISTING"
  72.     PRINT "CHECK            TO CHECK PARMS"
  73.     PRINT
  74.     GOTO 100
  75. REM    READ INDEX FILE
  76. 1000    INDEX.NAME$=MID$(C$,7,99)
  77.     PRINT "READING FILE ";INDEX.NAME$
  78.     FILE INDEX.NAME$
  79.     IF END #5 THEN 1050
  80.     REM CAN'T FOR-NEXT: EOF WOULD EXIT LOOP EARLY
  81.     REM NOTE BASIC SINCE FIXED TO ALLOW EXIT, BUT \
  82.         CODE STILL LEFT AS IT WAS
  83.     I=1
  84. 1010    READ #5;INDEX(I)
  85.     IF INP(KB)=ABORT THEN \
  86.         PRINT I
  87.     I=I+1
  88.     GOTO 1010
  89. 1050    CLOSE 5
  90.     INDEX.COUNT = I-1
  91.     PRINT INDEX.COUNT;" INDEX ENTRIES LOADED."
  92.     PRINT INDEX.SIZE-INDEX.COUNT;" ENTRIES OPEN."
  93.     INDEX.READ = 1 :REM SHOW READ
  94. 1080    PRINT "POSITIONED TO RECORD 1"
  95.     POSITION = 1
  96.     GOTO 100
  97.  
  98. REM    POSITION TO PARTICULAR RECORD
  99. 1100    X=ASC(MID$(C$,10,1))
  100.     IF X > 47 AND X < 58 THEN 1200
  101.     GOSUB 8910 :REM EXTRACT FIELD NAME, VALUE
  102.     IF INDEX.READ = 0 THEN 8700
  103.     X=LEN(FIELD.VALUE$)
  104. 1110    IF POSITION >  INDEX.COUNT THEN \
  105.         PRINT "NOT FOUND":\
  106.         GOTO 1080
  107.     IF INP(KB)=ABORT THEN 100
  108.     KEY = INDEX(POSITION)
  109.     GOSUB 8800 :REM READ RECORD
  110.     PRINT KEY,RECORD$(FIELD.NO)
  111.     IF LEFT$(RECORD$(FIELD.NO),X)=FIELD.VALUE$ THEN \
  112.         GOSUB 9000:\
  113.         GOTO 100
  114.     POSITION = POSITION + 1
  115.     GOTO 1110
  116.  
  117. REM    POSITION TO RECORD NUMBER
  118. 1200    POSITION = VAL(MID$(C$,10,99))
  119.     IF INDEX.READ = 0 THEN 8700
  120.     PRINT "POSITIONED TO ";POSITION
  121.     IF POSITION < 1 OR POSITION > INDEX.COUNT THEN \
  122.         PRINT "INVALID POSITION":\
  123.         GOTO 1080
  124.     KEY = INDEX(POSITION)
  125.     GOSUB 8800
  126.     GOSUB 9000
  127.     GOTO 100
  128.  
  129. REM    ENTER TITLE
  130. 1300    TITLE$=CHR$(14)+MID$(C$,7,132)
  131.     GOTO 100
  132.  
  133. REM    PRINT REPORT USING INDEX
  134. 1400    WIDTH = 132
  135.     PRINT "WIDTH IS ";WIDTH
  136.     PRINT "PRESS LINE FEED TO START"
  137.     IF INDEX.READ = 0 THEN 8700
  138. 1405    IF INP (KB) = ABORT THEN 100
  139.     IF INP (KB) <> LF THEN 1405
  140.     REM SET UP FIELD TABS
  141.     T1=26
  142.     T2=T1+21
  143.     T3=T2+25
  144.     IF WIDTH < 80 THEN T3 = 6
  145.     T4=T3+21
  146.     T5=T4+6
  147.     T6=T5+15
  148.     T7=T6+6
  149.     T8=T7+5
  150.     T9=T8+2
  151.  
  152.     REM PRINT A PAGE
  153. 1410    PRINT TITLE$
  154.     PRINT
  155.     LINE.COUNT = 7
  156.     PRINT    "---------NAME-----------";\
  157.         TAB(T1);"-----CALL-SIGN------";\
  158.         TAB(T2);"---------STREET---------";
  159.     IF WIDTH < 80 THEN PRINT:\
  160.         LINE.COUNT = LINE.COUNT + 1
  161.     PRINT    TAB(T3);"----CITY & STATE----";\
  162.         TAB(T4);"-ZIP-";\
  163.         TAB(T5);"----PHONE----";\
  164.         TAB(T6);"CLAS";\
  165.         TAB(T7-1);"EXPDT";\
  166.         TAB(T8);"T";\
  167.         TAB(T9);"SORT"
  168.     PRINT
  169. 1420    IF POSITION > INDEX.COUNT THEN 1490
  170.     KEY = INDEX(POSITION)
  171.     POSITION = POSITION + 1
  172.     GOSUB 8800
  173.     PRINT    NAME$;\
  174.         TAB(T1);ORGANIZATION$;\
  175.         TAB(T2);STREET$;
  176.     IF WIDTH < 80 THEN \
  177.         PRINT :\
  178.         LINE.COUNT = LINE.COUNT + 1
  179.     PRINT    TAB(T3);CITY$;\
  180.         TAB(T4);ZIP$;\
  181.         TAB(T5);PHONE$;\
  182.         TAB(T6);COM$;\
  183.         TAB(T7);PAID$;\
  184.         TAB(T8);TYPE$;\
  185.         TAB(T9);SORT$
  186.     LINE.COUNT = LINE.COUNT + 1
  187.     IF INP(KB)=ABORT THEN 1490
  188.     IF LINE.COUNT < 64 THEN 1420
  189.     PRINT CHR$(12) :REM EJECT
  190.     GOTO 1410
  191.  
  192.     REM WAIT FOR KEY PRESSED OTHER THAN LINEFEED
  193. 1490    PRINT
  194. 1495    IF INP(KB)=LF THEN 1495
  195.     GOTO 100
  196. REM    SET REPORT OR LABEL WIDTH
  197. 1500    WIDTH = VAL(MID$(C$,7,99))
  198.     IF WIDTH > 24 THEN 100
  199.     PRINT "WIDTH TOO NARROW - SET TO 25"
  200.     WIDTH = 25
  201.     GOTO 100
  202.  
  203. REM    SET LABEL LENGTH
  204. 1550    LENGTH = VAL (MID$(C$,8,99))
  205.     IF LENGTH > 3 THEN 100
  206.     PRINT "LENGTH INVALID, SET TO 6"
  207.     LENGTH = 6
  208.     GOTO 100
  209.  
  210. REM    PRINT LABELS
  211. 1600    INPUT "Officers Only (Y or N)";OFF.ONLY$
  212.     INPUT "Charter Members Only (Y or N + ^P)"; CHART.ONLY$
  213.     CHART.ONLY = 0 : WIDTH = 35 : OFF.ONLY = 0
  214.     IF LEFT$ (OFF.ONLY$,1) = "Y" OR \
  215.     LEFT$ (OFF.ONLY$,1) = "y" THEN OFF.ONLY = 1
  216.     IF LEFT$ (CHART.ONLY$,1) = "Y" OR \
  217.     LEFT$ (CHART.ONLY$,1) = "y" THEN CHART.ONLY = 1
  218.     PRINT
  219.     PRINT "PRESS LINEFEED"
  220.     IF INDEX.READ = 0 THEN 8700
  221. 1610    IF INP (KB) <> LF THEN 1610
  222.     REM READ 'UP' LABELS OR TAGS
  223. 1620    IF POSITION > INDEX.COUNT THEN 1690
  224.     IF INP (KB) <> LF THEN 1690
  225.     FOR I = 1 TO UP
  226. 1621    IF POSITION > INDEX.COUNT THEN 1650
  227.     KEY = INDEX (POSITION)
  228.     POSITION = POSITION + 1
  229.     GOSUB 8800
  230.     IF OFF.ONLY = 1 AND COM$ <> "OFFCR" THEN 1621
  231.     IF CHART.ONLY = 1 AND TYPE$ <> "C" THEN 1621
  232.     IF TYPE$ = "F" THEN 1621
  233.     IF C$="LABELS" THEN 1630
  234.     REM FORMAT NAME TAGS
  235.     REM DON'T PRINT TAGS FOR MAILER TYPES
  236.     IF TYPE$="M" THEN 1621
  237.     FOR BLANK.POS = LEN(NAME$) TO 1 STEP -1
  238.     IF MID$(NAME$,BLANK.POS,1)=" " THEN 1624
  239. 1622    NEXT BLANK.POS
  240.     GOTO 1628
  241. 1624    IF MID$(NAME$+"  ",BLANK.POS+1,2)="JR" THEN 1622
  242.     IF BLANK.POS<4 THEN 1628
  243.     IF MID$(NAME$,BLANK.POS-2,2)="MC" THEN 1622
  244.     IF MID$(NAME$,BLANK.POS-3,3)=" DE" THEN 1622
  245.     IF MID$(NAME$,BLANK.POS-3,3)=" LA" THEN 1622
  246.     IF MID$(NAME$,BLANK.POS-3,3)=" DI" THEN 1622
  247.     IF BLANK.POS<5 THEN 1628
  248.     IF MID$(NAME$,BLANK.POS-4,4)=" VAN" THEN 1622
  249. 1628    LINE$(I,1)=""
  250.     IF BLANK.POS>1 THEN \
  251.         LINE$(I,1)=LEFT$(NAME$,BLANK.POS-1)
  252.     LINE$(I,2)=MID$(NAME$,BLANK.POS+1,99)
  253.     LINE$(I,3)=COM$
  254.     IF I=1 AND 0=LEN(COM$) THEN \
  255.         LINE$(1,3)="." REM CENTRONICS REQMT
  256.     LINE$(I,4)=CITY$
  257.     GOTO 1640
  258. 1630    LINE$(I,1)=LEFT$(NAME$+SPACES$,28)+TYPE$
  259.     LINE$(I,2)=ORGANIZATION$
  260.     LINE$(I,3)=STREET$
  261.     LINE$(I,4)=LEFT$(CITY$+SPACES$,24)+ZIP$
  262. 1640    NEXT I
  263.     REM PRINT THE LABELS
  264.     FOR LINE = 1 TO 4
  265.         WD=WIDTH
  266.         IF LINE < 4 AND C$="TAGS" THEN \
  267.             PRINT CHR$(14);:\
  268.             WD=.5+WIDTH/2
  269.         PRINT LINE$(1,LINE);
  270.         IF UP >= 2 THEN \
  271.             PRINT TAB(WD+1);LINE$(2,LINE);
  272.         IF UP >= 3 THEN \
  273.             PRINT TAB(2*WD+1);LINE$(3,LINE);
  274.         IF UP >= 4 THEN \
  275.             PRINT TAB(3*WD+1);LINE$(4,LINE);
  276.         PRINT
  277.     NEXT LINE
  278.     IF LENGTH > 4 THEN \
  279.         FOR I=4 TO LENGTH-1 :\
  280.             PRINT :\
  281.         NEXT I
  282.     GOTO 1620
  283.     REM END OF FILE - PAD W/BLANK FIELDS
  284. 1650    NAME$=" "
  285.     PAID$=" "
  286.     ORGANIZATION$=" "
  287.     STREET$=" "
  288.     CITY$=" "
  289.     ZIP$=" "
  290.     GOTO 1630
  291.     REM END OF LABELS
  292. 1690    PRINT
  293. 1695    IF INP(KB)=LF THEN 1695
  294.     GOTO 100
  295.  
  296. REM    PRINT CONTENTS OF VARIABLES
  297. 1700    PRINT "WIDTH=";WIDTH
  298.     PRINT "LENGTH=";LENGTH
  299.     PRINT "POSITION=";POSITION
  300.     PRINT "UP=";UP
  301.     PRINT "INDEX HAS ";
  302.     IF INDEX.READ = 0 THEN \
  303.         PRINT "NOT ";
  304.     PRINT "BEEN READ."
  305.     PRINT "MAX INDEX.SIZE=";INDEX.SIZE
  306.     PRINT "INDEX ENTRIES=";INDEX.COUNT
  307.     PRINT "LETTER HAS ";
  308.     IF LETTER.READ = 0 THEN \
  309.         PRINT "NOT ";
  310.     PRINT "BEEN READ."
  311.     PRINT "MAX LETTER SIZE=";LETTER.LINES
  312.     PRINT "LETTER LINES=";LETTER.COUNT
  313.     PRINT "FREE MEMORY = ";FRE
  314.     GOTO 100
  315.  
  316. REM    SET 'N' UP LABELS
  317. 1800    UP = VAL(MID$(C$,4,99))
  318.     IF UP=3 OR UP=4 THEN \
  319.         GOTO 100
  320.     PRINT "'UP' IS INVALID, SET TO 3."
  321.     UP=3
  322.     GOTO 100
  323.  
  324. REM    LOAD IN THE LETTER TO BE WRITTEN
  325.  
  326. 1900    LETTER.NAME$=MID$(C$,6,99)
  327.     PRINT"READING FILE ";LETTER.NAME$
  328.     FILE LETTER.NAME$
  329.     IF END #5 THEN 1950
  330.     I=1
  331. 1910    READ #5;LETTER$(I)
  332.     IF INP(KB)=ABORT THEN \
  333.         PRINT I
  334.     I=I+1
  335.     GOTO 1910
  336. 1950    CLOSE 5
  337.     LETTER.COUNT = I-1
  338.     PRINT LETTER.COUNT;" LETTER ENTRIES LOADED."
  339.     PRINT LETTER.LINES-LETTER.COUNT;" LINES OPEN."
  340.     LETTER.READ = 1 :REM SHOW READ
  341.     GOTO 100
  342.  
  343. REM    PRINT THE LETTER.
  344.  
  345. 2000    IF LETTER.READ = 0 THEN \
  346.         PRINT "NO LETTER READ" :\
  347.         GOTO 100
  348.     IF INDEX.READ = 0 THEN \
  349.         PRINT "NO INDEX READ" :\
  350.         GOTO 100
  351.     PRINT "TURN ON PRINTER, PRESS LINEFEED"
  352. 2005    IF INP(KB)=ABORT THEN 100
  353.     IF INP(KB)<>LF THEN 2005
  354. 2020    IF POSITION > INDEX.COUNT THEN 1490
  355.     KEY = INDEX(POSITION)
  356.     POSITION = POSITION + 1
  357.     GOSUB 8800
  358.     IF TYPE$ <> "C" THEN 2020
  359.     PRINT "Dear "; NAME$; ":"
  360.     PRINT
  361. REM    PRINT THE LETTER
  362.     FOR I=1 TO LETTER.COUNT
  363.         PRINT LETTER$(I)
  364.     NEXT I
  365. REM    FORMS FEED TO RETURN ADDR OF LETTER
  366.     PRINT CHR$(12)
  367. REM    PRINT RETURN ADDR
  368.     PRINT "THE BOLINGBROOK AMATEUR RADIO SOCIETY"
  369.     PRINT "JAMES K. MILLS, WB9KFP, SECRETARY"
  370.     PRINT "BOX 94864"
  371.     PRINT "SCHAUMBURG, IL  60194"
  372. REM    SKIP TO ADDRESS
  373.     PRINT:PRINT
  374.     T=20    :REM AMT TO TAB IN
  375.     PRINT TAB(T);"ADDRESS CORRECTION REQUESTED"
  376.     PRINT:PRINT
  377.     PRINT TAB(T);NAME$
  378.     PRINT TAB(T);ORGANIZATION$
  379.     PRINT TAB(T);STREET$
  380.     PRINT TAB(T);CITY$;"  ";ZIP$;
  381. REM    SKIP TO BOTTOM OF LETTER
  382.     FOR J=1 TO 10
  383.         PRINT
  384.     NEXT J
  385. REM    PRINT MEMBERSHIP STATUS
  386. REM    SKIP TO TOP OF NEXT PAGE
  387.     FOR J=1 TO 3
  388.         PRINT
  389.     NEXT J
  390. REM    LOOP UNTIL DONE
  391.     IF INP(KB)=ABORT THEN 1490
  392.     GOTO 2020
  393.  
  394. REM    ERROR  - NO INDEX READ
  395. 8700    PRINT "NO INDEX READ"
  396.     GOTO 100
  397.  
  398. REM    PHYSICAL READ RECORD # IN KEY
  399. 8800    FILE.NO = 1+INT((KEY-1)/128)
  400.     READ #FILE.NO,KEY;FLAG
  401.     IF FLAG=0 THEN RETURN
  402.     READ #FILE.NO,KEY;\
  403.         FLAG,\
  404.         RECORD$(1),\
  405.         RECORD$(2),\
  406.         RECORD$(3),\
  407.         RECORD$(4),\
  408.         RECORD$(5),\
  409.         RECORD$(6),\
  410.         RECORD$(7),\
  411.         RECORD$(8),\
  412.         RECORD$(9),\
  413.         RECORD$(10)
  414. REM    SET VARIABLE NAMES FROM RECORD$(N)
  415. 8850    SORT$=RECORD$(1)
  416.     NAME$=RECORD$(3)
  417.     ORGANIZATION$=RECORD$(2)
  418.     STREET$=RECORD$(4)
  419.     CITY$=RECORD$(5)
  420.     ZIP$=RECORD$(6)
  421.     PHONE$=RECORD$(7)
  422.     COM$=RECORD$(8)
  423.     PAID$=RECORD$(9)
  424.     TYPE$=RECORD$(10)
  425.     RETURN
  426.  
  427. REM    EXTRACT FIELD NAME, VALUE FROM C$
  428.     REM FIND BLANK AFTER COMMAND
  429. 8910    FOR I=LEN(C$) TO 1 STEP -1
  430.     IF MID$(C$,I,1)=" " THEN \
  431.         BLANK.POS = I+1
  432.     NEXT I
  433.     C$=MID$(C$,BLANK.POS,99)
  434.     BLANK.POS = 0
  435.     REM FIND BLANK AFTER FIELD NAME
  436.     FOR I=LEN(C$) TO 1 STEP -1
  437.     IF MID$(C$,I,1)=" " THEN \
  438.         BLANK.POS=I-1
  439.     NEXT I
  440.     IF BLANK.POS=0 THEN 199
  441.     FIELD$=LEFT$(C$,BLANK.POS)
  442.     FIELD.NO = 0
  443.     FOR I=1 TO FIELD.COUNT
  444.     IF LEFT$(FIELD.NAME$(I),BLANK.POS)=FIELD$ THEN\
  445.         FIELD.NO = I
  446.     NEXT I
  447.     IF FIELD.NO=0 THEN\
  448.         PRINT "NO SUCH FIELD ";FIELD$:\
  449.         GOTO 100
  450.     FIELD.VALUE$=MID$(C$,BLANK.POS+2,99)
  451.     FIELD$=FIELD.NAME$(FIELD.NO)
  452.     RETURN
  453. REM    RECORD PRINT ROUTINE
  454. 9000    PRINT
  455.     PRINT "RECORD #";KEY;" ";RECORD$(1) :REM SORT
  456.     PRINT RECORD$(2) :REM NAME
  457.     PRINT RECORD$(3) :REM ORGANIZATION
  458.     PRINT RECORD$(4) :REM STREET
  459.     PRINT RECORD$(5);" ";RECORD$(6)
  460.     PRINT RECORD$(7);"/";\
  461.         RECORD$(8);";";\
  462.         RECORD$(9);";";\
  463.         RECORD$(10)
  464.     PRINT
  465.     RETURN
  466. 9999    END
  467.