Listing of file='BOMS020A' on disk='vmedia/701-2656B.wvd.zip'
# Sector 154, program filename = 'BOMS020A'
0010 REM BOMS020A, 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$(25)Q0,A7$(25)2,A6(25),A8(25),A8$(25)1,A9(25),A6,K6$W3,K7$4,K8$Q0,
C9$Q0,I8,C6,K9$3,D9$8,A7$1,A8$1
: DIM B6$Q0,B7$2,B6,B8,B8$1,B9,P6$3,B9$3
: GOTO 4000
4000 SELECT @PARTS0$
4020 GOSUB '100("0",HEX(7F),Q0,0,"ENTER ASSEMBLY PRODUCT ID. (OR END)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="END"OR Q6$="end"THEN GOSUB '31
: PRINT AT(3,0,);
: GOSUB '96(2)
: W0$,C9$=Q6$
: GOSUB 7280
: IF Q$=" "THEN 4140
: PRINT AT(3,0,80);HEX(07);"*** PRODUCT ID. NOT ON INVENTORY FILE ***"
: GOTO 4020
4140 A8$=H4$
: AND (A8$,80)
: IF A8$=HEX(80)THEN 4250
: B6=0
: I9$="N"
: W1$="000"
: W3$=STR(T4$,1,2)
: GOSUB '100("Y,N","YyNnY ",1,1,"DO YOU WISH TO ADD THIS ASSEMBLY (Y OR N)
",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="N"THEN 4020
: ELSE GOTO 4470
4250 K6$=STR(C9$,,Q0)&"001"
: GOSUB 7440
: IF Q$=" "THEN 4310
: DBACKSPACE #2,1S
: AND (H4$,7F)
: GOSUB '42(2)
: PRINT AT(3,0,80);HEX(07);"*** STRUCTURE RECORD MISSING ***"
: GOTO 4020
4310 Q6$="C"
: B6=0
: GOSUB '100("A,C,D","AaCcDd",1,1,"ENTER TRANS TYPE (A=ADD COMPONENTS C=C
HANGE COMPONENTS D=DELETE ASSEMBLY)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: I9$=Q6$
: IF I9$<>"A"THEN 4470
4370 GOSUB 7710
: IF I8=0THEN 4370
: K6$=STR(C9$,,Q0)&K9$
: GOSUB 7440
: FOR C6=WTO 1STEP -1
: B6=C6
: IF W$(C6)<>" "THEN C6=1
: NEXT C6
: IF B6<WTHEN GOSUB 6860
: ELSE B6=0
4470 Q6$="* "&STR(Q6$)
: PRINT AT(5,0);Q6$
: PRINT "ASSEMBLY PRODUCT ID. ";F1$;TAB(40);" DESCRIPTION - ";F2$
: PRINT Q6$
: IF I9$="D"THEN 6430
: PRINT AT(8,0);TAB(6);"COMPONENT";TAB(19);"DESCRIPTION";TAB(42);"QUANTITY
EFFECTIVITY DATE SCRAP"
: PRINT AT(9,0);TAB(6);"PRODUCT ID.";TAB(55);"CD";TAB(71);"FACTOR"
: IF I9$="C"THEN 5180
4560 IF B6=0THEN 4610
: GOSUB 8540
: A6=B6
: GOTO 4660
4610 W1$=DAC HEX(01)
: B6=0
: GOSUB 6950
: A6=0
4660 A6=A6+1
: A7$=" "
: GOSUB 8060
: IF Q6$<>"END"THEN 4750
: A7$="E"
: A6=A6-1
: IF A6=0THEN 4020
: IF B6=0THEN 4810
: IF A6>B6THEN 4810
: ELSE GOTO 4020
4750 FOR I=1TO 3
: ON IGOSUB 8440,8240,8490
: GOSUB 8010
: NEXT I
: IF A6<W-1THEN 4660
4810 C7=A6
4820 Q7$="CHANGE"
: A6=C7
: GOSUB 7140
: IF A6<>0THEN 4850
: A6=C7
: GOTO 4960
4850 IF A6>B6THEN 4880
: PRINT AT(3,0,80);HEX(07);"RE-ENTER 0 OR VALUE >";B6
: GOTO 4820
4880 GOSUB 7210
: IF Q9=0THEN 4820
: ON Q9GOSUB 8060,8440,8240,8490
: IF Q6$="END"THEN 4820
: GOSUB 7370
: GOSUB 8010
: GOTO 4880
4960 K6$=STR(W0$,,Q0)&W1$
: IF B6=0THEN GOSUB 7570
: ELSE DBACKSPACE #5,1S
: FOR C6=B6+1TO A6
: K7$=STR(A7$(C6),1,2)&W3$
: GOSUB 7940
: IF Q$<>"D"THEN 5040
: A6$(C6),A8$(C6)=" "
: A7$(C6)=HEX(FF)
: A6(C6),A8(C6),A9(C6)=0
5040 NEXT C6
: GOSUB 6760
: GOSUB '150(5)
: IF W1$>"001"THEN 5130
: C9$=W0$
: GOSUB 7280
: OR (H4$,80)
: DBACKSPACE #2,1S
: GOSUB '42(2)
5130 IF A7$="E"THEN 4020
: PRINT AT(11,0,)
: GOTO 4610
5180 GOSUB 6860
5190 GOSUB 8540
5200 GOSUB '100("0","5",1,0,"ENTER ACTION: 0=END 1-INSERT 2-CHANGE 3-DELETE 4-
NEXT SCREEN 5-PREV. SCREEN",1)
: IF Q6$=HEX(1F)THEN GOSUB '31
: ON Q9+1GOTO 5240,5820,5540,5440,5270,5370
5240 GOSUB 7080
: GOTO 4020
5270 GOSUB 7710
: IF I8=0THEN 5180
: PRINT AT(22,15);"*** THE END OF COMPONENTS HAS BEEN REACHED ***"
: GOSUB '254
: PRINT AT(22,0,)
: STR(K6$,Q0+1,3)="001"
: GOSUB 7440
: IF Q$=" "THEN 5180
: GOTO 4020
5370 GOSUB 7850
: IF I8=0THEN 5180
: PRINT AT(22,10);"*** THE BEGINNING OF COMPONENTS HAS BEEN REACHED ***"
: GOSUB '254
: PRINT AT(22,0,)
: GOTO 5180
5440 Q7$="DELETE"
: GOSUB 7130
: IF A6=0THEN 5200
: K7$=STR(A7$(A6),1,2)&W3$
: GOSUB '231(3,1,K7$)
: A6$(A6),A7$(A6),A8$(A6)=HEX(20)
: A6(A6),A8(A6),A9(A6)=0
: GOSUB 7080
: GOTO 5190
5540 Q7$="CHANGE"
: GOSUB 7130
: IF A6=0THEN 5200
: IF A6$(A6)<>HEX(20)THEN 5600
: PRINT AT(3,0,80);HEX(07);"*** NO COMPONENT EXISTS ON THIS LINE NUMBER ***
"
: GOTO 5540
5600 GOSUB 7210
: ON Q9+1GOTO 5670,5700
: ON Q9-1GOSUB 8440,8240,8490
5630 GOSUB 7370
: GOSUB 8010
: GOTO 5600
5670 GOSUB 7080
: GOTO 5200
5700 K7$=STR(A7$(A6),1,2)&W3$
: GOSUB 8060
: IF Q6$="END"THEN 5200
: GOSUB '231(3,1,K7$)
: STR(K7$,1,2)=STR(A7$(A6),1,2)
: GOSUB 7940
: IF Q$<>"D"THEN 5630
: A6$(A6)=HEX(20)
: A7$(A6)=HEX(FF)
: PRINT AT(4,0,80);HEX(07);"*** COMPONENT ALREADY EXISTS ON THIS BILL OF MA
TERIAL ***"
: A6$(A6)=W$(A6)
: A7$(A6)=W0$(A6)
: GOTO 5600
5820 Q7$="INSERT"
: GOSUB 7130
: IF A6=0THEN 5200
: PRINT HEX(06)
: IF A6$(A6)=" "THEN 5950
: FOR C6=WTO A6STEP -1
: GOSUB 6680
: NEXT C6
: A6$(A6),A7$(A6),A8$(A6)=" "
: A6(A6),A8(A6),A9(A6)=0
: B6=A6
: GOSUB 8540
: A6=B6
5950 GOSUB 8060
: IF Q6$="END"THEN 5200
: K7$=STR(A7$(A6),1,2)&W3$
: GOSUB 7940
: IF Q$<>"D"THEN 6030
: A6$(A6)=HEX(20)
: A7$(A6)=HEX(FF)
: PRINT AT(3,0,80);HEX(07);"*** COMPONENT ALREADY EXISTS ON THIS BILL OF MA
TERIAL ***"
: GOTO 5950
6030 B9$=K9$
: FOR I=1TO 3
: GOSUB 8010
: ON IGOSUB 8440,8240,8490
: NEXT I
: GOSUB 8010
6100 GOSUB 7080
: IF A6$(W+1)=HEX(20)THEN 6380
: K7$=STR(A7$(W+1),1,2)&W3$
: GOSUB '231(3,1,K7$)
: B6$=A6$(W+1)
: B7$=A7$(W+1)
: B8$=A8$(W+1)
: B6=A6(W+1)
: B8=A8(W+1)
: B9=A9(W+1)
: GOSUB 7710
: IF I8=1THEN 6270
: GOSUB 7940
: GOSUB 6860
: FOR C6=WTO 1STEP -1
: GOSUB 6680
: NEXT C6
: A6$(1)=B6$
: A7$(1)=B7$
: A8$(1)=B8$
: A6(1)=B6
: A8(1)=B8
: A9(1)=B9
: GOTO 6100
6270 GOSUB 6950
: A6$(1)=B6$
: A7$(1)=B7$
: A8$(1)=B8$
: A6(1)=B6
: A8(1)=B8
: A9(1)=B9
: K9$=DAC HEX(01)
: STR(K6$,Q0+1,3),W1$=K9$
: W0$=STR(K6$,1,Q0)
: GOSUB 7570
: GOSUB 7940
: GOSUB 6760
: GOSUB '150(5)
6380 STR(K6$,Q0+1,3)=B9$
: GOSUB 7440
: GOTO 5180
6430 GOSUB '100("Y,N","YyNn",1,1,"DELETE THIS ASSEMBLY PRODUCT ID. (Y OR N)",
2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="N"THEN 4020
: PRINT AT(10,25);"*** DELETE IN PROGRESS ***"
: AND (H4$,7F)
: DBACKSPACE #2,1S
: GOSUB '42(2)
6500 FOR C6=1TO W
: IF W$(C6)=" "THEN 6540
: K7$=STR(W0$(C6),1,2)&W3$
: GOSUB '231(3,1,K7$)
6540 NEXT C6
: GOSUB '231(2,1,K6$)
: Q6$="PRODUCT STRUCTURE FILE"
: IF Q$<>" "THEN 6990
: GOSUB '160(5)
: DBACKSPACE #5,1S
: STR(W0$,1,1)=HEX(FF)
: GOSUB '150(5)
: GOSUB 7710
: IF I8=1THEN 4020
: STR(K6$,Q0+1,3)=W1$
: GOTO 6500
6680 A6$(C6+1)=A6$(C6)
: A7$(C6+1)=A7$(C6)
: A8$(C6+1)=A8$(C6)
: A6(C6+1)=A6(C6)
: A8(C6+1)=A8(C6)
: A9(C6+1)=A9(C6)
: RETURN
6760 W$()=A6$()
: W0$()=A7$()
: W2$()=A8$()
: MAT REDIM A6(W),A8(W),A9(W)
: MAT W=A6
: MAT W1=A8
: MAT W2=A9
: MAT REDIM A6(W+1),A8(W+1),A9(W+1)
: RETURN
6860 A6$()=W$()
: A7$()=W0$()
: A8$()=W2$()
: MAT A6=W
: MAT A8=W1
: MAT A9=W2
: MAT REDIM A6(W+1),A8(W+1),A9(W+1)
: RETURN
6950 INIT(20)A6$(),A8$()
: INIT(FF)A7$()
: MAT A6=ZER
: MAT A8=ZER
: MAT A9=ZER
: RETURN
6990 GOSUB '91
: PRINT AT(3,LEN(J$(J0))+3);HEX(07);"- ";Q6$
: GOSUB '254
7030 DEFFN'31
: PRINT AT(4,0,);"*** END OF PROCESSING ***"
: LOAD TM$
7080 DBACKSPACE #5,1S
: GOSUB 6760
: GOSUB '150(5)
: RETURN
7130 A6=W
7140 CONVERT A6TO W9$,(##)
: CONVERT B6+1TO W8$,(##)
: PRINT AT(1,0,80);"ENTER LINE NUMBER TO ";Q7$;" (";W8$;" - ";W9$;", 0=END
)"
: GOSUB '100("0",W9$,2,0," ",1)
: IF Q6$=HEX(1F)THEN GOSUB '31
: A6=Q9
: RETURN
7210 PRINT AT(3,0,80);"FIELD: (1)";TAB(46);"(2)";TAB(57);"(3)";TAB(74);"(4)"
: GOSUB '100("0","4",1,0,"ENTER FIELD TO CHANGE (0=END)",1)
: IF Q6$=HEX(1F)THEN GOSUB '31
: RETURN
7260 GOSUB '91
: GOSUB '92
7280 GOSUB '232(1,1,C9$)
: IF Q$="B"THEN 7260
: IF Q$=" "THEN 7340
: IF Q$="N"THEN RETURN
: Q6$="INVENTORY FILE"
: GOTO 6990
7340 GOSUB '52(2)
: RETURN
7370 DBACKSPACE #2,BEG
: DSKIP #2,VAL(A7$(A6),2)S
: GOSUB '52(2)
: RETURN
7420 GOSUB '91
: GOSUB '92
7440 GOSUB '232(2,1,K6$)
: IF Q$="B"THEN 7420
: P6$=T4$
: IF Q$=" "THEN 7510
: IF Q$="N"THEN RETURN
: Q6$="PRODUCT STRUCTURE FILE"
: GOTO 6990
7510 GOSUB '160(5)
: K9$=W1$
: RETURN
7550 GOSUB '91
: GOSUB '92
7570 GOSUB '233(2,1,K6$,0)
: P6$=T4$
: IF Q$="B"THEN 7550
: IF Q$=" "THEN RETURN
: Q6$="PRODUCT STRUCTURE FILE"
: GOTO 6990
7640 GOSUB '232(3,1,K7$)
: IF Q$=" "OR Q$="N"THEN RETURN
: Q6$="WHERE USED FILE"
: GOTO 6990
7690 GOSUB '91
: GOSUB '92
7710 K8$=STR(K6$,1,Q0)
: I8=0
: GOSUB '237(2,1)
: IF Q$="B"THEN 7690
: IF Q$=" "THEN 7800
: Q6$="PRODUCT STRUCTURE FILE"
: IF Q$<>"E"THEN 6990
: I8=1
: RETURN
7800 P6$=T4$
: GOSUB '160(5)
: IF K8$=W0$THEN K9$=W1$
: ELSE I8=1
: RETURN
7850 K9$=DSC HEX(01)
: I8=0
: IF K9$="000"THEN 7910
: STR(K6$,Q0+1,3)=K9$
: GOSUB 7440
: IF Q$<>"N"THEN RETURN
7910 I8=1
: RETURN
7940 T4$,STR(T5$(3),1,3)=P6$
: GOSUB '234(3,1,K7$,0)
: IF Q$=" "OR Q$="D"THEN RETURN
: Q6$="WHERE USED FILE"
: GOTO 6990
8010 PRINT HEX(06)
: PRINT AT(A6+10,0);
: PRINTUSING "## ############ ######################### ####.## #
######## ##.##",A6,A6$(A6),F2$,A6(A6),A8$(A6),D9$,A9(A6)
: RETURN
8060 PRINT HEX(06)
: GOSUB '100("0",HEX(7F),Q0,0,"ENTER COMPONENT PRODUCT ID. (OR END)",2)
: IF Q6$=HEX(1F)THEN GOSUB '31
: IF Q6$="end"THEN Q6$="END"
: IF Q6$="END"THEN RETURN
: GOSUB '96(2)
: IF Q6$<>W0$THEN 8150
: PRINT AT(3,0,80);HEX(07);"*** COMPONENT PART SAME AS ASSEMBLY PART NOT AL
LOWED ***"
: GOTO 8060
8150 FOR I2=A6TO 1STEP -1
: IF Q6$<>A6$(I2)THEN 8156
: PRINT AT(3,0,80);HEX(07);"*** COMPONENT PART ALREADY IN ASSEMBLY PART NOT
ALLOWED ***"
: I2=1
: NEXT I2
: GOTO 8060
8156 NEXT I2
: C9$=Q6$
: GOSUB 7280
: IF Q$=" "THEN 8200
: PRINT AT(3,0,80);HEX(07);"*** BOM ADD ILLEGAL, COMPONENT PRODUCT ID. NOT
ON INVENTORY FILE ***"
: GOTO 8060
8200 A6$(A6)=C9$
: A7$(A6)=T4$
: RETURN
8240 Q6$="E"
: GOSUB '100("E,T,X","EeTtXx",1,1,"ENTER EFFECTIVITY (E=IN T=OUT X=NO EX
PLOSION)",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: A8$(A6)=Q6$
: IF Q6$<>"X"THEN 8310
: IF A8(A6)=0THEN A8(A6)=Q1
: RETURN
8310 Q6$=Q1$
: PRINT HEX(06)
: IF A8$(A6)="E"THEN Q7$="EFFECTIVE"
: ELSE Q7$="TERMINATED"
: PRINT AT(1,0,80);"ENTER ";Q7$;" DATE (MM/DD/YY)"
: GOSUB '100(HEX(00),HEX(7F),8,0," ",3)
: IF Q6$=HEX(1F)THEN GOSUB '31
: D9$=Q6$
: GOSUB '121(Q6$)
: A8(A6)=U9
: IF Q6$<>"E"THEN RETURN
: PRINT AT(3,0,80);"Invalid date, Re-enter";HEX(07)
: GOTO 8310
: GOTO 8310
8440 GOSUB '100("0",HEX(7F),4,2,"ENTER QUANTITY",1)
: IF Q6$=HEX(1F)THEN GOSUB '31
: A6(A6)=Q9
: RETURN
8490 GOSUB '100("0",HEX(7F),2,2,"ENTER SCRAP FACTOR",1)
: IF Q6$=HEX(1F)THEN GOSUB '31
: A9(A6)=Q9
: RETURN
8540 PRINT HEX(06)
: FOR A6=1TO W
: F2$=" "
: IF A6$(A6)<>" "THEN 8600
: PRINT AT(A6+10,0,);
: PRINTUSING "##",A6
: GOTO 8640
8600 GOSUB 7370
: GOSUB '123(A8(A6))
: D9$=U9$
: GOSUB 8010
8640 NEXT A6
: RETURN
9998 DEFFN'29"Q$=";HEX(22);"BOMS020A";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 - Product Structure File Maintenance.";HEX(22);":SELECT#15<I0$>:
$OPEN#15:SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#
15:SELECTLIST005(80)";HEX(0D)