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)