1 '                    SELECT SPECIFIC RECORDS
2 '               Written by Tracy L. Gustafson, M.D.
3 '              Round Rock, Texas. Version 3.0, 1984
4 ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
15 DIM D(1,1),CS(1,1),T(1),N$(1),X(1),X2(1),MD(1),SD(1),CZ(1),NN(10),NA(10),NB(10),SA(10)
22 DATA "SELECT SPECIFIC RECORDS",23,25
30 LOCATE 5,1:GOSUB 4000
35 AR=CSRLIN:LOCATE 25,1:PRINT "1";:FOR Z=2 TO 10:PRINT TAB(Z*7-1);Z;:NEXT
40 RESTORE 45:COLOR CLR2,CLR1:FOR Z=1 TO 10:READ AC,DC:LOCATE 25,AC:PRINT DC;:NN(Z)=1:NEXT:COLOR CLR1,CLR2
45 DATA 2," Sample # ",15," = ",22," > ",29," >= ",36," < ",43," <= ",50," <> ",57," AND ",64," OR ",72," DONE "
50 LOCATE AR,1:PRINT:PRINT TAB(10);"1.) Use FORMAT  (A) SELECT IF: Sample #1 >= NUMBER"
55 PRINT TAB(22);"or  (B) SELECT IF: Sample #1 >= Sample #2"
60 PRINT TAB(10);"2.) Press RETURN after entering a NUMBER."
65 PRINT TAB(10);"3.) Press Key F10 when selection criteria are complete."
70 PRINT:PRINT "SELECT IF: ";:ZS=0:DS="SELECTED ON: "
75 GOSUB 145:IF AI=59 THEN ZS=ZS+1:PRINT "Sample #";:AR=CSRLIN:AC=POS(0):GOSUB 180:NA(ZS)=VAL(DZ):DS=DS+N$(VAL(DZ)) ELSE IF AI=68 AND ZS=0 THEN DS="":CC=C:FOR Z=1 TO C:CZ(Z)=Z:NEXT:GOTO 190 ELSE BEEP:GOTO 75
80 GOSUB 145:IF AI<60 OR AI>65 THEN BEEP:GOTO 80 ELSE AO=AI-59:NB(ZS)=AO
85 IF AO=1 THEN DZ="=" ELSE IF AO=2 THEN DZ=">" ELSE IF AO=3 THEN DZ=">=" ELSE IF AO=4 THEN DZ="<" ELSE IF AO=5 THEN DZ="<=" ELSE IF AO=6 THEN DZ="<>"
90 PRINT DZ;" ";:DS=DS+" "+DZ+" "
95 GOSUB 145:IF AI=59 THEN NB(ZS)=NB(ZS)+6:PRINT "Sample #";:AR=CSRLIN:AC=POS(0):GOSUB 180:SA(ZS)=VAL(DZ):DS=DS+N$(VAL(DZ)):GOTO 135 ELSE IF AI<>0 THEN BEEP:GOTO 95
100 PRINT A$;:DZ=A$:L=1:GOSUB 160:SA(ZS)=VAL(DZ):N=NA(ZS)
105 ON AO GOTO 110,115,115,120,120,130
110 IF SA(ZS)VAL(D(N,CS(N,T(N)))) THEN 125 ELSE 130
115 IF SA(ZS)>VAL(D(N,CS(N,T(N)))) THEN 125 ELSE 130
120 IF SA(ZS)0 THEN L=L-1:PRINT CHR$(29);" ";CHR$(29);:DZ=LEFT$(DZ,L):GOTO 160 ELSE BEEP:GOTO 160
170 IF A$>"-" AND A$<":" THEN PRINT A$;:DZ=DZ+A$:L=L+1 ELSE BEEP
175 GOTO 160
180 DZ="":GOSUB 160:IF VAL(DZ)>0 AND VAL(DZ)<=A THEN PRINT " ";:RETURN
185 LOCATE 24,25:PRINT FILE$;" has only";A;"samples.";:BEEP:LOCATE 24,20:LOCATE AR,AC:PRINT "    ":LOCATE AR,AC:GOTO 180
190 PRINT:PRINT:INPUT "Do you want Selected Records written to SCREEN (S),PRINTER (P), or DISK (D)? ",A$
195 PO$="":IF A$="D" OR A$="d" THEN 215 ELSE IF A$="s" OR A$="S" THEN PO$="SCRN:" ELSE IF A$="p" OR A$="P" THEN PO$="LPT1:" ELSE BEEP:GOTO 190
200 INPUT " Do you want the records printed in SORTED or in INPUT order? (S or I)  ",A$
205 IF A$="i" OR A$="I" THEN BSRT=0:GOTO 215 ELSE IF A$="s" OR A$="S" THEN BSRT=1 ELSE BEEP:GOTO 200
210 IF A>1 THEN PRINT TAB(12);:INPUT "Which sample number do you wish to SORT by?   ",NS:IF NS<1 OR NS>A THEN BEEP:GOTO 210
215 PRINT:PRINT:AR=CSRLIN:IF DS="" THEN 350 ELSE COLOR 23:LOCATE AR,29:PRINT "SELECTING RECORDS";:COLOR CLR1
220 CC=0:FOR Z=1 TO C:FOR TZ=1 TO ZS:VX=VAL(D(NA(TZ),Z)):VY=SA(TZ)
225 ON NB(TZ) GOTO 235,240,245,250,255,260,230,230,230,230,230,230
230 VY=VAL(D(SA(TZ),Z)):ON NB(TZ) GOTO 1,1,1,1,1,1,235,240,245,250,255,260
235 IF VX=VY THEN 275 ELSE 265
240 IF VX>VY THEN 275 ELSE 265
245 IF VX>=VY THEN 275 ELSE 265
250 IF VXVY THEN 275 ELSE 265
265 ON NN(TZ) GOTO 290,270,280
270 TZ=TZ+1:GOTO 265
275 IF NN(TZ)<>2 THEN 285
280 NEXT TZ
285 CC=CC+1:CZ(CC)=Z
290 NEXT Z
295 IF CC=0 THEN BEEP:LOCATE AR,19:PRINT "There are no records meeting these selection criteria.":GOTO 545
300 FOR T=1 TO A:T(T)=0:X(T)=0:X2(T)=0:MD(T)=0:SD(T)=0:NEXT
305 FOR TT=1 TO CC:FOR T=1 TO A:DT=D(T,CZ(TT)):D(T,TT)=DT:IF DT="" THEN 330 ELSE VC=VAL(DT)
310 FOR Z=1 TO T(T):VX=VAL(D(T,CS(T,Z))):IF VX<=VC THEN 320
315 FOR TZ=T(T)+1 TO Z+1 STEP -1:CS(T,TZ)=CS(T,TZ-1):NEXT:GOTO 325
320 NEXT Z
325 CS(T,Z)=TT:T(T)=T(T)+1:X(T)=X(T)+VC:X2(T)=X2(T)+VC*VC
330 NEXT T:NEXT TT
335 FOR T=1 TO A:N=T(T):IF N>1 THEN IF X2(T)>X(T)*X(T)/N THEN SD(T)=SQR((X2(T)-X(T)*X(T)/N)/(N-1))
340 IF N>0 THEN IF N MOD 2=0 THEN MD(T)=(VAL(D(T,CS(T,N/2)))+VAL(D(T,CS(T,N/2+1))))*.5 ELSE MD(T)=VAL(D(T,CS(T,N/2+.5)))
345 NEXT
350 IF PO$="LPT1:" THEN PMAX=PRNT-10 ELSE IF PO$="SCRN:" THEN PMAX=70:FOR T=0 TO INT((A-1)/7):SCREEN ,,T,0:CLS:NEXT:SCREEN ,,0:GOTO 365 ELSE 560
355 LOCATE AR,23:PRINT "Be sure paper is in printer.":PRINT TAB(24);"Press space bar when ready:":ON ERROR GOTO 5070
360 A$=INKEY$:IF A$="" THEN 360 ELSE IF A$<>CHR$(32) THEN BEEP:GOTO 360
365 OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
370 IF A>1 THEN 425
375 PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,:PRINT #1,DS
380 PRINT #1,:PRINT #1,"Sample Name = ";N$(1):PRINT #1,:TB=1:IF BSRT=1 THEN 400
385 FOR Z=1 TO CC:PRINT #1,USING "###";Z;PRINT #1,":";D(1,Z);
390 TB=TB+13:IF TB>PMAX THEN TB=1
395 PRINT #1,TAB(TB);:NEXT:GOTO 415
400 FOR Z=1 TO CC:PRINT #1,USING "###";CS(1,Z);:PRINT #1,":";D(1,CS(1,Z));
405 TB=TB+13:IF TB>PMAX THEN TB=1
410 PRINT #1,TAB(TB);:NEXT
415 PRINT #1,:PRINT #1,TAB(5);"TOTAL =";T(1);TAB(26);"MEAN =";X(1)/T(1);TAB(55);"MEDIAN =";MD(1)
420 PRINT #1,:PRINT #1,TAB(20);"STANDARD DEVIATION =";SD(1):PRINT:PRINT:GOTO 545
425 AR=CSRLIN:FOR AS=0 TO INT((A-1)*10/PMAX):A2=(AS+1)*PMAX/10:IF A2>A THEN A2=A
430 A1=AS*PMAX/10+1:IF PO$="SCRN:" THEN SCREEN,,AS,AS:LOCATE AR,1
435 PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,:PRINT #1,DS:PRINT #1,
440 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);"Sample";T;:NEXT:PRINT #1,
445 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);N$(T);:NEXT:PRINT #1,:PRINT #1,
450 IF BSRT=1 THEN 465
455 FOR Z=1 TO CC:PRINT #1,USING "###";Z;:PRINT #1,":";
460 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,Z);:NEXT:PRINT #1,:NEXT:GOTO 475
465 FOR Z=1 TO CC:PRINT #1,USING "###";CS(NS,Z);:PRINT #1,":";
470 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,CS(NS,Z));:NEXT:PRINT #1,:NEXT
475 PRINT #1,:PRINT #1,"NO.";:P$="#####"
480 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;T(T);:NEXT
485 PRINT #1,:PRINT #1,"MEAN";
490 FOR T=A1 TO A2:IF T(T)>0 THEN MN=X(T)/T(T) ELSE MN=0
495 MB=ABS(MN):GOSUB 570:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MN;:NEXT
500 PRINT #1,:PRINT #1,"MED";
505 FOR T=A1 TO A2:MB=ABS(MD(T)):GOSUB 570:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MD(T);:NEXT
510 PRINT #1,:PRINT #1,"SDEV";
515 FOR T=A1 TO A2:MB=SD(T):GOSUB 570:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;SD(T);:NEXT
520 PRINT #1,:PRINT:IF A2=A THEN 540
525 IF PO$="LPT1:" THEN PRINT CHR$(12)
530 LOCATE 25,12:PRINT TAB(75):LOCATE 25,12:PRINT "Press `P' to print next page, space bar to quit:";
535 A$=INKEY$:IF A$="" THEN 535 ELSE IF A$="p" OR A$="P" THEN NEXT AS ELSE IF A$<>CHR$(32) THEN BEEP:GOTO 530
540 CLOSE #1:IF PO$="SCRN:" THEN AR=CSRLIN:LOCATE 25,12:INPUT;"Do you want a hard copy of selected records?  ",A$:IF A$="y" OR A$="Y" THEN PO$="LPT1:":GOTO 355
545 LOCATE 25,1:PRINT TAB(79):LOCATE 25,12:INPUT;"Do you want to perform another record selection?  ",A$
550 IF A$="y" OR A$="Y" THEN SCREEN ,,0:GOTO 20
555 LOCATE 23,1:END
560 C=CC:GOSUB 4100
565 LOCATE 24,17:PRINT "Selected data has been saved in ";FILE$;:GOTO 545
570 IF MB>9999 THEN P$="#######.#" ELSE IF MB>99 THEN P$="#####.###" ELSE IF MB>=10 THEN P$="###.#####" ELSE P$="##.######"
575 RETURN
4025 ERASE D,CS,T,N$,X,X2,MD,SD,NN,CZ
4030 DIM D(A,C),CS(A,C),T(A),N$(A),X(A),X2(A),MD(A),SD(A),CZ(C)
5000 BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
5005 A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
5010 ON ERROR GOTO 0:END