image of READY prompt

Wang2200.org

Listing of file='ACCT010A' on disk='vmedia/701-2607C.wvd.zip'

# Sector 270, program filename = 'ACCT010A'
0010 REM ACCT010A, RELEASE 2.0, (06/01/79) THIS PROGRAM IS A COPYRIGHT PRODUCT
      OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0170 DIM A6$1,B6$1,C6$1,E7$12
   : DIM B6(4),B7(4),B8(4),B9(4),B9$(4)12
   : DIM K$1,K1$Q0,K2$Q0,K3$17
   : GOTO 4000
4000 SELECT @PARTS0$
   : K2$=ALL(7F)
   : A6$="N"
   : B6$="Y"
   : K,K1,P1=0
   : D6=INT(365.25*(INT(Q1/1E3)-1))+MOD(Q1,1E3)
   : GOSUB '100("Y,N","NnYyY ",1,1,"PRINT REPORT (Y OR N)",2)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : A6$=Q6$
   : IF A6$="Y"THEN 4140
   : $CLOSE
   : GOTO 4220
4140 GOSUB '93(" ")
   : IF I0$=" "THEN A6$="N"
   : GOSUB '100("Y,N","NnYyY ",1,1,"SCREEN DISPLAY (Y OR N)",2)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : B6$=Q6$
   : IF B6$="N"AND A6$="N"THEN 5860
4220 PRINT AT(5,0,);,"A = LIST ALL OPEN ITEMS";HEX(0D0A);,"B = LIST AGED OPEN
     ITEMS"
   : GOSUB '100("A,B","AaBb",1,1,"ENTER OPTION DESIRED",2)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : C6$=Q6$
   : IF C6$="B"THEN GOSUB 6290
   : PRINT AT(5,0,)
   : GOSUB '100("A,R,I","AaIiRr",1,1,"ENTER INQUIRY TYPE  (A=ALL, R=RANGE, I=I
     NDIVIDUAL)",2)
4290 IF Q6$=HEX(1F)THEN GOSUB '31
   : K$=Q6$
   : Q6$="ALL       RANGE     INDIVIDUAL"
   : K3$=STR(Q6$,Q9*10-9,10)
   : K3$=K3$&" OPTION"
   : IF C6$="B"THEN K3$=K3$&" (AGED)"
   : ON Q9GOTO ,4480,4420
   : GOSUB '235(1,0)
   : GOSUB '91
   : ON J0+1GOTO 4620,,,,,,,4000
   : GOTO 5920
4420 GOSUB '34(HEX(08))
   : IF Q6$="END"THEN 5860
   : K1$,K2$=Q6$
   : GOTO 4560
4470 PRINT AT(3,0,80);"Starting ID must be lower than Ending ID.";HEX(07)
4480 GOSUB '34("STARTING")
   : IF Q6$="END"THEN 5740
   : K1$=Q6$
   : GOSUB '34("ENDING")
   : K2$=ALL(7F)
   : IF Q6$<>"END"THEN K2$=Q6$
   : IF K1$>K2$THEN 4470
4560 K=0
   : Q6$=STR(K1$)&ALL(00)
   : GOSUB '232(1,0,Q6$)
   : K1$=HEX(00)
   : GOTO 5400
4620 K9=Q
   : A1$="Customer not on file"
   : GOSUB '232(2,0,STR(T7$,,Q0))
   : IF Q$=" "THEN GOSUB '50(4," ")
   : Q=K9
4670 GOSUB '51(2,Q)
   : K1$=STR(T7$,,Q0)
   : IF K1$>K2$THEN 5650
   : K1=K1+1
   : GOSUB '123(D1(Q))
   : D6$=U9$
   : B8(1)=0
   : B8(2)=A(Q)
   : B8(3)=A1(Q)
   : B8(4)=A2(Q)
   : ON VAL(F$(Q))-48GOTO 4930,4990,5040,5090,,,,5140,5140
   : IF C(Q)=0THEN 4870
   : E6$="INV"
   : E7$="INVOICE"
   : B8=A(Q)-A1(Q)-A2(Q)
   : GOTO 5190
4870 E6$="BAL"
   : E7$="BALANCE FWD."
   : B8,B8(2)=C1(Q)+A(Q)+A1(Q)+A2(Q)
   : B8(3),B8(4)=0
   : GOTO 5190
4930 E6$="PAY"
   : E7$="PAYMENT"
   : B8=-A1(Q)-A2(Q)
   : D(Q)=C1(Q)
   : GOTO 5190
4990 E6$="DM"
   : E7$="DEBIT MEMO"
   : B8=A(Q)-A1(Q)-A2(Q)
   : GOTO 5190
5040 E6$="CM"
   : E7$="CREDIT MEMO"
   : B8=-A(Q)
   : GOTO 5190
5090 E6$="C/I"
   : E7$="CREDIT INV."
   : B8=-A(Q)
   : GOTO 5190
5140 E6$="S/C"
   : E7$="SERVICE CHG."
   : B8,B8(2)=C1(Q)+A(Q)+A1(Q)+A2(Q)
   : B8(3),B8(4)=0
5190 B6=B6+B8
   : IF C6$="A"THEN 5300
   : D7=D6-INT(365.25*(INT(D1(Q)/1E3)-1))-MOD(D1(Q),1E3)
   : MAT B8=ZER
   : Q9=0
   : FOR J=1TO 4
   : IF D7>=B9(J)THEN Q9=J
   : NEXT J
   : IF Q9=0THEN 5400
   : ELSE B8(Q9)=B8
   : MAT B6=B6+B8
5300 IF A6$="Y"THEN GOSUB 6860
   : SELECT PRINT 005(80)
   : IF B6$="N"THEN PRINT AT(5,0,80);"Processing customer ";C$;HEX(06)
   : IF B6$="N"THEN 5400
   : B9=1
   : GOSUB 6700
   : K=MOD(K+1,15)
   : IF K=0THEN GOSUB '254
   : IF Q6$=HEX(1F)THEN GOSUB '31
5400 IF J0=7THEN GOSUB '92
   : GOSUB '237(1,0)
   : J$(1)=" "
   : GOSUB '91
   : IF J0=7THEN 5400
   : IF J0>1THEN 5920
   : IF J0=1THEN T7$=HEX(FF)
   : IF K1$=HEX(00)AND J0=0THEN 4620
   : IF K1$=STR(T7$,,Q0)THEN 4670
   : IF A6$="Y"THEN GOSUB 6590
   : SELECT PRINT 005(80)
   : IF T7$=HEX(FF)THEN Q=1
   : C$(Q)=" "
   : C(Q),D(Q)=0
   : E7$="   CUSTOMER"
   : U9$="BALANCE"
   : PRINT AT(4,36);
   : MAT B8=ZER
   : IF C6$="A"THEN B8(2)=B6
   : ELSE MAT B8=B6
5590 IF B6$="Y"THEN GOSUB 6700
   : IF B6$="Y"AND B9=0THEN PRINT AT(5,0,);"NO RECORDS FOR CUSTOMER";TAB(79)
   : B7=B7+B6
   : MAT B7=B7+B6
   : K,B6,B9=0
   : MAT B6=ZER
5650 IF K$="A"AND T7$=HEX(FF)THEN 5730
   : IF K$="I"THEN 4420
   : IF K$="R"THEN IF STR(T7$,,Q0)>K2$THEN 4480
   : IF B6$="Y"THEN GOSUB '254
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : GOTO 4620
5730 IF B6$="Y"THEN GOSUB '254
5740 IF A6$="N"OR K$="I"THEN 5860
   : SELECT PRINT <I0$>(87)
   : PRINT HEX(0A)
   : IF K1=0THEN 5860
   : A1$="REPORT"
   : IF C6$="A"THEN B6=B7
   : ELSE MAT B6=B7
   : GOSUB 6590
   : PRINT "NO. OF RECORDS PROCESSED = ";K1
   : B6,B7=0
   : MAT B6=ZER
   : MAT B7=ZER
5860 SELECT PRINT 005(80)
   : PRINT AT(1,0,)
   : GOSUB '100("M,R","MmRr",1,1,"ENTER R TO RESTART, M FOR MENU",2)
   : IF Q6$="R"THEN 4000
   : J0=0
5920 DEFFN'31
   : IF J0>0THEN GOSUB '254
   : LOAD TM$
6020 DEFFN'90
   : Q6$=" "
   : KEYIN Q6$,6050,6050
6050 IF Q6$="P"THEN GOSUB '254
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : SELECT PRINT <I0$>(132)
   : IF L<L0THEN RETURN
   : P1=P1+1
   : PRINT HEX(0C0A0E);TAB(3);N2$
   : PRINT K3$;TAB(57);"A/R OPEN ITEM FILE";TAB(110);Q1$;TAB(122);"PAGE";P1
   : PRINT HEX(0A)
   : PRINT "CUST ID   INV NO.     TYPE         DATE";TAB(47);"REF NO.";
6140 IF C6$="A"THEN PRINT TAB(66);"TOTALS";TAB(84);"AMOUNT";TAB(98);"DISC/ALLO
     W";TAB(119);"PAYMENT";
   : ELSE PRINT TAB(60);B9$(1);TAB(78);B9$(2);TAB(96);B9$(3);TAB(114);B9$(4)
   : PRINT HEX(0A)
   : L=7
   : RETURN
6190 DEFFN'34(Q7$)
   : IF B6$="N"THEN PRINT AT(5,0,80)
   : PRINT AT(1,0,80);"ENTER ";Q7$;" CUSTOMER ID (OR END)"
   : GOSUB '100(" ",HEX(7F),Q0,0," ",2)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : IF Q6$="end"THEN Q6$="END"
   : IF Q6$="END"THEN RETURN
   : GOSUB '96(1)
   : RETURN
6290 PRINT AT(5,0,)
   : IF B9$()=" "THEN B9$()="     CURRENT     31 - 60     61 - 90     OVER 90"
   : Q6$=HEX(0000003100610091)
   : IF MAX(B9())=0THEN $UNPACK(F=HEX(6002))Q6$TO B9()
   : Q9=B9(1)
   : GOSUB '100("0","9998",4,0,"ENTER LOWER AGE LIMIT FOR ITEMS TO BE LISTED (
     IN DAYS)",1)
   : B9(1)=Q9
6360 PRINT AT(5,0);,"COLUMN NO.";TAB(30);"HEADING";TAB(40);"LOWER LIMIT (IN DA
     YS)"
   : FOR J=1TO 4
   : PRINT AT(1,0);"ENTER HEADING FOR COLUMN ";J
   : Q6$=B9$(J)
   : GOSUB '100(" ",HEX(7F),12,0," ",3)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : B9$(J)=" "
   : STR(B9$(J),13-LEN(Q6$))=Q6$
   : PRINT AT(5+J,0);TAB(19);J;TAB(25);B9$(J);TAB(47);
   : PRINTUSING "####",B9(J)
6460 IF J=4THEN 6530
   : CONVERT B9(J)TO Q$(1),(####)
   : PRINT AT(1,0);"ENTER UPPER AGE LIMIT";J;"(IN DAYS)"
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : Q9=MAX(B9(J+1)-1,B9(J))
   : GOSUB '100(Q$(1),"9999",4,0," ",0)
   : B9(J+1)=Q9+1
6530 NEXT J
   : GOSUB '100("Y,N","YyY Nn",1,1,"ARE AGE LIMITS CORRECT (Y OR N)",2)
   : IF Q6$=HEX(1F)THEN GOSUB '31
   : IF Q6$="N"THEN 6290
   : RETURN
6590 GOSUB '90
   : PRINT TAB(20);"BALANCE FOR ";A1$;
   : MAT B8=ZER
   : IF C6$="A"THEN B8(1)=B6
   : ELSE MAT B8=B6
   : IF C6$="A"AND A1$="REPORT"THEN B8(1)=B7
   : GOSUB 6910
   : PRINT
   : L=L+1
   : RETURN
6670 %###,###.##-
6680 %########
6700 IF K>0THEN 6750
   : PRINT AT(4,0,);"CUST ID ";C$;"  ";A1$;HEX(0D0A);"INV NO.   TRANS TYPE  IN
     V DATE";
   : IF B9=0THEN RETURN
   : IF C6$="A"THEN PRINT TAB(35);"REF NO.      AMOUNT  DISC/ALLOW     PAYMENT
     "
   : ELSE PRINT TAB(30);B9$(1);TAB(42);B9$(2);TAB(54);B9$(3);TAB(66);B9$(4)
6750 PRINT AT(6+K,0,0)
   : IF C(Q)>0THEN PRINTUSING 6680,C(Q);
   : PRINT TAB(8);C$(Q);TAB(10);E7$;TAB(22);U9$;TAB(30);
   : IF C6$="A"AND D(Q)>0THEN PRINTUSING 6680,D(Q);
   : FOR J=1TO 4
   : PRINT TAB(20+J*12);
   : IF B8(J)<>0THEN PRINTUSING 6670,B8(J);
   : NEXT J
   : PRINT
   : RETURN
6860 GOSUB '90
   : PRINT STR(C1$(Q),,MIN(Q0,10));TAB(10);
   : PRINTUSING 6680,C(Q);
   : PRINT TAB(19);C$(Q);TAB(23);E6$;TAB(31);U9$;TAB(46);
   : IF E6$<>"BAL"AND E6$<>"S/C"THEN PRINTUSING 6680,D(Q);
6910 FOR J=1TO 4
   : PRINT TAB(44+J*18);
   : IF B8(J)<>0THEN PRINTUSING 6670,B8(J);
   : NEXT J
   : PRINT
   : L=L+1
   : RETURN
9998 DEFFN'29"Q$=";HEX(22);"ACCT010A";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 - Print/display A/R open items.";HEX(22);":SELECT#15<I0$>:$OPEN#
     15:SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:SEL
     ECTLIST005(80)";HEX(0D)