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)