Listing of file='BOMS030A' on disk='vmedia/701-2656B.wvd.zip'
# Sector 24, program filename = 'BOMS030A' 0010 REM BOMS030A, RELEASE 2.3, (12/29/80) THIS PROGRAM IS A COPYRIGHT PRODUC T OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITE D 0170 DIM A6$2,A7$1,L,B7$(W4)W3,B7$24,A8$1,B7(W4),B8(W4),B9$1 : DIM D6$(W4)16,D7$(W4)8,D8$(W4)2 : GOTO 4000 4000 SELECT @PARTS0$ 4050 A6$="N" : Q$=" " : STR(B7$(),Q0+1,3)="001" : B7$()=B7$()&STR(B7$()) : K8,L9,P1=0 : B7(1)=1 : K9=6 : L=L0 : PRINT AT(1,0,); : Q6$="Y" : GOSUB '100("N,Y","NnYyY ",1,1,"PRINT REPORT (Y OR N)",3) : IF Q6$=HEX(1F)THEN GOSUB '31 : A6$=Q6$ : IF Q6$="Y"THEN 4200 : GOTO 4214 4200 GOSUB '93(" ") : IF I0$=" "THEN A6$="N" 4214 GOSUB '100("Y,N","YyNnY ",1,1,"DO YOU WISH TO NET AGAINST EXISTING INVENT ORY (Y OR N)",2) : IF Q6$=HEX(1F)THEN GOSUB '31 : B9$=Q6$ 4230 L9,K8=0 : L=L0 : GOSUB '34(HEX(08)) : IF Q6$="END"THEN 5280 : B7$(1)=STR(Q6$,,Q0) : GOSUB '232(1,0,B7$(1)) : GOSUB '91 : ON J0+1GOTO 4320,,,4230,,,,4230 : GOTO 5330 4320 B7$(1)=STR(B7$(1),,Q0)&"001" : L6=W4-1 : C6=0 : GOSUB '100("1","999999",6,0,"ENTER DESIRED AMOUNT",1) : IF Q6$=HEX(1F)THEN GOSUB '31 : C6=Q9 : GOSUB '52(2) : B7$=F2$ : C7=E : IF C6>0THEN Q9=C6 : ELSE Q9=0 : B8(1)=Q9-C7 : GOSUB '36(A6$,1) : IF C7>=C6THEN 4230 : A8$=H4$ : AND (A8$,80) : IF A8$=HEX(80)THEN 4510 : SELECT PRINT 005(132) 4470 PRINT AT(1,0);"NO BILL OF MATERIAL FOR THIS ITEM";AT(2,0); : A7$=" " : LINPUT "KEY RETURN EXEC TO RESUME"?A7$ : GOTO 4230 4510 GOSUB '232(2,0,B7$(1)) : GOSUB '91 : ON J0+1GOTO 4550,,,,4230,,,,4230 : GOTO 5330 4550 GOSUB '160(4) : PRINT AT(2,25);"*** SCANNING INVENTORY***" : K9=6 4640 L9=L9+1 4660 D6$(L9)=T2$() : D7$(L9)=T$ : D8$(L9)=T4$ 4690 K8=K8+1 : IF K8>WTHEN 4930 4710 IF W$(K8)=" "THEN 4690 : IF W2$(K8)="X"THEN 4690 : IF W2$(K8)="E"AND W1(K8)>Q1THEN 4690 : IF W2$(K8)="T"AND W1(K8)<=Q1THEN 4690 : B7$(L9+1)=STR(W$(K8),,Q0)&"001" : B7(L9+1)=B7(L9)*W(K8) : B8(L9+1)=B8(L9)*W(K8) : DBACKSPACE #2,BEG : DSKIP #2,VAL(W0$(K8),2)S : GOSUB '52(2) : IF F1$=HEX(FF)THEN 4690 : IF A8=0THEN GOSUB '36(A6$,2) : GOSUB '36(A6$,3) 4811 IF E>0THEN Q9=E : ELSE Q9=0 : IF B9$="Y"THEN B8(L9+1)=B8(L9+1)-Q9 : IF B8(L9+1)<0THEN B8(L9+1)=0 : A8$=H4$ : AND (A8$,80) : IF A8$<>HEX(80)OR L9>=L6THEN 4910 : IF B9$="1"AND B8(L9+1)=0THEN 4910 4830 GOSUB '232(2,0,B7$(L9+1)) : J$(3)=" " : GOSUB '91 : IF J0=7THEN GOSUB '92 : IF J0=7THEN 4830 : IF J0>1THEN 5330 : GOSUB '160(4) : K8=0 : GOTO 4640 4910 IF K8<WTHEN 4690 4930 T2$()=D6$(L9) : T$=D7$(L9) : GOSUB '237(2,0) : IF Q$="E"OR STR(T7$,,Q0)<>STR(B7$(L9),,Q0)THEN 5010 : GOSUB '160(4) : B7$(L9)=T7$ : K8=0 : GOTO 4660 5010 IF L9=1THEN 5140 : IF Q$="E"THEN GOSUB '235(2,0) : L9=L9-1 : DBACKSPACE #4,BEG : DSKIP #4,VAL(D8$(L9),2)S : GOSUB '160(4) : MAT SEARCHW$(),=STR(B7$(L9+1),,Q0)TO Q6$STEP Q0 : K8=INT((VAL(Q6$,2)+Q0-1)/Q0)+1 : IF K8<=WTHEN 4710 : GOTO 4930 5140 GOSUB '36(A6$,4) : L=L0 : A8=0 : IF A6$="N"THEN PRINT AT(22,26,28); : ELSE GOTO 5220 : A7$=" " : LINPUT "KEY RETURN TO RESUME",?A7$ : PRINT AT(22,26,28);AT(1,0,); : SELECT PRINT 005(80) : GOTO 4230 5220 PRINT HEX(0A0A0A0A0A) : L=L+5 : SELECT PRINT 005(80) : GOTO 4230 5280 GOSUB '100("M,R","MmRr",1,1,"KEY R TO RESTART, M FOR MENU",2) : IF Q6$=HEX(1F)OR Q6$="M"THEN GOSUB '31 : ELSE GOTO 4050 5330 GOSUB '91 : GOSUB '254 5360 DEFFN'31 : LOAD TM$ 6040 DEFFN'34(Q7$) : SELECT PRINT 005 : PRINT AT(1,0,80);"ENTER ";Q7$;" ASSEMBLY PRODUCT 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(2) : Q7$=Q6$ : RETURN 6160 DEFFN'90 : Q6$=" " : KEYIN Q6$,6200,6200 : IF Q6$="P"THEN GOSUB '254 6200 IF Q6$=HEX(1F)THEN GOSUB '31 : SELECT PRINT <I0$>(132) : IF L<L0THEN RETURN : P1=P1+1 : PRINT HEX(0C0D0A0E);N2$ : IF B9$="Y"THEN PRINT "WITH NETTING"; : ELSE PRINT "WITHOUT NETTING"; : PRINT TAB(44);"BILL OF MATERIALS GROSS REQUIREMENTS EXPLOSION";TAB(110);Q 1$;TAB(120);"PAGE ";P1 : PRINT HEX(0D0A);TAB(10);"PRODUCT ID - ";STR(B7$(1),,Q0);TAB(39);B7$ 6280 IF A7=1THEN PRINT TAB(10);"ON HAND ";C7;" ON ORDER ";E1;" REQUESTED ";C 6 : PRINT HEX(0A) : IF C7>=C6AND A7=1THEN GOSUB 6870 : ELSE PRINT "LEVEL";TAB(12);"PRODUCT ID";TAB(30);"DESCRIPTION";TAB(55);"ON HAND";TAB(67);"REQUIRED";TAB(79);"NOT AVAILABLE" : PRINT HEX(0A) : IF A7=1THEN L=8 : ELSE L=7 : RETURN 6370 DEFFN'36(A7$,A7) : IF A7$="Y"THEN 6720 : IF A7=4THEN RETURN : ON A7GOTO ,6470,6520 : PRINT AT(6,0,);"PRODUCT ID - ";STR(B7$(1),,Q0);" DESCRIPTION - ";F2$ : PRINT HEX(0A);"ON HAND -";C7;" ON ORDER -";E1;" REQUESTED -";C6 : IF B8(1)>=0THEN PRINT HEX(0A);"INVENTORY IS LOW BY ";B8(1) : ELSE PRINT HEX(0A);"INVENTORY IS ADEQUATE" : GOSUB '254 6450 RETURN 6470 PRINT AT(2,10,40);"PRODUCT ID - ";STR(B7$(1),,Q0);AT(2,40);B7$; : PRINT AT(4,0,);"LEVEL";AT(4,10);"COMPONENT ID";AT(4,26);"DESCRIPTION";AT( 4,51);"ON HAND";AT(4,66);"REQ";AT(4,72);"NOT AV." : A8=1 : RETURN 6520 IF K9<=20THEN 6590 : PRINT AT(22,26,28); : A7$=" " : LINPUT "KEY RETURN TO RESUME?"?A7$ : PRINT AT(5,0,) : K9=6 6590 Q6$=" " : IF L9<=9THEN 6600 : STR(Q6$,9-INT(L9/10),INT(L9/10))=HEX(82) : CONVERT L9TO STR(Q6$,9),(##) : GOTO 6610 6600 CONVERT L9TO STR(Q6$,L9),(#) 6610 PRINT HEX(06);AT(K9,0);Q6$;TAB(12);STR(W$(K8),,Q0);TAB(26);F2$;TAB(51); : IF B9$="Y"THEN Q9=B8(L9+1) : ELSE Q9=B7(L9+1)*B8(1) : IF E>0THEN Q8=E : ELSE Q8=0 : IF Q8>=Q9THEN Q8=Q9 : PRINTUSING "-######## -######## -########",E,Q9,Q9-Q8 : K9=K9+1 : RETURN 6720 GOSUB '90 : ON A7GOTO ,,6760,6860 : RETURN 6760 Q6$=" " : IF L9<=9THEN CONVERT L9TO STR(Q6$,L9),(#) : ELSE CONVERT L9TO STR(Q6$,9),(##) : PRINT Q6$;TAB(12);W$(K8);TAB(30);F2$;TAB(54); : IF B9$="Y"THEN Q9=B8(L9+1) : ELSE Q9=B7(L9+1)*B8(1) : IF E>0THEN Q8=E : ELSE Q8=0 : IF Q8>=Q9THEN Q8=Q9 : PRINTUSING " #######- ##########- ##########",E,Q9,Q9-Q8 : IF L<L0THEN A8=1 : ELSE A8=0 : L=L+1 : RETURN 6860 GOSUB '90 6870 PRINT HEX(0D0A);"OF ";C6;" REQUESTED, ";C7;" ARE ON HAND" : PRINT "NUMBER UNAVAILABLE = ";MAX(B8(1),0) : L=L+3 : RETURN 9998 DEFFN'29"Q$=";HEX(22);"BOMS030A";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 - Gross Requirements.";HEX(22);":SELECT#15<I0$>:$OPEN#15:SELECTL IST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:SELECTLIST005 (80)";HEX(0D)