10 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   !!             MARQ.BAS                !!
   !!COMPUTER AUG. CASES IN OP. AND LOG.  !!
   !!            MANAGEMENT               !!
20 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   !!              AUTHORS                !!
   !!  WILLIAM BERRY & D. CLAY WHYBARK    !!
30 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   !!             PUBLISHER               !!
   !!           SOUTH-WESTERN             !!
40 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   !!        RSTS/11 VERSION BY           !!
   !!          DARRYL JOHNSON             !!
   !!          BENTLEY COLLEGE            !!
   !!             MAY 1973                !!
50 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
100 &:&:& "THE MARQUIS COMPANY":U$="#### #### #### ### ##.## ##.##":
	U$=U$+" ###.## ###.## ####.## ####.## ######.##"
140 &:&:&:INPUT "SAMPLE SIZE ( '-1' WILL TERMINATE THE PROGRAM) ";N%:
	GOTO 9999 IF N%<1%:&:INPUT "SAMPLE FREQUENCY ";N4%:&
150 INPUT "LENGTH OF RUN <100 DAYS MAX.> ";N0%:&:
	GOTO 150 IF N0%<1 OR N0%> 100%:
	INPUT "CRITICAL NUMBER FOR ACCEPTANCE ";M0%:&:
	INPUT "RESET1 - (CHANGE DIE AFTER SAMPLING)";R0
155 INPUT "RESET2 - (CHANGE DIE AFTER 100% INSPECTION)";R1:&:
	INPUT "FMAX - (FOR 100% INSPECTION)";F1:&:&:
	INPUT "DO YOU WANT A DETAILED REPORT ";F$
159 I2%=-1% IF ASCII(F$)<>78%:
	&:&:INPUT "DIRECT OUTPUT TO ";F$:
	F$="KB:" IF LEN(F$)=0%:
	OPEN F$ FOR OUTPUT AS FILE 1%
160 &#1%:&#1%:&#1%:&#1% TAB(25);"THE MARQUIS COMPANY":
	&#1%:&#1% TAB(23);"QUALITY CONTROL PROGRAM":&#1%:&#1%:&#1%
190 &#1%:&#1%:&#1%:&#1% " A = NUMBER DEFECTIVE IN SAMPLE":
	&#1% " B = FRACTION DEFECTIVE IN SAMPLE":
	&#1% " C = FRACTION DEFECTIVE IN LOT"
200 &#1%:&#1% TAB(31);" SAMP-   DIE     100% CUSTMER     DAILY":
	&#1% " DAY  LOT SAMP";SPACE$(19%);"LING  CHANGE INSPEC";:
	&#1% " PENALTY     TOTAL":
	&#1% " NO. SIZE SIZE   A    B     C    COST   COST    COST    ";:
	&#1% "COST      COST"
300 DIM P(8%):C4,C5,C6,C7,C8=0:N7%,K1%=1%:A=.00002:B=.10:
	N6%,T=0:RESTORE:MAT READ P:N5%=N%:&#1%
400 DATA .13,.40,.67,.85,.94,.98,.99,.999999
500 FOR I0%=1% TO N0%:C,C0,C1,C2,K0%,K2%,K3%,N%,N2%,S,S0=0
510 GOTO 520 IF N7%>=K1%:GOSUB 2000: GOTO 510
520 K1%=K1%+20%:GOSUB 2000: FOR I%=1% TO 8%:
	IF R<=P(I%) THEN L0%=250+50*I%:D=L0%:GOTO 540
530 NEXT I%:D,L0%=650
540 S1,F%=0:GOSUB 2000:S1=1 IF R>=.9:T=T+A*D+B*S1:T=1 IF T>1:
	I%=0%:X1=D*T:IF X1>100 THEN 610 ELSE ON ERROR GOTO 545:
	P0=1/2.7183**X1:GOTO 547
545 IF ERR=49 AND ERL=540 THEN RESUME 546 ELSE ON ERROR GOTO 0
546 P0=.1E-37:F%=-1%
547 GOSUB 2000:GOTO 600 IF R<P0:X3=P0
550 FOR I%=1% TO L0%:X0=I%:X3=X3*(X1/X0):P0=X3+P0:GOTO 600 IF R<P0
560 NEXT I%:N1%=L0%
600 N1%=I%:GOTO 620
610 S2=X1**.5:GOSUB 3000:N1%=Z+.499999
620 T1=N1%:B1=L0%:F2=T1/B1:N6%=N6%+1%:GOTO 1000 IF N6%<N4%:N%=N5%:
	X2=N%:IF X2<=0 THEN C=0:GOTO 1000
630 C=1+.05*X2:K3%=1%:N6%,I%=0%:P0=(1-F2)**N%:GOSUB 2000:
	GOTO 640 IF R<P0:X3=P0
633 FOR I%=1% TO N%:X0=I%:X2=N%:X3=X3*(F2*(X2-(X0-1)))/(X0*(1-F2)):
	P0=P0+X3:GOTO 640 IF R<P0:NEXT I%:N3%=N%:GOTO 642
640 N3%=I%
642 N2%,T0=N3%:B0=N%:S=T0/B0:S=0 IF B0<=0:GOTO 1000 IF N3%<=M0%:
	GOTO 660 IF S<F1:D0=L0%-N%:A0=N1%:C1=.05*D0+.40*A0:
	S0=F2:K0%=1%:GOTO 1050
660 GOTO 1000 IF S<R0:K2%=1%:N6%=0%:C0=70
1000 C2=0:GOTO 1050 IF K0%>0%:P0=(1-F2)**20+20*F2*(1-F2)**19:
	GOSUB 2000: GOTO 1070 IF R<P0:X4=N1%:IF F% THEN C2=X4+1 ELSE C2=X4
1050 T0=N1%:B2=L0%:S0=T0/B2:GOTO 1070 IF S0<R1 OR K2%>0%:
	K2%=1%:N6%=0%:C0=70
1070 C5=C5+C:C6=C6+C0:C7=C7+C1:C8=C8+C2:C3=C+C0+C1+C2:C4=C4+C3:
	&#1% USING U$,I0%,L0%,N%,N2%,S,S0,C,C0,C1,C2,C3 IF I2%:
	T=0 IF K2%>0%:NEXT I0%
1195 &#1%:&#1% "TOTAL COST";TAB(29);:&#1% USING "#####.##",C5;:
	&#1% USING "####.##",C6;:&#1% USING "#####.##",C7;:
	&#1% USING "#####.##",C8;:&#1% USING "#######.##",C4:
	&#1% FOR I%=1% TO 5%:CLOSE 1%:GOTO 140
2000 ! RANDOM NUMBER SUBROUTINE
2010 GOTO 2020 IF N7%>1:M%,F=8192:K4%=1%
2020 FOR I3%=1% TO 3%:L%=3%*K4%:K4%=L%-(L%/M%)*M%:
	NEXT I3%:R=K4%/F:I1%=INT(R*1000.):R=I1%/1000.:N7%=N7%+1%:
	RETURN
3000 ! STATISTICAL SUB ROUTINE
3010 S3=0:FOR I4%=1% TO 12%:GOSUB 2000:S3=S3+R:
	NEXT I4%:Z=S2*(S3-6)+X1:RETURN
9999 END