image of READY prompt

Wang2200.org

Listing of file='ACPA060A' on disk='vmedia/701-2654C.wvd.zip'

# Sector 277, program filename = 'ACPA060A'
0010 REM ACPA060A, RELEASE 2.3, (12/11/80) THIS PROGRAM IS A COPYRIGHT PRODUCT
      OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0020 REM PROGRAM NAME      = ACPA060A
0030 REM RELEASE NUMBER    = 01
0040 REM REVISION NUMBER   = 00
0050 REM DATE WRITTEN      = 01/09/79
0055 REM REVISION DATE     = 12/10/80  MAF
0056 REM THIS PROGRAM WAS UPGRADED TO 2.2 BY ERRATA 1161
0057 REM THIS PROGRAM WAS UPGRADED TO 2.3 BY ERRATA 1188
0060 REM **************************************************
0070 REM *     THIS PROGRAM IS PART OF A GENERALIZED      *
0080 REM *   APPLICATION. COPYRIGHT WANG LABS INC. 1979   *
0090 REM **************************************************
0110 REM SYSTEM NAM         =  GBS ACCOUNTS/PAYABLE SYSTEM
0120 REM MODULE NAME        =  A/P CHECK PRINT
0130 REM PROGRAM FUNCTION   =  TO PRINT CHECKS AND VOUCHERS
0140 REM **************************************************
0150 REM
0159 REM
0170     DIM D8$8,A8$11,A9$11
0198     GOTO 4000
3990 REM
3996 REM *******************
3997 REM ! A/P CHECK PRINT !
3998 REM *******************
3999 REM
4000     SELECT @PARTS0$
4080     A8$="#######.##-"
4090     A9$="###,###.##-"
4110 REM CHECK PRINTER
4120     GOSUB '93("MOUNT CHECK VERTICAL FORMAT TAPE AND CHECKS")
4130     IF I0$=" " THEN LOAD T M$
4300 REM GET DATE FROM CONTROL FILE
4320     GOSUB '66(6,0,1)
4350     GOSUB '100("1","99999999",8,0,"ENTER STARTING CHECK NO",1)
4360     IF Q6$ = HEX(1F) THEN GOSUB '31
4370     A7,A8 = Q9
4380     N0$ = " "
4390 REM PRINT CHECK MASKS
4400     GOSUB 7670
4410 REM SET VENDOR ID TO INDICATE FIRST TIME THROUGH
4420     N0$ = HEX(00)
4425     PRINT AT(4,0,80);"Processing Vendor ID.";HEX(06)
4430 REM READ OPEN ITEM FILE
4440     IF N0$ = HEX(00) THEN GOSUB '235(2,0)
   : ELSE GOSUB '237(2,0)
4450     IF Q$ = "E" THEN 4600
4460     IF N0$ = HEX(00) THEN N0$ = " "
4470     Q6$ = "A/P OPEN ITEM FILE"
4480     IF Q$ <> " " THEN 5670
4490     A6 = Q
4500     GOSUB '71(4,A6)
4510     IF C5$(A6) <> "1" THEN 4440
4520 REM CONVERT INVOICE DATE  - JULIAN ==> GREGORIAN
4530     GOSUB '123(B3(A6))
4540     IF Q6$<>"E" THEN D8$=U9$
   : ELSE D8$="NO DATE"
4550 REM DETERMINE SIGN OF TRANSACTION AMOUNT
4560     IF C3$(A6) <> "E" AND C3$(A6) <> " " THEN B(A6) = -B(A6)
4570 REM CHECK FOR VENDOR BREAK
4580     IF N0$ = C0$(A6) THEN 4830
4590 REM IF THERE IS A CHECK TO PRINT, PRINT IT
4600     IF A9 <= 0 AND K1 <> 0 THEN GOSUB 7500
4610     IF A9 <= 0 THEN 4700
4620     GOSUB 7270
4630     N$ = " "
4640     N3$ = Q1$
4650     N1 = B8
4660     N2 = B7
4670     N3 = A9
4680     GOSUB 7040
4690     GOSUB '64(5)
4700     IF Q$="E" THEN 5210
4710     A9,B7,B8,B9,K1,K7 = 0
4720 REM GET VENDOR MASTER FILE RECORD
4730     N0$ = C0$(A6)
4740     PRINT AT(4,23,5);N0$
4750     IF J0 = 7 THEN J$(7) = " "
4760     GOSUB '232(1,0,N0$)
4770     Q6$ = "VENDOR MASTER FILE"
4780     IF Q$ <> " " AND Q$ <> "B" THEN 5670
4790     GOSUB '91
4800     IF J0 = 7 THEN 4750
4810     GOSUB '70(2)
4820     N1$ = A1$
4830     IF C3$(A6) = "X" OR C3$(A6) = "E" THEN 5100
4840 REM PROCESS " ",C, OR P TRANSACTION
4850     IF B4$ = "1" THEN 4440
4860 REM IF 12 VOUCHER LINES HAVE BEEN PRINTED, PRINT LAST LINE OF THIS VOUCHE
     R ,PRINT VOID CHECK, WRITE TO CHECK FILE
4870     IF K7 >= 12 THEN GOSUB 7500
4880 REM PRINT VOUCHER LINE
4890     SELECT PRINT <I0$>(90)
4900     Q8=POS(" CPX"=C3$(A6))
4910     Q8=MAX(MIN(Q8,3),1)
4920     Q6$ = "INVOICE      CREDIT MEMO  MANUAL PAYMNT"
4930 REM CHOOSE PARTIAL PAYMENT AMOUNT IF APPLICABLE - ELSE USE INVOICE AMOUNT
4940     IF B1(A6) <> 0 THEN Q9 = B1(A6)
   : ELSE Q9 = B(A6)
4950     IF B1(A6) <> 0 THEN PRINT "PART PAY";
4960     PRINT TAB(10);C1$(A6);TAB(21);D8$;TAB(30);STR(Q6$,Q8*13-12,13);TAB(45
     );
4970     IF Q9>=1E6 THEN Q6$=A8$
   : ELSE Q6$=A9$
4980     PRINTUSING Q6$,Q9;
4985     PRINT TAB(58);
4990     PRINTUSING A9$,ROUND((B0(A6)*Q9/100,2);
4995     PRINT TAB(71);
5000     PRINTUSING Q6$,Q9 - ROUND((B0(A6)*Q9/100,2)
5010     A9 = A9 + Q9 - ROUND((Q9*B0(A6)/100,2)
5020     B7 = B7 + ROUND((Q9*B0(A6)/100,2)
5030     B9 = B9 + Q9 - ROUND((Q9*B0(A6)/100,2)
5040     B8 = B8 + Q9
5050     K1 = K1 + 1
5060     K7 = K7 + 1
5070     SELECT PRINT 005(80)
5080     GOTO 4440
5090 REM PROCESS X AND E RECORDS
5100     IF C3$(A6) = "E" THEN N$ = "2"
   : ELSE N$ = "1"
5110     N1 = B(A6)
5120     N2 = ROUND((B(A6)*B0(A6)/100,2)
5130     N0 = B2(A6)
5140     N3 = N1 - N2
5150     N3$ = D8$
5160     GOSUB '64(5)
5170     IF C3$(A6) = "E" OR B4$ = "1" OR B4(A6) > M(3) THEN 4440
5180     GOTO 4870
5190 REM ----------
5200 REM END OF A/P OPEN ITEM FILE
5210     N0 = 99999999
5220     N0$ = HEX(FF)
5230     GOSUB '64(5)
5240     IF O <> 0 THEN DSKIP #5,1S
5250 REM UPDATE CONTROL FILE
5260     $OPEN #6
5270     GOSUB '66(6,0,1)
5280     M(1) = Q1
5290     F5$(2) = "2"
5300     GOSUB '66(6,0,0)
5310     GOSUB '66(6,Q1,1)
5320     M(1) = A7 - A8
5330     IF M(1) <> 0 THEN Q9 = A7 - 1
   : ELSE Q9 = 0
5340     M(2)=Q9
5350     GOSUB '66(6,Q1,0)
5360     $CLOSE#6
5370     GOSUB '218(S$(5),5," ",0)
   : REM "END" FOR CHECK FILE
5380     PRINT AT(4,0,80)
5390     GOSUB '100("Y,N","YyNn",1,1,"DO YOU WANT A REPRINT (Y OR N)",2)
5410     IF Q6$ = "N" THEN 5500
5450 REM RESTART
5460     DBACKSPACE #5,BEG
5470     O,B7,B8,B9,K1,A9 = 0
5480     GOTO 4320
5490 REM CLOSE FILES
5500     DEFFN '31
5510     PRINT AT(1,0,240);"MOUNT STANDARD VERTICAL FORMAT TAPE/PAPER"
5520     GOSUB '254
5525     SELECT PRINT <I0$>(90)
5530     PRINT HEX(0C)
5540     PRINT HEX(0E);"PRINTED CHECKS TOTAL"
5550     PRINT HEX(0A)
5560     PRINT TAB(34);
5570     PRINTUSING "$###,###,###.##",B6
5650     LOAD T M$
5660 REM TERMINATE FOR KFAM ERROR
5670     GOSUB '91
5680     PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED";AT(3,16);"- ";Q6$
5690     GOSUB '254
5700     GOTO 5500
7000 REM ***************
7010 REM * SUBROUTINES *
7020 REM ***************
7030 REM PRINT CHECK
7040     SELECT PRINT <I0$>(90)
7050     PRINT HEX(0B)
7060     PRINT TAB(1);Q1$;TAB(65);
7070     Q9 = MAX(INT(LOG(A9)/LOG(10)),0)
7080     Q6$="$"
7090     STR(Q6$,2) = ALL("*")
7100     STR(Q6$,12-Q9) = ALL("#")
7110     STR(Q6$,13) = ".##"
7120     IF Q9 > 2 THEN Q7$=STR(Q6$,,9)&","&STR(Q6$,10)
   : ELSE Q7$=Q6$
7130     IF Q9 > 5 THEN Q6$=STR(Q7$,,6)&","&STR(Q7$,7)
   : ELSE Q6$=Q7$
7140     PRINTUSING Q6$,A9
7150 REM ACCUMULATE TOTAL OF PRINTED CHECKS
7160     B6=B6+A9
7170     PRINT HEX(0B)
7180     PRINT TAB(16);A1$
7190     IF A2$ <> " " THEN PRINT TAB(16);A2$
7200     IF A3$ <> " " THEN PRINT TAB(16);A3$
7210     PRINT TAB(16);A4$;"  ";A5$
7220     PRINT HEX(0C)
7230     SELECT PRINT 005(80)
7240     RETURN
7250 REM -------------
7260 REM PRINT LAST LINE OF VOUCHER
7270     SELECT PRINT <I0$>(90)
7280     IF K7 > 9 THEN 7300
7290     PRINT HEX(0B)
7300     PRINT HEX(0B)
7310     PRINTUSING "#####################  #####",A1$,N0$;
7320     IF K7 < 12 THEN 7350
7330     PRINT TAB(31);A7;TAB(49);"CONTINUED ON NEXT PAGE"
7331 REM  PRINT TAB(49);"CONTINUED ON NEXT PAGE"
7340     GOTO 7420
7350     PRINT TAB(31);A7;TAB(45);
7360     IF B8>=1E6 THEN Q6$=A8$
   : ELSE Q6$=A9$
7370     PRINTUSING Q6$,B8;
7380     IF B7>=1E6 THEN Q6$=A8$
   : ELSE Q6$=A9$
7385     PRINT TAB(58);
7390     PRINTUSING Q6$,B7;
7400     IF B9>=1E6 THEN Q6$=A8$
   : ELSE Q6$=A9$
7405     PRINT TAB(71);
7410     PRINTUSING Q6$,B9
7420     PRINTUSING "   #####",K1
7430     K7 = 0
7440     N0 = A7
7450     A7 = A7 + 1
7460     SELECT PRINT 005(80)
7470     RETURN
7480 REM ----------
7490 REM PROCESS VOID CHECKS
7500     GOSUB 7270
7510     SELECT PRINT <I0$>(90)
7520     PRINT HEX(0B);
7530     PRINT TAB(1);"********";TAB(71);"********"
7540     PRINT HEX(0B);
7550     FOR I = 1 TO 2
7560        PRINT HEX(0E);TAB(8);"VOID"
7570        PRINT
7580     NEXT I
7590     PRINT HEX(0C)
7600     SELECT PRINT 005(80)
7610     N3$ = Q1$
7620     N1,N2,N3 = 0
7630     N$ = "3"
7640     GOSUB '64(5)
7650     RETURN
7660 REM FORMS ALIGNMENT MASK
7670     GOSUB '100("Y,N","YyY Nn",1,1,"DO YOU WANT TO PRINT A MASK (Y OR N)",
     2)
7690     IF Q6$ = "N" THEN RETURN
7730     SELECT PRINT <I0$>(90)
7740     FOR I = 1 TO 12
7750        PRINT "********  ********   MM/DD/YY";TAB(45);"XXX,XXX.XX   XXX,XX
     X.XX   XXX,XXX.XX"
7760     NEXT I
7770     PRINT
7780     PRINT "VENDOR NAME";TAB(23);"XXXXX";TAB(33);"XXXXXXXX";TAB(45);"XXX,X
     XX.XX   XXX,XXX.XX   XXX,XXX.XX"
7790     PRINT "  XXXXX"
7800     PRINT HEX(0B);TAB(1);"MM/DD/YY";TAB(71);"XXX,XXX.XX"
7810     PRINT HEX(0B);TAB(16);"VENDOR NAME"
7820     PRINT TAB(16);"ADDRESS LINE1"
7830     PRINT TAB(16);"ADDRESS LINE2"
7840     PRINT TAB(16);"CITY  STATE   ZIP"
7850     PRINT HEX(0C)
7860     N0 = A7
7870     A7=A7+1
7880     N3$ = Q1$
7890     N1,N2,N3 = 0
7900     N1$="** CHECK MASK **"
7910     N$ = "3"
7920     GOSUB '64(5)
7930     GOSUB '100("Y,N","YyY Nn",1,1,"DO YOU WANT ANOTHER MASK (Y OR N)",2)
7940     IF Q9=1 THEN GOTO 7730
7950     RETURN
9000 REM *************
9010 REM * VARIABLES *
9020 REM *************
9030 REM  A6  = RECORD NUMBER - A/P OPEN ITEM FILE
9040 REM  A7  = CURRENT CHECK NUMBER
9050 REM  A8  = STARTING CHECK NUMBER
9060 REM  A9  = NET AMOUNT FOR VENDOR
9070 REM  B6  = TOTAL NET FOR ALL VENDORS
9080 REM  B7  = DISCOUNT AMOUNT
9090 REM  B8  = GROSS AMOUNT
9100 REM  B9  = NET AMOUNT
9110 REM  D8  = TOTAL NET AMOUNT
9120 REM D8$  = GREGORIAN INVOICE DATE
9130 REM  K1  = NO. OF TRANSACTIONS PROCESSED
9140 REM  K6  = FOR-NEXT COUNTER
9150 REM  K7  = VOUCHER LINE COUNT
9160 REM  K8  = SWITCH TO INDICATE A REPRINT
9170 REM $
9999 DEFFN'29"Q$= ";HEX(22);"ACPA060A";HEX(22);":SCRATCH T Q$:SAVE T$()Q$";HEX
     (0D)