home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol136 / checkdel.bas < prev    next >
Encoding:
BASIC Source File  |  1986-12-15  |  7.6 KB  |  159 lines
  1. 4000 COLOR 7,0: REM ****************************************************************************************************
  2. 4010 REM                 "CHECKDEL" SUBROUTINE TO DELETE A PAYEE FROM FILE #1 AND FILE #2 RECORDS
  3. 4020 REM  **************************************************************************************************************
  4. 4030 GOSUB 260   'OPEN FILES #1,#2,#3
  5. 4040 WIDTH "LPT1:",132
  6. 4041 PRINT: PRINT IN$;"  Does your printer require condensed"
  7. 4042 PRINT IN$;"  character printing mode to print 132"
  8. 4043 PRINT IN$;"  characters per line?  Reply Y or N"
  9. 4044 C$ = INKEY$: IF C$ = "" THEN GOTO 4044
  10. 4045 IF C$ = "N" OR C$ = "n" THEN GOTO 4050
  11. 4046 IF C$ = "Y" OR C$ = "y" THEN GOTO 4048
  12. 4047 PRINT IN$;"  I need a Y or N.  Retry": GOTO 4044
  13. 4048 LPRINT CHR$(15);   'TURN ON CONDENSED CHARACTER PRINT MODE
  14. 4050 PAGENO% = 0  'INITIALIZE TO ZERO
  15. 4060 LINECT% = 0  'INITIALIZE TO ZERO
  16. 4070 GOSUB 5380  'PRINT REPORT HEADING
  17. 4080 GOSUB 300   'GET REQUESTED FILE #1 AND FILE #2 RECORDS
  18. 4090 IF ASC(F1$)<>255 THEN GOTO 4140
  19. 4100     COLOR 31,0: PRINT "  This Payee Record not in use. Retry."
  20. 4110     PRINT "  Press any key to continue."
  21. 4120     IF INKEY$ = "" THEN GOTO 4120
  22. 4130     COLOR 7,0: GOTO 4080
  23. 4140 PRINT: PRINT: PRINT "  You are deleting Payee ";P1$
  24. 4150 PRINT "  at record address ";REC%
  25. 4160 PRINT "  Name: ";A1$
  26. 4170 COLOR 0,7: PRINT "  Are you sure? Reply Y or N ";
  27. 4180 C$ = INKEY$: IF C$="" THEN 4180
  28. 4190 PRINT C$: COLOR 7,0: IF C$="N" OR C$="n" THEN GOTO 4080
  29. 4200 IF C$="Y" OR C$="y" THEN GOTO 4250
  30. 4210 COLOR 31,0: PRINT "  I need a Y or N, retry":  GOTO 4180
  31. 4220 REM  **************************************************************************************************************
  32. 4230 REM                        WRITE FILE #1 AUDIT TRAIL RECORD TO ACTIVITY LOG FILE
  33. 4240 REM  **************************************************************************************************************
  34. 4250 TC$ = "20"
  35. 4260 CN% = 0
  36. 4270 AC$ = SPACE$(1)
  37. 4280 TD$ = SPACE$(8)
  38. 4290 PA% = REC%
  39. 4300 PC$ = P1$
  40. 4310 PA$ = A1$
  41. 4320 TAMT = 0
  42. 4330 LACTM% = 0
  43. 4340 LACTS% = 0
  44. 4350 LAMT = 0
  45. 4360 BDIW = 0
  46. 4370 BAMT = 0
  47. 4380 GOSUB 310
  48. 4390 REM  **************************************************************************************************************
  49. 4400 REM                           INITIALIZE FILE #1 RECORD AS AN AVAILABLE RECORD
  50. 4410 REM  **************************************************************************************************************
  51. 4420 LSET F1$=CHR$(255)
  52. 4430 LSET P1$=SPACE$(4)
  53. 4440 PUT #1,REC%
  54. 4450 PDTODATE# = 0
  55. 4460 GOSUB 270  'MOVE FILE #2 TO ARRAY
  56. 4470 LPRINT TAB(2);P2$;" ";REC%;TAB(16);A1$;TAB(48);G1$;SPC(5);
  57. 4480 FOR K = 1 TO 8
  58. 4490     IF CHEK1%(K) = 0 THEN GOTO 5050
  59. 4500     LPRINT USING "####";CHEK1%(K);
  60. 4510     LPRINT SPC(5);CHEK2$(K);SPC(4);CHEK3$(K);
  61. 4520     LPRINT USING "  #####,.##";CHEK4(K)
  62. 4530     REM  **********************************************************************************************************
  63. 4540     REM                     WRITE FILE #2 AUDIT TRAIL RECORD TO ACTIVITY LOG FILE
  64. 4550     REM  **********************************************************************************************************
  65. 4560     TC$ = "21"
  66. 4570     CN% = CHEK1%(K)
  67. 4580     AC$ = CHEK2$(K)
  68. 4590     TD$ = CHEK3$(K)
  69. 4600     PA% = REC%
  70. 4610     PC$ = P2$
  71. 4620     PA$ = A1$
  72. 4630     TAMT = CHEK4(K)
  73. 4640     LACTM% = 0
  74. 4650     LACTS% = 0
  75. 4660     LAMT = 0
  76. 4670     BDIW = 0
  77. 4680     BAMT = 0
  78. 4690     IF BOOKS$="Y" THEN GOTO 4750
  79. 4700     GOSUB 310  'EXECUTED ONLY IF NOT USING THE SIMPLE BOOKKEEPING SYSTEM OPTION
  80. 4710     GOTO 5020
  81. 4720     REM  **********************************************************************************************************
  82. 4730     REM         DISTRIBUTE THE 'DELETE' TRANSACTION AMOUNT TO THE SIMPLE BOOKKEEPING SYSTEM ACCOUNTS
  83. 4740     REM  **********************************************************************************************************
  84. 4750     T = CHEK4(K)
  85. 4760     CLS
  86. 4770     PRINT "  Enter Account Numbers and Amounts"
  87. 4780     PRINT "  For BOOKKEEPING SYSTEM"
  88. 4790     PRINT: PRINT USING "    Transaction Amount is: #####,.##-";T
  89. 4800     PRINT: PRINT "  Enter the following:"
  90. 4810     COLOR 0,7: PRINT SPC(10);"Major Account #: ";: Y = CSRLIN: X = POS(0)
  91. 4820     FIELDMAX% = 4: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 320
  92. 4830     IF DATU$ = "" THEN GOTO 4810
  93. 4840     IF LEN(DATU$)<>4 THEN PRINT "  Account is a 4 digit code, retry.": GOTO 4810
  94. 4850     LACTM% = VAL(DATU$)
  95. 4860     IF LACTM% = 0 THEN COLOR 31,0: PRINT NOTNUM$: GOTO 4810
  96. 4870     PRINT: COLOR 0,7: PRINT SPC(12);"Record Number: ";: Y = CSRLIN: X = POS(0)
  97. 4880     FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 320
  98. 4890     IF DATU$ = "" THEN GOTO 4870
  99. 4900     LACTS% = VAL(DATU$)
  100. 4910     IF LACTS% > 0 AND LACTS% < (M10% + M11% + 1) THEN GOTO 4930
  101. 4920         COLOR 31,0: PRINT "  Enter a valid Record Number": GOTO 4870
  102. 4930     COLOR 0,7: PRINT "  Amount for this Account: ";: Y = CSRLIN: X = POS(0)
  103. 4940     FIELDMAX% = 9: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 320
  104. 4950     IF DATU$ = "" THEN GOTO 4930
  105. 4960     LAMT = VAL(DATU$)
  106. 4970     LOCATE Y,X+1: COLOR 0,7: PRINT USING "#####.##-";LAMT: COLOR 7,0
  107. 4980     GOSUB 310  'WRITE AUDIT TRAIL RECORD
  108. 4990     T = T - LAMT
  109. 5000     IF ABS(T) > (8.999999E-03) THEN TAMT=0:  PRINT USING "  Undistributed amount is: #####,.##-";T:  GOTO 4800
  110. 5010     REM  ----------------------------------------------------------------------------------------------------------
  111. 5020     IF CHEK2$(K)<>"V" THEN PDTODATE# = PDTODATE# + CHEK4(K)
  112. 5030     LINECT% = LINECT% + 1
  113. 5040     IF LINECT% > 60 THEN GOSUB 5380  'PRINT REPORT HEADING
  114. 5050     LPRINT TAB(54);
  115. 5060 NEXT K
  116. 5070 FOR K = 1 TO 8
  117. 5080     CHEK1%(K) = 0
  118. 5090     CHEK2$(K) = SPACE$(1)
  119. 5100     CHEK3$(K) = SPACE$(8)
  120. 5110     CHEK4(K) = 0
  121. 5120 NEXT K
  122. 5130 GOSUB 280  'MOVE ARRAY FIELDS TO FILE #2
  123. 5140 LSET P2$ = SPACE$(4)
  124. 5150 LSET F2$ = CHR$(255)
  125. 5160 CHANE% = CVI(L$)
  126. 5170 LSET L$ = MKI$(0)  'INITIALIZE CHAIN ADDRESS TO ZERO
  127. 5180 PUT #2,REC%
  128. 5190 REC% = CHANE%
  129. 5200 IF REC% = 0 THEN GOTO 5250
  130. 5210 GET #2,REC%  'GET CHAINED RECORD
  131. 5220 LPRINT TAB(54);
  132. 5230 GOSUB 270  'MOVE FILE #2 TO ARRAY
  133. 5240 GOTO 4480
  134. 5250 LPRINT TAB(69);"TOTAL";TAB(77);
  135. 5260 LPRINT USING "######,.##";PDTODATE#
  136. 5270 LPRINT
  137. 5280 PDTODATE# = 0
  138. 5290 PRINT: COLOR 0,7: PRINT "  Do you wish to delete another Payee?"
  139. 5300 PRINT "  Reply Y or N ";
  140. 5310 C$ = INKEY$: IF C$ = "" THEN 5310
  141. 5320 PRINT C$: COLOR 7,0: IF C$="Y" OR C$="y" THEN GOTO 4080
  142. 5330 IF C$="N" OR C$="n" THEN CLOSE: LPRINT CHR$(18);: GOTO 250   'RETURN TO JOB CHOICES MENU
  143. 5340 COLOR 31,0: PRINT "  I need a Y or N, retry ";:  GOTO 5310
  144. 5350 REM  **************************************************************************************************************
  145. 5360 REM                SUBROUTINE TO PRINT REPORT HEADING OF PAYEES DELETED FROM DISKETTE FILES
  146. 5370 REM  **************************************************************************************************************
  147. 5380 IF PAGENO%<>0 THEN LPRINT CHR$(12)  'SKIP TO NEXT PAGE
  148. 5390 PAGENO% = PAGENO% + 1
  149. 5400 LPRINT CHR$(14);SPC(14);"DELETED PAYEES AS OF ";
  150. 5410 LPRINT DATE$;SPC(6);"PAGE ";
  151. 5420 LPRINT USING "###";PAGENO%
  152. 5430 LPRINT: LPRINT TAB(48);"TAX   CHECK  STATUS  ISSUE"
  153. 5440 LPRINT TAB(6);"CODES";TAB(23);"PAYEE NAME";TAB(47);"CODE  NUMBER   CODE    DATE    AMOUNT"
  154. 5450 LPRINT
  155. 5460 LINECT% = 5
  156. 5470 RETURN
  157. 5480 REM  --------------------------------------------------------------------------------------------------------------
  158. 9000 GOTO 9000  'CHAIN MERGE AREA LAST STATEMENT
  159. -------------------------------------------------