Listing of file='BOMS100B' on disk='vmedia/701-2656B.wvd.zip'
# Sector 228, program filename = 'BOMS100B'
0010 REM BOMS100B, RELEASE 2-0, (06/01/79) THIS PROGRAM IS A COPYRIGHT PRODUC
T OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITE
D
0170 GOTO 4000
4000 SELECT @PARTS0$
: INIT("*")STR(Q6$,1,55)
: GOSUB '36(Q6$,8)
: GOSUB '36(Q6$,12)
: GOSUB '36("BILL OF MATERIALS",9)
: GOSUB '36("FILE REORGANIZATION",10)
: GOSUB '36("RESETTING ALL ASSEMBLY FLAGS IN INVENTORY",11)
: LIMITS T#2,S$(2),F6,F6,F6,Q9
: DBACKSPACE #2,BEG
: FOR M7=1TO F6-2
: GOSUB '52(2)
: IF STR(F1$,,1)=HEX(FF)THEN 4140
4130 AND (H4$,7F)
: DBACKSPACE #2,1S
: GOSUB '42(2)
4140 NEXT M7
: GOSUB '36("COPY STRUCTURE RECORDS TO SORTWORK FILE",11)
: F6=0
: GOSUB 5630
: GOSUB '235(2,0)
: K6$=T7$
: IF Q$=" "THEN 4340
: GOTO 5680
4280 GOSUB 5110
: IF I8=0THEN 4340
: IF B6$(1)<>" "THEN GOSUB 4980
: IF Q$="E"THEN 4650
: F6=0
4340 GOSUB '160(5)
: GOSUB 5580
: GOSUB 5410
: IF F6<>0THEN 4510
: B6$,C9$=A6$
: B7$="000"
: GOSUB 5060
: IF Q$<>" "THEN 4470
: GOSUB '52(2)
: OR (H4$,80)
: DBACKSPACE #2,1S
: GOSUB '42(2)
4470 IF Q$="N"THEN T4$=HEX(00000000)
: B8$=STR(T4$,1,2)
: F6,M6=1
4510 FOR M7=1TO W
: IF A6$(M7)=" "THEN 4620
: IF A8$(M7)="T"AND Q1>A8(M7)THEN 4620
: C9$=A6$(M7)
: GOSUB 5060
: IF Q$="N"THEN 4620
: B6$(M6)=A6$(M7)
: B8$(M6)=A8$(M7)
: B7$(M6)=T4$
: B6(M6)=A6(M7)
: B8(M6)=A8(M7)
: B9(M6)=A9(M7)
: M6=M6+1
: IF M6=(W-1)THEN GOSUB 4980
4620 NEXT M7
: GOTO 4280
4650 GOSUB '36("RE-INITIALIZING STRUCTURE FILE",11)
: GOSUB '218(S$(3),3," ",0)
: GOSUB '239(1)
: GOSUB '239(2)
: GOSUB '239(3)
: GOSUB '35(S$(5),5,4,Q0+3)
: GOSUB '36("RE-INITIALIZING WHERE-USED FILE",11)
: GOSUB '35(S$(7),7,6,4)
: GOSUB '36("COPYING STRUCTURE RECORDS BACK FROM SORTWORK",11)
4770 GOSUB '230(2,4,5,1,S$(5),4," ",D9$(1),D9$(2))
: IF Q$<>" "THEN 5680
: GOSUB '230(3,6,7,1,S$(7),4," ",D9$(3),D9$(4))
: IF Q$<>" "THEN 5680
: DBACKSPACE #3,BEG
4830 GOSUB '160(3)
: IF END THEN 5710
: K6$=STR(W0$,,Q0)&W1$
: V8=.2
: GOSUB '233(2,1,K6$,0)
: V8=.5
: IF Q$<>" "THEN 5680
: P6$=T4$
: GOSUB '150(5)
: FOR M6=1TO W-2
: IF W$(M6)=" "THEN 4940
: K7$=STR(W0$(M6),,2)&W3$
: GOSUB 5230
4940 NEXT M6
: GOTO 4830
4980 M6=1
: B7$=DAC HEX(01)
: GOSUB 5290
: GOSUB 5630
: GOSUB '150(3)
: RETURN
5060 GOSUB '232(1,0,C9$)
: IF Q$=" "OR Q$="N"THEN RETURN
: GOTO 5680
5110 K8$=STR(K6$,1,Q0)
: I8=0
: GOSUB '237(2,1)
: K6$=T7$
: IF Q$=" "THEN 5180
: IF Q$="E"THEN 5190
: GOTO 5680
5180 IF K8$=STR(T7$,1,Q0)THEN RETURN
5190 I8=1
: RETURN
5230 STR(T5$(3),1,3)=P6$
: GOSUB '234(3,1,K7$,0)
: IF Q$=" "OR Q$="D"THEN RETURN
: GOTO 5680
5290 W0$=B6$
: W1$=B7$
: W3$=B8$
: W$()=B6$()
: W0$()=B7$()
: W2$()=B8$()
: MAT W=B6
: MAT W1=B8
: MAT W2=B9
: RETURN
5410 A6$=W0$
: A7$=W1$
: A8$=W3$
: A6$()=W$()
: A7$()=W0$()
: A8$()=W2$()
: MAT A6=W
: MAT A8=W1
: MAT A9=W2
: RETURN
5530 INIT(20)W0$,W1$,W3$,W$(),W0$(),W2$()
: MAT W=ZER
: MAT W1=ZER
: MAT W2=ZER
: RETURN
5580 INIT(20)A6$,A7$,A8$,A6$(),A7$(),A8$()
: MAT A6=ZER
: MAT A8=ZER
: MAT A9=ZER
: RETURN
5630 INIT(20)B6$(),B7$(),B8$()
: MAT B6=ZER
: MAT B8=ZER
: MAT B9=ZER
: RETURN
5680 GOSUB '91
5700 DEFFN'31
5710 PRINT AT(4,0,);"*** END OF PROCESSING ***"
: GOSUB '239(1)
: GOSUB '239(2)
: GOSUB '239(3)
: GOSUB '219(S$(3),3,S2," ",0)
: COM CLEAR I
: LOAD TM$
5800 DEFFN'35(K$,K,K1,N3)
: K1$=K$
: STR(K1$,5,2)="K1"
: IF K$=S$(5)THEN N=1
: ELSE N=0
: N1=252
: N2=1
: V1$="N"
: N4=3
: N7=INT(240/(N3+3))
: LIMITS T#K,K$,L1,L2,L8
: N8=L2-L1+1
: LIMITS T#K1,K1$,L3,L4,L8
: K2=L4-L3+1
: DATA LOAD BA T#K,(L2)R9$()
: STR(R9$(1),4)=HEX(FD4D5558)
: STR(R9$(),17,64)=ALL(20)
: DATA SAVE BA T$#K,(L2)R9$()
: DATA LOAD DC OPEN T#K1,K1$
6020 Q2$=BIN(MAX(N,1)-1,2)XOR ALL(FF)
: IF N>0THEN Q3$=BIN(N*(INT((N8-2)/N)-1),2)
: ELSE Q3$=BIN(52000,2)
: BIN(V8$)=N2
: FOR L8=1TO 16
: $PACK(F=HEX(A002A001))T$(3)<3*L8-2>FROMQ3$,V8$
: NEXT L8
: BIN(STR(V1$,2))=N1
: STR(V1$,3)=BIN(N4,2)
: BIN(STR(V1$,5))=N3
: BIN(STR(V1$,6))=N7
: V2$=HEX(0001)
: L9=K2-3
: V3$=BIN(L9,2)
: BIN(V6$)=N
: T2$=HEX(0001)
: T0=1
: INIT(5A)T$(1)
6190 INIT(FF)STR(T$(1),17)
: T8=0
: $PACK(F=HEX(5001A002A002A0025004A001A002A002A001))T$(2)FROMT0,T2$,Q2$,V2$
,T8,V6$,V3$,Q3$,V8$
: STR(T$(2),18)=V1$
: DATA SAVE DC $#K1,0,T$()
: INIT(FF)T0$()
: INIT(00)STR(T0$(1),1,N3)
: T9$=HEX(0001)
: DATA SAVE DC $#K1,T9$,T0$()
: DATA SAVE DC $#K1,END
: R9$()=HEX(A0FD)&T$()
: DATA SAVE BA T$#K,(L2-1)R9$()
6330 T9=0
: RETURN
6360 DEFFN'36(Q6$,Q9)
: PRINT AT(Q9,0,80);AT(Q9,INT(40-.5*LEN(Q6$)));Q6$
: RETURN
9998 DEFFN'29"Q$=";HEX(22);"BOMS100B";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D)