Listing of file='ACPA120A' on disk='vmedia/701-2654C.wvd.zip'
# Sector 539, program filename = 'ACPA120A' 0010 REM ACPA120A, RELEASE 1-0, (01/31/79) THIS PROGRAM IS A COPYRIGHT PRODU CT OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBIT ED 0020 REM PROGRAM NAME = ACPA120A 0030 REM RELEASE NUMBER = 01 0040 REM REVISION NUMBER = 00 0050 REM DATE WRITTEN = 1/14/79 0060 REM ************************************************** 0070 REM * THIS PROGRAM IS PART OF A GENERALIZED * 0080 REM * APPLICATION. COPYRIGHT WANG LABS INC. 1979 * 0090 REM ************************************************** 0110 REM SYSTEM NAME = GBS/MVP ACCOUNTS PAYABLE 0120 REM MODULE NAME = OPEN ITEM & VENDOR UPDATE 0130 REM PROGRAM FUNCTION = THE PURPOSE OF THIS PROGRAM IS TO ALLOW FOR THE UP DATING OF THE OPEN ITEM & VENDOR FILE. 0140 REM ************************************************** 0160 REM 0170 DIM A9$1,K9$Q0,N9$20 0171 REM 0172 DIM N2$(6)40 0198 GOTO 4000 3990 REM 3996 REM ******************************* 3997 REM ! OPEN ITEM AND VENDOR UPDATE ! 3998 REM ******************************* 3999 REM 4000 SELECT @PART S0$ 4080 B$(1)="O" 4090 PACK(##)STR(B$(1),2)FROM S2 4100 N2$()=ALL(FF) 4120 PRINT AT(4,0,80);"This program deletes all transactions that were sel ected for payment." 4130 Q6$="After this program, it will not be possible to reprint checks."O R ALL(80) 4140 PRINT Q6$ 4150 GOSUB '100("Y,N","YyNn",1,1,"ARE YOU SURE YOU WANT TO RUN THIS PROGRA M (Y OR N)",2) 4160 IF Q9=2 THEN 5340 4320 REM GET DATE FROM CONTROL FILE 4340 GOSUB '66(6,0,1) 4350 REM -------------- 4360 REM READ OPEN ITEM FILE RECORDS 4370 GOSUB '235(2,0) 4380 K9$ = STR(T7$,,Q0) 4390 PRINT AT(4,0,160);"Processing Vendor ID. ";K9$;HEX(06) 4400 GOTO 4450 4410 REM FINDNEXT 4420 GOSUB '237(2,0) 4430 N9$ = HEX(FF) 4440 IF Q$ = "E" THEN 4540 4450 N9$ = T7$ 4460 Q6$ = "A/P OPEN ITEM FILE" 4470 IF Q$ = " " THEN 4480 4471 REM TERMINATE FOR KFAM ERROR 4472 GOSUB '91 4474 PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED";AT(3,16);"- ";Q6$ 4476 GOSUB '254 4478 GOTO 5340 4480 A6 = Q 4490 GOSUB '71(4,A6) 4500 IF C5$(A6) <> "1" THEN 4420 4510 REM CHECK FOR VENDOR BREAK 4520 IF K9$ = C0$(A6) THEN 4730 4530 REM READ VENDOR RECORD 4540 IF A7 = 0 AND A8 = 0 THEN 4680 : REM FIRST TIME THROUGH, OR '0' CHECK 4550 GOSUB '232(1,0,K9$) 4560 IF Q$ = " " THEN 4610 4570 PRINT AT(3,0,80);"Vendor ID. ";K9$;" is not in file";HEX(0607) 4580 GOSUB '254 4590 PRINT AT(1,0,240) 4600 GOTO 4680 4610 GOSUB '70(2) 4620 A3 = A3 + A8 4630 A2 = A2 - A7 4640 A0 = B8 4650 DBACKSPACE #2,1S 4660 REM WRITE UPDATED VENDOR RECORD 4670 GOSUB '60(2) 4680 A7,A8 = 0 4690 REM CHECK FOR END OF A/P FILE 4700 IF N9$ = HEX(FF) THEN 5230 4710 K9$ = C0$(A6) 4720 PRINT AT(4,0,80);"Processing Vendor ID. ";K9$;HEX(06) 4730 B8=MAX(A0,B5(Q),M(3)) : REM DATE OF LAST PAYMENT 4740 REM CHANGE 'X' ==> 'P' PAYMENT ? 4750 IF C3$(A6) = "X" THEN IF B4$ = "1" OR B4(A6) > M(3) THEN 5160 4760 IF B1(A6) > 0 THEN 5030 : REM IS THERE A PARTIAL PAYMENT ? 4770 REM ------------- 4780 REM DELETE OPEN ITEM RECORD 4790 GOSUB '231(2,0,N9$) 4800 IF Q$ = " " THEN 4850 4810 PRINT AT(3,0,80);"Transaction ";N9$;" not on file" 4820 GOSUB '254 4830 PRINT AT(1,0,240) 4840 GOTO 4420 4850 A6 = Q 4860 Q9 = -B(A6) 4870 IF C3$(A6) = " " THEN Q9 = B(A6) 4880 IF C3$(A6) = "E" THEN Q9 = 0 4890 A7 = A7 + Q9 4900 A8 = A8 + ROUND((B(A6)*B0(A6)/100,2) 4910 D9 = D9 + ROUND((B(A6)*B0(A6)/100,2) 4920 B9 = B9 + Q9 4930 GOSUB '71(4,A6) 4940 DBACKSPACE #4,1S 4950 STR(C0$(A6),1,1) = HEX(FF) 4960 GOSUB '61(4,A6) 4970 REM WRITE TRANSACTION AUDIT FILE RECORD 4980 IF A9$ <> "F" THEN GOSUB 7040 4990 GOTO 4420 5000 REM ------------- 5010 REM PARTIAL PAYMENT 5020 REM ADD TO TOTALS, CALCULATE NEW AMOUNT 5030 A7 = A7 + B1(A6) 5040 A8 = A8 + ROUND((B1(A6)*B0(A6)/100,2) 5050 D9 = D9 + ROUND((B1(A6)*B0(A6)/100,2) 5060 B9 = B9 + B1(A6) 5070 B(A6) = B(A6) - B1(A6) 5080 REM WRITE TRANSACTION AUDIT FILE RECORD, SET PARTIAL PAYMENT AMOUNT TO 0 5090 A9$ = "PARTIAL PAYMENT" 5100 IF A9$ <> "F" THEN GOSUB 7040 5110 B1(A6) = 0 5120 GOTO 5170 5130 REM ----------------- 5140 REM EXTERNAL PAYMENT - TYPE 'X' BECOMES A 'P' PAYMENT 5150 REM THIS NOW BECOMES A P-PAYMENT 5160 C3$(A6) = "P" 5170 DBACKSPACE #4,1S 5180 GOSUB '61(4,A6) 5190 GOTO 4420 5200 REM ------------- 5210 REM END PROGRAM, RETURN TO MENU 5230 GOSUB '66(6,0,1) 5240 M(3) = 0 5250 D8,M(2) = M(2) - B9 5260 F5$(2) = " " 5270 GOSUB '66(6,0,0) 5280 GOSUB '66(6,Q1,1) 5290 M(9) = D8 5300 M(3) = M(3) + B9 5310 M(8) = M(8) + D9 5320 GOSUB '66(6,Q1,0) 5330 REM CLOSE FILES 5340 DEFFN '31 5400 LOAD T M$ 7000 REM *************** 7010 REM * SUBROUTINES * 7020 REM *************** 7030 REM WRITE TRANSACTION AUDIT FILE RECORD 7040 IF B1(A6) > 0 THEN Q9 = B1(A6) : ELSE Q9 = B(A6) 7050 A9 = A9 + 1 7054 Q8=Q0+VAL(Q0$(6)) 7055 Q6$=HEX(A0)&BIN(Q8)&HEX(500350035003520552055001) 7060 $PACK(F=Q6$)N2$(A9)FROM STR(N9$,,Q8),B3(A6),B4(A6),B5(A6),Q9,ROUND((B 0(A6)*Q9/100,2),SGN(B1(A6)) 7070 IF A9 < 4 THEN RETURN 7080 N1$()=N2$() 7090 GOSUB '48(5) 7100 N2$() = ALL(FF) 7110 A9 = 0 7120 IF Q9 < .99 THEN RETURN 7130 PRINT AT(3,0,80);"Transaction Audit File is full - remaining update r ecords will be lost" 7140 GOSUB '254 7150 A9$ = "F" 7160 RETURN 9000 REM ************* 9010 REM * VARIABLES * 9020 REM ************* 9030 REM A6 = RECORD NUMBER - A/P OPEN ITEM FILE 9040 REM A7 = TRANSACTION TOTAL - CURRENT VENDOR 9050 REM A8 = DISCOUNTS TAKEN - CURRENT VENDOR 9060 REM A9 = RECORD NUMBER - TRANSACTION AUDIT FILE 9070 REM D9 = WORK FIELD FOR YTD DISCOUNTS TAKEN 9080 REM A9$ = AUDIT FILE FULL INDICATOR 9090 REM K9$ = CURRENT VENDOR ID. 9100 REM N9$ = CURRENT A/P OPEN ITEM KEY 9110 REM $ 9999 DEFFN'29"Q6$=";HEX(22);"ACPA120A";HEX(22);":SCRATCHTQ6$:SAVET()Q6$";HEX(0 D)