Listing of file='ACCT070A' on disk='vmedia/701-2607C.wvd.zip'
# Sector 209, program filename = 'ACCT070A'
0010 REM ACCT070A, RELEASE 2.0, (06/01/79) THIS PROGRAM IS A COPYRIGHT PRODUCT
OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0170 COM L1$12
: DIM T0$(4)60,T$(3)48,K$8,K1$8,R9$(16),V$18
: GOTO 4000
4000 SELECT @PARTS$
: V$=@V$
: SELECT @PARTS0$
: B$(1)="P"
: PACK(##)STR(B$(1),2)FROMS2
: L1$=HEX(A0)&BIN(MIN(Q0,6))&HEX(6004A00652055205A001)
: LIMITS T#7,S$(7),Q6,Q7,Q8
: IF Q8<3THEN 4120
: PRINT AT(1,0,240);"Transaction audit file must be cleared before purge."
: GOSUB '254
: LOAD TM$
4120 GOSUB '46(6,0,1)
: GOSUB '123(M(12))
: GOTO 4210
4160 PRINT AT(3,0,80);HEX(07);"Invalid date - Re-enter"
4170 GOSUB '100(" ","^",8,0,"ENTER AGING DATE (MM/DD/YY)",2)
: GOSUB '121(Q6$)
: IF Q6$="E"THEN 4160
: K4=U9
4210 PRINT AT(5,0,80);"Aging date = ";U9$,U9
: GOSUB '100("Y,N","YyNn",1,1,"IS AGING DATE CORRECT (Y OR N)",2)
: IF Q6$="N"THEN 4170
: GOSUB '235(2,0)
: K$,K1$=S$(2)
: K=2
: K1=T1
: $OPEN #6,#K,#K1
: GOSUB '46(6,0,1)
: M3$="2"
: GOSUB '46(6,0,0)
: STR(K1$,5,2)="K1"
: LIMITS T#K,K$,Q9,L2,Q9
: DATA LOAD DC OPEN T#K,K$
: DATA SAVE DC #K,END
4380 R9$()=HEX(A00002FD)&"MUX "&K$
: DATA SAVE BA T$#K,(L2)R9$()
: DATA LOAD DC OPEN T#K1,K1$
: DATA LOAD DC #K1,Q9,T$()
: DBACKSPACE #K1,1S
: $UNPACK(F=V$)T$(2)TO T0,T2$,Q2$,V2$,T8,V6$,V3$,Q3$,V8$
: Q9=VAL(V6$)
: Q2$=BIN(Q9-1,2)XOR ALL(FF)
: V1$=STR(T$(2),18)
: T4=VAL(STR(V1$,5))
: T2$,V2$,T9$=HEX(0001)
: T0=1
: T8=0
: INIT(5A)T$(1)
: INIT(FF)STR(T$(1),17)
4540 $PACK(F=V$)T$(2)FROMT0,T2$,Q2$,V2$,T8
: T$(3)=STR(Q3$)&V8$&STR(T$(3))
: DATA SAVE DC $#K1,0,T$()
: INIT(FF)T0$()
: INIT(00)STR(T0$(1),,T4)
: DATA SAVE DC $#K1,T9$,T0$()
: DATA SAVE DC $#K1,END
: R9$()=HEX(A0FD)&T$()
: DATA SAVE BA T$#K,(L2-1)R9$()
: T9=0
: $CLOSE#6,#K,#K1
: IF S0$=" "THEN 4730
: SELECT @PARTS$
: $PACK(F=V$)STR(@T$(V6),7,3)FROMT0,T2$
4710 STR(@T$(V6),10)=OR ALL(44)
: SELECT @PARTS0$
4730 STR(M5$,8)="B"
: LOAD TM5$4000,
9998 DEFFN'29"Q$=";HEX(22);"ACCT070A";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 - initialization.";HEX(22);":SELECT#1
5<I0$>:$OPEN#15:SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':
$CLOSE#15:SELECTLIST005(80)";HEX(0D)