Listing of file='ACPA120A' on disk='vmedia/701-2652C.wvd.zip'
# Sector 142, 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
0170 DIM A9$1,K9$Q0,N9$20
0172 DIM N2$(6)40
: GOTO 4000
4000 SELECT @PARTS0$
: B$(1)="O"
: PACK(##)STR(B$(1),2)FROMS2
: N2$()=ALL(FF)
: PRINT AT(4,0,80);"This program deletes all transactions that were selecte
d for payment."
: Q6$="After this program, it will not be possible to reprint checks."OR AL
L(80)
: PRINT Q6$
4150 GOSUB '100("Y,N","YyNn",1,1,"ARE YOU SURE YOU WANT TO RUN THIS PROGRAM (Y
OR N)",2)
: IF Q9=2THEN 5340
: GOSUB '66(6,0,1)
: GOSUB '235(2,0)
: K9$=STR(T7$,,Q0)
: PRINT AT(4,0,160);"Processing Vendor ID. ";K9$;HEX(06)
: GOTO 4450
4420 GOSUB '237(2,0)
: N9$=HEX(FF)
: IF Q$="E"THEN 4540
4450 N9$=T7$
: Q6$="A/P OPEN ITEM FILE"
: IF Q$=" "THEN 4480
: GOSUB '91
: PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED";AT(3,16);"- ";Q6$
: GOSUB '254
: GOTO 5340
4480 A6=Q
: GOSUB '71(4,A6)
: IF C5$(A6)<>"1"THEN 4420
: IF K9$=C0$(A6)THEN 4730
4540 IF A7=0AND A8=0THEN 4680
: GOSUB '232(1,0,K9$)
: IF Q$=" "THEN 4610
: PRINT AT(3,0,80);"Vendor ID. ";K9$;" is not in file";HEX(0607)
: GOSUB '254
: PRINT AT(1,0,240)
: GOTO 4680
4610 GOSUB '70(2)
: A3=A3+A8
: A2=A2-A7
: A0=B8
: DBACKSPACE #2,1S
: GOSUB '60(2)
4680 A7,A8=0
: IF N9$=HEX(FF)THEN 5230
: K9$=C0$(A6)
: PRINT AT(4,0,80);"Processing Vendor ID. ";K9$;HEX(06)
4730 B8=MAX(A0,B5(Q),M(3))
: IF C3$(A6)="X"THEN IF B4$="1"OR B4(A6)>M(3)THEN 5160
: IF B1(A6)>0THEN 5030
: GOSUB '231(2,0,N9$)
: IF Q$=" "THEN 4850
: PRINT AT(3,0,80);"Transaction ";N9$;" not on file"
: GOSUB '254
: PRINT AT(1,0,240)
: GOTO 4420
4850 A6=Q
: Q9=-B(A6)
: IF C3$(A6)=" "THEN Q9=B(A6)
: IF C3$(A6)="E"THEN Q9=0
: A7=A7+Q9
: A8=A8+ROUND((B(A6)*B0(A6)/100,2)
: D9=D9+ROUND((B(A6)*B0(A6)/100,2)
: B9=B9+Q9
: GOSUB '71(4,A6)
: DBACKSPACE #4,1S
: STR(C0$(A6),1,1)=HEX(FF)
: GOSUB '61(4,A6)
: IF A9$<>"F"THEN GOSUB 7040
: GOTO 4420
5030 A7=A7+B1(A6)
: A8=A8+ROUND((B1(A6)*B0(A6)/100,2)
: D9=D9+ROUND((B1(A6)*B0(A6)/100,2)
: B9=B9+B1(A6)
: B(A6)=B(A6)-B1(A6)
: A9$="PARTIAL PAYMENT"
: IF A9$<>"F"THEN GOSUB 7040
: B1(A6)=0
: GOTO 5170
5160 C3$(A6)="P"
5170 DBACKSPACE #4,1S
: GOSUB '61(4,A6)
: GOTO 4420
5230 GOSUB '66(6,0,1)
: M(3)=0
: D8,M(2)=M(2)-B9
: F5$(2)=" "
: GOSUB '66(6,0,0)
: GOSUB '66(6,Q1,1)
: M(9)=D8
: M(3)=M(3)+B9
: M(8)=M(8)+D9
: GOSUB '66(6,Q1,0)
5340 DEFFN'31
: LOAD TM$
7040 IF B1(A6)>0THEN Q9=B1(A6)
: ELSE Q9=B(A6)
: A9=A9+1
: Q8=Q0+VAL(Q0$(6))
: Q6$=HEX(A0)&BIN(Q8)&HEX(500350035003520552055001)
: $PACK(F=Q6$)N2$(A9)FROMSTR(N9$,,Q8),B3(A6),B4(A6),B5(A6),Q9,ROUND((B0(A6)
*Q9/100,2),SGN(B1(A6))
: IF A9<4THEN RETURN
: N1$()=N2$()
: GOSUB '48(5)
: N2$()=ALL(FF)
: A9=0
: IF Q9<.99THEN RETURN
7130 PRINT AT(3,0,80);"Transaction Audit File is full - remaining update recor
ds will be lost"
: GOSUB '254
: A9$="F"
: RETURN
9999 DEFFN'29"Q6$=";HEX(22);"ACPA120A";HEX(22);":SCRATCHTQ6$:SAVET()Q6$";HEX(0
D)