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