Listing of file='INVT110E' on disk='vmedia/701-2661A.wvd.zip'
# Sector 91, program filename = 'INVT110E'
0010 REM INVT110E, RELEASE 1-0, (06/15/79), THIS PROGRAM IS A COPYRIGHT PRODUC
T OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED,
SALES PROJ/L.O.S. EXECUTION
0170 DIM B8$24,B9$24,D6(13),D8(13),E6(13),E8(13),E9$10,F9$1,P$(12)3,K5$(50)4
: DIM D6$4,D6$(3)8,D7$6,D7$(39)15,K9$4
: DIM C6$4,C6$(21)2,C7$(21)1,P7$(1)2
4000 GOSUB 6575
: IF I6$="K"THEN 4250
: DATA LOAD DC OPEN T#4,S$(4)
: LIMITS T#1,S$(1),B6,E8,E8
: DATA LOAD DC OPEN T#1,S$(1)
: DATA LOAD DC #4,K5$()
: IF END THEN B8=0
: ELSE B8=1
: GOSUB '90
: IF B8=0THEN GOSUB '31
4070 IF B8<51THEN 4095
: B8=1
: DATA LOAD DC #4,K5$()
: IF END THEN K5$()=ALL(FF)
4095 IF STR(K5$(B8),1,1)<>HEX(FF)THEN 4120
: GOSUB 4555
: GOSUB 4615
: GOSUB '31
4120 B7=VAL(K5$(B8),2)-B6
: IF B7=0THEN 4135
: DSKIP #1,B7S
4135 GOSUB '78(1)
: F8$=STR(M$(B6(1)),B6(2),B6(3))
: DBACKSPACE #1,(B7+1)S
: IF F9$="1"THEN 4180
: F6$=F8$
: GOSUB 4950
: GOTO 4205
4180 IF F6$=F8$THEN 4205
: GOSUB 4555
: F6$=F8$
: GOSUB 4950
4205 MAT D6=ZER
: ON I6+1GOSUB 6270,5420
: F9$="1"
: B8=B8+1
: GOTO 4070
4250 GOSUB '90
: IF K6>3THEN 4350
: ON K6GOTO 4350,4295
4270 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER PRODUCT ID (OR END)",2)
: IF Q6$=HEX(1F)OR Q6$="END"OR Q6$="end"THEN 4505
: GOSUB '96(2)
: F6$=Q6$
4295 GOSUB '232(1,0,F6$)
: IF K6=3THEN 4310
: IF Q$="N"THEN 4445
4310 GOSUB '91
: IF J0=0THEN 4390
: PRINT AT(3,LEN(J$(J0))+1);"- PRODUCT ID ";F6$
: IF J0=3THEN 4270
: IF J0<>7THEN 6555
: GOSUB '92
: GOTO 4295
4350 GOSUB '235(1,0)
: IF Q$=" "THEN 4390
: GOSUB '91
: PRINT AT(3,LEN(J$(J0))+1);"- INVENTORY FILE"
: IF J0<>7THEN 6555
: GOSUB '92
: GOTO 4350
4390 GOSUB '78(1)
: IF K6<4THEN 4420
: F8$=STR(M$(B6(1)),B6(2),B6(3))
: IF F8$<>F6$THEN 4445
4420 MAT D6=ZER
: ON I6+1GOSUB 6270,5420
: F9$="1"
: IF K6=3THEN 4270
4445 GOSUB '237(1,0)
: IF Q$=" "THEN 4495
: IF Q$="E"THEN 4505
: GOSUB '91
: IF J0<>7THEN 4480
: GOSUB '92
: GOTO 4445
4480 PRINT AT(3,LEN(J$(J0))+1);"- INVENTORY FILE"
: GOTO 6555
4495 IF K6<>2THEN 4390
: IF T7$<=F7$THEN 4390
4505 GOSUB 4555
: GOSUB '31
4530 % ##########
4535 DEFFNL(Z)=ROUND((100*E6(Z)/(E6(Z)+E6(1+Z)),2)
4540 DEFFNR(Z)=ROUND((Z,0)
4555 MAT E6=D8
: MAT E8=E8+D8
: MAT D8=ZER
: B8$="TOTALS"
: B9$=" "
: IF I6=0THEN 4630
: IF I6$="K"THEN 4630
: B8$=F6$
: STR(B8$,LEN(B8$)+2)="TOTALS"
: GOTO 4630
4615 B8$="GRAND TOTALS"
: B9$=" "
: MAT E6=E8
4630 GOSUB '90
: PRINT HEX(0A)
: L=L+1
: IF F9$="1"THEN 4675
4650 PRINT " NO PRODUCTS IN GROUP"
: L=L+1
: RETURN
4675 IF I6=1THEN 4755
: I4=E6(1)
: FOR I3=1TO 12
: IF E6(I3)<=I4THEN 4700
: I4=E6(I3)
4700 NEXT I3
: IF I4<99999999THEN 4755
: I4=INT(LOG(I4+1)/LOG(10))-7
: B9$="SCALED BY 1"
: INIT(30)Q6$
: STR(B9$,12)=STR(Q6$,1,I4)
: MAT E6=(10^(-I4))*E6
4755 GOSUB '90
: IF I6=0THEN 4825
: IF A6$="S"THEN 4780
: PRINT TAB(5);B8$;TAB(19);B9$;TAB(I2-1);
: GOTO 4790
4780 PRINT B8$;TAB(I2-1);
4790 I3,I4=0
: IF E6(1)+E6(2)>0THEN I3=FNL(1)
: IF E6(3)+E6(4)>0THEN I4=FNL(3)
: PRINTUSING "-#####,###,### -#####,###,### -###.## -#####,###,### -#####
,###,### -###.##",E6(1),E6(2),I3,FNR(E6(3)),FNR(E6(4)),I4
: L=L+1
: RETURN
4825 PRINT B8$;TAB(12);
: Q9,I4=0
: FOR I3=1TO 13
: IF I3=I2THEN 4880
: I4=I4+1
: E8=E6(I4)
: Q9=Q9+E8
: E6(I4)=Q9
: PRINTUSING " ########",FNR(E8);
: GOTO 4885
4880 PRINTUSING 4530,FNR(E6(13)+Q9);
4885 NEXT I3
: PRINT
: PRINT " ";B9$;
: FOR I3=3TO 12STEP 3
: PRINT TAB(1+I3*9+5.5*(SGN(I3-I2+.5)+1));
: PRINTUSING 4530,FNR(E6(I3));
: NEXT I3
: PRINT
: L=L+2
: RETURN
4950 IF A6$="S"AND I6=1THEN RETURN
: GOSUB '90
: PRINT HEX(0A);TAB(5*(1-K6));"*** ";B6$;" ";F8$;" ***"
: PRINT HEX(0A)
: L=L+3
: RETURN
4995 MAT D8=D8+D6
: IF A6$="D"THEN 5010
: RETURN
5010 B8$=F1$
: B9$=F2$
: MAT E6=D6
: GOSUB 4755
: RETURN
5045 DEFFN'90
: SELECT PRINT 005(80)
: Q6$=" "
: KEYIN Q6$,5070,5070
5070 IF Q6$="P"THEN GOSUB '254
: IF Q6$=HEX(1F)THEN GOSUB '31
: SELECT PRINT <I0$>(132)
: IF L<=L0-3THEN RETURN
: P1=P1+1
: PRINT HEX(0D0C0A0E);TAB(3);N2$
: IF I6=0THEN 5130
: PRINT TAB(55);"LEVEL OF SERVICE REPORT";
: GOTO 5150
5130 Q6$="DOLLARS"
: IF A9$="Y"THEN 5145
: Q6$="UNITS"
5145 PRINT "FIGURES IN ";Q6$;TAB(55);"SALES PROJECTION REPORT";
5150 PRINT TAB(109);Q1$;" PAGE";P1
: L=3
: IF P1>1THEN 5240
: PRINT HEX(0A);"DATA GROUPING: ";B6$;" ";
: IF (K6-1)*(K6-3)=0THEN 5205
: IF F6$=" "THEN PRINT "BEGINNING";
: ELSE PRINT F6$;
: IF F7$=F6$THEN 5205
: Q6$=F7$
: IF POS(STR(F7$,1,B6(3))<>7F)=0THEN Q6$="END"
: PRINT " TO ";Q6$;
5205 PRINT
: L=L+2
: IF I6$="K"THEN 5240
: IF B8>0THEN 5240
: PRINT HEX(0A)
: GOSUB 4650
: RETURN
5240 IF I6=0THEN 5300
: PRINT HEX(0A);TAB(I2+3);"YEAR TO DATE UNIT SALES: LEVEL OF YEAR
TO DATE $ SALES: LEVEL OF"
: IF A6$="S"THEN 5265
: PRINT TAB(5);"PRODUCT ID DESCRIPTION";
5265 PRINT TAB(I2+9);"MADE LOST SERVICE MADE L
OST SERVICE"
: PRINT HEX(0A)
: L=L+4
: RETURN
5300 I4=1+SGN(I5-1)*(13-I5)
: Q6$=STR(Q1$,7,2)
: IF K5+I5=2THEN 5330
: CONVERT STR(Q1$,7,2)TO I3
: CONVERT I3+1TO Q6$,(##)
5330 IF A6$="S"THEN 5340
: PRINT HEX(0A);"PRODUCT ID";
5340 PRINT TAB(I4*9+8+5.5*(SGN(I4-I2+.5)+1));"19";Q6$
: PRINT "DESCRIPTION ";
: FOR I3=1TO 13
: IF I3<>I2THEN 5370
: PRINT " TOTAL";
5370 IF I3=13THEN 5380
: PRINT " ";P$(I3);
5380 NEXT I3
: PRINT
: PRINT " QUARTERLY CUMULATIVE TOTALS"
: PRINT HEX(0A)
: L=L+5
: RETURN
5420 D6(1)=H+H2
: D6(2)=D3(1)+D3(2)
: D6(3)=H1+H4
: IF D6(1)*D6(3)<=0THEN 5460
: I4=D6(3)/D6(1)
: GOTO 5470
5460 IF H(1)>0THEN I4=H(1)
: ELSE I4=0
5470 D6(4)=I4*D6(2)
: FOR I3=1TO 4
: D6(I3)=ROUND((D6(I3),0)
: NEXT I3
: GOSUB 4995
: RETURN
5495 DEFFN'173
: B$=" "
: IF K9=0THEN 5760
: IF INT(-C5)=-1THEN 5530
: B$="A"
5530 GOSUB 6085
: INIT(00)D6$(),D7$()
: CONVERT STR(K9$,1,2)TO F7
: D8,F9=F7
: D6=D
: IF D>0THEN 5590
: D6,D7,D9=0
: B$="D"
: RETURN
5590 D7=D1
: E7=D*D7
: IF A4$="F"THEN 5610
: D7,E7=0
5610 IF I9=0THEN 5630
: GOSUB 5815
5630 A6=B(F7)*D6*(1+D7*.5)
: A7=A6+C8*D6*SQR(B(F7))
: A8=A7-F6
: IF A8>0THEN 5660
: A8=0
5660 F6=F6+A8-A6
: $PACK(F=D7$)D7$(F9-D8+1)FROMA6,A7,A8
: IF D7>0THEN 5695
: D6=D6*(1+D7)
: GOTO 5700
5695 D6=D6+E7
5700 IF F7<>P2THEN 5725
: GOSUB 5775
: $PACK(F=D6$)D6$(-INT(-F9/P))FROMD6,D9
5725 F7=F7+1
: F9=F9+1
: IF F7<=PTHEN 5745
: F7=1
5745 IF F9<D8+K9THEN 5630
: GOSUB 5775
5760 RETURN
5775 D9=0
: IF F8=0THEN 5790
: D9=(D6-F8)/F8
5790 F8=D6
: RETURN
5815 IF K9>1THEN 5845
: IF B(F7)=0THEN 6055
: D7=2*(I9/(D*B(F7))-1)
: GOTO 6040
5845 D7,E7,A7,A8=0
: FOR A6=D8TO D8+K9-1
: D9=A6-INT((A6-1)/P)*P
: A7=A7+B(D9)
: A8=A8+B(D9)*(A6-D8)
: NEXT A6
: IF A7*D>I9THEN 5940
: IF A8=0THEN 6055
: D7=(-A7*.5-A8+SQR(A7*A7*.25+A8*A8-A7*A8+2*A8*I9/D))/A8
: E7=D*D7
: RETURN
5940 IF I9<=D*.5*B(F7)THEN 6055
5955 A7=B(D8)
: A8=0
: A9=1
: FOR A6=D8+1TO D8+K9-1
: D9=A6-P*INT((A6-1)/P)
: A8=A8+B(D9)*A9*(A6-D8)
: A9=A9*(1+D7)
: A7=A7+B(D9)*A9
: NEXT A6
: A8=D*((1+.5*D7)*A8+.5*A7)
: IF A8=0THEN 6055
: A7=(D*(1+.5*D7)*A7-I9)/A8
: D7=D7-A7
: IF ABS(A7)>=.001THEN 5955
6040 IF D7<=-1THEN 6055
: RETURN
6055 D7=D1
: B$="C"
: RETURN
6085 IF D0*D=0THEN 6145
: C8=C5
: IF INT(-C8)=-1THEN 6105
: C8=.95
6105 C8=D/D0*(1-C8)
: IF C8>=.5THEN 6145
: PACK(.####)C6$FROMC8
: MAT SEARCHC6$(),>STR(C6$,1,2)TO P7$()STEP 2
: C9=.5*VAL(STR(P7$(1),2))+.5
: IF C9>1THEN 6160
6145 C8=0
: RETURN
6160 UNPACK(.####)C6$(C9-1)TO D6
: UNPACK(.####)C6$(C9)TO D8
: UNPACK(#.#)C7$(C9-1)TO D7
: UNPACK(#.#)C7$(C9)TO D9
: C8=((D9-D7)/(D8-D6)*(C8-D6)+D7)*(D0/D)
: RETURN
6205 DEFFN'172
: A4$="F"
: C5=.95
: D1=0
: I9=0
: P=12
: P2=I8
: D6$=HEX(51055303)
: D7$=HEX(510551055105)
: RETURN
6270 IF E9$=G1$THEN 6355
: GOSUB '232(2,0,G1$)
: IF Q$=" "THEN 6340
: IF Q$="N"THEN 6315
: GOSUB '91
: PRINT AT(3,LEN(J$(J0))+1);"- PROFILE ID ";G1$
: IF J0<>7THEN 6555
: GOSUB '92
: GOTO 6270
6315 GOSUB '90
: L=L+1
: PRINT F1$;" PROFILE ";G1$;" NOT FOUND"
: RETURN
6340 GOSUB '79(8)
: E9$=G1$
6355 Q9=1
: IF I1$="L"THEN 6380
: Q9=2
: IF I1$="M"THEN 6380
: Q9=3
6380 A4$=STR(D4$(),Q9,1)
: D0,F8=0
: GOSUB '173
: FOR I3=I7TO I7+11
: $UNPACK(F=D7$)D7$(I3)TO D6(I3-I7+1)
: NEXT I3
: IF K2=0THEN 6465
: FOR I3=K1TO K1+K2-1
: $UNPACK(F=D7$)D7$(I3)TO I4
: D6(13)=D6(13)+I4
: NEXT I3
6465 Q9=H2
: IF A9$="N"THEN 6530
: IF H+H2<10THEN 6500
: I4=(H1+H4)/(H+H2)
: GOTO 6510
6500 IF H(1)>0THEN I4=H(1)
: ELSE I4=0
6510 MAT D6=(I4)*D6
: Q9=H4
6530 D6(13)=D6(13)+Q9*K3
: FOR I3=1TO 13
: D6(I3)=ROUND((D6(I3),0)
: NEXT I3
: GOSUB 4995
: RETURN
6555 PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED"
: GOSUB '254
6575 SELECT @PARTS0$
: SELECT PRINT 005(80),LIST 005,CO 005
: IF I6=0THEN Q6$="SALES PROJECTION REPORT"
: ELSE Q6$="LEVEL OF SERVICE REPORT"
: PRINT HEX(03);AT(0,40-.5*LEN(Q6$));Q6$
: GOSUB '93(" ")
: IF I0$=" "THEN GOSUB '31
: IF K6<>3THEN PRINT AT(10,33,0);"PRINTING REPORT"
: F9$="0"
: P1=0
: L=L0+5
: MAT D8=ZER
: MAT E8=ZER
: I2=48
: IF A6$="D"THEN 6660
: I2=22
6660 IF I6=1THEN RETURN
: Q6$="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
: MAT REDIM P$(1)36
: P$(1)=STR(Q6$,I5*3-2)
: IF I5=1THEN 6695
: STR(P$(1),40-I5*3)=Q6$
6695 MAT REDIM P$(12)3
: GOSUB '172
: STR(K9$,1,2)=STR(Q1$,1,2)
: CONVERT STR(K9$,1,2)TO K5
: I7=1+I5-K5-6*(SGN(I5-K5+.5)-1)
: K9=I7+11
: K1,K3=1
: K2=I7-1
: I2=2+I8-I5-6*(SGN(I8-I5+.5)-1)
: IF I2<13THEN 6785
: K2,K3=0
: RETURN
6785 IF I7=1THEN RETURN
: FOR I3=K5TO K5+I7-1
: IF I3-12*INT((I3-1)/12)<>I8THEN 6815
: K1=I3-K5+2
: K2=I7-K1
: K3=0
6815 NEXT I3
: RETURN
6835 DEFFN'31
: SELECT PRINT 005(80)
: PRINT HEX(030A);TAB(20);"** TERMINATING PROGRAM **"
: Q=2
: LOAD T"KFAMOPEN"10,6835BEG 6865
6865 LOAD T"COMCLEAR"10,199BEG 6870
6870 SELECT @PARTS0$
: IF I6$="S"THEN 6895
: GOSUB '239(1)
: GOTO 6905
6895 GOSUB '219(S$(1),1,S2," ",0)
: GOSUB '219(S$(4),4,S2," ",0)
6905 IF I6=0THEN GOSUB '239(2)
: COM CLEAR I
: LOAD TM$
7140 DEFFN'29"Q$=";HEX(22);"INVT110E";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D)