home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 176-200 / apd176 / dbm_sys / dbm-report.amos / dbm-report.amosSourceCode
AMOS Source Code  |  1991-03-11  |  8KB  |  275 lines
  1. '
  2. ' Database master Detailed Reports by Steve (05/02/91)   
  3. '
  4. FLD_SETUP:
  5. Screen Open 0,640,260,16,Hires
  6. 'Break Off 
  7. On Error Goto EROR
  8. Global FILENAME$,ICON$,DISK$,PIC$,REC_COUNT,PROGRAMS$
  9. '
  10. Open In 9,"DBM_SYS:DBMPROG.DAT"
  11. Input #9,DISK$
  12. Input #9,ACCOUNT$
  13. Close 9
  14. PROGRAMS$=DISK$+ACCOUNT$
  15. CHAIN_PROG$=PROGRAMS$+"DBM-MASTER.AMOS"
  16. Dim DBFN$(50)
  17. Dim DBFL$(50)
  18. Dim INFO$(50)
  19. Dim DBRPW$(50)
  20. Dim DBWPW$(50)
  21. BEGIN:
  22. Doke ADATA+38,22
  23. Curs Off 
  24. Paper 0
  25. Cls 
  26. Curs Off 
  27. Wind Open 1,1,1,79,5,1
  28. Paper 4 : Pen 3 : Clw 
  29. Locate 18,2 : Print "    D A T A B A S E  M A S T E R    "
  30. Wind Open 2,1,33,79,28,14
  31. Paper 6 : Pen 5 : Clw 
  32. '
  33. If Not Exist("RAM:DBMCHAIN.DAT")
  34.    Cls 
  35.    Print "Chain file missing return to main menu.  C/R to Recover."
  36.    Wait Key 
  37.    Goto EX_PROG
  38. End If 
  39. Open In 9,"RAM:DBMCHAIN.DAT"
  40. Input #9,FILENAME$
  41. Close 9
  42. '
  43. Open Out 9,"RAM:DBMLINK.DAT"
  44. Print #9,"By pass the select database option. Database - ";FILENAME$
  45. Close 9
  46. '
  47. Gosub OPEN_FILES
  48. '------------------------------------------------------------------------- 
  49. '
  50. ' Select printer or screen 
  51. '
  52. SEL_SCR:
  53. Clw : Pen 2 : Locate 27,1 : Print Border$("DETAILED PRINT",1) : Pen 5
  54. Pen 4 : Print At(20,5);" Please Select Option :         "
  55. Pen 5 : Print At(20,7);" 1. Print to Printer "
  56. Pen 5 : Print At(20,8);" 2. Print to Screen  "
  57. Pen 5 : Print At(20,9);" 3. Exit             "
  58. Pen 4 : Input At(44,5);SELECT$
  59. If Upper$(SELECT$)="1" Then Goto PRT_PRT
  60. If Upper$(SELECT$)="2" Then Goto SCR_PRT
  61. If Upper$(SELECT$)="3" Then Goto EX_PROG
  62. Goto SEL_SCR
  63. '
  64. '------------------------------------------------------------------------- 
  65. '
  66. ' Print to Screen
  67. '
  68. SCR_PRT:
  69. PRESS_KEY=0
  70. Pen 5 : Clw 
  71. Print "==================================================================="
  72. Print "DATABASE MASTER DETAIL PRINT FOR ";DBNAME$
  73. Print "==================================================================="
  74. PRESS_KEY=PRESS_KEY+3
  75. Pen 4
  76. For LP=1 To Val(IDXMAX$)
  77.    Get 4,LP
  78.    If Mid$(AIDX$,1,6)<>"]]]DEL"
  79.       Get 3,Val(RECIDX$)
  80.       INFO$(1)=A$
  81.       INFO$(2)=B$
  82.       INFO$(3)=C$
  83.       INFO$(4)=D$
  84.       INFO$(5)=E$
  85.       INFO$(6)=F$
  86.       INFO$(7)=G$
  87.       INFO$(8)=H$
  88.       INFO$(9)=I$
  89.       INFO$(10)=J$
  90.       INFO$(11)=K$
  91.       INFO$(12)=L$
  92.       INFO$(13)=M$
  93.       INFO$(14)=N$
  94.       INFO$(15)=O$
  95.       INFO$(16)=P$
  96.       INFO$(17)=Q$
  97.       INFO$(18)=R$
  98.       INFO$(19)=S$
  99.       INFO$(20)=T$
  100.       If PRESS_KEY+Val(FLD_USE$)=>21
  101.          Pen 5 : Print At(1,24);"C/R FOR NEXT PAGE" : Wait Key : Pen 4
  102.          PRESS_KEY=0 : Clw 
  103.       Pen 5 : Print "-------------------------------------------------------------------" : Pen 4
  104.       End If 
  105.       For LP5=1 To Val(FLD_USE$)
  106.          Inc PRESS_KEY
  107.          Print DBFN$(LP5);"  : ";INFO$(LP5)
  108.       Next LP5
  109.       Pen 5
  110.       Print "-------------------------------------------------------------------"
  111.       Pen 4
  112.    End If 
  113. Next LP
  114. '  
  115. Pen 5 : Print At(1,24);"C/R FOR PRINT MENU"
  116. Wait Key : Pen 4
  117. Print At(1,24);"                               "
  118. Goto SEL_SCR
  119. '
  120. '------------------------------------------------------------------------- 
  121. '
  122. ' Print to printer 
  123. '
  124. PRT_PRT:
  125. Clw : Pen 2 : Locate 27,1 : Print Border$("DETAILED PRINT",1) : Pen 5
  126. Pen 5 : Print At(20,5);" Printing - Please Wait "
  127. Print At(25,8);"Record : "
  128. PRESS_KEY=0
  129. Lprint "==================================================================="
  130. Lprint "DATABASE MASTER DETAIL PRINT FOR ";DBNAME$
  131. Lprint "==================================================================="
  132. PRESS_KEY=PRESS_KEY+3
  133. For LP=1 To Val(IDXMAX$)
  134. Pen 4 : Print At(34,8);LP
  135.    Get 4,LP
  136.    If Mid$(AIDX$,1,6)<>"]]]DEL"
  137.       Get 3,Val(RECIDX$)
  138.       INFO$(1)=A$
  139.       INFO$(2)=B$
  140.       INFO$(3)=C$
  141.       INFO$(4)=D$
  142.       INFO$(5)=E$
  143.       INFO$(6)=F$
  144.       INFO$(7)=G$
  145.       INFO$(8)=H$
  146.       INFO$(9)=I$
  147.       INFO$(10)=J$
  148.       INFO$(11)=K$
  149.       INFO$(12)=L$
  150.       INFO$(13)=M$
  151.       INFO$(14)=N$
  152.       INFO$(15)=O$
  153.       INFO$(16)=P$
  154.       INFO$(17)=Q$
  155.       INFO$(18)=R$
  156.       INFO$(19)=S$
  157.       INFO$(20)=T$
  158.       For LP5=1 To Val(FLD_USE$)
  159.          Inc PRESS_KEY
  160.          Lprint DBFN$(LP5);"  : ";INFO$(LP5)
  161.       Next LP5
  162.       Lprint "-------------------------------------------------------------------"
  163.    End If 
  164. Next LP
  165. '  
  166. Pen 5 : Print At(1,23);"PRINT COMPLETE - C/R FOR PRINT MENU"
  167. Wait Key : Pen 4
  168. Print At(1,23);"                                          "
  169. Goto SEL_SCR
  170. '========================================================================
  171. '
  172. OPEN_FILES:
  173. '
  174. 'open header file
  175. '
  176. FILNAM$=FILENAME$
  177. Open Random 1,FILNAM$
  178. Field 1,30 As DBNAME$,6 As DBUSE$,6 As DBDEL$,2 As SYSSEARCH$,8 As CREATEDATE$,6 As COUNT$,6 As MENU1PW$,6 As MENU2PW$,6 As MENU3PW$,6 As MENU4PW$,6 As MENU5PW$,6 As IDXMAX$,2 As FLD_USE$,8 As DBM_VERSION$
  179. If NEW_DB$="Y"
  180.    DBUSE$="000000" : DBDEL$="000000" : IDXMAX$="000000"
  181.    DBNAME$=THE_NAME$
  182.    FLD_USE$=Str$(REC_COUNT)
  183.    SYSSEARCH$="1" : CREATEDATE$="12/10/90" : COUNT$="1" : DBM_VERSION$="2.0(100)"
  184.    Put 1,1
  185. End If 
  186. Get 1,1
  187. '
  188. 'open field file 
  189. '
  190. FILNAM$=FILENAME$+"F"
  191. Open Random 2,FILNAM$
  192. Field 2,20 As FLDN$,3 As FLDL$,10 As FLRPW$,10 As FLWPW$,21 As FLFILLER$
  193. For LP=1 To 50
  194.    Get 2,LP
  195.    DBFN$(LP)=FLDN$
  196.    DBFL$(LP)=FLDL$
  197.    DBRPW$(LP)=FLRPW$
  198.    DBWPW$(LP)=FLWPW$
  199. Next LP
  200. For LP=1 To 50
  201.    If DBFL$(LP)="" : DBFL$(LP)="1" : End If 
  202. Next LP
  203. A=Val(DBFL$(1))
  204. B=Val(DBFL$(2))
  205. C=Val(DBFL$(3))
  206. D=Val(DBFL$(4))
  207. E=Val(DBFL$(5))
  208. F=Val(DBFL$(6))
  209. G=Val(DBFL$(7))
  210. H=Val(DBFL$(8))
  211. I=Val(DBFL$(9))
  212. J=Val(DBFL$(10))
  213. K=Val(DBFL$(11))
  214. L=Val(DBFL$(12))
  215. M=Val(DBFL$(13))
  216. N=Val(DBFL$(14))
  217. O=Val(DBFL$(15))
  218. P=Val(DBFL$(16))
  219. Q=Val(DBFL$(17))
  220. R=Val(DBFL$(18))
  221. S=Val(DBFL$(19))
  222. T=Val(DBFL$(20))
  223. '
  224. ' open data file 
  225. '
  226. FILNAM$=FILENAME$+"D"
  227. Open Random 3,FILNAM$
  228. Field 3,A As A$,B As B$,C As C$,D As D$,E As E$,F As F$,G As G$,H As H$,I As I$,J As J$,K As K$,L As L$,M As M$,N As N$,O As O$,P As P$,Q As Q$,R As R$,S As S$,T As T$
  229. '
  230. 'Open Index file 
  231. '
  232. If Val(SYSSEARCH$)=1 : STORE$=A$ : STORE_VALUE=A : End If 
  233. If Val(SYSSEARCH$)=2 : STORE$=B$ : STORE_VALUE=B : End If 
  234. If Val(SYSSEARCH$)=3 : STORE$=C$ : STORE_VALUE=C : End If 
  235. If Val(SYSSEARCH$)=4 : STORE$=D$ : STORE_VALUE=D : End If 
  236. If Val(SYSSEARCH$)=5 : STORE$=E$ : STORE_VALUE=E : End If 
  237. If Val(SYSSEARCH$)=6 : STORE$=F$ : STORE_VALUE=F : End If 
  238. If Val(SYSSEARCH$)=7 : STORE$=G$ : STORE_VALUE=G : End If 
  239. If Val(SYSSEARCH$)=8 : STORE$=H$ : STORE_VALUE=H : End If 
  240. If Val(SYSSEARCH$)=9 : STORE$=I$ : STORE_VALUE=I : End If 
  241. If Val(SYSSEARCH$)=10 : STORE$=J$ : STORE_VALUE=J : End If 
  242. If Val(SYSSEARCH$)=11 : STORE$=K$ : STORE_VALUE=K : End If 
  243. If Val(SYSSEARCH$)=12 : STORE$=L$ : STORE_VALUE=L : End If 
  244. If Val(SYSSEARCH$)=13 : STORE$=M$ : STORE_VALUE=M : End If 
  245. If Val(SYSSEARCH$)=14 : STORE$=N$ : STORE_VALUE=N : End If 
  246. If Val(SYSSEARCH$)=15 : STORE$=O$ : STORE_VALUE=O : End If 
  247. If Val(SYSSEARCH$)=16 : STORE$=P$ : STORE_VALUE=P : End If 
  248. If Val(SYSSEARCH$)=17 : STORE$=Q$ : STORE_VALUE=Q : End If 
  249. If Val(SYSSEARCH$)=18 : STORE$=R$ : STORE_VALUE=R : End If 
  250. If Val(SYSSEARCH$)=19 : STORE$=S$ : STORE_VALUE=S : End If 
  251. If Val(SYSSEARCH$)=20 : STORE$=T$ : STORE_VALUE=T : End If 
  252. If Val(SYSSEARCH$)<1 or Val(SYSSEARCH$)>20 : STORE$=A$ : STORE_VALUE=A : End If 
  253. FILNAM$=FILENAME$+"I"
  254. Open Random 4,FILNAM$
  255. Field 4,6 As RECIDX$,STORE_VALUE As AIDX$
  256. '
  257. ' open and write to chain file 
  258. '
  259. Open Out 9,"RAM:DBMCHAIN.DAT"
  260. Print #9,FILENAME$
  261. Close 9
  262. '
  263. Return 
  264. '======================================================================= 
  265. '
  266. EROR:
  267. Cls 
  268. Print "ERROR! Return to main program - C/R to Recover."
  269. Wait Key 
  270. If Exist("RAM:DBMLINK.DAT") Then Kill "RAM:DBMLINK.DAT"
  271. '
  272. EX_PROG:
  273. Print At(1,23);"Loading Menu, Please Wait....."
  274. Close 
  275. Run CHAIN_PROG$