home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug043.ark / A_P060.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  6.5 KB  |  189 lines
  1.     REMARK    ***********************************************\
  2.         *  A/P060.BAS ACCOUNTS PAYABLE CHECK WRITER   *\
  3.         *       6/18/79               5:15 PM         *\
  4.         ***********************************************
  5.  
  6.  
  7.     DIM W3$(7),W2(4),M$(5),P(6),W(5),G3(5),G2$(5),C(27),D(27),Y(2)
  8. %INCLUDE CURSOR
  9.     DATA "ONE","TWO","THREE","FOUR","FIVE","SIX","SEVEN"        REMARK    DATA TABLE USED IN CHECK AND DATE CALCULATIONS
  10.     DATA "EIGHT","NINE","TEN","ELEVEN","TWELVE"
  11.     DATA "THIRTEEN","FOURTEEN","FIFTEEN","SIXTEEN"
  12.     DATA "SEVENTEEN","EIGHTEEN","NINETEEN","TWENTY"
  13.     DATA "THIRTY","FORTY","FIFTY","SIXTY","SEVENTY"
  14.     DATA "EIGHTY","NINETY"
  15.     DATA "JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY"
  16.     DATA "AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"
  17.     GOTO 6000
  18. %INCLUDE SUBS1
  19. %INCLUDE GENINFO
  20. %INCLUDE BINSEARC
  21. %INCLUDE READVEND
  22. %INCLUDE A/P-INFO
  23.  
  24.  
  25.  
  26. 4000    A2=A1                                REMARK    ROUTINE TO GENERATE ENGLISH VERSION OF CHECK AMOUNT.\
  27.                                         AMOUNTS OVER $1000.00 PRINT ON FIRST LINE; BELOW THAT, ON THE SECOND.
  28.     IF A1<1000  THEN PRINT:GOTO 4070
  29. 4040    N1=INT(A1/100000)                        REMARK    HUNDRED-THOUSANDS
  30.     PRINT TAB(5);"**";
  31.     IF N1>99  THEN RETURN
  32.     IF N1<>0  THEN GOSUB 4160:PRINT "HUNDRED ";:A1=A1-N1*100000
  33. 4050    N1=INT(A1/1000)                            REMARK    THOUSANDS OF DOLLARS
  34.     IF N1<>0 THEN GOSUB 4160:A1=A1-N1*1000
  35.     PRINT "THOUSAND**"
  36. 4070    PRINT TAB(5);"**";                        REMARK    HUNDREDS  "   "   "
  37.     N1=INT(A1/100)
  38.     IF N1<>0 THEN GOSUB 4160:PRINT "HUNDRED ";:A1=A1-N1*100
  39. 4080    N1=INT(A1)                            REMARK    DOLLARS
  40.     IF N1<>0 THEN GOSUB 4160:PRINT "DOLLARS ";:GOTO 4110
  41.     IF INT(A2)>0 THEN PRINT "DOLLARS ";
  42. 4110    A1=A1-N1                            REMARK    CALCULATE CENTS
  43.     IF A2>=1  THEN PRINT "AND";
  44.     IF A1=0  THEN PRINT " NO "; \
  45.     ELSE PRINT A1*100;
  46.     PRINT "CENTS**";
  47.     RETURN 
  48.  
  49. 4160    IF N1 >= 21 THEN 4161                         REMARK    ROUTINE TO CONVERT AMOUNT IN N1 TO ENGLISH LANGUAGE
  50.     RESTORE
  51.     FOR I%=1 TO N1:READ X0$:NEXT I%:GOTO 4180
  52. 4161    RESTORE
  53.     FOR I%=1 TO INT(((N1-20)/10)+20)
  54.     READ X0$
  55.     NEXT I%
  56.     PRINT X0$;
  57.     A3=N1-INT(N1/10)*10
  58.     IF A3=0 THEN PRINT" ";: RETURN
  59.     PRINT "-";
  60.     RESTORE
  61.     FOR I%=1 TO A3
  62.     READ X0$
  63.     NEXT I%
  64. 4180    PRINT X0$;
  65.     PRINT " ";
  66.     RETURN 
  67.  
  68.  
  69. 4200    A1=A8:GOSUB 4400                        REMARK    PRINT BODY OF CHECK
  70.     A1=W5:GOSUB 4000                        REMARK    GENERATE ENGLISH CHECK AMOUNT
  71. 4240    PRINT TAB(65);
  72.     PRINT USING "**#######.##";W5                    REMARK    PRINT CHECK WITH ASTERISK FILL
  73.     PRINT:PRINT:PRINT:PRINT
  74. 4250    FOR I%=2 TO 5
  75.     PRINT TAB(12);M$(I%)                        REMARK    PRINT NAME/ADDRESS LINE OF PAYEE
  76.     NEXT I%
  77.     FOR I%=1 TO 9                            REMARK    PRINT LINE FEEDS TO CHECK STUB PORTION
  78.     PRINT
  79.     NEXT I%
  80.     RETURN 
  81. 4320    C6%=C6%+1                            REMARK    SKIP TO BOTTOM OF THE CURRENT CHECK STUB.\
  82.                                         IF LAST STUB PAGE, PRINT TOTALS.
  83.     FOR I%=1 TO 14-C8%
  84.     PRINT
  85.     NEXT I%
  86.     C8%=0
  87.     IF C5%=0  THEN PRINT TAB(15);"TOTAL";TAB(33);: \
  88.     PRINT USING MASKD$;W(1)+W(3)+W(4);W(2);: \
  89.     PRINT TAB(65);: \
  90.     PRINT USING MASKC$;W(5)
  91.     PRINT:PRINT
  92.     PRINT "   REG. NO.";W7;TAB(25);M$(2);TAB(53);"PAGE";C6%;"OF";C9%
  93.     PRINT CHR$(12)
  94.     RETURN 
  95. 4370    A1=A8:GOSUB 4400                        REMARK    ROUTINE TO PRINT A DUMMY CHECK FOR MULTI-PAGE CHECKS.
  96.     PRINT
  97.     PRINT TAB(5);L1$;TAB(65);L1$;L1$
  98.     PRINT:PRINT:PRINT:PRINT
  99.     GOTO 4250
  100. 4400    X1=INT(A1/10000)                        REMARK    PRINT DATE (STORED IN A1) IN ENGLISH, AND PRINT REGISTER #
  101.     X2=INT((A1-X1*10000)/100)
  102.     X3=INT(A1-(X1*100+X2)*100)
  103.     RESTORE
  104.     FOR I%=1 TO 27+X1
  105.     READ X0$
  106.     NEXT I%
  107.     PRINT TAB(70-LEN(X0$));X0$;X2;" ";X3
  108.     PRINT TAB(62);"REG. NO.";W7
  109.     RETURN 
  110. 6000    MASKA$="######"
  111.     MASKB$=" #######.##"
  112.     MASKC$="$$######.##"
  113.     MASKD$="$$######.## LESS $$####.## DISC"
  114.     IF END #3 THEN 6180                        REMARK    EXIT IF THE CHECK FILE IS EMPTY
  115.     OPEN "G/I0F010.DAT" AS 1,"A/P0F110.DAT" RECL 162 AS 2,\
  116.     "A/P0F030.DAT" RECL 86 AS 3, "A/P0F130.DAT" AS 4
  117.     Y9=1:GOSUB 700                            REMARK    READ GENERAL INFORMATION FILE
  118.     X0=4:GOSUB 3310                            REMARK    READ A/P INFORMATION FILE
  119.     RECORD.COUNT=AP.VENDFILE.EXTENT
  120.     Y9=2:Y2=Y9
  121. 6010    L1$="*VOID*"
  122.     CHECKS%=0
  123.     CONSOLE
  124. 6020    PRINT CLEAR.SCREEN$;"A/P CHECK WRITER"
  125.     PRINT:PRINT:PRINT:PRINT
  126.     PRINT "FIRST CHECK REG. #"
  127.     PRINT "LAST CHECK REG. #"
  128. 6025    X1=339:X2=6:X3=0:X4=999999:GOSUB 345                REMARK    ENTER FIRST REGISTER # TO PRINT
  129.     F=X0
  130.     IF F=0  THEN 6180
  131.     X1=403:X2=6:X3=F:X4=999999:GOSUB 345                REMARK    ENTER LAST REGISTER # TO PRINT
  132.     E=X0
  133.     X2=1:X3=0:X4=1:X2$="ENTRY CORRECT?":GOSUB 665            REMARK    ENTER '1' IF ENTRY OK; OTHERWISE, RE-PROMPT
  134.     IF X0=0 THEN 6025
  135.     IF END #3 THEN 6010
  136. 6050    CHECKS%=CHECKS%+1
  137.     READ #3,CHECKS%;W1$,W7,W5,A8,W9                    REMARK    READ CHECK HEADER RECORD
  138.     IF W7 > E THEN 6010                        REMARK    IF REGISTER # IS BEYOND RANGE, END PRINTING; RE-START
  139. 6060    IF W7 < F THEN CHECKS%=CHECKS%+W9:GOTO 6050            REMARK    IF REGISTER # IS BELOW RANGE, ADD DETAIL RECORD COUNT\
  140.                                         TO FILE POINTER AND GET NEXT CHECK HEADER.
  141. 6065    XYZ$=W1$+"      "
  142.     K$=LEFT$(XYZ$,6):GOSUB 1060                    REMARK    SEARCH VENDOR FILE
  143.     IF H=-1 OR VAR1=0 THEN \
  144.          M$(2)="*** VOID ***":M$(3)="":M$(4)="":M$(5)="":W5=0 \    REMARK    IF RECORD NOT FOUND, VOID THE CURRENT PAYEE & CHECK
  145.     ELSE X0=L:GOSUB 3200                        REMARK    IF FOUND, READ FROM A/P0F110.DAT
  146. 6080    CONSOLE
  147.     X1=768:GOSUB 210
  148.     PRINT "REG.  NUMBER";W7                        REMARK    PRINT CURRENT REGISTER #, PAYEE AND CHECK AMOUNT
  149.     PRINT M$(2);TAB(64)
  150.     PRINT "AMOUNT";
  151.     PRINT USING MASKB$;W5
  152.     LPRINTER
  153. 6100    GOSUB 4200                            REMARK    EXECUTE SUBROUTINE TO PRINT BODY OF CHECK
  154.     FOR I%=1 TO 5
  155.     W(I%)=0                                REMARK    ZERO OUT CHECK TOTALS
  156.     NEXT I%
  157.     C5%=W9
  158.     C8%=0:C6%=0
  159.     C9%=INT((W9-1)/6)+1                        REMARK    CALCULATE NUMBER OF PAGES AND DETAIL ITEMS TO PRINT\
  160.                                         ON NEXT PAGE OF CHECK STUB
  161. 6130    IF C5%<7  THEN C4%=C5%:C5%=0 \
  162.     ELSE C5%=C5%-6:C4%=6
  163. 6150    FOR B%=1 TO C4%
  164.     CHECKS%=CHECKS%+1
  165.     READ #3,CHECKS%; W2$,W1%,D8,W0,W2(1),W2(2),W2(3),W2(4)        REMARK    READ CHECK DETAIL RECORD
  166.     C8%=C8%+1
  167.     PRINT TAB(3);
  168.     X0=D8:GOSUB 680.5                        REMARK    PRINT INVOICE DATE ON DETAIL RECORD
  169.     PRINT TAB(15);
  170.     PRINT USING MASKA$;W0;                        REMARK    PRINT INVOICE NUMBER
  171.     PRINT TAB(25);W2$;TAB(35);                    REMARK    PRINT PURCHASE ORDER REFERENCE
  172.     IF W2(2) <> 0 THEN PRINT USING MASKD$;W2(1)+W2(3)+W2(4),W2(2);    REMARK    PRINT AMT, DISCOUNT (IF DISCOUNT <> 0) 
  173.     PRINT TAB(65);
  174.     PRINT USING MASKC$;W2(1)+W2(2)+W2(3)+W2(4);            REMARK    PRINT TOTAL AMOUNT
  175.     FOR I%=1TO 4
  176.     W(I%)=W(I%)+W2(I%)                        REMARK    ADD DETAIL AMOUNTS TO CHECK TOTAL
  177.     W(5)=W(5)+W2(I%)
  178.     NEXT I%
  179.     IF W1%=5  THEN PRINT " DB";                    REMARK    IF DEBIT MEMO, PRINT "DB"
  180.     IF W1%=4  THEN PRINT " CR";                    REMARK    IF CREDIT MEMO, PRINT "CR"
  181.     PRINT 
  182.     NEXT B%
  183.     GOSUB 4320
  184.     IF C5%=0  THEN 6050
  185.     GOSUB 4370                            REMARK    IF MORE PAGES TO PRINT, PRINT A DUMMY CHECK AND SKIP TO STUB
  186.     GOTO 6130
  187. 6180    PRINT CLEAR.SCREEN$;"A/P CHECK WRITER LOADING MENU"
  188.     CHAIN "A/P000"
  189.