Listing of file='INVC050A' on disk='vmedia/701-2607C.wvd.zip'
# Sector 154, program filename = 'INVC050A'
0010 REM INVC050A, RELEASE 2.1, (04/09/80) THIS PROGRAM IS A COPYRIGHT PRODUCT
OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0170 DIM K$1,K1$4,K2$4
: GOTO 4000
4000 SELECT @PARTS0$
: GOSUB '93("MOUNT INVOICE FORMS")
: L0=42
: Q$=" "
: IF I0$=" "THEN 5140
: GOSUB '84
: SELECT PRINT 005(80)
4080 GOSUB '100("C,O","CcC Oo",1,1,"ENTER INVOICE TRANSACTION FILE ID (C = Cur
rent, O = Old)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: A6=Q9
: K2$=ALL(99)
: GOSUB '100("A,R,I","AaRrIi",1,1,"ENTER REPORT TYPE (A=ALL, R=RANGE, I=IN
DIVIDUAL)",2)
: K$=Q6$
: ON Q9GOTO 4410,4260
4130 GOSUB '34(HEX(08))
: IF Q9=0THEN 5080
: K1$,K2$=Q6$
: Q6$=STR(K1$,,4)&ALL(00)
: GOSUB '232(A6,0,Q6$)
: GOSUB '237(A6,0)
: IF STR(T7$,,4)=K1$AND Q$=" "THEN 4470
: IF Q$=" "THEN Q$="N"
: GOSUB '91
: ON J0GOTO 4130,,4130,,,,4130
: GOTO 5140
4250 PRINT AT(3,0,80);HEX(07);"Starting invoice number must be lower than endi
ng invoice number."
4260 GOSUB '34("STARTING")
: IF Q9=0THEN 5080
: K1$=Q6$
: GOSUB '34("ENDING")
: K2$=ALL(99)
: IF Q9>0THEN K2$=Q6$
: IF K2$<K1$THEN 4250
: Q6$=STR(K1$,,4)&ALL(00)
: GOSUB '232(A6,0,Q6$)
: GOSUB '237(A6,0)
: IF Q$=" "THEN 4470
: GOSUB '91
: ON J0GOTO 4260,,4260,,,,4260
: GOTO 5140
4410 GOSUB '235(A6,0)
: J$(3)=" "
: IF Q$=" "THEN 4470
: GOSUB '91
: ON J0GOTO 5010,,5010,,,,4080
: GOTO 5140
4470 GOSUB '54(A6,1)
: IF K$<>"A"OR P4$<>"P"THEN 4477
: B$=STR(T7$,,4)&HEX(FFFF)
: GOSUB '232(A6,0,B$)
: GOTO 4870
4477 P4$="P"
: DBACKSPACE #A6,1S
: GOSUB '44(A6,1)
: B7=0
: P1=1
: CONVERT I2$TO Q9
: Q6$=" CREDIT INVOICEDEBIT MEMO CREDIT MEMO"
: H6$=STR(Q6$,Q9*14+1,14)
: PRINT AT(6,0,80);"Processing invoice no. ";HEXOF(STR(B$,,4))
: GOSUB '81
4560 IF J0=7THEN GOSUB '92
: GOSUB '237(A6,0)
: GOSUB '91
: IF J0=7THEN 4560
: IF J0>0THEN 5140
: GOSUB '54(A6,2)
: I=1
4630 IF P$(I)="END"THEN 4700
: B7=B7+B4(I)
: GOSUB '82(I)
: IF I=N0THEN 4560
: I=I+1
: GOTO 4630
4700 IF J0=7THEN GOSUB '92
: GOSUB '237(A6,0)
: GOSUB '91
: IF J0=7THEN 4700
: IF J0>0THEN 5140
: GOSUB '54(A6,3)
: IF D1=B7+G(1)+G(2)+G(3)+A2+D-A1THEN 4810
: PRINT AT(3,0,80);HEX(07);"Invoice total out of balance."
: GOSUB '100("Y,N","YyY Nn",1,1,"DO YOU WANT TO CONTINUE (Y OR N)",2)
: IF Q6$="N"THEN 5080
4810 GOSUB '83
: Q6$=" "
: KEYIN Q6$,4840,4840
4840 IF Q6$="P"THEN GOSUB '254
: IF Q6$=HEX(1F)THEN GOSUB '31
4870 IF J0=7THEN GOSUB '92
: GOSUB '237(A6,0)
: IF Q$="E"THEN 5010
: GOSUB '91
: IF J0=7THEN 4870
: IF J0>0THEN 5140
: IF STR(T7$,,4)<=K2$THEN 4470
5010 ON POS("ARI"=K$)GOTO ,4260,4130
: $OPEN #3
: GOSUB '46(3,0,1)
: IF M(11)+1=A6THEN M(6)=1
: ELSE M(13)=1
: GOSUB '46(3,0,0)
: $CLOSE#3
5080 SELECT PRINT 005(80)
: PRINT AT(1,0,)
: GOSUB '100("M,R","RrMm",1,1,"ENTER R TO RESTART, M FOR MENU",2)
: IF Q6$="R"THEN 4080
: Q$=" "
5140 DEFFN'31
: GOSUB '91
: IF J0>0THEN GOSUB '254
: LOAD TM$
6020 DEFFN'34(Q7$)
: PRINT AT(6,0,80);AT(1,0,80);"ENTER ";Q7$;" INVOICE NO. (0 = END)"
: GOSUB '100("0","99999999",8,0," ",1)
: IF Q6$=HEX(1F)THEN GOSUB '31
: PACK(########)Q6$FROMQ9
: RETURN
6080 %###,###.##-
6090 %##,###.##-
6100 %##,###.##
6120 DEFFN'81
: MAT REDIM M$(8)23
: M$()=" "
: M$(1)=B0$
: J=2
: IF C0$>" "THEN M$(J)=C0$
: ELSE J=J-1
: J=J+1
: IF D0$>" "THEN M$(J)=D0$
: ELSE J=J-1
: J=J+1
: IF E0$>" "OR F0$>" "THEN M$(J)=E0$&" "&F0$
: ELSE J=J-1
: M$(5)=L0$
: J=6
: IF M0$>" "THEN M$(J)=M0$
: ELSE J=J-1
: J=J+1
: IF N0$>" "THEN M$(J)=N0$
: ELSE J=J-1
: J=J+1
6300 IF O0$>" "OR P0$>" "THEN M$(J)=O0$&" "&P0$
: ELSE J=J-1
: SELECT PRINT <I0$>(85)
: FOR J=1TO 4
: PRINT TAB(9);M$(J);TAB(46);M$(J+4)
: NEXT J
: MAT REDIM M$(4)62
: GOSUB '85(D4)
: PRINT
: IF O2$<>HEX(FF)THEN PRINT TAB(43);"ORDER ";HEXOF(STR(O2$,,3));"-";HEXOF(A
0$);" DATE ";Q6$;
: IF P1>1THEN PRINT TAB(72);"PAGE";P1;
: PRINT
: PRINT HEX(0E);
: PRINT TAB(13);H6$
: PRINT HEX(0A0A)
: GOSUB '85(D3)
6460 PRINT TAB(1);G0$;TAB(11);C1$;TAB(19);O3$;TAB(33);H0$;TAB(47);H1$;TAB(52);
N4$;TAB(59);Q6$;TAB(70);HEXOF(STR(B$,,4))
: PRINT HEX(0A0A)
: L=23
: SELECT PRINT 005(80)
: RETURN
6510 DEFFN'85(Q9)
: CONVERT Q9TO Q7$,(######)
: Q6$=STR(Q7$,,2)&"/"&STR(Q7$,3,2)&"/"&STR(Q7$,5)
: RETURN
6560 DEFFN'82(I)
: IF L>37THEN 6750
: SELECT PRINT <I0$>(85)
: PRINT TAB(1);P$(I);TAB(15);
: IF B(I)>0THEN PRINTUSING "#####",B(I);
: PRINT TAB(22);P1$(I);TAB(47);
: IF B1(I)>0THEN PRINTUSING 6080,B1(I);
: PRINT TAB(58);
: IF B2(I)>0THEN PRINTUSING 6090,ROUND((B(I)*B1(I)*B2(I)/100,2);
: PRINT TAB(69);
: IF B4(I)<>0THEN PRINTUSING 6080,B4(I);
: IF B0$(I)<>" "THEN PRINT TAB(79);"*"
: ELSE PRINT
: L=L+1
: SELECT PRINT 005(80)
: RETURN
6750 SELECT PRINT <I0$>(85)
: Q$()=ALL(0D)
: PRINT STR(Q$(),,L0-3-L)
: PRINT TAB(70);"CONTINUED"
: PRINT STR(Q$(),,12)
: P1=P1+1
: GOSUB '81
: GOTO 6560
6850 DEFFN'83
: SELECT PRINT <I0$>(85)
: Q$()=ALL(0D)
: PRINT STR(Q$(),,L0-3-L)
: PRINTUSING 6100,G(1);
: PRINT TAB(9);
: PRINTUSING 6100,G(2);
: PRINT TAB(18);
: PRINTUSING 6100,G(3);
: PRINT TAB(27);
: PRINTUSING 6090,A2;
: PRINT TAB(37);
: PRINTUSING 6090,A1;
: PRINT TAB(49);
: PRINTUSING 6080,D;
: PRINT TAB(69);
: PRINTUSING 6080,D1
: GOSUB '85(D5)
: IF D2>0THEN PRINTUSING "CASH DISCOUNT OF ##.##% IF PAID BY ########",D2,Q
6$;
: PRINT
: PRINT STR(Q$(),,12)
: SELECT PRINT 005(80)
: RETURN
7090 DEFFN'84
: GOSUB '100("Y,N","YyY Nn",1,1,"DO YOU WANT TO PRINT A MASK (Y OR N)",2)
: IF Q6$="N"THEN RETURN
7120 SELECT PRINT <I0$>(87)
: C1$,B0$,L0$,C0$,M0$,N0$,D0$,E0$,O0$,F0$,P0$,G0$,N4$,O3$,H$,H0$,P$(),P1$()
,B0$(),C0$()=ALL("X")
: O2$,A0$=ALL(99)
: D3,D4,D5,B(1)=999999
: B1(1)=999999.99
: P1=1
: GOSUB '81
: GOSUB '82(1)
: GOSUB '83
7210 C1$,B0$,L0$,C0$,M0$,N0$,D0$,E0$,O0$,F0$,P0$,O2$,G0$,N4$,O3$,H$,H0$,P$(),P
1$(),B0$(),C0$()=" "
: O2$=HEX(FF)
: A0$=HEX(00)
: D3,D4,D5,B(1),B1(1)=0
: GOSUB '100("Y,N","YyY Nn",1,1,"DO YOU WANT ANOTHER MASK (Y OR N)",2)
: IF Q6$="Y"THEN 7120
: RETURN
9998 DEFFN'29"Q$=";HEX(22);"INVC050A";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 invoices.";HEX(22);":SELECT#15<I0$>:$OPEN#15:SELECTLIST<
I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:SELECTLIST005(80)
";HEX(0D)