home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / database / creator.lbr / REPORTOR.OZL / REPORTOR.OVL
Text File  |  1987-10-25  |  9KB  |  113 lines
  1. 1 'REPORTOR; WRITTEN ON 1/16/80 BY BRUCE W. TONKIN
  2. 20 'ADAPTED FOR CP/M AND MICROSOFT BASIC 5.01 ON 5/11/80
  3. 30 'FOR 4.51 ON 3/18/81, AND FOR MODEL III ON 2/20/83, FOR CP/M AND MBASIC 4.51/5.2+ AGAIN ON 3/23/83; FOR 48K CP/M WITH OVERLAYS ON 7/2/83; THIS IS THE OVERLAY
  4. 35 'THIS IS PUBLIC DOMAIN SOFTWARE AND MAY NOT BE SOLD OR INCORPORATED IN ANY COMMERCIAL SOFTWARE WITHOUT THE EXPRESS PERMISSION OF THE AUTHOR
  5. 50 GOTO 1570
  6. 60 FX=0:IF LEN(CV$)<1 THEN RETURN
  7. 70 FOR II=1 TO LEN(CV$):CV%=ASC(MID$(CV$,II,1)):IF CV%=34 THEN FX=ABS(FX-1)
  8. 80 IF FX=0 AND CV%>90 THEN CV%=CV% AND 95:MID$(CV$,II,1)=CHR$(CV%)
  9. 90 NEXT:RETURN
  10. 1570 PRINT CLS$;"Now we must describe what goes into the columns of the report.":PRINT"You should write sentences of the following form:"
  11. 1580 PRINT"Column name=FIELD(9)"
  12. 1590 PRINT"Column name=FIELD$(5)"
  13. 1600 PRINT"IF Column.name.1=Column.name.2 THEN Column.name.3=";Q$;"SAME";Q$
  14. 1610 PRINT"V1=Name1/Name2:V2=100*V1:Name3=V2"
  15. 1620 PRINT"IF Name1=";Q$;"OVERDUE";Q$;" THEN SKIP"
  16. 1630 PRINT"IF Name2<1 THEN SKIP"
  17. 1640 PRINT"Please note that you should use the HEADING NAMES as your":PRINT"variables. Variables beginning with the letter V are work":PRINT"variables. You may issue a number of commands on one line, if":PRINT"you separate them with a colon (:)"
  18. 1650 PRINT"Also, note the quotation marks around string constants,":PRINT"and the $ sign used for string fields.":PRINT"DEPRESS ANY KEY FOR MORE INFORMATION: ";
  19. 1660 CV$=INKEY$:IF CV$="" THEN 1660
  20. 1670 PRINT:PRINT"YOU MAY USE THE FOLLOWING VARIABLE NAMES:"
  21. 1680 FOR I=1 TO B:PRINT C$(I),:NEXT:PRINT:PRINT"TYPE 999 TO EXIT."
  22. 1690 PRINT"READY FOR YOUR COMMAND: ";
  23. 1700 LINE INPUT SX$:IF VAL(SX$)=999 THEN 2050
  24. 1710 FOR I=1 TO B:J=C%(I)
  25. 1720 F1%=INSTR(SX$,C$(J)):IF F1%<1 THEN 1790
  26. 1730 J$=MID$(STR$(J),2):I$=MID$(STR$(I),2):IF MID$(M$,J,1)="S" THEN F1$="C$(":ELSE F1$="C#("
  27. 1740 F1$=F1$+J$+")":GOSUB 5000:GOTO 1720
  28. 1790 NEXT
  29. 1800 F1%=INSTR(SX$,"FIELD"):IF F1%<1 THEN 1850
  30. 1810 IF F1%=1 THEN PRINT"FIELDS CANNOT BE RE-DEFINED.":GOTO 1690
  31. 1815 F2%=INSTR(F1%,SX$,"("):F3%=INSTR(F1%,SX$,"$"):F4%=INSTR(F1%,SX$,"#"):IF (F4%=0 OR F4%>F2%) AND (F3%=0 OR F3%>F2%) THEN SY$="#":ELSE SY$=""
  32. 1820 SX$=LEFT$(SX$,F1%-1)+"P"+SY$+MID$(SX$,F1%+5):GOTO 1800
  33. 1850 PRINT"I interpret your command to be:":PRINT SX$:PRINT"Is this correct (Y/N)? ";
  34. 1860 CV$=INKEY$:IF CV$="" THEN 1860:ELSE GOSUB 60:PRINT CV$:IF INSTR("YN",CV$)<1 THEN 1850
  35. 1870 IF CV$="N" THEN PRINT"INSTRUCTION DELETED.":GOTO 1690
  36. 1880 F1%=INSTR(SX$,"SKIP"):IF F1%>1 THEN SX$=LEFT$(SX$,F1%-1)+"19000"+MID$(SX$,F1%+4):GOTO 1880
  37. 1890 LN=LN+10:PRINT #1,LN;SX$:GOTO 1670
  38. 2050 LN=LN+10:PRINT #1,LN;"FOR J=1 TO ";B;":T#(J)=T#(J)+C#(J):NEXT"
  39. 2052 GOTO 2310
  40. 2055 PRINT CLS$;"All right. Now we need to define the column print formats.":PRINT"I will ask you to tell me if a column will contain letters or":PRINT"numbers. If a column contains numbers, but those numbers come"
  41. 2060 PRINT"from an unpacked field, and are not used as numbers (for ":PRINT"example, phone numbers or ID numbers), then that column should":PRINT"be formatted as if it were LETTERS. On the other hand, a "
  42. 2070 PRINT"column containing the result of a computation, or a column":PRINT"containing numbers coming from a PACKED numeric field should":PRINT"be formatted as NUMBERS. If you do not tell me the correct"
  43. 2080 PRINT"format, your report will contain zeros or blanks."
  44. 2090 DIM CF$(B):FOR I=1 TO B
  45. 2100 PRINT"COLUMN NAME: ";C$(I);": NUMBERS OR LETTERS (N/L)? ";
  46. 2110 CV$=INKEY$:IF CV$="" THEN 2110:ELSE GOSUB 60:PRINT CV$:IF INSTR("NL",CV$)<1 THEN 2100
  47. 2120 IF CV$<>"L" THEN 2200
  48. 2130 PRINT"How many characters might be printed in this column";:INPUT FX:IF FX<1 OR FX>255 THEN PRINT"Invalid!":GOTO 2130
  49. 2140 IF FX=1 THEN CF$(I)="!":ELSE CF$(I)="\"+STRING$(FX-2,32)+"\"
  50. 2150 GOTO 2300
  51. 2200 PRINT"How many digits will be printed to the LEFT of the decimal";:INPUT FX:IF FX<0 OR FX>16 THEN PRINT"Illegal!":GOTO 2200
  52. 2210 CF$(I)=STRING$(FX,"#")
  53. 2212 IF FX<4 THEN 2220:ELSE PRINT"Do you want the number printed with commas (Y/N)? ";:
  54. 2214 CV$=INKEY$:IF CV$="" THEN 2214:ELSE GOSUB 60:PRINT CV$:IF INSTR("YN",CV$)<1 THEN 2212
  55. 2216 IF CV$="Y" THEN CF$(I)=CF$(I)+","
  56. 2220 PRINT"How many digits will be printed to the RIGHT of the decimal";:INPUT FX:IF FX<0 OR FX>16 THEN PRINT"Illegal!":GOTO 2220
  57. 2230 IF FX THEN CF$(I)=CF$(I)+"."+STRING$(FX,"#")
  58. 2235 IF CF$(I)="" THEN PRINT"ILLEGAL FORMAT!":GOTO 2200
  59. 2300 IF INSTR(CF$(I),"#") THEN MID$(M$,I,1)="M":ELSE MID$(M$,I,1)="S"
  60. 2301 NEXT
  61. 2305 CHAIN"REPORTOR.BAS",1030,ALL
  62. 2310 FOR I=1 TO B:PRINT #1,40000!+I;"CF$(";MID$(STR$(I),2);")=";Q$;CF$(I);Q$:NEXT
  63. 2320 PRINT #1,"56 M$=";Q$;M$;Q$;":'FIELD TYPES - S = STRING, M =MULTIPLE PRECISION"
  64. 2325 PRINT CLS$;"How many columns wide is the paper or screen the report will":PRINT"be printed on";:INPUT FX:IF FX<1 OR FX>255 THEN PRINT"Illegal!":GOTO 2325
  65. 2330 LN=LN+10:PRINT #1,LN;"IF L=0 AND PD$<>";Q$;"S";Q$;" THEN LPRINT CHR$(12);TAB(";(FX-LEN(T$))/2;");TI$";:IF LP<1 THEN PRINT #1," ":ELSE PRINT #1,";TAB(";FX-15;");";Q$;"PAGE NUMBER";Q$;";PG"
  66. 2335 LN=LN+10:PRINT #1,LN;"IF L=0 AND PD$<>";Q$;"P";Q$;" THEN PRINT CHR$(12);TAB(";(FX-LEN(T$))/2;");TI$";:IF LP<1 THEN PRINT #1," ":ELSE PRINT #1,";TAB(";FX-15;");";Q$;"PAGE NUMBER";Q$;";PG"
  67. 2350 LN=LN+10:PRINT #1,LN;"IF L=0 THEN GOSUB 31000"
  68. 2360 PRINT #1,"31006 FOR J=1 TO ";B:LN=LN+10:PRINT #1,LN;"FOR J=1 TO ";B
  69. 2370 LN=LN+10:PRINT #1,LN;"READ T:IF PD$=";Q$;"P";Q$;" THEN ";LN+30
  70. 2380 LN=LN+10:PRINT #1,LN;"IF MID$(M$,J,1)=";Q$;"S";Q$;" THEN PRINT TAB(T);:PRINT USING CF$(J);C$(J);"
  71. 2390 LN=LN+10:PRINT #1,LN;"IF MID$(M$,J,1)=";Q$;"M";Q$;" THEN PRINT TAB(T);:PRINT USING CF$(J);C#(J);"
  72. 2400 LN=LN+10:PRINT #1,LN;"IF PD$=";Q$;"S";Q$;" THEN ";LN+30
  73. 2402 LN=LN+10:PRINT #1,LN;"IF MID$(M$,J,1)=";Q$;"S";Q$;" THEN LPRINT TAB(T);:LPRINT USING CF$(J);C$(J);"
  74. 2404 LN=LN+10:PRINT #1,LN;"IF MID$(M$,J,1)=";Q$;"M";Q$;" THEN LPRINT TAB(T);:LPRINT USING CF$(J);C#(J);"
  75. 2406 LN=LN+10:PRINT #1,LN;"NEXT:RESTORE:IF PD$<>";Q$;"S";Q$;" THEN LPRINT:ELSE PRINT"
  76. 2408 LN=LN+10:PRINT #1,LN;"L=L+1";:IF LP THEN PRINT #1,":IF L>";LP;" THEN PG=PG+1:L=0":ELSE PRINT #1,":'LINE COUNTER"
  77. 2410 LN=19000:PRINT #1,LN;"NEXT"
  78. 2412 IF RL<256 THEN PRINT #1,KZ;"GET 1,I:IF ZU$=STRING$(";RL;",255) OR ZU$=STRING$(";RL;",250) THEN ";LN:ELSE PRINT #1,KZ;"GET 1,I:IF ZU$=STRING$(255,250) OR ZU$=STRING$(255,255) THEN ";LN
  79. 2414 IF RL<256 THEN PRINT #1,"30801 FIELD #1,";RL;"AS ZU$":ELSE PRINT #1,"30801 FIELD #1,255 AS ZU$"
  80. 2416 PRINT CLS$;"Have you saved any totals you want printed at the end of your":PRINT"report (Y/N)? ";
  81. 2418 CV$=INKEY$:IF CV$="" THEN 2418:ELSE GOSUB 60:PRINT CV$:IF INSTR("YN",CV$)<1 THEN PRINT"ILLEGAL!":GOTO 2418
  82. 2420 IF CV$="N" THEN PRINT #1,"20000 CLOSE:END":GOTO 2630
  83. 2430 PRINT CLS$;"Then you must tell me which variables to print in which columns":PRINT"of your report. Please be careful here: you CANNOT print":PRINT"strings in numeric columns, or vice-versa!"
  84. 2440 PRINT"You may use the BASIC operations +, *, /, and - (and others)":PRINT"if you wish. As a default, just hit the enter key: I will":PRINT"print the grand total for a column, using the same print"
  85. 2450 PRINT"format as the previous data in that column.":LN=20000
  86. 2451 PRINT #1,LN;"IF PD$<>";Q$;"S";Q$;" THEN LPRINT":LN=LN+10:PRINT #1,LN;"IF PD$<>";Q$;"P";Q$;" THEN PRINT"
  87. 2454 PRINT"If you want to use the totals in your computations, the totals":PRINT"are stored in the variable array T#(X), where X is the column":PRINT"number. Feel free to use these totals in computations."
  88. 2455 FOR I=1 TO B
  89. 2460 PRINT"COLUMN NAME: ";C$(I);": DEFAULT IS ";
  90. 2470 IF MID$(M$,I,1)="S" THEN PRINT"BLANK":ELSE PRINT"T#(";I;")":PRINT"COLUMN PRINT FORMAT IS:";CF$(I)
  91. 2480 PRINT"What should I print in this column: ";:LINE INPUT CV$
  92. 2485 IF CV$<=STRING$(LEN(CV$),32) THEN CV$=""
  93. 2490 IF CV$="" THEN IF MID$(M$,I,1)="S" THEN CV$=Q$+Q$
  94. 2500 IF CV$="" THEN IF MID$(M$,I,1)="M" THEN CV$="T#("+MID$(STR$(I),2)+")"
  95. 2510 LN=LN+10:PRINT #1,LN;"READ T:IF PD$<>";Q$;"S";Q$;" THEN LPRINT TAB(T);:LPRINT USING CF$(";MID$(STR$(I),2);");";CV$;";"
  96. 2520 LN=LN+10:PRINT #1,LN;"IF PD$<>";Q$;"P";Q$;" THEN PRINT TAB(T);:PRINT USING CF$(";MID$(STR$(I),2);");";CV$;";"
  97. 2530 NEXT:LN=LN+10:PRINT #1,LN;"IF PD$<>";Q$;"S";Q$;" THEN LPRINT CHR$(12)":LN=LN+10:PRINT #1,LN;"IF PD$<>";Q$;"P";Q$;" THEN PRINT:PRINT";Q$;"END OF REPORT";Q$
  98. 2540 LN=LN+10:PRINT #1,LN;"CLOSE:END"
  99. 2630 OPEN"I",2,"R451.LIB"
  100. 2631 ON ERROR GOTO 2635
  101. 2632 LINE INPUT #2,A$:PRINT #1,A$:GOTO 2631
  102. 2635 PRINT #1,"3 RESET"
  103. 2636 PRINT CLS$;"Your report program has been written. You may run it any time.":PRINT"If you wish, you may load your program, then re-save it: this":PRINT"will decrease subsequent program load times."
  104. 2639 CLOSE:END
  105. 2640 'ERROR HANDLER
  106. 2675 PRINT"ERROR NUMBER";ERR;"AT LINE";ERL;":PROGRAM ABORTED.":ON ERROR GOTO 0
  107. 2680 CLOSE:END
  108. 4999 'REPLACE A STRING WITH ANOTHER
  109. 5000 IF F1%=1 THEN SX$=F1$+MID$(SX$,LEN(C$(J))+1):RETURN
  110. 5010 SX$=LEFT$(SX$,F1%-1)+F1$+MID$(SX$,F1%+LEN(C$(J))):RETURN
  111. THER
  112. 5000 IF F1%=1 THEN SX$=F1$+MID$(SX$,LEN(C$(J))+1):RETURN
  113. 5010 SX$