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 / CPMUG006.ARK / REPORT.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  8KB  |  344 lines
  1. REM    CACHE MAILING LIST REPORT PROGRAM
  2.     PRINT    "REPORT VERSION 0.8"
  3.     SPACES$="                         "
  4.     UP = 3
  5.     WIDTH = 38
  6.     LENGTH = 6
  7.     FILE.NAME$="CACHE.FIL"
  8.     FILE.SIZE = 512
  9.     INDEX.SIZE = 400
  10.     REC.LENG = 128
  11.     INDEX.READ = 0 :REM SHOW NO INDEX READ
  12.     KB = 1 :REM KEYBOARD INPUT
  13.     ABORT = 255 :REM KB VALUE TO ABORT
  14.     LF = 138:REM LINEFEED FROM KB
  15.     FIELD.COUNT = 10 :REM # FIELDS IN RECORD
  16.     FILE FILE.NAME$(REC.LENG),\
  17.         FILE.NAME$(REC.LENG),\
  18.         FILE.NAME$(REC.LENG),\
  19.         FILE.NAME$(REC.LENG)
  20.     DIM FIELD.NAME$(FIELD.COUNT)
  21.     DIM RECORD$(FIELD.COUNT)
  22.     DIM INDEX(INDEX.SIZE)
  23.     DIM LINE$(4,4)
  24.     TITLE$=CHR$(14)+"CACHE MAILING LIST"
  25. REM    READ FIELD NAMES
  26.     DATA SORT,NAME,ORGANIZATION,STREET,CITY,ZIP,\
  27.         PHONE,COMPUTER,PAID,TYPE
  28.     FOR I = 1 TO FIELD.COUNT
  29.     READ FIELD.NAME$(I)
  30.     NEXT I
  31.  
  32. REM    MAIN PROCESSING LOOP
  33. 100    INPUT "COMMAND--->";C$
  34.     IF C$="HELP" THEN 200
  35.     IF LEFT$(C$,6)="INDEX "    THEN 1000
  36.     IF LEFT$(C$,9)="POSITION " THEN 1100
  37.     IF LEFT$(C$,6)="TITLE " THEN 1300
  38.     IF C$="PRINT" THEN 1400
  39.     IF LEFT$(C$,6)="WIDTH " THEN 1500
  40.     IF LEFT$(C$,7)="LENGTH "THEN 1550
  41.     IF C$="TAGS" THEN 1600
  42.     IF C$="LABELS" THEN 1600
  43.     IF C$="CHECK" THEN 1700
  44.     IF LEFT$(C$,3)="UP " THEN 1800
  45.     IF C$="END" THEN 9999
  46. 199    PRINT "INVALID COMMAND"
  47.     GOTO 100
  48.  
  49. REM    HELP
  50. 200    PRINT "END        TO END EXECUTION"
  51.     PRINT "INDEX FN.FT    READ INDEX FILE"
  52.     PRINT "POSITION FIELD VALUE POSITION VIA FILE SCAN"
  53.     PRINT
  54.     GOTO 100
  55. REM    READ INDEX FILE
  56. 1000    INDEX.NAME$=MID$(C$,7,99)
  57.     PRINT "READING FILE ";INDEX.NAME$
  58.     FILE INDEX.NAME$
  59.     IF END #5 THEN 1050
  60.     REM CAN'T FOR-NEXT: EOF WOULD EXIT LOOP EARLY
  61.     I=1
  62. 1010    READ #5;INDEX(I)
  63.     IF INP(KB)=ABORT THEN \
  64.         PRINT I
  65.     I=I+1
  66.     GOTO 1010
  67. 1050    CLOSE 5
  68.     INDEX.COUNT = I-1
  69.     PRINT INDEX.COUNT;" INDEX ENTRIES LOADED."
  70.     INDEX.READ = 1 :REM SHOW READ
  71. 1080    PRINT "POSITIONED TO RECORD 1"
  72.     POSITION = 1
  73.     GOTO 100
  74.  
  75. REM    POSITION TO PARTICULAR RECORD
  76. 1100    X=ASC(MID$(C$,10,1))
  77.     IF X > 47 AND X < 58 THEN 1200
  78.     GOSUB 8910 :REM EXTRACT FIELD NAME, VALUE
  79.     IF INDEX.READ = 0 THEN 8700
  80.     X=LEN(FIELD.VALUE$)
  81. 1110    IF POSITION >  INDEX.COUNT THEN \
  82.         PRINT "NOT FOUND":\
  83.         GOTO 1080
  84.     IF INP(KB)=ABORT THEN 100
  85.     KEY = INDEX(POSITION)
  86.     GOSUB 8800 :REM READ RECORD
  87.     PRINT KEY,RECORD$(FIELD.NO)
  88.     IF LEFT$(RECORD$(FIELD.NO),X)=FIELD.VALUE$ THEN \
  89.         GOSUB 9000:\
  90.         GOTO 100
  91.     POSITION = POSITION + 1
  92.     GOTO 1110
  93.  
  94. REM    POSITION TO RECORD NUMBER
  95. 1200    POSITION = VAL(MID$(C$,10,99))
  96.     IF INDEX.READ = 0 THEN 8700
  97.     PRINT "POSITIONED TO ";POSITION
  98.     IF POSITION < 1 OR POSITION > INDEX.COUNT THEN \
  99.         PRINT "INVALID POSITION":\
  100.         GOTO 1080
  101.     KEY = INDEX(POSITION)
  102.     GOSUB 8800
  103.     GOSUB 9000
  104.     GOTO 100
  105.  
  106. REM    ENTER TITLE
  107. 1300    TITLE$=CHR$(14)+MID$(C$,7,99)
  108.     GOTO 100
  109.  
  110. REM    PRINT REPORT USING INDEX
  111. 1400    PRINT "PRESS LINE FEED TO START"
  112.     IF INDEX.READ = 0 THEN 8700
  113. 1405    IF INP(KB)<>LF THEN 1405
  114.     REM SET UP FIELD TABS
  115.     T1=6
  116.     T2=T1+25
  117.     T3=T2+21
  118.     T4=T3+25
  119.     IF WIDTH < 80 THEN T4 = 6
  120.     T5=T4+21
  121.     T6=T5+6
  122.     T7=T6+15
  123.     T8=T7+6
  124.     T9=T8+5
  125.  
  126.     REM PRINT A PAGE
  127. 1410    PRINT TITLE$
  128.     PRINT
  129.     LINE.COUNT = 7
  130.     PRINT "SORT";\
  131.         TAB(T1);"---------NAME-----------";\
  132.         TAB(T2);"----ORGANIZATION----";\
  133.         TAB(T3);"---------STREET---------";
  134.     IF WIDTH < 80 THEN PRINT:\
  135.         LINE.COUNT = LINE.COUNT + 1
  136.     PRINT    TAB(T4);"---------CITY-------";\
  137.         TAB(T5);"-ZIP-";\
  138.         TAB(T6);"----PHONE----";\
  139.         TAB(T7);"MICRO";\
  140.         TAB(T8);"PAID";\
  141.         TAB(T9);"T"
  142.     PRINT
  143. 1420    IF POSITION > INDEX.COUNT THEN 1490
  144.     KEY = INDEX(POSITION)
  145.     POSITION = POSITION + 1
  146.     GOSUB 8800
  147.     PRINT SORT$;\
  148.         TAB(T1);NAME$;\
  149.         TAB(T2);ORGANIZATION$;\
  150.         TAB(T3);STREET$;
  151.     IF WIDTH < 80 THEN \
  152.         PRINT :\
  153.         LINE.COUNT = LINE.COUNT + 1
  154.     PRINT    TAB(T4);CITY$;\
  155.         TAB(T5);ZIP$;\
  156.         TAB(T6);PHONE$;\
  157.         TAB(T7);COM$;\
  158.         TAB(T8);PAID$;\
  159.         TAB(T9);TYPE$
  160.     LINE.COUNT = LINE.COUNT + 1
  161.     IF INP(KB)=ABORT THEN 1490
  162.     IF LINE.COUNT < 60 THEN 1420
  163.     PRINT CHR$(12) :REM EJECT
  164.     GOTO 1410
  165.  
  166.     REM WAIT FOR KEY PRESSED OTHER THAN LINEFEED
  167. 1490    PRINT
  168. 1495    IF INP(KB)=LF THEN 1495
  169.     GOTO 100
  170. REM    SET REPORT OR LABEL WIDTH
  171. 1500    WIDTH = VAL(MID$(C$,7,99))
  172.     IF WIDTH > 24 THEN 100
  173.     PRINT "WIDTH TOO NARROW - SET TO 25"
  174.     WIDTH = 25
  175.     GOTO 100
  176.  
  177. REM    SET LABEL LENGTH
  178. 1550    LENGTH = VAL (MID$(C$,8,99))
  179.     IF LENGTH > 3 THEN 100
  180.     PRINT "LENGTH INVALID, SET TO 6"
  181.     LENGTH = 6
  182.     GOTO 100
  183.  
  184. REM    PRINT LABELS
  185. 1600    PRINT "PRESS LINEFEED"
  186.     IF INDEX.READ = 0 THEN 8700
  187. 1610    IF INP(KB)<>LF THEN 1610
  188.     REM READ 'UP' LABELS OR TAGS
  189. 1620    IF POSITION > INDEX.COUNT THEN 1690
  190.     IF INP(KB)<>LF THEN 1690
  191.     FOR I=1 TO UP
  192. 1621    IF POSITION > INDEX.COUNT THEN 1650
  193.     KEY = INDEX(POSITION)
  194.     POSITION = POSITION + 1
  195.     GOSUB 8800
  196.     IF C$="LABELS" THEN 1630
  197.     REM FORMAT NAME TAGS
  198.     REM DON'T PRINT FOR GROUPS OR MAGAZINES
  199.     IF TYPE$="G" THEN 1621
  200.     IF TYPE$="M" THEN 1621
  201.     FOR BLANK.POS = LEN(NAME$) TO 1 STEP -1
  202.     IF MID$(NAME$,BLANK.POS,1)=" " THEN 1624
  203. 1622    NEXT BLANK.POS
  204.     GOTO 1628
  205. 1624    IF MID$(NAME$+"  ",BLANK.POS+1,2)="JR" THEN 1622
  206.     IF BLANK.POS<4 THEN 1628
  207.     IF MID$(NAME$,BLANK.POS-2,2)="MC" THEN 1622
  208.     IF MID$(NAME$,BLANK.POS-3,3)="VAN" THEN 1622
  209.     IF MID$(NAME$,BLANK.POS-3,3)=" DE" THEN 1622
  210.     IF MID$(NAME$,BLANK.POS-3,3)=" LA" THEN 1622
  211.     IF MID$(NAME$,BLANK.POS-3,3)=" DI" THEN 1622
  212. 1628    LINE$(I,1)=""
  213.     IF BLANK.POS>1 THEN \
  214.         LINE$(I,1)=LEFT$(NAME$,BLANK.POS-1)
  215.     LINE$(I,2)=MID$(NAME$,BLANK.POS+1,99)
  216.     LINE$(I,3)=COM$
  217.     IF I=1 AND 0=LEN(COM$) THEN \
  218.         LINE$(1,3)="."
  219.     LINE$(I,4)=CITY$
  220.     GOTO 1640
  221. 1630    LINE$(I,1)=LEFT$(NAME$+SPACES$,25)+PAID$
  222.     LINE$(I,2)=ORGANIZATION$
  223.     LINE$(I,3)=STREET$
  224.     LINE$(I,4)=LEFT$(CITY$+SPACES$,24)+ZIP$
  225. 1640    NEXT I
  226.     REM PRINT THE LABELS
  227.     FOR LINE = 1 TO 4
  228.         WD=WIDTH
  229.         IF LINE < 4 AND C$="TAGS" THEN \
  230.             PRINT CHR$(14);:\
  231.             WD=.5+WIDTH/2
  232.         PRINT LINE$(1,LINE);TAB(WD);
  233.         PRINT LINE$(2,LINE);TAB(2*WD);
  234.         PRINT LINE$(3,LINE);
  235.         IF UP = 4 THEN \
  236.             PRINT TAB(3*WD);LINE$(4,LINE);
  237.         PRINT
  238.     NEXT LINE
  239.     IF LENGTH > 4 THEN \
  240.         FOR I=4 TO LENGTH-1 :\
  241.             PRINT :\
  242.         NEXT I
  243.     GOTO 1620
  244.     REM END OF FILE - PAD W/BLANK FIELDS
  245. 1650    NAME$=" "
  246.     PAID$=" "
  247.     ORGANIZATION$=" "
  248.     STREET$=" "
  249.     CITY$=" "
  250.     ZIP$=" "
  251.     GOTO 1630
  252.     REM END OF LABELS
  253. 1690    PRINT
  254. 1695    IF INP(KB)=LF THEN 1695
  255.     GOTO 100
  256.  
  257. REM    PRINT CONTENTS OF VARIABLES
  258. 1700    PRINT "WIDTH=";WIDTH
  259.     PRINT "LENGTH=";LENGTH
  260.     PRINT "POSITION=";POSITION
  261.     PRINT "INDEX HAS ";
  262.     IF INDEX.READ = 0 THEN \
  263.         PRINT "NOT ";
  264.     PRINT "BEEN READ."
  265.     PRINT "INDEX ENTRIES=";INDEX.COUNT
  266.     GOTO 100
  267. REM    SET 'N' UP LABELS
  268. 1800    UP = VAL(MID$(C$,4,99))
  269.     GOTO 100
  270.  
  271. REM    ERROR  - NO INDEX READ
  272. 8700    PRINT "NO INDEX READ"
  273.     GOTO 100
  274.  
  275. REM    PHYSICAL READ RECORD # IN KEY
  276. 8800    FILE.NO = 1+INT((KEY-1)/128)
  277.     READ #FILE.NO,KEY;FLAG
  278.     IF FLAG=0 THEN RETURN
  279.     READ #FILE.NO,KEY;\
  280.         FLAG,\
  281.         RECORD$(1),\
  282.         RECORD$(2),\
  283.         RECORD$(3),\
  284.         RECORD$(4),\
  285.         RECORD$(5),\
  286.         RECORD$(6),\
  287.         RECORD$(7),\
  288.         RECORD$(8),\
  289.         RECORD$(9),\
  290.         RECORD$(10)
  291. REM    SET VARIABLE NAMES FROM RECORD$(N)
  292. 8850    SORT$=RECORD$(1)
  293.     NAME$=RECORD$(2)
  294.     ORGANIZATION$=RECORD$(3)
  295.     STREET$=RECORD$(4)
  296.     CITY$=RECORD$(5)
  297.     ZIP$=RECORD$(6)
  298.     PHONE$=RECORD$(7)
  299.     COM$=RECORD$(8)
  300.     PAID$=RECORD$(9)
  301.     TYPE$=RECORD$(10)
  302.     RETURN
  303.  
  304. REM    EXTRACT FIELD NAME, VALUE FROM C$
  305.     REM FIND BLANK AFTER COMMAND
  306. 8910    FOR I=LEN(C$) TO 1 STEP -1
  307.     IF MID$(C$,I,1)=" " THEN \
  308.         BLANK.POS = I+1
  309.     NEXT I
  310.     C$=MID$(C$,BLANK.POS,99)
  311.     BLANK.POS = 0
  312.     REM FIND BLANK AFTER FIELD NAME
  313.     FOR I=LEN(C$) TO 1 STEP -1
  314.     IF MID$(C$,I,1)=" " THEN \
  315.         BLANK.POS=I-1
  316.     NEXT I
  317.     IF BLANK.POS=0 THEN 199
  318.     FIELD$=LEFT$(C$,BLANK.POS)
  319.     FIELD.NO = 0
  320.     FOR I=1 TO FIELD.COUNT
  321.     IF LEFT$(FIELD.NAME$(I),BLANK.POS)=FIELD$ THEN\
  322.         FIELD.NO = I
  323.     NEXT I
  324.     IF FIELD.NO=0 THEN\
  325.         PRINT "NO SUCH FIELD ";FIELD$:\
  326.         GOTO 100
  327.     FIELD.VALUE$=MID$(C$,BLANK.POS+2,99)
  328.     FIELD$=FIELD.NAME$(FIELD.NO)
  329.     RETURN
  330. REM    RECORD PRINT ROUTINE
  331. 9000    PRINT
  332.     PRINT "RECORD #";KEY;" ";RECORD$(1) :REM SORT
  333.     PRINT RECORD$(2) :REM NAME
  334.     PRINT RECORD$(3) :REM ORGANIZATION
  335.     PRINT RECORD$(4) :REM STREET
  336.     PRINT RECORD$(5);" ";RECORD$(6)
  337.     PRINT RECORD$(7);"/";\
  338.         RECORD$(8);";";\
  339.         RECORD$(9);";";\
  340.         RECORD$(10)
  341.     PRINT
  342.     RETURN
  343. 9999    END
  344.