home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / DBMS9108.ZIP / ACCOUNT2.AUG < prev    next >
Encoding:
Text File  |  1991-06-13  |  8.1 KB  |  207 lines
  1.  
  2. Listing 2
  3.         
  4. 0001:     PROCEDURE gethdr
  5. 0002:      * Procedure to get or modify the transaction header
  6. 0003:      * The transaction number is assign for new transactions only
  7. 0004:      * by incrementing the last transaction.  This technique would
  8. 0005:      * not be suitable to a multi-user application.
  9. 0006:      * This procedure will also set up and call the engine if the
  10. 0007:      * transaction is accepted.
  11. 0008:        IF c_new_rec
  12. 0009:           GO BOTTOM
  13. 0010:           tran_no = tranhdr->Tran_No + 1
  14. 0011:           tran_desc = SPACE(LEN(tranhdr->Tran_Desc))
  15. 0012:           tran_amt = 0 
  16. 0013:        ELSE
  17. 0014:           tran_no = tranhdr->Tran_No
  18. 0015:           tran_desc = tranhdr->Tran_Desc
  19. 0016:           tran_amt = tranhdr->Tran_Amt
  20. 0017:        ENDIF
  21. 0018:        SET COLOR TO &vid_nrml
  22. 0019:        @  5,0 CLEAR
  23. 0020:        @  5,5 TO 11,74 DOUBLE      
  24. 0021:        @  6,10 SAY  "Transaction Number"
  25. 0022:        @  8,17 SAY  "Description"
  26. 0023:        @ 10,22 SAY  "Amount"
  27. 0024:        SET COLOR TO &vid_bright
  28. 0025:        @ 6,30  SAY  m->tran_no PICTURE "###"  
  29. 0026:        SET COLOR TO &vid_rvrs
  30. 0027:        @ 23,0 SAY "Press Esc to return to menu"
  31. 0028:        SET COLOR TO &vid_nrml
  32. 0029:        c_amc = 2
  33. 0030:        DO WHILE c_amc = 2
  34. 0031:           @ 8,30 GET m->tran_desc
  35. 0032:           @ 10,30 GET m->tran_amt PICTURE "999999.99 "
  36. 0033:           READ
  37. 0034:           key_press = keypress()
  38. 0035:           IF key_press = 12    && Escape
  39. 0036:              RETURN
  40. 0037:           ENDIF
  41. 0038:           DO qamc WITH IIF(c_new_rec,2,1) && Add record as displayed or 
  42. 0039:                                           && Save record with changes
  43. 0040:        ENDDO
  44. 0041:        IF c_amc = 1
  45. 0042:           SELECT tranhdr
  46. 0043:           IF c_new_rec
  47. 0044:              APPEND BLANK
  48. 0045:              REPLACE Tran_No WITH m->tran_no
  49. 0046:           ENDIF
  50. 0047:           REPLACE Tran_Desc WITH m->tran_desc, ;
  51. 0048:                   Tran_Amt WITH m->tran_amt
  52. 0049:           SET SAFETY OFF
  53. 0050:           SELECT Dstrwork
  54. 0051:           IF c_new_rec
  55. 0052:              ZAP
  56. 0053:              rmng_2_bal = tranhdr->Tran_Amt
  57. 0054:           ELSE
  58. 0055:              USE
  59. 0056:              SELECT trandstr
  60. 0057:              SET DELETED ON
  61. 0058:              COPY TO Dstrwork FOR Tran_No = tranhdr->Tran_No
  62. 0059:              SELECT 3
  63. 0060:              USE Dstrwork
  64. 0061:              rmng_2_bal = tranhdr->Tran_Amt - tranhdr->Dstr_Total
  65. 0062:           ENDIF
  66. 0063:           SET SAFETY ON
  67. 0064:         * Scope memory variables for distribution
  68. 0065:           STORE SPACE(LEN(trandstr->Dstr_To)) TO dstr_to
  69. 0066:           STORE 0 TO dstr_amt
  70. 0067:         * Assign procedures for engine       
  71. 0068:           zd_screen  = "DO dstrscn"
  72. 0069:           zd_display = "DO dstrdsp"
  73. 0070:           zd_init    = "DO dstrinit"
  74. 0071:           zd_get     = "DO dstrget"
  75. 0072:           zd_append  = "DO dstrapp"
  76. 0073:           zd_modify  = "DO dstrmod"
  77. 0074:           zd_insert  = "DO dstrins"
  78. 0075:           zd_delete  = "DO dstrdel"
  79. 0076:           zd_file    = "DO dstrfile"
  80. 0077:           zd_alias   = "dstrwork"
  81. 0078:         * Call the engine
  82. 0079:           DO zerodstr WITH (rmng_2_bal)
  83. 0080:        ENDIF
  84. 0081:     RETURN         
  85. 0082:     
  86. 0083:     PROCEDURE dstrscn          
  87. 0084:      * Paint screen for distribution
  88. 0085:      * this procedure name is assigned to variable zd_screen
  89. 0086:        SELECT Dstrwork 
  90. 0087:        @ 12,0  CLEAR 
  91. 0088:        @ 12,5 TO 20,74 DOUBLE      
  92. 0089:        @ 15,6 TO 15,73 
  93. 0090:        @ 15,5 SAY CHR(199)
  94. 0091:        @ 15,74 SAY CHR(182)
  95. 0092:        @ 13,11 SAY "Distribution Item"
  96. 0093:        @ 13,37 SAY "of"
  97. 0094:        @ 14,8  SAY "Remaining to Balance"
  98. 0095:        @ 16,15 SAY "Distribute to"
  99. 0096:        @ 18,22 SAY "Amount"
  100. 0097:        SET COLOR TO &vid_bright
  101. 0098:        @ 13,31 SAY cur_item PICTURE "9999"
  102. 0099:        @ 13,40 SAY last_item PICTURE "9999"
  103. 0100:        @ 14,31 SAY rmng_2_bal PICTURE "999,999.99"
  104. 0101:        SET COLOR TO &vid_nrml
  105. 0102:     RETURN
  106. 0103:     
  107. 0104:     PROCEDURE dstrdsp          
  108. 0105:      * Display current distibution item
  109. 0106:      * this procedure name is assigned to variable zd_dsp
  110. 0107:        SET COLOR TO &vid_bright
  111. 0108:        @ 13,31 SAY cur_item PICTURE "9999"
  112. 0109:        @ 13,40 SAY last_item PICTURE "9999"
  113. 0110:        @ 14,31 SAY rmng_2_bal PICTURE "999,999.99"
  114. 0111:        @ 16,31 SAY Dstrwork->Dstr_To
  115. 0112:        @ 18,31 SAY Dstrwork->Dstr_Amt PICTURE "999,999.99"
  116. 0113:        SET COLOR TO &vid_nrml
  117. 0114:     RETURN
  118. 0115:     
  119. 0116:     PROCEDURE dstrinit         
  120. 0117:      * Initialize memory variables to get an item
  121. 0118:      * this procedure name is assigned to variable zd_init
  122. 0119:        dstr_to = Dstrwork->Dstr_To
  123. 0120:        dstr_amt = IIF(c_new_rec,rmng_2_bal,Dstrwork->Dstr_Amt)
  124. 0121:     RETURN
  125. 0122:     
  126. 0123:     PROCEDURE dstrget
  127. 0124:      * Get and read
  128. 0125:      * this procedure name is assigned to variable zd_get
  129. 0126:        @ 16,31 GET m->dstr_to PICTURE REPLICATE("!",LEN(m->dstr_to))
  130. 0127:        @ 18,31 GET m->dstr_amt PICTURE "999999.99 "
  131. 0128:        READ
  132. 0129:     RETURN
  133. 0130:     
  134. 0131:     PROCEDURE dstrapp
  135. 0132:      * Append item to Dstrwork
  136. 0133:      * this procedure name is assigned to variable zd_append
  137. 0134:        SELECT Dstrwork
  138. 0135:        APPEND BLANK
  139. 0136:        rmng_2_bal = m->rmng_2_bal - m->dstr_amt
  140. 0137:        finished = (rmng_2_bal = 0.)
  141. 0138:        DO dstrrepl
  142. 0139:     RETURN
  143. 0140:     
  144. 0141:     PROCEDURE dstrmod
  145. 0142:      * Modify item in Dstrwork
  146. 0143:      * this procedure name is assigned to variable zd_modify
  147. 0144:      * Update rmng_2_bal with difference between old and new values, 
  148. 0145:      * and do it before the replace !!
  149. 0146:        rmng_2_bal = m->rmng_2_bal - m->dstr_amt + Dstrwork->dstr_amt
  150. 0147:        DO dstrrepl
  151. 0148:     RETURN
  152. 0149:     
  153. 0150:     PROCEDURE dstrins         
  154. 0151:      * Insert item in front of current item
  155. 0152:      * this procedure name is assigned to variable zd_insert
  156. 0153:        SELECT Dstrwork
  157. 0154:        INSERT BLANK BEFORE
  158. 0155:        rmng_2_bal = m->rmng_2_bal - m->dstr_amt
  159. 0156:        DO dstrrepl
  160. 0157:     RETURN
  161. 0158:     
  162. 0159:     PROCEDURE dstrrepl
  163. 0160:      * Replace database fields with value of corresponding memory variables
  164. 0161:      * This procedure name IS NOT assigned to a zd_ variable, but it is 
  165. 0162:      * called by procedures dstrapp, dstrmod, and dstrins, and keeps the
  166. 0163:      * writes to the database fields in a single procedure
  167. 0164:        REPLACE Dstr_To WITH m->dstr_to, Dstr_Amt WITH m->dstr_amt
  168. 0165:     RETURN
  169. 0166:        
  170. 0167:     PROCEDURE dstrdel
  171. 0168:      * Delete item from Dstrwork
  172. 0169:      * this procedure name is assigned to variable zd_delete
  173. 0170:      * DELETE and PACK statements are in calling procedure
  174. 0171:      * only need to adjust rmng_2_bal
  175. 0172:        SELECT Dstrwork 
  176. 0173:        rmng_2_bal = rmng_2_bal + Dstrwork->dstr_amt
  177. 0174:     RETURN
  178. 0175:     
  179. 0176:     PROCEDURE dstrfile
  180. 0177:      * Distribution has been accepted - write it to permanent files.
  181. 0178:      * this procedure name is assigned to variable zd_file
  182. 0179:      * If we are modifying a previous transaction, we need to delete the
  183. 0180:      * the old distribution if the field tranhdr->Dstr_Count is non-zero.
  184. 0181:      * After the new distribution is saved, ZAP the workfile.
  185. 0182:        SELECT Dstrwork
  186. 0183:        PACK
  187. 0184:        REPLACE tran_no WITH tranhdr->Tran_No FOR .T.
  188. 0185:        USE
  189. 0186:        SET DELETED ON
  190. 0187:        SELECT trandstr
  191. 0188:        IF tranhdr->dstr_count <> 0
  192. 0189:           LOCATE FOR Tran_No = tranhdr->Tran_No      && not using an index in
  193. this sample
  194. 0190:           DELETE WHILE trandstr->Tran_No = tranhdr->Tran_No
  195. 0191:        ENDIF
  196. 0192:        APPEND FROM Dstrwork
  197. 0193:        SELECT tranhdr
  198. 0194:        REPLACE dstr_count WITH last_item, dstr_total WITH tran_amt -
  199. rmng_2_bal
  200. 0195:        SELECT 3
  201. 0196:        SET SAFETY OFF
  202. 0197:        USE Dstrwork
  203. 0198:        ZAP
  204. 0199:        SET SAFETY ON
  205. 0200:     RETURN
  206.           
  207.