Listing of file='ACCT070B' on disk='vmedia/701-2607C.wvd.zip'
# Sector 327, program filename = 'ACCT070B'
0010 REM ACCT070B, RELEASE 2.0, (06/01/79) THIS PROGRAM IS A COPYRIGHT PRODUCT
OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0170 DIM K$(4)Q0,K1$(4)1,K2$(4)2,K3$(4)1,K4$(4)1,K(4),K1(4),K2(4),K3(4),K4(4),
K5(4),K6(4),K4$Q0,K5$1,K7$1,K9$1
: GOTO 4000
4000 SELECT @PARTS0$
: K4$=HEX(00)
: MAT REDIM N1$(9)27
: J=1
: Q6$="No data in A/R sequential open item file - correct and restart."
: GOSUB '55(1)
: IF C1$(1)=HEX(FF)THEN 5530
: GOSUB 6160
: GOTO 4150
4110 J=MOD(J,M0)+1
: IF J=1THEN GOSUB '55(1)
: IF C1$(J)=HEX(FF)THEN 5110
: IF C1$(J)<>K4$THEN GOSUB 6030
4150 CONVERT F$(J)TO K
: K=K+1
: IF C(J)<>0THEN 4610
: ON KGOTO 4220,4270,4330,4440,4440,,,,,4540
: GOSUB 5430
4220 K3=K3+C1(J)+A(J)+A1(J)+A2(J)
: I=1
: GOSUB 7420
: GOTO 4110
4270 K3=K3-A1(J)-A2(J)
: IF K$(2)=" "THEN 4400
: K5(2)=K5(2)+A1(J)
: K6(2)=K6(2)+A2(J)
: GOTO 4110
4330 IF K5$="1"THEN 4660
: K3=K3+(A(J)-A1(J)-A2(J))
: IF K$(2)=" "THEN 4400
: K4(2)=K4(2)+A(J)
: K5(2)=K5(2)+A1(J)
: K6(2)=K6(2)+A2(J)
: GOTO 4110
4400 I=2
: GOSUB 7420
: GOTO 4110
4440 K3=K3-A(J)
: IF K$(2)=" "THEN 4480
: K6(2)=K6(2)+A(J)
: GOTO 4110
4480 I=2
: GOSUB 7420
: K6(2)=A(J)
: K4(2)=0
: GOTO 4110
4540 K3=K3+C1(J)+A(J)+A1(J)+A2(J)
: I=3
: GOSUB 7420
: GOSUB 7560
: GOTO 4110
4610 IF K5$="1"THEN ON KGOTO 4660,4270,4660,4440,4440,,,,4700
: ELSE ON KGOTO 4820,4880,4970,5060,5060,,,,4700
: GOSUB 5430
: IF K5$<>"1"THEN 4820
4660 K3(1)=K3(1)+(A(J)-A1(J)-A2(J))
: K3=K3+(A(J)-A1(J)-A2(J))
: GOTO 4110
4700 K3=K3+C1(J)
: K8=K8+C1(J)
: IF K$(3)=" "THEN 4750
: K3(3)=K3(3)+C1(J)
: GOTO 4110
4750 I=3
: GOSUB 7420
: K(I)=0
: K1$(I)="9"
: GOTO 4110
4820 K3=K3+(A(J)-A1(J)-A2(J))
: IF K$(4)>" "THEN GOSUB 7890
4840 I=4
: GOSUB 7420
: GOTO 4110
4880 K3=K3-A1(J)-A2(J)
: IF K$(4)=" "THEN 4840
: IF C(J)=K(4)THEN 4930
: GOSUB 7890
: GOTO 4840
4930 K5(4)=K5(4)+A1(J)
: K6(4)=K6(4)+A2(J)
: GOTO 4110
4970 K3=K3+(A(J)-A1(J)-A2(J))
: IF K$(4)=" "THEN 4840
: IF C(J)=K(4)THEN 5020
: GOSUB 7890
: GOTO 4840
5020 K4(4)=K4(4)+(A(J)-A1(J)-A2(J))
: IF K1$(4)="1"THEN K1$(4)="2"
: GOTO 4110
5060 K3=K3-A(J)
: IF C(J)=K(4)THEN K4(4)=K4(4)-A(J)
: ELSE GOSUB 6850
: GOTO 4110
5110 IF K5$<>"1"THEN 5160
: I=1
: GOSUB 7560
: K6(2)=K2
: GOTO 5170
5160 GOSUB 7890
5170 GOSUB 6480
: K7$="4"
: K5=K1
: GOSUB 7240
: $OPEN #6
: GOSUB '46(6,0,1)
: IF K1-K9=M(3)THEN 5290
: K7$="5"
: K5=K1
: B=M(3)
: GOSUB 7240
5290 M(3)=K1
: M(1)=K4
: M3$=" "
: GOSUB '46(6,0,0)
: GOSUB '46(6,K4,1)
: M(16)=K1
: GOSUB '46(6,K4,0)
: $CLOSE#6
: $GIO/005(02200300122140074007400740074007,Q6$)
: MAT REDIM N1$(5)49
: IF G0>1THEN GOSUB '48(7)
5410 LOAD TM$
5430 Q6$="Transaction code error - "&K1$(J)
: PRINT AT(3,0,80);Q6$
: GOSUB '100("Y,N","YyY Nn",1,1,"Do you want to terminate this program (Y O
R N)",2)
: IF Q6$="N"THEN RETURN
: GOTO 5410
5490 Q7$="Customer Open Item A/R Seq. Trans aud."
: IF J0=0THEN J0=6
: Q7$=STR(Q7$,T6*10-9,10)
: Q6$=J$(J0)&" - "&Q7$&" file."
5530 PRINT AT(1,0,240);Q6$
: GOSUB '254
: GOTO 5410
6030 IF K5$<>"1"THEN 6080
: I=1
: GOSUB 7560
: K$(2)=" "
: GOTO 6090
6080 GOSUB 7890
6090 GOSUB 6480
: K$(),K1$(),K3$(),K4$()=" "
: Q6$=HEX(6001)&STR(Q6$)
: M$()=ALL(00)
: $UNPACK(F=Q6$)M$()TO K(),K1(),K2(),K3(),K4(),K5(),K6()
: K2$()=ALL("0")
6160 IF J0=7THEN GOSUB '92
: K4$=C1$(J)
: GOSUB '232(1,1,K4$)
: IF Q$=" "THEN 6310
: GOSUB '91
: IF J0=7THEN 6160
: IF J0<>3THEN 5490
: C$=HEX(00)
: B=0
: P3$="0"
: K7$="3"
: K5=K3
: GOSUB 7240
6310 IF C$>HEX(00)THEN GOSUB '50(5," ")
: PRINT AT(7,0,0);"Processing customer ID ";K4$;HEX(06)
: IF F$(J)<>"0"OR C(J)<>0THEN 6370
: K5$="1"
: RETURN
6370 IF P3$="1"THEN 6410
: K5$="0"
: RETURN
6410 K5$="1"
: K$(1)=C1$(J)
: K(1)=0
: K1$(1)="0"
: RETURN
6480 IF K$(1)=" "THEN 6550
: IF K3(1)+K4(1)+K5(1)+K6(1)=0THEN 6550
: K2(1)=K4
: I=1
: GOSUB 6990
6550 IF K$(2)=" "THEN 6670
: K2=K4(2)-K5(2)-K6(2)
: IF K2=0THEN 6670
: K1$(2)="2"
: IF K2>0THEN 6640
: K6(2)=-K2
: K4(2),K5(2)=0
: K1$(2)="1"
6640 I=2
: GOSUB 6990
6670 I=3
: IF K3(3)+K4(3)+K5(3)+K6(3)<>0AND K$(3)>" "THEN GOSUB 6990
: K7$="2"
: K5=K3
: IF K3<>BTHEN P5=K4
: IF K3<>BAND K3-K8<>BTHEN GOSUB 7240
: B=K3
: K1=K1+K3
: K9=K9+K8
: K3,K8=0
: IF C$=HEX(00)THEN RETURN
: DBACKSPACE #5,1S
: GOSUB '40(5," ")
: GOSUB '238(1)
: RETURN
6850 H3$=C1$(J)
: J5=C(J)
: G4$=F$(J)
: G5$=H$(J)
: E4$=A$(J)
: E5$=C$(J)
: C=D(J)
: C1=D1(J)
: C2=C1(J)
: C3=A(J)
: C4=A1(J)
: C5=A2(J)
: GOTO 7120
6990 H3$=K$(I)
: J5=K(I)
: G4$=K1$(I)
: G5$=K2$(I)
: E4$=K3$(I)
: E5$=K4$(I)
: C=K1(I)
: C1=K2(I)
: C2=K3(I)
: C3=K4(I)
: C4=K5(I)
: C5=K6(I)
7120 $PACK(F=L2$)T7$FROMH3$,J5,G4$,G5$
: GOSUB '233(2,0,T7$,0)
: GOSUB '91
: IF J0>0THEN 5490
: Q9=1
: O1$()=ALL(FF)
: IF Q>1THEN DATA LOAD DC #2,O1$()
: ELSE Q9=0
: DBACKSPACE #2,Q9S
: $PACK(F=L2$)O1$(Q)FROMH3$,J5,G4$,G5$,E4$,E5$,C,C3,C4,C5,C2,C1
: DATA SAVE DC #2,O1$()
: RETURN
7240 IF K9$="F"THEN RETURN
: Q6$=STR(U9$,,2)&STR(U9$,4,2)&STR(U9$,7,2)
: $PACK(F=L1$)N1$(G0)FROMK4$,K(4),Q6$,K5,B,K7$
: G0=G0+1
: IF G0<=9THEN RETURN
: LIMITS T#7,Q6,Q7,Q8
: IF Q8<Q7-4THEN 7350
: K9$="F"
: PRINT AT(3,0,80);"Insufficient space in transaction audit file for purge
report.";HEX(07)
: GOSUB '254
7350 MAT REDIM N1$(5)49
: GOSUB '48(7)
: MAT REDIM N1$(9)27
: N1$()=ALL(FF)
: G0=1
: RETURN
7420 K$(I)=C1$(J)
: K(I)=C(J)
: K1$(I)=F$(J)
: K2$(I)=H$(J)
: K3$(I)=A$(J)
: K4$(I)=C$(J)
: K1(I)=D(J)
: K2(I)=D1(J)
: K3(I)=C1(J)
: K4(I)=A(J)
: K5(I)=A1(J)
: K6(I)=A2(J)
: RETURN
7560 K2=K4(2)-K5(2)-K6(2)
: IF K2>=0THEN RETURN
: K4(2),K5(2),K6(2)=0
: K2=-K2
: IF K6(I)=0THEN 7690
: IF K6(I)<K2THEN 7660
: K6(I)=K6(I)-K2
: K2=0
: RETURN
7660 K2=K2-K6(I)
: K6(I)=0
7690 IF K5(I)=0THEN 7770
: IF K5(I)<K2THEN 7740
: K5(I)=K5(I)-K2
: K2=0
: RETURN
7740 K2=K2-K5(I)
: K5(I)=0
7770 IF K4(I)=0THEN 7850
: IF K4(I)<K2THEN 7820
: K4(I)=K4(I)-K2
: K2=0
: RETURN
7820 K2=K2-K4(I)
: K4(I)=0
7850 IF I<>1THEN K6(2)=K2
: ELSE K3(I)=K3(I)-K2
: K2=K6(2)
: RETURN
7890 IF K$(4)=" "THEN 8060
: IF K4$(4)="D"THEN 8040
: K6=K4(4)-K5(4)-K6(4)
: IF K6=0THEN 8100
: IF K6<0THEN 8040
: K2=K4(2)-K5(2)-K6(2)
: IF K2>=0THEN 8040
: K4(2),K5(2)=0
: K2=-K2
: IF K2>K6THEN 8070
: K6(4)=K6(4)+K2
: K6(2)=0
: IF K2=K6THEN 8100
8040 I=4
: GOSUB 6990
8060 RETURN
8070 K6(4)=K6(4)+K6
: K6(2)=K2-K6
8100 K7$="1"
: GOSUB '123(K2(4))
: K5=K4(4)
: GOSUB 7240
: RETURN
9998 DEFFN'29"Q$=";HEX(22);"ACCT070B";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D
)
9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22);
"GBS/MVP - Purge A/R open item file.";HEX(22);":SELECT#15<I0$>:$OPEN#15:S
ELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:SELECTL
IST005(80)";HEX(0D)