home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG009.ARK / GL1.ASC < prev    next >
Text File  |  1984-04-29  |  6KB  |  192 lines
  1. 10 ' PROGRAM NAME "GL1"
  2. 490 CLEAR 1500
  3. 500 INPUT "ENTER -Y TO MOUNT THE FILE";WY$
  4. 510 IF WY$<>"Y" THEN 530
  5. 520 UNLOAD 1:MOUNT 1
  6. 530 DIM B$(100)  ' MATRIX FOR TRANSACTIONS
  7. 535 DIM II(16)
  8. 540 R$="R":F=1:D=1:BK$=" ":ZER$=" "
  9. 550 GL$="LEDGER"
  10. 560 PRINT "ENTER GENERAL LEDGER TRANSACTIONS"
  11. 570 PRINT
  12. 610 PRINT "ENTER -1- FOR HEADERS & BAL FWDS"
  13. 620 PRINT "ENTER -2- FOR CHECK TRANSACTIONS"
  14. 630 PRINT "ENTER -3- FOR VOUCHER TRANSACTIONS"
  15. 640 INPUT TY$
  16. 690 INPUT "ENTER -U- FOR UNBALANCED ENTRIES";U$
  17. 700 IF TY$="3" THEN TY$="2":T$="V":GOTO 730
  18. 710 IF TY$="2" THEN T$="C":GOTO 730
  19. 720 IF TY$="1" THEN 730 ELSE 690
  20. 730 INPUT "ENTER TRANSACTION MO & YR AS - MOYR";GD$
  21. 740 PRINT "100 ENTRIES MAX PER CHECK OR VOUCHER"
  22. 750 PRINT "ENTER -T- TO TOTAL TRANSACTIONS"
  23. 760 PRINT "ENTER -L- FOR LAST TRANSACTION" ' ALL TRANSACTIONS ENTERED
  24. 770 OPEN R$,F,GL$,D  ' OPEN LEDGER FILE
  25. 780 A=2037           ' GET TABLE TO DETERMINE FILE START
  26. 790 GET #1,A
  27. 800 FOR II=1 TO 16    ' SEARCH(TABLE FOR CORRECT MONTH & YEAR
  28. 810 FIELD #1, (II-1)*8 AS D$, 8 AS D1$(II)
  29. 820 IF GD$=MID$(D1$(II),1,4) THEN 860  ' THIS IS CORRECT MONTH & YEAR
  30. 830 NEXT II
  31. 840 PRINT "NO FILE ADDRESS IN TABLE"
  32. 850 GOTO 850
  33. 860 REC$=MID$(D1$(II),5,4)  ' LOAD FILE ADDRESS FROM TABLE
  34. 870 REC=VAL(REC$)
  35. 880 GET #1,REC              ' GET FIRST RECORD
  36. 890 IF TY$="1" THEN 1970    ' IS IT A BALANCE FORWARD RECORD
  37. 900 '
  38. 910 ' ****** SET UP TERMINAL HEADINGS FOR TERMINAL INPUT ******
  39. 920 '
  40. 930 T#=0                  ' COUNTER FOR DEBITS & CREDITS
  41. 940 H1$="   TRANS ACCT C/V                      AMOUNT"
  42. 950 H2$="  MODYYR NUMB NUMB DESCRIPTION....-$$$.$$$.$$"
  43. 960 S1=0                  ' RE-SET ERROR SWITCH
  44. 970 I=1
  45. 980 FOR I=1 TO 100'   FILE ENTRIES - 100 - MAX
  46. 990 PRINT H1$
  47. 1000 PRINT H2$
  48. 1010 INPUT A$        ' DATA INPUT LINE
  49. 1020 '
  50. 1030 '****** EDIT DATA ENTERED FOR ERRORS ******
  51. 1040 '
  52. 1050 IF MID$(A$,1,1)="T" THEN 1300 ' TO TOTAL CHECK OR VOUCHER
  53. 1060 IF MID$(A$,1,1)="L" THEN 1300 ' LAST ENTRY MADE
  54. 1070 IF MID$(A$,(LEN(A$)))="/" THEN 990
  55. 1080 IF MID$(A$,1,2)<"01" OR MID$(A$,1,2)>"13" THEN 1800
  56. 1090 IF MID$(A$,3,2)<"01" OR MID$(A$,3,2)>"31" THEN 1800
  57. 1100 IF MID$(A$,5,2)<"76" THEN 1800
  58. 1110 IF MID$(A$,7,1)>="1" THEN 1800
  59. 1120 IF MID$(A$,12,1)>="1" THEN 1800
  60. 1130 IF TY$="1" THEN 2030
  61. 1140 IF MID$(A$,17,1)>="1" THEN 1800
  62. 1150 IF MID$(A$,33,1)="-" THEN 1180
  63. 1160 IF MID$(A$,33,1)<"1" THEN 1180
  64. 1170 GOTO 1800
  65. 1180 IF MID$(A$,37,1)="." THEN 1210
  66. 1190 IF MID$(A$,37,1)<"1" THEN 1210
  67. 1200 GOTO 1800
  68. 1210 IF MID$(A$,41,1)<>"." THEN 1800
  69. 1220 '
  70. 1230 '****** CHECK FOR HIGHEST POSSIBLE ACCOUNT NUMBER ******
  71. 1240 '
  72. 1250 IF MID$(A$,8,4)>"7904" OR MID$(A$,8,4)<"1000" THEN 1800
  73. 1260 '
  74. 1270 IF LEN(A$)<>43 THEN 1800
  75. 1280 L=L+1
  76. 1290 LPRINT A$;SPC(5) USING "##";L  ' PRINT OUT LINE NUMBER
  77. 1300 IF A$="T" OR A$="L" THEN 1910
  78. 1310 IF TY$="1" THEN 2190
  79. 1320 '
  80. 1330 '****** LOAD MATRIX - CHECK AND VOUCHERS ******
  81. 1340 '
  82. 1350 B$(I)=MID$(A$,1,6)+MID$(A$,8,4)+T$+MID$(A$,13,4)
  83. 1360 B$(I)=B$(I)+MID$(A$,18,16)+ZER$+MID$(A$,34,3)
  84. 1370 B$(I)=B$(I)+MID$(A$,38,3)+MID$(A$,41,3)+TY$
  85. 1380 C$=MID$(A$,33,4)+MID$(A$,38,3)+MID$(A$,41,3)
  86. 1390 TT#=VAL(C$)
  87. 1400 T#=T#+TT#
  88. 1410 IF S1=1 THEN 1450    ' CHECK ERROR SWITCH
  89. 1420 NEXT I
  90. 1430 PRINT "ERROR TO MANY TRANSACTIONS";CHR$(7);CHR$(7);CHR$(7);CHR$(7)
  91. 1440 GOTO 490
  92. 1450 PRINT SPC(32) USING "$#,###,###.##-";T# ' PRINT OUT TOTAL DEBITS & 
  93. 1460 LPRINT SPC(30) USING "$#,###,###.##-";T#
  94. 1470 LPRINT
  95. 1480 L=0
  96. 1490 IF U$="U" THEN T#=0:GOTO 1660
  97. 1500 IF T#<.01# AND T#>-.01# THEN 1660' DR = CR GO TO PUT DISK
  98. 1510 '
  99. 1520 '****** OPTIONAL LINE CORRECTION ROUTINE ******
  100. 1530 '****** LINE PRINTER NECESSARY                 ******
  101. 1540 '
  102. 1550 PRINT "TO RE-START, GOTO RUN"
  103. 1560 INPUT "*** ERROR *** DR<>CR-ENTER ERROR LINE #";LN
  104. 1570 I=LN
  105. 1580 S1=1                 ' TURN ERROR SWITCH ON
  106. 1590 E$=MID$(B$(I),31,11)
  107. 1600 TT#=VAL(E$)
  108. 1610 T#=T#-TT#
  109. 1620 GOTO 1010
  110. 1630 '
  111. 1640 '****** PROCESS AND WRITE OUT THIS TRANSACTION ******
  112. 1650 '
  113. 1660 FOR I=1 TO 100
  114. 1670 T#=0
  115. 1680 IF B$(I)="T" THEN 890'  END OF THIS TRANSACTION
  116. 1690 GOSUB 2270
  117. 1700 NEXT I
  118. 1710 GOTO 1430
  119. 1720 LSW=1                ' TURN LAST RECORD SWITCH ON
  120. 1730 GOSUB 2270           ' GO PROCESS LAST RECORD
  121. 1740 CLOSE 1              ' CLOSE LEDGER FILE
  122. 1750 PRINT "EOJ"          ' PRINT END OF JOB MESSAGE
  123. 1760 LOAD "GLMENU",0,R
  124. 1770 '
  125. 1780 ' ****** DATA ENTRY ERROR - RE-ENTER DATA ******
  126. 1790 '
  127. 1800 PRINT CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7)
  128. 1810 A$=ZZ$               ' CLEAR INPUT AREA TO BLANKS
  129. 1820 GOTO 990
  130. 1830 '
  131. 1840 '
  132. 1850 CLOSE 1
  133. 1860 UNLOAD 1
  134. 1870 PRINT "END OF DISK ERROR. THIS SHOULD NEVER OCCUR USING THIS"
  135. 1880 PRINT "PROGRAM.  GL2 CHECKS TO MAKE SURE THERE IS ALWAYS ROOM"
  136. 1890 PRINT "FOR A ENTIRE MONTHS FILE."
  137. 1900 STOP
  138. 1910 IF A$="L" THEN 1720'  LAST TRANSACTIONS TO PROCESS
  139. 1920 B$(I)=A$
  140. 1930 GOTO 1450
  141. 1940 '
  142. 1950 '****** SET UP TERMINAL LINE FOR ACCOUNT HEADER ******
  143. 1960 '
  144. 1970   H1$="   TRANS ACCT                          AMOUNT "
  145. 1980   H2$="  MODYYR NUMB ACCOUNT HEADER......-$.$$$.$$$.$$"
  146. 1990 GOTO 960
  147. 2000 '
  148. 2010 '****** EDIT BALANCE FORWARD - ACCOUNT HEADER ENTRIES ******
  149. 2020 '
  150. 2030 IF MID$(A$,33,1)="-" THEN 2060
  151. 2040 IF MID$(A$,33,1)<"1" THEN 2060
  152. 2050 GOTO 1800
  153. 2060 IF MID$(A$,35,1)="." THEN 2090
  154. 2070 IF MID$(A$,35,1)<"1" THEN 2090
  155. 2080 GOTO 1800
  156. 2090 IF MID$(A$,39,1)="." THEN 2120
  157. 2100 IF MID$(A$,39,1)<"1" THEN 2120
  158. 2110 GOTO 1800
  159. 2120 IF MID$(A$,43,1)<>"." THEN 1800
  160. 2130 IF MID$(A$,8,4)>"7904" OR MID$(A$,8,4)<"1000" THEN 1800
  161. 2140 IF LEN(A$)<>45 THEN 1800
  162. 2150 GOTO 1280
  163. 2160 '
  164. 2170 '****** LOAD MATRIX - BALANCE FORWARD-ACCOUNT HEADERS ******
  165. 2180 '
  166. 2190 B$(I)=MID$(A$,1,6)+MID$(A$,8,4)+MID$(A$,13,20)
  167. 2200 B$(I)=B$(I)+MID$(A$,33,2)+MID$(A$,36,3)+MID$(A$,40,6)
  168. 2210 B$(I)=B$(I)+TY$
  169. 2220 C$=(MID$(A$,33,2))+(MID$(A$,36,3))+(MID$(A$,40,6))
  170. 2230 GOTO 1390
  171. 2240 '
  172. 2250 '****** LOAD DISK OUTPUT AREA ******
  173. 2260 '
  174. 2270 FOR M=1 TO 3
  175. 2280 FIELD #1, (M-1)*42 AS D$,42 AS D1$(M)
  176. 2330 IF WSW=1 AND MID$(B$(I),1,2)<>MID$(D1$(M),1,2) THEN 2410
  177. 2340 IF MID$(D1$(M),1,3)="EOF" THEN 2410 
  178. 2350 IF MID$(D1$(M),1,3)<"001" THEN 2410 
  179. 2360 NEXT M
  180. 2370 REC=REC+1              
  181. 2380 IF REC=2027 THEN 1850  
  182. 2390 GET #1,REC             
  183. 2400 GOTO 2270
  184. 2410 IF LSW=1 THEN 2460  
  185. 2420 WSW=1            
  186. 2430 RSET D1$(M)=MID$(B$(I),1,42)
  187. 2440 PUT #1,REC        
  188. 2450 RETURN
  189. 2460 LSET D1$(M)="EOF"  
  190. 2470 GOTO 2440
  191. 2480 END
  192.