Listing of file='BOMS050A' on disk='vmedia/701-2656B.wvd.zip'
# Sector 266, program filename = 'BOMS050A' 0010 REM BOMS050A, RELEASE 2-0, (02/23/79) 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,K2$W3,B7$(W4)W3,K3$17,B7$24,K4$4,A9$1,A8$1,B8$1,B6$1 : DIM D6$(W4)16,D7$(W4)8,D8$(W4)2 : GOTO 4000 4000 SELECT @PARTS0$ 4020 K2$=ALL(7F) : A6$,A9$="N" : Q$=" " : STR(B7$(),Q0+1,3)="001" : B7$()=B7$()&STR(B7$()) : K8,L9,P1=0 : K9=6 : L=L0 4110 PRINT AT(1,0,); : Q6$="Y" 4130 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 4190 : $CLOSE#15 : GOTO 4220 4190 IF I0$=" "THEN GOSUB '93(" ") : IF I0$=" "THEN A6$="N" 4220 GOSUB '100("Y,N","YyNn",1,1,"DO YOU WISH A COSTED REPORT (Y OR N)",2) : IF Q6$=HEX(1F)THEN GOSUB '31 : IF Q6$="Y"THEN B8$="C" : ELSE B8$="P" : GOSUB '100("A,R,I","AaIiRr",1,1,"ENTER INQUIRY TYPE (A=ALL, R=RANGE, I=I NDIVIDUAL)",2) : IF Q6$=HEX(1F)THEN GOSUB '31 : K$=Q6$ : Q6$="ALL RANGE INDIVIDUAL" 4300 L7=POS("ARI"=K$) : K3$=STR(Q6$,L7*10-9,10) : K3$=K3$&" OPTION" : IF L7=3THEN 4510 : Q6$=" " : CONVERT W4-1TO STR(Q6$,22,2),(##) : STR(Q6$,,21)="ENTER LEVEL LIMIT (1-" : STR(Q6$,24,1)=")" : Q9=W4-1 : GOSUB '100("1",STR(Q6$,22,2),2,0,Q6$,0) : IF Q6$=HEX(1F)THEN GOSUB '31 : L6=Q9 4390 GOSUB '100("N,Y","NnYyY ",1,1,"DO YOU WANT TO EXPLODE LEVEL '0' PRODUCTS ONLY (Y OR N)",2) : IF Q6$=HEX(1F)THEN GOSUB '31 : A9$=Q6$ : IF L7=2THEN 4680 : GOSUB '235(2,0) : B7$(1)=T7$ : IF Q$=" "THEN 4820 : IF Q$<>"B"THEN 5840 : GOSUB '91 : GOTO 4130 4510 L9,K8,A9,P1=0 : L9,K8,A9,P1=0 : L=L0 : GOSUB '34(HEX(08)) : IF Q6$="END"THEN 5770 : B7$(1)=STR(Q6$,,Q0)&"001" : GOSUB '232(2,0,B7$(1)) : GOSUB '91 : ON J0+1GOTO 4605,,,4510,,,,4510 : GOTO 5840 4605 Q6$=" " : CONVERT W4-1TO STR(Q6$,22,2),(##) : STR(Q6$,,21)="ENTER LEVEL LIMIT (1-" : STR(Q6$,24,1)=")" : Q9=W4-1 : GOSUB '100("1",STR(Q6$,22,2),2,0,Q6$,0) : IF Q6$=HEX(1F)THEN GOSUB '31 : L6=Q9 : A9=0 : GOTO 4820 4670 PRINT AT(3,0,80);"Starting ID must be lower than Ending ID";HEX(07) 4680 GOSUB '34("STARTING") : IF Q6$="END"THEN 5810 : B7$(1)=STR(Q6$,,Q0)&"001" : GOSUB '34("ENDING") : K2$=STR(Q6$,,Q0)&"001" : IF B7$(1)>K2$THEN 4670 : GOSUB '232(2,0,B7$(1)) : IF Q$="N"THEN GOSUB '237(2,0) : B7$(1)=T7$ : GOSUB '91 : IF J0=7THEN 4110 : IF J0>0THEN 5840 4820 A8$="I" : GOSUB '160(4) : IF W0$>K2$THEN 5770 : DBACKSPACE #2,BEG : DSKIP #2,VAL(W3$,2)S : GOSUB '52(2) : B7$=F2$ 4910 L9=L9+1 4930 D6$(L9)=T2$() : D7$(L9)=T$ : D8$(L9)=T4$ 4960 K8=K8+1 : IF A8$=" "THEN 5200 : A8$=" " : IF A9$="N"THEN 5160 : K4$=STR(W3$,,2)&HEX(0000) : GOSUB '232(3,1,K4$) : IF Q$=" "OR Q$="B"THEN 5090 : IF Q$<>"N"THEN 5840 : GOSUB '237(3,1) : IF Q$="X"THEN 5840 : IF Q$="E"OR STR(T7$,,2)<>STR(K4$,,2)THEN 5140 5090 B7$(1)=STR(B7$(1),,Q0)&HEX(FFFFFF) : GOSUB '232(2,0,B7$(1)) : GOSUB '237(2,0) : GOTO 5720 5140 GOSUB '235(2,0) 5160 GOSUB '36(1) : GOSUB '36(2) : K9=6 5200 IF K8>WTHEN 5430 5210 IF W$(K8)=" "THEN 4960 : IF W2$(K8)="X"THEN 4960 : IF W2$(K8)="E"AND W1(K8)>Q1THEN 4960 : IF W2$(K8)="T"AND W1(K8)<=Q1THEN 4960 : B7$(L9+1)=STR(W$(K8),,Q0)&"001" : DBACKSPACE #2,BEG : DSKIP #2,VAL(W0$(K8),2)S : GOSUB '52(2) : IF F1$=HEX(FF)THEN 4960 : GOSUB '36(3) : B6$=H4$ : AND (B6$,80) : IF B6$<>HEX(80)OR L9>=L6THEN 5410 5320 GOSUB '232(2,0,B7$(L9+1)) : J$(3)=" " : GOSUB '91 : IF J0=7THEN GOSUB '92 : IF J0=7THEN 5320 : IF J0>1THEN 5840 : GOSUB '160(4) : K8=0 : GOTO 4910 5410 IF K8<WTHEN 4960 5430 T2$()=D6$(L9) : T$=D7$(L9) : GOSUB '237(2,0) : IF Q$="E"OR STR(T7$,,Q0)<>STR(B7$(L9),,Q0)THEN 5510 : GOSUB '160(4) : B7$(L9)=T7$ : K8=0 : GOTO 4930 5510 IF L9=1THEN 5640 : 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 5210 : GOTO 5430 5640 IF B8$="C"THEN GOSUB '36(-1) : IF A6$="N"THEN PRINT AT(22,26,28); : ELSE GOTO 5690 : LINPUT "KEY RETURN TO RESUME",?A7$ : PRINT AT(22,26,28);AT(1,0,); : SELECT PRINT 005(80) : GOTO 5700 5690 PRINT HEX(0A0A0A0A0A) : L=L+5 : SELECT PRINT 005(80) 5700 IF K$="I"THEN 4510 5720 K8,L9,A9=0 : L=L0 : B7$(1)=STR(T7$,,Q0)&"001" : IF Q$=" "THEN 4820 5770 IF A6$="N"THEN 5810 : SELECT PRINT 005(80) : IF K$="R"THEN 4680 5810 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 4020 5840 GOSUB '91 : GOSUB '254 5865 DEFFN'126 5870 DEFFN'31 : LOAD TM$ 5930 DEFFN'90 : Q6$=" " : KEYIN Q6$,5970,5970 : IF Q6$="P"THEN GOSUB '254 5970 IF Q6$=HEX(1F)THEN GOSUB '31 : SELECT PRINT <I0$>(132) : IF L<L0THEN RETURN : P1=P1+1 : PRINT HEX(0D0C0A0E);N2$ : PRINT K3$;TAB(32); : IF B8$="C"THEN PRINT TAB(32);"INDENTED COSTED BILL OF MATERIALS"; : ELSE PRINT TAB(32);"BILL OF MATERIALS PARTS EXPLOSION"; : PRINT TAB(73);Q1$;TAB(85);"PAGE ";P1 : PRINT HEX(0D0A);TAB(10);"PRODUCT ID - ";STR(B7$(1),,Q0);TAB(39);B7$ 6055 PRINT HEX(0A0A) : L=10 : RETURN 6100 DEFFN'34(Q7$) : PRINT AT(1,0,80);"ENTER ";Q7$;" ASSEMBLY PRODUCT ID (OR END)" : GOSUB '100(" ",HEX(7F),VAL(Q0$(2)),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 6230 DEFFN'36(A7) : IF B8$="P"THEN 6820 : IF A6$="Y"THEN 6530 : ON A7GOTO 6290,6330 : GOTO 6360 6290 PRINT AT(0,0,20);K3$;AT(0,60);Q1$ : PRINT AT(2,10,40);"PRODUCT ID - ";W0$;AT(2,40);F2$ : RETURN 6330 PRINT AT(4,0);"LEVEL";TAB(11);"COMPONENT ID";AT(4,25,0);"DESCRIPTION";AT( 4,49);"QUANTITY";AT(4,61);"U. COST";AT(4,71);"EXT. COST" : RETURN 6360 IF K9>=21THEN PRINT AT(22,26,28); : ELSE GOTO 6400 : LINPUT "KEY RETURN TO RESUME"?A7$ : PRINT AT(22,26,28);AT(5,0,); : K9=6 6400 IF A7=-1THEN PRINT AT(K9,51);"TOTAL COST - ";AT(K9,66); : ELSE GOTO 6430 : PRINTUSING 6780,A9 : RETURN 6430 GOSUB 7230 : PRINT HEX(06); : PRINT AT(K9,0,10);Q6$;TAB(11);STR(W$(K8),1,Q0);AT(K9,25);F2$;AT(K9,50); : PRINTUSING "####.##",W(K8); : PRINTUSING 6770,F;ROUND((F*W(K8),2) : K9=K9+1 : IF L9=1THEN A9=A9+F*W(K8) : RETURN 6530 GOSUB '90 : L=L+1 : IF A7=1THEN RETURN : IF A7=-1THEN PRINT TAB(69);"TOTAL COST - "; : ELSE GOTO 6610 : PRINT TAB(75); : PRINTUSING 6780,A9 : RETURN 6610 IF L<>10AND A7=3THEN 6660 : PRINT "LEVEL";TAB(13);"COMPONENT ID";TAB(30);"DESCRIPTION";TAB(55);"QUANT ITY";TAB(70);"U/M";TAB(77);"U. COST";TAB(87);"EXT. COST" : PRINT HEX(0A) : IF A7=3THEN L=L+2 : ELSE RETURN 6660 IF L9<L8THEN PRINT HEX(0D0A) : ELSE GOTO 6680 : L=L+2 6680 GOSUB 7230 : IF STR(Q6$,8,1)=HEX(82)OR STR(Q6$,7,1)=HEX(82)THEN INIT(20)STR(Q6$,,8) : PRINT HEX(06);Q6$;TAB(13);STR(W$(K8),1,Q0);TAB(30);F2$;TAB(55); : PRINTUSING " ####.##",W(K8); : PRINT TAB(70);F3$;TAB(73); : PRINTUSING 6770,F;ROUND((F*W(K8),2) : IF L9=1THEN A9=A9+F*W(K8) : L8=L9 : RETURN 6760 %####.## 6770 % ######.## ########.## 6780 % ##########.## 6820 IF A6$="Y"THEN 7050 : ON A7GOTO ,6900,6930 : PRINT AT(0,0,20);K3$;AT(0,60);Q1$ : PRINT AT(2,10,40);"PRODUCT ID - ";W0$;AT(2,40);F2$ : RETURN 6900 PRINT AT(4,0);"LEVEL";TAB(13);"COMPONENT ID";TAB(27);"DESCRIPTION";TAB(58 );"QUANTITY";TAB(72);"U/M" : PRINT HEX(0A) : RETURN 6930 IF K9>=21THEN PRINT AT(22,26,28); : ELSE GOTO 6970 : LINPUT "KEY RETURN TO RESUME"?A7$ : PRINT AT(22,26,28);AT(5,0,); : K9=6 6970 GOSUB 7230 : PRINT HEX(06); : PRINT AT(K9,0,10);Q6$;TAB(13);STR(W$(K8),1,Q0);AT(K9,27);F2$;AT(K9,58); : PRINTUSING 7210,W(K8); : PRINT AT(K9,72);F3$ : K9=K9+1 : RETURN 7050 GOSUB '90 : L=L+1 : IF A7=1THEN RETURN : IF L<>10AND A7=3THEN 7130 : PRINT "LEVEL";TAB(13);"COMPONENT ID";TAB(30);"DESCRIPTION";TAB(70);"QUANT ITY";TAB(89);"U/M" : PRINT HEX(0A) : IF A7=3THEN L=L+1 : ELSE RETURN 7130 IF L9<L8THEN PRINT HEX(0D0A) : ELSE GOTO 7150 : L=L+2 7150 GOSUB 7230 : PRINT HEX(06);Q6$;TAB(13);STR(W$(K8),1,Q0);TAB(30);F2$;TAB(70); : PRINTUSING 7210,W(K8); : PRINT TAB(89);F3$ : L8=L9 : RETURN 7210 % ####.## 7230 Q6$=" " : IF L9>9THEN 7240 : CONVERT L9TO STR(Q6$,L9),(#) : RETURN 7240 STR(Q6$,9-INT(L9/10),INT(L9/10))=HEX(82) : CONVERT L9TO STR(Q6$,9),(##) : RETURN 9998 DEFFN'29"Q$=";HEX(22);"BOMS050A";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 - Indented Costed Parts Explosion.";HEX(22);":SELECT#15<I0$>:$OP EN#15:SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15: SELECTLIST005(80)";HEX(0D)