|
|
DataMuseum.dkPresents historical artifacts from the history of: Ohio Scientific Inc. |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Ohio Scientific Inc. Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 22000 (0x55f0)
Notes: OS65UFile, OSU65U-BASIC
Names: »STAT2«
└─⟦2f57871a3⟧ Bits:30009355 Ohio Scientific OS-OMS Nucleus, delvist oversat til dansk
└─⟦this⟧ »STAT2«
00001 PRINT"PROGRAM NOT EXECUTABLE FROM THE CONSOLE":RUN"DBMSYS","PASS"
00002 CLOSE:CLEAR:REM 1/79 STATISTICAL REPORT GENERATOR (STAT2)
00003 K0=0: K1=1: K2=2: K3=3: K4=4: K5=5: K6=6: K7=7: K8=8: K9=9
00004 FOR X=1 TO 33: PRINT: NEXT
00005 POKE 2888,0
00006 PRINT: INPUT"CONSOLE OR PRINTER ";QA$
00007 PD=PEEK(11665): SW=79: IF PD=2 THEN SW=63
00008 IF LEFT$(QA$,1)="P" THEN PD=5: SW=131: GOTO 10
00009 IF LEFT$(QA$,1)<>"C" AND QA$<>"" THEN PRINT: PRINT "WHAT": GOTO 6
00010 SKIP=0: PRINT: INPUT"SINGLE OR DOUBLE SPACED REPORT ";SKIP$
00011 IF LEFT$(SKIP$,1)="D" THEN SKIP=2: GOTO 20
00015 IF LEFT$(SKIP$,1)<>"S" AND SKIP$<>"" THEN PRINT: PRINT"WHAT": GOTO 10
00020 LM=PEEK(14457): IF PD<3 THEN LM=LM-20
00040 FLAG 9: FLAG 11: FLAG 21
00050 FOR X=1 TO 30: PRINT: NEXT X
00060 PRINT"OS-DMS STATISTICAL REPORT GENERATOR"
00065 PRINT"-----------------------------------"
00070 DV(1)=PEEK(11686): IF LEFT$(QA$,1)="P" THEN DV(1)=5
00080 DV(2)=PEEK(9832): IF DV(2)>127 THEN DV(2)=DV(2)-128+4
00090 PRINT: INPUT"KEY FILE OR MASTER FILE ACCESS ";QA$: KEY=2
00095 IF LEFT$(QA$,1)="K" THEN KEY=1: GOTO 99
00096 IF LEFT$(QA$,1)="M" OR QA$="" THEN KEY=2: GOTO 99
00097 PRINT: PRINT "WHAT": GOTO 90
00099 ON KEY GOTO 100,130
00100 GOSUB 1500: REM KEY
00130 CH=1: GOSUB 31020
00132 CH=1: GOSUB 30012
00135 FOR X=1 TO 33: PRINT: NEXT
00140 PRINT:INPUT"ENTER REPORT HEADING ";H$:PRINT:IFLEN(H$)<SW-15 GOTO150
00145 PRINT"**MAXIUM LENGTH OF STATEMENT IS ";SW-15;:PRINT" CHARACTERS**":GOTO140
00150 POKE 2972,13: POKE 2976,13: REM ALLOW , & : IN DATA FIELD
00160 FOR X=1 TO 33: PRINT: NEXT X
00280 PRINT:INPUT"HOW MANY CONDITIONS DO YOU WISH TO SET (0>4) ";K$
00281 IF K$="" THEN K=0: GOTO 285
00282 K=VAL(K$): FOR X=1 TO LEN(K$): T$=MID$(K$,X,1)
00283 IF T$<"0" OR T$>"9" THEN K=9
00284 NEXT X
00285 IF K<>INT(K) OR K<0 OR K>4 THEN PRINT: PRINT"WHAT": GOTO 280
00286 TEST=1: IF K<>0 THEN TEST=2: REM TEST=1==NO COND/ 2==CONDIT
00288 IF K=0 GOTO 760
00290 GOSUB 35020
00301 PRINT: FOR Y=1 TO K: FOR X=1 TO 33: PRINT: NEXT
00303 XX=0: FOR X=1 TO TF: T$="("+MID$(STR$(X),2)+") "+L$(X)
00304 XX=XX+1: IF XX=1 THEN PRINT T$;: GOTO 306
00305 XX=0: PRINT TAB(38); T$
00306 NEXT X: XX=0: FOR QQ=1 TO 3: PRINT: NEXT QQ
00307 PRINT"'^'FIELD # OR LABEL TO KEY ON FOR CONDITION #";Y;:INPUTBB$
00308 IF BB$="" THEN PRINT:PRINT"WHAT!":GOTO 307
00309 IF LEN(BB$)=K1 AND BB$="^" THEN PRINT:PRINT"WHAT!":GOTO 307
00310 IF LEFT$(BB$,1)<>"^" GOTO 315
00311 FOR X=2 TO LEN(BB$): T$=MID$(BB$,X,1)
00312 IF T$<"0" OR T$>"9" THEN PRINT: PRINT"WHAT": GOTO 307
00313 NEXT X: GOTO 317
00315 FORZ=K1TOTF:IF BB$=L$(Z) THEN F1$(Y)=BB$:Z=TF:GOTO 320
00316 NEXTZ:PRINT:PRINT"WHAT!":GOTO 307
00317 BB=VAL(MID$(BB$,2)):IF BB<>INT(BB) THEN PRINT:PRINT"WHAT!":GOTO 307
00318 IF BB<1 OR BB>TF THEN PRINT:PRINT"WHAT!":GOTO 307
00319 F1$(Y)=L$(BB)
00320 PRINT: PRINT F1$(Y);" VS CONSTANT (1)"
00330 PRINT F1$(Y);: INPUT" VS CONTENTS (2) ";T$: T1(Y)=VAL(T$)
00340 IF T1(Y)<1 OR T1(Y)>2 THEN PRINT:PRINT"WHAT!":GOTO 320
00350 IF T1(Y)<>INT(T1(Y)) THEN PRINT:PRINT"WHAT!":GOTO 320
00360 IF T1(Y)<2 GOTO 400
00380 PRINT: PRINT: PRINT"('^'FIELD NUMBER OR LABEL)"
00381 PRINT"THE FIELD ";F1$(Y);
00382 INPUT" IS TO BE COMPARED AGAINST ";BC$
00383 IF BC$="" THEN PRINT:PRINT"WHAT!":GOTO 380
00384 IF LEN(BC$)=1 AND BC$="^" THEN PRINT:PRINT"WHAT": GOTO 380
00385 IFLEFT$(BC$,1)<>"^" GOTO 390
00386 FOR X=2 TO LEN(BC$): T$=MID$(BC$,X,1)
00387 IF T$<"0" OR T$>"9" THEN PRINT: PRINT"WHAT": GOTO 380
00388 NEXT X: GOTO 392
00390 FORZ=K1TOTF:IF BC$=L$(Z) THEN C1$(Y+K4)=BC$:Z=TF:GOTO 400
00391 NEXTZ:PRINT:PRINT"WHAT!":GOTO 380
00392 BC=VAL(MID$(BC$,2)):IF BC<>INT(BC)THENPRINT:PRINT"WHAT!":GOTO 380
00393 IF BC<1 OR BC>TF THEN PRINT:PRINT"WHAT!":GOTO 380
00394 C1$(Y+K4)=L$(BC)
00400 NF=1:IF T1(Y)>1 THEN NF=NF+1
00475 A$="6": IF T1(Y)<K2 THEN A$="7"
00477 FOR X=1 TO 33: PRINT: NEXT
00480 PRINT:PRINT"IF CONDITIONS POSSIBLE (3-";A$;" FOR NUMERIC VARIABLES ONLY)"
00485 PRINT
00490 PRINT"(1) ";F1$(Y);" IS EQUAL TO"
00495 PRINT"(2) ";F1$(Y);" IS NOT EQUAL TO"
00500 PRINT"(3) ";F1$(Y);" IS LESS THAN"
00505 PRINT"(4) ";F1$(Y);" IS LESS THAN OR EQUAL TO"
00510 PRINT"(5) ";F1$(Y);" IS GREATER THAN"
00515 PRINT"(6) ";F1$(Y);" IS GREATER THAN OR EQUAL TO ";
00516 IF T1(Y)<K2 THEN PRINT:GOTO 520
00517 INPUT T$: T2(Y)=VAL(T$): IFT2(Y)<1ORT2(Y)>6 THENPRINT:PRINT"WHAT":GOTO480
00519 GOTO 540
00520 PRINT"(7) ";F1$(Y);: INPUT" IS WITHIN A SPECIFIC RANGE ";T$
00525 T2(Y)=VAL(T$)
00530 IF T2(Y)<1 OR T2(Y)>7 THEN PRINT:PRINT"WHAT!":GOTO 480
00540 IF T2(Y)<>INT(T2(Y)) THEN PRINT:PRINT"WHAT!":GOTO 480
00550 ON T2(Y) GOTO 580,580,580,580,580,580,560
00560 PRINT: PRINT F1$(Y);: INPUT" CANNOT BE LESS THAN ";T1$
00565 R1(Y)=VAL(T1$): REM R1++
00570 PRINTF1$(Y);: INPUT" CANNOT BE GREATER THAN ";T$: R2(Y)=VAL(T$)
00572 GOTO 640: REM R1++
00580 IF T1(Y)>1 GOTO 640
00585 PRINT:PRINT"CONSTANT ";F1$(Y);:INPUT" IS TO BE COMPARED AGAINST ";C1$(Y+K4)
00586 IF C1$(Y+K4)="" THEN PRINT: PRINT"WHAT!": GOTO 585
00640 IF T1(Y)=K1 THEN L2(Y)=VAL(C1$(Y+K4)):REM CHG TO # VAR
00650 NEXT Y
00720 TMP=K:FORX=K1 TO K:CMP$(X)=F1$(X):CMP$(X+K4)=C1$(X+K4):NEXTX
00730 GOSUB33020:FORX=K1TOK:QQ(X)=FP(SUB(X)):QQ(X+K4)=FP(SUB(X+K4)):NEXTX
00760 FOR X=1 TO 33: PRINT: NEXT
00785 GOSUB 35520
00790 GOSUB 39020
00910 FOR X=1 TO 33: PRINT: NEXT
01140 KPR=BODF(CH): FOUND=2: REM FOUND=2==NO REC'S MET CONDITION(S)
01150 PRINT: PRINT"PLEASE WAIT"
01160 GOSUB 32002: REM GOTO 'CONDITIONAL RETURN REC' SUB
01180 ON F1 GOTO 1360,1385
01360 FOUND=1: OO=OO+K1: PRINT " ";: IF OO>K9 THEN OO=K0: PRINT
01380 GOSUB 38020
01385 ON F2 GOTO 1160,20020
01390 GOTO 20020
01500 REM KEY
01510 PRINT: INPUT"DEVICE KEY FILE IS STORED ON ";KD$
01512 IF LEN(KD$)<>1 THEN PRINT: PRINT "INVAILD DEVICE": GOTO 1510
01514 IF KD$<"A" OR KD$>"E" THEN PRINT: PRINT "INVALID DEVICE": GOTO 1510
01516 PRINT: INPUT"KEY FILE NAME,PASSWORD ";KF$,KP$
01518 IF LEN(KF$)<1ORLEN(KF$)>5THENPRINT:PRINT"INVAILD FILE NAME":GOTO1516
01530 IF KP$="." THEN KP$="ANAN": REM .==ANAN
01540 IF LEN(KP$)<>4 THEN PRINT: PRINT"INVAILD PASSWORD":GOTO1516
01550 PRINT: INPUT"KEY FILE TYPE ";KT$: KT=VAL(KT$)
01560 IF KT<1ORKT>7ORKT<>INT(KT)THENPRINT:PRINT"INVAILD TYPE (1-7)":GOTO1550
01610 IF LEN(KF$)<5 THEN KF$=KF$+" ": GOTO 1610
01620 KF$=KF$+MID$(STR$(KT),2): REM ADD TYPE TO NAME
01630 DEV KD$: OPEN KF$,KP$,8: REM OPEN KEY FILE
01640 INPUT %8,DUMY$: IF DUMY$=LEFT$(KF$,5) GOTO 1660
01650 ERR$="FILE HEADER MISMATCH": GOTO 40000
01660 INPUT %8,DUMY$: DUMY=VAL(DUMY$): IF DUMY=KT+10 GOTO 1680
01670 ERR$="KEY FILE TYPE MISMATCH": GOTO 40000
01680 INPUT %8,EDF$: EDF=VAL(EDF$)
01690 INPUT %8,DUMY$: INPUT %8,DUMY$: INPUT %8,LABEL$
01700 IF EDF<INDEX(8) THEN ERR$="FILE EMPTY": GOTO 40000
01710 RETURN: REM BAC WE GO
20020 IF FOUND=2 AND K<>0 GOTO 29900: REM NO DATA SO NO OUTPUT
20030 IF K=0 GOTO 25000: REM SKIP THIS IF NO CONDITION(S)
20040 PRINT#PD,"THIS REPORT IS BASED ON ONLY THOSE RECORDS WHERE :"
20060 LT=LT+1: FOR X=1 TO K: IF X>1 THEN PRINT #PD,"AND"
20070 PRINT#PD,F1$(X);: REM PRINT KEY FIELD
20080 ON T2(X) GOTO 20100,20110,20120,20130,20140,20150,20160
20100 PRINT#PD," EQUALS ";: GOTO 20190
20110 PRINT#PD," IS NOT EQUAL TO ";: GOTO 20190
20120 PRINT#PD," IS LESS THAN ";: GOTO 20190
20130 PRINT#PD," IS LESS THAN OR EQUAL TO ";: GOTO 20190
20140 PRINT#PD," IS GREATER THAN ";: GOTO 20190
20150 PRINT#PD," IS GREATER THAN OR EQUAL TO ";: GOTO 20190
20160 PRINT#PD," IS LESS THAN OR EQUAL TO ";R2(X): LT=LT+2: REM LN CNT
20170 PRINT#PD,"AND IS GREATER THAN OR EQUAL TO ";R1(X): GOTO 20240
20190 LT=LT+1: ON T1(X) GOTO 20210,20220: REM LT=LINE CNT
20210 PRINT#PD,"THE CONSTANT ";C1$(X+4): GOTO 20240
20220 PRINT#PD,C1$(X+4)
20230 IF X>1 THEN LT=LT+1: REM ADD ONE LINE FOR 'AND'
20240 GOSUB 34015: NEXT X
25000 P=2: IF SU=1 OR AV=1 OR NU=1 OR MU=1 THEN P=1
25005 IF SD=1 OR V1=1 OR LH=1 THEN P=1
25020 ON P GOTO 25050,29900: REM 1==DO IT/ 2==DON'T DO IT
25050 GOSUB 34030
28020 ON SUMFLG GOTO 28035,28200
28035 LT=LT+3+CNT(1): IF SKIP>0 THEN LT=LT+CNT(1)
28037 GOSUB 34015
28040 PRINT#PD,TAB(INT((SW-10)/2));"SUMMATIONS"
28050 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
28070 FOR X=1 TO CNT(1): S2(X)=INT((S2(X)+.000000005)*1E8)/1E8:NEXT
28080 FOR X=1 TO CNT(1): PRINT#PD,TAB(GG);L1$(X);TAB(36);S2(X):GG=2
28090 IF SKIP>0 THEN PRINT #PD: REM DOUBLE SPACEING
28100 NEXT: GG=0: FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
28200 ON AVERGE GOTO 28215,28300
28215 LT=LT+3+CNT(2): IF SKIP>0 THEN LT=LT+CNT(2)
28217 GOSUB 34015
28220 PRINT#PD,TAB(INT((SW-10)/2));"AVERAGES"
28224 IF S4=0 THEN S4=1
28230 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";:NEXT: PRINT#PD
28240 FOR X=1 TO CNT(2): S3(X)=INT((S3(X)+.000000005)*1E8)/1E8/S4:NEXT
28250 FOR X=1 TO CNT(2): PRINT#PD,TAB(GG);L2$(X);TAB(36);S3(X):GG=2
28260 IF SKIP>0 THEN PRINT #PD
28270 NEXT: GG=0: FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
28300 ON MU GOTO 28305,28420
28305 LT=LT+5: IF SKIP>0 THEN LT=LT+5
28307 GOSUB 34015
28310 PRINT#PD,TAB(INT((SW-10)/2));"SUM OF THE PRODUCTS"
28320 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
28330 PRINT#PD,L3$(1);" * ";L3$(2);"=";INT((S5+.000000005)*1E8)/1E8
28340 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
28420 ON SD GOTO 28435,28600
28435 LT=LT+3+CNT(4): IF SKIP>0 THEN LT=LT+CNT(4)
28437 GOSUB 34015
28440 PRINT#PD,TAB(INT((SW-10)/2));"STANDARD DEVIATIONS"
28450 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
28452 IF S8-1<>0 AND S8<>0 GOTO 28470: REM PREVENT /0 ERROR !!
28454 PRINT#PD,"NOT ENOUGH DATA IN FILE TO CALCULATE STANDARD DEVIATION"
28456 GOTO 28600
28470 FOR X=1 TO CNT(4): S7(X)=((S7(X)*S7(X))/S8): REM (E)^2/N
28475 S6(X)=SQR(ABS((S6(X)-S7(X))/(S8-1))): REM (E^2)-((E)^2/N))//N-1
28480 NEXT: FOR X=1 TO CNT(4): PRINT#PD,TAB(GG);L5$(X);TAB(36);S6(X):GG=2
28500 IF SKIP>0 THEN PRINT #PD
28510 NEXT: GG=0: FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
28600 ON V1 GOTO 28615,28720
28615 LT=LT+3+CNT(5): IF SKIP>0 THEN LT=LT+CNT(5)
28617 GOSUB 34015
28620 PRINT#PD,TAB(INT((SW-10)/2));"VARIANCE"
28630 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
28634 IF E3-1<>0 AND E3<>0 GOTO 28650: REM PREVENT /0 ERROR !!
28636 PRINT#PD,"NOT ENOUGH DATA IN FILE TO CALCULATE VARIANCE"
28638 GOTO 28720
28650 FOR X=1 TO CNT(5): E2(X)=((E2(X)*E2(X))/E3): REM (E)^2/N
28655 E1(X)=ABS((E1(X)-E2(X))/(E3-1)): REM (E^2)-((E)^2/N)//N-1
28660 NEXT: FOR X=1 TO CNT(5): PRINT#PD,TAB(GG);L6$(X);TAB(36);E1(X):GG=2
28670 IF SKIP>0 THEN PRINT #PD
28680 NEXT: GG=0: FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
28720 ON LH GOTO 28735,28800
28735 LT=LT+3+CNT(6): IF SKIP>0 THEN LT=LT+CNT(6)
28737 GOSUB 34015
28740 PRINT#PD,TAB(INT((SW-10)/2));"MIN. & MAX."
28750 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
28770 FOR X=1 TO CNT(6): ML$(X)=STR$(ML(X)): MH$(X)=STR$(MH(X))
28774 IF ML(X)>=1.7E38 THEN ML$(X)=""
28778 IF MH(X)<=-1.7E-38 THEN MH$(X)=""
28782 PRINT#PD,TAB(GG);L7$(X);TAB(36);ML$(X);
28786 PRINT #PD,TAB(48);MH$(X): GG=2: IF SKIP>0 THEN PRINT #PD
28790 NEXT: GG=0: FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
28800 ON NU GOTO 28810,29900: REM # OF
28810 LT=LT+3+CNT(3): IF SKIP>0 THEN LT=LT+CNT(3)
28812 GOSUB 34015
28820 PRINT#PD,TAB(INT((SW-10)/2));"NUMBER OF OCCURENCES"
28830 FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
28840 FOR X=1 TO CNT(3): PRINT #PD,TAB(GG);L4$(X);TAB(36);NT:GG=2
28850 IF SKIP>0 THEN PRINT #PD
28860 NEXT: GG=0: FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
28870 REM LAST OF PRINT CODE
29890 REM COMMON EXIT +++++++>
29900 IF FOUND<>2 OR K=0 GOTO 29904
29902 PRINT "NO RECORD(S) FOUND THAT MET THE CONDITION(S) SPECIFIED"
29904 PRINT: INPUT"ENTER A C TO CONTINUE ";QA$
29906 IF FOUND=2 AND K<>0 THEN ER=1: GOTO 51110: REM NO TOF ON ERROR
29910 FOR X=1 TO PEEK(15908): PRINT #PD: NEXT
29920 FOR X=1 TO PEEK(15908): PRINT #PD: NEXT: REM R1* + BACK ONE
29930 GOTO 51110: REM COMMON EXIT
30012 INDEX<CH>=53: TF=K0
30014 INPUT %CH,DUMY$: INPUT %CH,DUMY
30016 TF=TF+K1: IF INDEX(CH)<BODF(CH) GOTO 30014
30017 DIM L$(TF+1),LL$(TF+1),FL(TF+1),FP(TF+1),SUB(TF+5),CMP$(TF+5)
30018 DIM PF(TF+1),TYPE(TF+1),PP(TF+1),TMP$(TF+1)
30020 TT=K0: TF=K1: G1=30030: INDEX<CH>=53: REM TT=OFFSET TF=# OF F'S
30030 INPUT %CH,L$(TF): INPUT %CH,FL(TF): FP(TF)=TT
30040 TT=TT+FL(TF): IF INDEX(CH)<BODF(CH) THEN TF=TF+1: GOTO G1
30050 IF INDEX(CH)>BODF(CH) THEN ERR$="FILE HEADER ERROR": GOTO 40000
30060 RETURN: REM BAC WE GO
31020 PRINT: INPUT"DEVICE MASTER FILE IS STORED ON ";MD$(CH)
31025 IF MD$(CH)="" THEN MD$(CH)=CHR$(DV(2)+65): GOTO 31060
31030 IF LEN(MD$(CH))>1 THEN PRINT: PRINT"WHAT": GOTO 31020
31040 IF MD$(CH)<"A" OR MD$(CH)>"E" THEN PRINT: PRINT"WHAT": GOTO 31020
31060 PRINT: INPUT"MASTER FILE NAME,PASSWORD ";MF$(CH),MP$(CH)
31065 IF MF$(CH)="" OR MP$(CH)="" THEN PRINT: PRINT"WHAT": GOTO 31060
31070 IF LEN(MF$(CH))<5 THEN MF$(CH)=MF$(CH)+" ": GOTO 31070
31080 IF LEN(MF$(CH))=6 AND RIGHT$(MF$(CH),1)="0" GOTO 31100
31085 IF LEN(MF$(CH))>6 THEN PRINT: PRINT"IMPROPER FILENAME": GOTO 31060
31090 IF LEN(MF$(CH))<6 THEN MF$(CH)=MF$(CH)+"0": REM XXXXX0
31100 IF MP$(CH)="." THEN MP$(CH)="ANAN": REM CHK PASSWORD
31110 IF LEN(MP$(CH))<>4 THEN PRINT: PRINT"IMPROPER PASSWORD": GOTO 31060
31130 DEV MD$(CH)
31140 OPEN MF$(CH),MP$(CH),CH
31145 PRINT:PRINT"PLEASE WAIT"
31160 INDEX<CH>=0: INPUT %CH,N$: IF N$=LEFT$(MF$(CH),5) GOTO 31180
31170 ERR$="FILE HEADER MISMATCH": GOTO 40000: REM ERR HANDLER
31180 INDEX<CH>=6: INPUT %CH,TY: REM VERIFY MASTER FILE TYPE
31190 IF TY<>10 THEN ERR$="NOT A MASTER FILE TYPE": GOTO 40000
31200 INDEX<CH>=9: INPUT %CH,EODF(CH): REM GET END OF DATA INDEX
31210 INDEX<CH>=20: INPUT %CH,BODF(CH): REM GET START OF DATA INDEX
31230 IF EODF(CH)<=BODF(CH) THEN ERR$="FILE EMPTY": GOTO 40000
31240 INDEX<CH>=31: INPUT %CH,RL(CH): REM GET RECORD LENGTH
31250 INDEX<CH>=42: INPUT %CH,NR(CH): REM GET # OF RECORDS
31270 IF NR(CH)<1 THEN ERR$="FILE EMPTY": GOTO 40000
31290 RETURN: REM RETURN TO CALLER
32000 REM CONDITIONAL
32002 G1=32900: G2=32950: REM GOTOS
32004 F2=K1: F1=K2: ON KEY GOTO 32005,32010: REM KEY=1==NON-CONDIT
32005 DEV KD$:INPUT%8,D$:IFRIGHT$(D$,1)<>"*"THENINPUT%8,KPR:GOTO32010
32006 INPUT %8,DUMY$: IF INDEX(8)<EDF GOTO 32005
32007 GOTO 32965: REM EODF IN KEY
32010 DEV MD$(CH): ON TEST GOTO 32905,32015: REM 1==NON/ 2==COND
32015 FOR ZZ=K1 TO K: INDEX<CH>=KPR+QQ(ZZ): INPUT %CH,DUMY$(ZZ)
32020 ON T1(ZZ) GOTO 32030,32025
32025 INDEX<CH>=KPR+QQ(ZZ+K4): INPUT %CH,DUMY$(ZZ+K4)
32030 ON T2(ZZ) GOTO 32070,32100,32040,32040,32040,32040,32040
32040 ON T1(ZZ) GOTO 32060,32050
32050 L2(ZZ)=VAL(DUMMY$(ZZ+K4))
32060 L1=VAL(DUMY$(ZZ))
32065 ON T2(ZZ) GOTO 32070,32100,32125,32135,32145,32155,32165
32070 ON T1(ZZ) GOTO 32080,32090
32080 IF DUMY$(ZZ)=C1$(ZZ+K4) GOTO G1
32085 GOTO G2
32090 IF DUMY$(ZZ)=DUMY$(ZZ+K4) GOTO G1
32095 GOTO G2
32100 ON T1(ZZ) GOTO 32105,32115
32105 IF DUMY$(ZZ)<>C1$(ZZ+K4) GOTO G1
32110 GOTO G2
32115 IF DUMY$(ZZ)<>DUMY$(ZZ+K4) GOTO G1
32120 GOTO G2
32125 IF L1<L2(ZZ) GOTO G1
32130 GOTO G2
32135 IF L1<=L2(ZZ) GOTO G1
32140 GOTO G2
32145 IF L1>L2(ZZ) GOTO G1
32150 GOTO G2
32155 IF L1>=L2(ZZ) GOTO G1
32160 GOTO G2
32165 IF L1>=R1(ZZ) AND L1<=R2(ZZ) GOTO G1
32170 GOTO G2
32900 NEXT
32905 FOR X=K1 TO TF: INDEX<CH>=KPR+FP(X): INPUT %CH,L$(X): NEXT
32910 ON KEY GOTO 32920,32930: REM KEY=1==NON/ 2==CONDITIONAL
32920 IF INDEX(8)>=EDF THEN F2=K2: REM EDF IN K HIT
32925 F1=K1: RETURN: REM ALL CONDITION(S) MET (IF ANY SET)
32930 KPR=KPR+RL(CH): IF KPR>=EODF(CH) THEN F2=K2: REM EODF IN MASTER
32940 F1=K1: RETURN: REM F1=1==CONDITION(S) MET
32950 ON KEY GOTO 32960,32970: REM KEY=1=KEY ACCESS / 2==DIRECT
32960 IF INDEX(8)<EDF GOTO 32004: REM EDF IN KEY/ NO=GOTO
32965 F2=K2: RETURN: REM F2=K2==EDF HIT IN KEY FILE
32970 KPR=KPR+RL(CH): IF KPR<EODF(CH) GOTO 32004: REM EODF IN MASTER
32980 F2=K2: RETURN: REM F2=K2==EODF HIT IN MASTER
33000 REM VARIFY FIELD SUB
33020 FOR X=K1 TO TMP: SUB(X)=0: SUB(X+K4)=0: FOR Y=K1 TO TF
33030 IF CMP$(X)=L$(Y) THEN SUB(X)=Y
33040 IF CMP$(X+K4)=L$(Y) THEN SUB(X+K4)=Y
33050 NEXT: NEXT X
33060 FE=K0: FOR X=K1 TO TMP: IF SUB(X)>K0 OR CMP$(X)="" GOTO 33080
33070 PRINT:PRINT"NOT ENOUGH DATA IN FILE. FIELD NEEDED IS : ";CMP$(X):FE=1
33080 ON T1(X) GOTO 33110,33090: REM T1(X)=2==(F)
33090 IF SUB(X+K4)>K0 OR CMP$(X)="" GOTO 33110
33100 PRINT:PRINT"NOT ENOUGH DATA IN FILE. FIELD NEEDED IS : ";CMP$(X+K4):FE=1
33110 NEXT X: IF FE>K0 GOTO 40000: REM FE>0==FIELD(S) NOT FOUND
33120 RETURN: REM BAC WE GO
34015 IF SKIP>0 THEN LT=LT+1
34016 LC=LC+LT: IF LC<LM THEN RETURN
34017 IF PD>2 GOTO 34020
34018 W=PEEK(11686): POKE 11686,0: INPUT QQ$: POKE 11686,W
34020 FOR SY=1 TO PEEK(15908): PRINT #PD: NEXT SY
34030 PG=PG+1: LC=0: LT=0: PRINT#PD
34040 PRINT#PD,H$;TAB(SW-10);" PAGE ";PG;:PH=POS(X)-3:PRINT#PD
34050 FOR SY=0 TO PH-K2: PRINT #PD,TAB(SY);"-";: NEXT SY: PRINT #PD
34060 FOR SY=0 TO PH-K2: PRINT #PD,TAB(SY);"-";: NEXT SY: PRINT #PD: PRINT#PD
34070 RETURN: REM BAC WE GO
35020 DEV CHR$(DV(2)+65): OPEN "HOW-TO","PASS",2
35030 FOR X=1 TO 33: PRINT: NEXT
35040 INPUT %2,DUMY$: IF DUMY$<>"^P" THEN PRINT DUMY$: GOTO 35040
35050 PRINT: INPUT"ENTER A C TO CONTINUE ";QA$
35060 FOR X=1 TO 33: PRINT: NEXT X: RETURN: REM BAC WE GO
35520 DEV CHR$(DV(2)+65): IF K=0 THEN OPEN "HOW-TO","PASS",2
35525 IF K=0 THEN INPUT %2,DUMY$: IF DUMY$<>"^P" GOTO 35525
35526 FOR X=1 TO 33: PRINT: NEXT X
35530 INPUT %2,DUMY$: IF DUMY$<>"^P" THEN PRINT DUMY$: GOTO 35530
35540 CLOSE 2: PRINT: INPUT"ENTER A C TO CONTINUE ";QA$
35550 FOR X=1 TO 33: PRINT: NEXT X: RETURN: REM BAC WE GO
36020 FOR X=1 TO 33: PRINT: NEXT: PRINT
36025 PRINT"NUMBER(S) MUST BE PRECEDED BY A ^": PRINT
36030 PRINT"ENTER THE SELECTIONS WHICH YOU WOULD LIKE TO SUM"
36040 PRINT"IF NONE, SIMPLY HIT THE RETURN KEY"
36130 PRINT:PRINT: GOSUB 37020
36160 SUMFLG=2: ON P GOTO 36180,36998
36180 SUMFLG=1: CNT(1)=WW: FOR X=1 TO WW: S1UM(X)=TMP(X)
36185 P1(X)=PNTR(X): L1$(X)=LL$(TMP(X)): NEXT: REM P1=TABS/L1$=LABEL
36188 GOTO 36998
36225 FOR X=1 TO 33: PRINT: NEXT
36227 PRINT"NUMBER(S) MUST BE PRECEDED BY A ^": PRINT
36230 PRINT"ENTER THE SELECTIONS YOU WOULD LIKE TO HAVE AVERAGED"
36240 PRINT"IF NONE, SIMPLY HIT THE RETURN KEY"
36250 PRINT:PRINT: GOSUB 37020: REM GO GET USER PARTICULARS
36270 AVERAG=2: ON P GOTO 36290,36998
36290 AVERGE=1: CNT(2)=WW: FOR X=1 TO WW: A1VERG(X)=TMP(X)
36295 P2(X)=PNTR(X): L2$(X)=LL$(TMP(X)): NEXT: REM P2=TABS/L2$=LABEL
36298 GOTO 36998
36325 FOR X=1 TO 33: PRINT: NEXT
36327 PRINT"NUMBER(S) MUST BE PRECEDED BY A ^": PRINT
36330 PRINT"YOU MAY NOW SELECT THOSE FIELD(S) FOR WHICH"
36340 PRINT"THE MIN. & MAX. IS TO BE DETERMINED."
36345 PRINT"IF YOUR CHOICE IS NONE, SIMPLY HIT THE RETURN KEY."
36350 PRINT:PRINT: GOSUB 37020: REM GET USER'S CHOICE
36370 LH=2: ON P GOTO 36380,36998
36380 LH=1: CNT(6)=WW: FOR X=1 TO WW: P8(X)=PNTR(X): L7$(X)=LL$(TMP(X))
36385 MM(X)=TMP(X): ML(X)=1.7E38: MH(X)=-1.7E-38: NEXT
36400 GOTO 36998
36422 FOR X=1 TO 33: PRINT: NEXT
36424 PRINT"NUMBER(S) MUST BE PRECEDED BY A ^"
36425 PRINT:PRINT"YOU MAY NOW SELECT ANY TWO FIELDS. THESE TWO FIELDS"
36430 PRINT"WILL THEN BE MULTIPLIED TOGETHER AND THE SUM OF THEIR"
36440 PRINT"PRODUCTS WILL BE DISPLAYED AT THE END OF THIS REPORT"
36450 PRINT"IF YOU DO NOT DESIRE THIS OPTION SIMPLY HIT THE RETURN KEY"
36470 MU=2: PRINT: GOSUB 37020: REM GO TO GET USER'S CHOICE
36480 ON P GOTO 36500,36998
36500 IF WW>2 THEN PRINT"TWO FIELDS ONLY": GOTO 36470
36505 IF WW<2 THEN PRINT"TWO FIELDS REQUIRED": GOTO 36470
36510 MU=1: P3=TMP(1): P4=TMP(2): REM PICK UP SUBSCRIPTS
36515 L3$(1)=LL$(TMP(1)): L3$(2)=LL$(TMP(2)): REM PICKUP LABELS
36518 GOTO 36998
36605 FOR X=1 TO 33: PRINT: NEXT
36608 PRINT"NUMBER(S) MUST BE PRECEDED BY A ^"
36610 PRINT:PRINT"YOU MAY NOW SELECT THOSE FIELD(S) OF WHICH YOU"
36620 PRINT"WOULD LIKE TO KNOW THE NUMBER OF OCCURENCES."
36630 PRINT"IF YOUR CHOICE IS NONE, SIMPLY HIT THE RETURN KEY."
36650 NU=2: PRINT: GOSUB 37020: REM GET USER'S CHOICE
36660 ON P GOTO 36680,36998
36680 NU=1: CNT(3)=WW: FOR X=1 TO WW: L4$(X)=LL$(TMP(X))
36690 P5(X)=PNTR(X): NEXT: REM PICKUP THIS FUNCTIONS PARAMS
36695 GOTO 36998
36805 FOR X=1 TO 33: PRINT: NEXT
36808 PRINT"NUMBER(S) MUST BE PRECEDED BY A ^"
36810 PRINT: PRINT"YOU MAY NOW SELECT THOSE FIELD(S) FOR WHICH"
36820 PRINT"THE STANDARD DEVIATION IS TO BE CALCULATED."
36830 PRINT"IF YOUR CHOICE IS NONE, SIMPLY HIT THE RETURN KEY."
36850 SD=2: PRINT: GOSUB 37020: REM GET USER'S CHOICE
36860 ON P GOTO 36880,36998
36880 SD=1: CNT(4)=WW: FOR X=1 TO WW: L5$(X)=LL$(TMP(X))
36890 P6(X)=PNTR(X): DE(X)=TMP(X): NEXT: REM PICKUP PARAMS
36895 GOTO 36998
36905 FOR X=1 TO 33: PRINT: NEXT
36908 PRINT"NUMBER(S) MUST BE PRECEDED BY A ^"
36910 PRINT:PRINT"YOU MAY NOW SELECT THOSE FIELD(S) WHOSE VARIANCE"
36920 PRINT"IS TO BE CALCULATED."
36930 PRINT"IF YOUR CHOICE IS NONE, SIMPLY HIT THE RETURN KEY."
36940 V1=2: PRINT: GOSUB 37020: REM GET USER'S CHOICE
36950 ON P GOTO 36970,36998
36970 V1=1: CNT(5)=WW: FOR X=1 TO WW: L6$(X)=LL$(TMP(X))
36980 P7(X)=PNTR(X): VA(X)=TMP(X): NEXT: REM PICKUP PARAMS
36995 GOTO 36998
36998 FOR X=1 TO 33: PRINT: NEXT: RETURN: REM PREMATURE EXIT PNT
37020 XX=0: FOR X=1 TO TF: T$="("+MID$(STR$(X),2)+") "+L$(X)
37030 XX=XX+1: IF XX=1 THEN PRINT T$;: GOTO 37050
37040 XX=0: PRINT TAB(38);T$
37050 NEXT: PRINT
37110 PRINT"ENTER YOUR SELECTION(S)": INPUT QA$
37120 P=1: WW=0: IF QA$="" THEN P=2: GOTO 37600
37122 FOR X=1 TO LEN(QA$): T$=MID$(QA$,X,1)
37124 IF T$=" " OR T$="^" GOTO 37128
37126 IF T$<"0" OR T$>"9" GOTO 37150
37128 NEXT X
37130 IF LEN(QA$)=1 AND QA$="^" GOTO 37150
37135 IF LEFT$(QA$,1)<>"^" GOTO 37150
37140 GOTO 37170
37150 XX=0: WW=0: PRINT: PRINT"WHAT": GOTO 37020
37170 FOR X=1 TO LEN(QA$): IF MID$(QA$,X,1)<>"^" GOTO 37190
37180 MRK(WW+K1)=X: WW=WW+K1: IF WW>TF+K1 THEN GOTO 37150
37185 IF WW>9 GOTO 37200
37190 NEXT: MRK(WW+1)=LEN(QA$)+1
37195 IF WW<=9 GOTO 37230
37200 FOR X=1 TO 33: PRINT: NEXT
37210 PRINT"SORRY NINE FIELDS MAX.": PRINT: GOTO 37020
37230 FOR X=1 TO WW: MRK$(X)=MID$(QA$,MRK(X)+K1,MRK(X+K1)-(MRK(X)+1))
37240 T=VAL(MRK$(X))
37250 IF T<>INT(T) OR T<1 OR T>TF GOTO 37150
37260 NEXT : PRINT
37290 Z=0: FOR X=1 TO WW: PNTR(X)=0: TMP(X)=VAL(MRK$(X))
37300 LL$(TMP(X))=L$(TMP(X)): NEXT: FOR X=1 TO 33: PRINT: NEXT
37310 PRINT: INPUT"DO YOU WISH TO CHANGE ANY REPORT HEADING(S) ";QB$
37320 IF LEFT$(QB$,1)="N" OR QB$="" GOTO 37520
37325 IF LEFT$(QB$,1)<>"Y" THEN PRINT: PRINT "WHAT": GOTO 37310
37340 FOR X=1 TO WW
37342 PRINT "DO YOU WISH TO RENAME ";L$(TMP(X));
37345 LL$(TMP(X))=L$(TMP(X)): REM EQUATE ORIGINAL NAME
37350 INPUT" ";QB$: IF LEFT$(QB$,1)="N" OR QB$="" GOTO 37370
37355 IF LEFT$(QB$,1)<>"Y" THEN PRINT: PRINT"WHAT": PRINT: GOTO 37342
37360 INPUT"NEW NAME ";LL$(TMP(X)): IF LL$(TMP(X))<>"" GOTO 37370
37365 PRINT: PRINT"WHAT": GOTO 37360
37370 NEXT: GOTO 37600
37520 FOR X=1 TO WW: LL$(TMP(X))=L$(TMP(X)): NEXT
37600 RETURN: REM BAC WE GO
38010 REM UPDATE REG'S
38020 ON SUMFLG GOTO 38040,38100
38040 FOR X=K1 TO CNT(K1): S2(X)=S2(X)+VAL(L$(S1UM(X))): NEXT
38100 ON AV GOTO 38120,38200
38120 FOR X=K1 TO CNT(K2): S3(X)=S3(X)+VAL(L$(A1VG(X))):NEXT:S4=S4+K1
38200 ON MU GOTO 38220,38300
38220 S5=S5+(VAL(L$(P3))*VAL(L$(P4)))
38300 ON NU GOTO 38320,38400
38320 NT=NT+K1
38400 ON SD GOTO 38420,38600
38420 FOR X=K1 TO CNT(4): S6(X)=S6(X)+(VAL(L$(DE(X)))*VAL(L$(DE(X))))
38430 S7(X)=S7(X)+VAL(L$(DE(X))): NEXT: S8=S8+K1
38600 ON V1 GOTO 38620,38720
38620 FOR X=K1 TO CNT(5): E1(X)=E1(X)+(VAL(L$(VA(X)))*VAL(L$(VA(X))))
38630 E2(X)=E2(X)+VAL(L$(VA(X))): NEXT: E3=E3+K1
38720 ON LH GOTO 38740,38900
38740 FOR X=K1 TO CNT(K6)
38750 IF VAL(L$(MM(X))) < ML(X) THEN ML(X)=VAL(L$(MM(X)))
38760 IF VAL(L$(MM(X))) > MH(X) THEN MH(X)=VAL(L$(MM(X)))
38770 NEXT: REM ML==MIN/ MH==MAX
38900 RETURN: REM BAC WE GO
39020 SU=2: AV=2: LH=2: MU=2: NU=2: SD=2: V1=2
39040 NQ=0: NZ=9
39050 FOR X=1 TO 33: PRINT: NEXT
39060 NQ=NQ+1
39070 ON NQ GOTO 39080,39090,39100,39110,39120,39130,39140,39150
39080 PRINT"(1) SUMMATIONS"
39090 PRINT"(2) AVERAGES"
39100 PRINT"(3) MIN. & MAX."
39110 PRINT"(4) SUM OF THE PRODUCTS"
39120 PRINT"(5) NUMBER OF OCCURENCES"
39130 PRINT"(6) STANDARD DEVIATION"
39140 PRINT"(7) VARIANCE"
39150 PRINT"(8) DONE"
39160 INPUT"(9) ABORT (RETURN TO OS-DMS MAIN MENU) ";QR$
39165 ZQ=ZQ+1: IF P=1 THEN ZS=1
39180 FOR X=1 TO LEN(QR$): T$=MID$(QR$,X,1)
39190 IF T$>="0" AND T$<="9" OR T$=" " GOTO 39230
39195 REM ZQ=0 REMOVED
39210 PRINT: PRINT"WHAT DOES ";QR$;" MEAN ?": GOTO 39070
39230 NEXT: QR=VAL(QR$)
39235 IF ZQ<2 AND QR=8 THEN ZQ=0: GOTO 39250
39237 IF ZS=0 AND QR=8 GOTO 39250
39240 IF QR>=NQ AND QR<=NZ AND QR=INT(QR) GOTO 39260
39250 PRINT: PRINT"NOT A VALID SELECTION": GOTO 39070
39260 IF QR=8 GOTO 39300
39270 IF QR=9 GOTO 51110
39280 ON QR GOSUB 36020,36225,36325,36422,36605,36805,36905
39290 NQ=QR: GOTO 39060
39300 RETURN: REM BAC WE GO
40000 ER=1: GOTO 51050: REM FORCE WAIT ON INPUT
50000 ER=PEEK(10226): EL=PEEK(11774)+PEEK(11775)*256
50040 IF ER=128 THEN ERR$="INVALID FILENAME": GOTO 51050
50050 IF ER=132 THEN ERR$="END OF FILE ERROR": GOTO 51050
50060 IF ER=130 THEN ERR$="ACCESS RIGHTS VIOLATION": GOTO 51050
50070 IF ER=129 THEN ERR$="CANNOT ACCESS FILE ": GOTO 51050
50080 ERR$="DISC ERROR CODE "+STR$(ER)+" IN LINE "+STR$(EL)
50094 EA=0: FOR I=4 TO 1 STEP -1: EA=EA*256+PEEK(9889+1): NEXT I
50096 DV(3)=PEEK(9832): IF DV(3)>127 THEN DV(3)=DV(3)-128+4
50098 PRINT"ERROR ON DEVICE "+CHR$(DV(3)+65)+" AT DISC ADDRESS";EA
51050 PRINT: PRINT "***** ERROR *****": PRINT
51060 PRINT ERR$: ERR$=""
51110 DEV CHR$(DV(2)+65)
51120 POKE 2972,58: POKE 2976,44: REM DISALLOW , & : IN DATA FIELD
51150 IF ER>0 THEN PRINT:INPUT"ENTER A C TO CONTINUE ";QA$
51155 ZA=ZA+1: IF ZA>1 GOTO 51180
51160 IF ER>0 THEN FOR X=1 TO PEEK(15908): PRINT #PD: NEXT X
51170 IF ER>0 THEN FOR X=1 TO PEEK(15908): PRINT #PD: NEXT X
51180 CLOSE: RUN "DBMSYS","PASS"