image of READY prompt

Wang2200.org

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)