image of READY prompt

Wang2200.org

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)