home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug009.ark / GL6.ASC < prev    next >
Encoding:
Text File  |  1984-04-29  |  6.9 KB  |  163 lines
  1. 10  ' PROGRAM NAME "GL6"
  2. 20 ' PROGRAMMED BY:    BUD SHAMBURGER        NOVEMBER 1976
  3. 30 '                   #27 RED OAK DR
  4. 40 '                   CONWAY ARK  72032
  5. 50 '                   501-327-3641
  6. 60 '
  7. 70 ' A PROGRAM TO ENTER AND EDIT GENERAL LEDGER DAILY DEPOSIT
  8. 80 ' VOUCHERS FROM THE TERMINAL AND OUTPUT THEM TO DISK DR 1.
  9. 90 ' A SPECIAL PROGRAM UNIQUE TO CONWAY R.I.'S DAILY TRANSACTIONS.
  10. 100 ' IT GENERATES A FIXED SET OF LEDGER TRANSACTIONS, ASSIGNS THE
  11. 110 ' ACCOUNT NUMBERS, THE JOURNAL VOUCHER NUMBERS(BASED ON THE DATE)
  12. 120 ' SUPPLIES THE PROPER DESCRIPTION, DETERMINES WHICH ONES ARE
  13. 130 ' DEBITS AND CREDITS AND MAKES CERTAIN THAT THE
  14. 140 ' DEBITS AND CREDITS ARE EQUAL.  IT ALSO PRINTS A HARD COPY
  15. 150 ' OF THE TRANSACTIONS ON THE LINE PRINTER.
  16. 160 ' THE OPERATOR SUPPLIES ONLY THE DEBIT OR CREDIT MONEY AMT.
  17. 170 '
  18. 180 '*******************************************************************
  19. 190 '
  20. 200 CLEAR 1500
  21. 210 INPUT "ENTER -Y TO MOUNT THE FILE";WY$
  22. 220 IF WY$<>"Y" THEN 240
  23. 230 UNLOAD 1:MOUNT 1
  24. 240 DIM B$(100)     ' MATRIX FOR DATA FROM THE TERMINAL
  25. 250 DIM II(16)   ' SUBSCRIPT FOR TABLE IN RECORD 2037
  26. 260 R$="R":F=1:D=1:BK$=" ":ZER$="0000000"
  27. 270 GL$="LEDGER"
  28. 280 TY$="2"
  29. 290 PRINT "GENERAL LEDGER TRANSACTIONS"
  30. 300 PRINT
  31. 310 PRINT "DAILY DEPOSIT VOUCHERS"
  32. 320 INPUT "ENTER TRANSACTION MO-DY-YR";DT$
  33. 330 GD$=MID$(DT$,1,2)+MID$(DT$,7,2)  ' EXTRACT DATE FOR TABLE COMPARE
  34. 340 VDY$=MID$(DT$,4,2)           'EXTRACT DATE FOR ASSIGNING JNL VCHR #
  35. 350 VDY=VAL(VDY$)
  36. 360 MO$=MID$(DT$,1,2)+MID$(DT$,4,2):MO=VAL(MO$)
  37. 370 PRINT "ENTER -N- FOR NO TRANSACTION"
  38. 380 PRINT "ENTER -DONE- TO STOP"
  39. 390 OPEN R$,F,GL$,D      ' OPEN THE LEDGER FILE
  40. 400 A=2037               ' ADDRESS OF FILE TABLE
  41. 410 GET #1,A             ' GET TABLE
  42. 420 FOR II=1 TO 16
  43. 430 FIELD #1, (II-1)*8 AS D$, 8 AS D1$(II)
  44. 440 IF GD$=MID$(D1$(II),1,4) THEN 480 ' IS THIS THE PROPER MO AND YEAR E
  45. 450 NEXT II              ' GET NEXT TABLE ENTRY
  46. 460 PRINT "NO FILE ADDRESS IN TABLE"
  47. 470 STOP
  48. 480 REC$=MID$(D1$(II),5,4)
  49. 490 REC=VAL(REC$)   ' LOAD THE ADDRESS FOR THIS DATES FILE START
  50. 500 GET #1,REC      ' GET THE THE RECORD
  51. 510 IF VDY>31 THEN 1100    ' END OF THIS MONTHS VOUCHERS
  52. 520 '
  53. 530 ' ROUTINE FOR PROCESSING THE 16 LINES OF DATA FROM THE TERMINAL
  54. 540 '
  55. 550 FOR I=1 TO 16
  56. 560 PRINT "   TRANS ACCT VOCHR                     AMOUNT" 'TERMINAL HEA
  57. 570 PRINT "  MODYYR NMBR NUMBR DESCRIPTION....  $$$$$$.$$"
  58. 580 NUM$=STR$(MO):NUM$="V"+NUM$:IF MID$(NUM$,2,1)<"1" THEN
  59.     MID$(NUM$,2,1)="0"        ' CONSTRUCT VOUCHER NUMBER
  60. 590 '
  61. 600 ' ASSIGN THE JOURNAL ACCOUNT NUMBER AND DESCRIPTION
  62. 610 '
  63. 620 IF I=1 THEN ACC$="1110":DS$="BANK DEPOSIT    ":GOTO 820
  64. 630 IF I=2 THEN ACC$="1130":DS$="ACCTS REC       ":GOTO 820
  65. 640 IF I=3 THEN ACC$="1129":DS$="CITY LEDGER     ":GOTO 820
  66. 650 IF I=4 THEN ACC$="7400":DS$="CR CARD DISC    ":GOTO 820
  67. 660 IF I=5 THEN ACC$="7404":DS$="SHORT           ":GOTO 820
  68. 670 '
  69. 680 ' IF ITS A CREDIT ACCOUNT - TURN ON SWITCH 1
  70. 690 '
  71. 700 IF I=6 THEN ACC$="4100":DS$="ROOM RENT      -":SW=1:GOTO 820
  72. 710 IF I=7 THEN ACC$="4204":DS$="SALES TAX      -":SW=1:GOTO 820
  73. 720 IF I=8 THEN ACC$="4102":DS$="TELEPHONE      -":SW=1:GOTO 820
  74. 730 IF I=9 THEN ACC$="2134":DS$="DUE BOWENS     -":SW=1:GOTO 820
  75. 740 IF I=10 THEN ACC$="4302":DS$="NEWSSTAND      -":SW=1:GOTO 820
  76. 750 IF I=11 THEN ACC$="4101":DS$="MEETING ROOM   -":SW=1:GOTO 820
  77. 760 IF I=12 THEN ACC$="1130":DS$="ACCTS REC      -":SW=1:GOTO 820
  78. 770 IF I=13 THEN ACC$="1129":DS$="CITY LEDGER    -":SW=1:GOTO 820
  79. 780 IF I=14 THEN ACC$="1129":DS$="CR CARD DISC   -":SW=1:GOTO 820
  80. 790 IF I=15 THEN ACC$="4301":DS$="VALET          -":SW=1:GOTO 820
  81. 800 ACC$="7404":DS$="LONG           -":SW=1
  82. 810 '
  83. 820 A$=MID$(NUM$,2,4)+MID$(DT$,7,2)
  84.     +BK$+AC$+BK$+NUM$+BK$+DS$       ' CONSTRUCT TERMINAL LINE
  85. 830 PRINT "  ";A$     ' PRINT TERMINAL LINE
  86. 840 INPUT "                                   ";AA$ ' INPUT TER LINE
  87. 850 IF MID$(AA$,1,1)="N" THEN SW=0:GOTO 940 ' IS IT A NO TRANSACTION
  88. 860 IF MID$(AA$,1,4)="DONE" THEN 1190  ' IS IT END OF LAST VOUCHER
  89. 870 LT=LEN(AA$)
  90. 880 AB$=AA$
  91. 890 AA$=MID$(ZER$,1,10-LT)+AB$ ' ADD HIGH ORDER ZEROS TO MONEY FIELD
  92. 900 IF MID$(AA$,8,1)<>"." THEN 1240 ' EDIT THE MONEY FIELD
  93. 910 TT#=VAL(AA$)         ' COUNTER TO ZERO THE DEBITS AND CREDITS
  94. 920 IF SW=1 THEN T#=T#-TT#:SW=0:GOTO 940 ' IS IT A CREDIT-TURN OFF SW1
  95. 930 T#=T#+TT#                            ' ITS A DEBIT
  96. 940 A$=A$+AA$
  97. 950 LPRINT A$;SPC(5) USING "##";I ' PRINT HARD COPY AUDIT LIST
  98. 960 B$(I)=MID$(A$,1,6)+MID$(A$,8,4)+MID$(A$,13,5)+MID$(A$,19,16)
  99. 970 B$(I)=B$(I)+MID$(A$,35,10)+TY$    ' LOAD THE MATRIX WITH TRANSACTION
  100. 980 NEXT I                            ' GO PROCESS NEXT TRANSACTION
  101. 990 B$(17)="T"                        ' LOAD STOP CODE IN MATRIX
  102. 1000 PRINT SPC(32) USING "$#,###,###.##-";T# ' PRINT SUM OF DEBITS & CRE
  103. 1010 LPRINT SPC(30) USING "$#,###,###.##-";T#
  104. 1020 LPRINT
  105. 1030 B$(I)="T"
  106. 1040 IF T#<.01# AND T#>-.01# THEN IF T#<>-.01# THEN 1120' DR=CR GO PUT D
  107. 1050 PRINT "** ERROR ** DR<>CR - RE-ENTER VOUCHER";CHR$(7);CHR$(7)
  108. 1060 T#=0                ' CLEAR THE COUNTER
  109. 1070 GOTO 550
  110. 1080 VDY=VDY+1:MO=MO+1:GOTO 510  ' INCREMENT VOUCHER NUMBER WORK AREAS
  111. 1090 GOTO 510
  112. 1100 I=1:A$="L"
  113. 1110 GOTO 1370
  114. 1120 FOR I=1 TO 100
  115. 1130 T#=0
  116. 1140 IF B$(I)="T" THEN 1080'  END OF THIS TRANSACTION
  117. 1150 IF MID$(B$(I),32,1)="N" THEN 1170   ' SKIP-NO TRANSACTION
  118. 1160 GOSUB 1430       ' WRITE THIS TRANSACTION TO DISK FILE
  119. 1170 NEXT I        ' GET NEXT TRANSACTION
  120. 1180 PRINT "ERR-TOO MANY TRANSACTIONS":STOP
  121. 1190 LSW=1         ' LAST TRANSACTION SWITCH
  122. 1200 GOSUB 1430    ' WRITE LAST TRANSACTION TO DISK FILE
  123. 1210 CLOSE 1
  124. 1220 PRINT "EOJ"
  125. 1230 LOAD "GLMENU",0,R
  126. 1240 PRINT CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7);CHR$(7) 'ENTRY ERROR
  127. 1250 A$=ZZ$      ' CLEAR DATA AREA
  128. 1260 GOTO 820    ' GO RE-ENTER THE DATA
  129. 1270 CLOSE 1     ' TO CHANGE TO NEW DISK-CURRENT DISK FULL
  130. 1280 UNLOAD 1
  131. 1290 PRINT "CHANGE DISK #1"
  132. 1300 INPUT "ENTER -Y- TO CONT.";Y$
  133. 1310 IF Y$="Y" THEN 1330
  134. 1320 GOTO 1300
  135. 1330 MOUNT 1
  136. 1340 OPEN R$,F,GL$,D
  137. 1350 REC=1
  138. 1360 RETURN
  139. 1370 IF A$="L" THEN 1190'  LAST TRANSACTIONS TO PROCESS
  140. 1380 B$(I)=A$    ' TRANSFER DATA TO MATRIX
  141. 1390 GOTO 1000
  142. 1400 '
  143. 1410 ' GET THE NEXT AVAILABLE DISK SPACE
  144. 1420 '
  145. 1430 FOR M=1 TO 3
  146. 1440 FIELD #1, (M-1)*42 AS D$,42 AS D1$(M)
  147. 1450 IF WSW=1 AND MID$(B$(I),1,2)<>MID$(D1$(M),1,2) THEN 1530
  148. 1460 IF MID$(D1$(M),1,3)="EOF" THEN 1530 ' END OF LAST ENTRY TO FILE
  149. 1470 IF MID$(D1$(M),1,3)<"001" THEN 1530 ' IS THE AREA BLANK
  150. 1480 NEXT M
  151. 1490 REC=REC+1    ' INCREMENT THE DISK RECORD COUNTER
  152. 1500 IF REC=2037 THEN GOSUB 1270 ' IS THE DISK FULL
  153. 1510 GET #1,REC    ' GET THE NEXT DISK RECORD
  154. 1520 GOTO 1430
  155. 1530 IF LSW=1 THEN 1580  ' IS THIS THE LAST TRANSACTION
  156. 1540 WSW=1   ' TURN ON FIRST AVAILABLE SPACE SWITCH
  157. 1550 RSET D1$(M)=MID$(B$(I),1,42) ' TRANSFER MATRIX DATA TO DISK AREA
  158. 1560 PUT #1,REC                ' WRITE THE DISK RECORD
  159. 1570 RETURN
  160. 1580 LSET D1$(M)="EOF"      ' WRITE THE END OF FILE TRAILER RECORD
  161. 1590 GOTO 1560
  162. 1600 END
  163.