1 '                 STATISTICAL DATA ENTRY PROGRAM
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)
22 DATA "STATISTICAL DATA ENTRY PROGRAM",20,32
30 LOCATE 6,27:PRINT "1.) INITIAL DATA ENTRY"
35 PRINT:PRINT TAB(27);"2.) APPEND DATA"
40 PRINT:PRINT TAB(27);"3.) EDIT DATA"
45 PRINT:PRINT TAB(27);"4.) PRINT DATA"
50 PRINT:PRINT TAB(27);"5.) SAVE DATA TO DISK"
55 PRINT:PRINT TAB(27);"6.) LOAD DATA FROM DISK"
60 PRINT:PRINT TAB(27);"7.) EXIT":PRINT
65 PRINT TAB(27);:INPUT "Enter choice:   ",ASUB:IF ABS(ASUB-4)>3 THEN BEEP:GOTO 65
70 ON ASUB GOTO 155,355,375,505,735,750,775
75 COLOR CLR2,CLR1:LOCATE 25,35:PRINT " F2 = NO DATA ";:LOCATE ,55:PRINT " F10 = STOP ";:COLOR CLR1,CLR2:LOCATE AR,1:RETURN
80 GOSUB 75:TB=1:PRINT "Sample Name = ";:IF APND=1 THEN PRINT N$(1) ELSE INPUT "",N$(1)
85 C=C+1:PRINT USING "###";C;:PRINT ": ";
90 INPUT;"",DI:IF DI="" THEN 120
95 VC=VAL(DI):T(1)=T(1)+1:X(1)=X(1)+VC:X2(1)=X2(1)+VC*VC
100 FOR Z=1 TO T(1)-1:VX=VAL(D(1,CS(1,Z))):IF VX<=VC THEN 110
105 FOR TZ=T(1) TO Z+1 STEP -1:CS(1,TZ)=CS(1,TZ-1):NEXT:GOTO 115
110 NEXT Z
115 CS(1,Z)=C
120 A$=INKEY$:IF A$="" THEN 120 ELSE IF A$=CHR$(13) THEN 125 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN D(1,C)=DI:GOTO 150 ELSE IF AI=60 THEN 130 ELSE 120 ELSE 120
125 IF DI="" THEN BEEP:GOTO 90
130 D(1,C)=DI:TB=TB+13:IF TB>70 THEN TB=1
135 PRINT TAB(TB);:GOTO 85
140 AR=CSRLIN:LOCATE 25,30:PRINT TAB(79):IF AR>22 THEN PRINT:PRINT:LOCATE 24,1 ELSE LOCATE AR+2,1
145 RETURN
150 GOSUB 140:GOSUB 305:OPEN "SCRN:" FOR OUTPUT AS #1:GOTO 595
155 PRINT:INPUT "  How many samples or variables would you like to enter? (1 to 28)   ",A:IF A<1 OR A>28 THEN BEEP:GOTO 155
160 GOSUB 350:APND=0:ERASE D,CS,N$,X,X2,T,MD,SD
165 DIM D(A,2000/A),CS(A,2000/A),N$(A),X(A),X2(A),T(A),MD(A),SD(A)
170 C=0:FILE$="":PRINT "First NAME your samples or variables, then ENTER ";
175 PRINT "data:"
180 PRINT TAB(16);"1.) Press `RETURN' twice to continue data entry."
185 PRINT TAB(16);"2.) Press `RETURN' then F2 if no data for that cell."
190 PRINT TAB(16);"3.) Press `RETURN' then F10 after last data entry."
195 PRINT:AR=CSRLIN:IF A=1 THEN 80
200 FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
205 A1=AS*7+1:SCREEN ,,AS,0
210 FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);"Sample";T;:NEXT:GOSUB 75:NEXT AS
215 PRINT:AR=CSRLIN
220 FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
225 A1=AS*7+1:SCREEN ,,AS,(APND=0)*(-AS):LOCATE AR,1:PRINT "NAME=";
230 FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);:IF APND=1 THEN PRINT N$(T); ELSE INPUT;"",N$(T)
235 NEXT:NEXT AS
240 PRINT:AR=CSRLIN:C=C+1
245 FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
250 A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1:PRINT USING "###";C;:PRINT ":";
255 FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);
260 INPUT;"",DI:VC=VAL(DI):IF DI="" THEN 290
265 VC=VAL(DI):T(T)=T(T)+1:X(T)=X(T)+VC:X2(T)=X2(T)+VC*VC
270 FOR Z=1 TO T(T)-1:VX=VAL(D(T,CS(T,Z))):IF VX<=VC THEN 280
275 FOR TZ=T(T) TO Z+1 STEP -1:CS(T,TZ)=CS(T,TZ-1):NEXT:GOTO 285
280 NEXT Z
285 CS(T,Z)=C
290 A$=INKEY$:IF A$="" THEN 290 ELSE IF A$=CHR$(13) THEN 295 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN D(T,C)=DI:GOSUB 320 ELSE IF AI=60 THEN 300 ELSE 290 ELSE 290
295 IF DI="" THEN BEEP:GOTO 260
300 D(T,C)=DI:NEXT T:NEXT AS:GOTO 240
305 SCREEN ,,0: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))
310 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)))
315 NEXT:RETURN
320 GOSUB 305:PO$="SCRN:":OPEN PO$ FOR OUTPUT AS #1
325 FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
330 A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1:GOSUB 140
335 GOSUB 665:NEXT AS:CLOSE #1:GOTO 20
340 IF MB>9999 THEN P$="#######.#" ELSE IF MB>99 THEN P$="#####.###" ELSE IF MB>=10 THEN P$="###.#####" ELSE P$="##.######"
345 RETURN
350 FOR AS=0 TO INT((A-1)/7):SCREEN ,,AS,0:CLS:NEXT:SCREEN ,,0:RETURN
355 GOSUB 350:PRINT TAB(33);"APPEND DATA": PRINT TAB(33);STRING$(11,205):APND=1
360 PRINT TAB(16);"There are ";A;" sample groups in this datafile.":PRINT
365 IF A=0 THEN BEEP:PRINT "     You must enter a datafile from keyboard or disk before using APPEND.":GOTO 765
370 PRINT "APPEND your ";:GOTO 175
375 CLS:PRINT TAB(34);"EDIT DATA":PRINT TAB(34);STRING$(9,205):PRINT
380 PRINT TAB(14);"There are ";A; "sample groups in this datafile.":PRINT
385 PRINT TAB(7);"1.)  Enter positive record number to REPLACE a record."
390 PRINT TAB(7);"2.)  Enter negative record number to DELETE a record."
395 PRINT TAB(7);"3.)  Press F2 to change a sample NAME."
400 PRINT TAB(7);"4.)  Press F10 to exit from EDIT session."
405 KEY 2,"98"+CHR$(13):KEY 10,"99"+CHR$(13):AR=CSRLIN:LOCATE 25,32:COLOR CLR2,CLR1:PRINT " F2 = CHANGE NAME ";:LOCATE ,55:PRINT " F10 = EXIT ";:COLOR CLR1,CLR2:LOCATE AR+1,1
410 PRINT "Sample #";TAB(20);"Record #";TAB(40);"Old value";TAB(60);"New value"
415 F=0:AR=CSRLIN:LOCATE AR,3:INPUT;"",B:IF B=99 THEN 500 ELSE IF B=98 THEN 490 ELSE IF B<1 OR B>A THEN BEEP:GOTO 415
420 LOCATE AR,23:INPUT;"",BR:IF ABS(BR)>C OR BR=0 THEN BEEP:GOTO 420
425 IF BR<0 THEN F=1:BR=-BR:IF D(B,BR)="" THEN PRINT:GOTO 415 ELSE 440
430 PRINT TAB(40);D(B,BR);:LOCATE AR,60:INPUT "",DI:VN=VAL(DI)
435 IF D(B,BR)="" THEN T(B)=T(B)+1:GOTO 465
440 VC=VAL(D(B,BR)):X(B)=X(B)-VC:X2(B)=X2(B)-VC*VC
445 FOR Z=1 TO T(B)-1:IF CS(B,Z)<>BR THEN 455
450 FOR TZ=Z TO T(B)-1:CS(B,TZ)=CS(B,TZ+1):NEXT:GOTO 460
455 NEXT Z
460 IF F=1 THEN D(B,BR)="":T(B)=T(B)-1:PRINT:GOTO 415
465 D(B,BR)=DI:X(B)=X(B)+VN:X2(B)=X2(B)+VN*VN
470 FOR Z=1 TO T(B)-1:VX=VAL(D(B,CS(B,Z))):IF VX<=VN THEN 480
475 FOR TZ=T(B) TO Z+1 STEP -1:CS(B,TZ)=CS(B,TZ-1):NEXT:GOTO 485
480 NEXT Z
485 CS(B,Z)=BR:GOTO 415
490 LOCATE AR,1:PRINT "Sample #";TAB(20);"Old name";TAB(40);"New name"
495 LOCATE ,3:INPUT;"",B:IF B>A OR B=0 THEN BEEP:GOTO 495 ELSE PRINT TAB(20);:PRINT N$(B);TAB(40);:INPUT "",N$(B):GOTO 410
500 LOCATE 25,60:PRINT TAB(79);:KEY 10,"":KEY 2,"":GOSUB 305:GOTO 20
505 CLS:PRINT TAB(25);"PRINT DATAFILE ";FILE$:PRINT TAB(25);STRING$(LEN(FILE$)+15,205):PRINT
510 INPUT " Do you want the DATAFILE printed in SORTED or INPUT order? (S or I)  ",A$
515 IF A$="i" OR A$="I" THEN BSRT=0:GOTO 525 ELSE IF A$="s" OR A$="S" THEN BSRT=1 ELSE BEEP:GOTO 510
520 IF A>1 THEN PRINT TAB(12);:PRINT "Which sample number do you wish to SORT by?";:AR=CSRLIN:AC=57:GOSUB 4200
525 PRINT:PRINT TAB(8);:INPUT "Do you want to print data on SCREEN or PRINTER? (S or P)   ",A$
530 IF A$="P" OR A$="p" THEN PO$="LPT1:":PMAX=PRNT-10 ELSE IF A$="S" OR A$="s" THEN PO$="SCRN:":GOSUB 350:PMAX=70:GOTO 545 ELSE BEEP:GOTO 525
535 PRINT:PRINT TAB(23); "Be sure paper is in printer.":PRINT:PRINT TAB(24);"Press any key when ready:"
540 A$=INKEY$:IF A$="" THEN 540
545 ON ERROR GOTO 5070:OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
550 IF A>1 THEN 610 ELSE IF A=0 THEN BEEP:PRINT:PRINT TAB(18);"There is no data in this datafile.":CLOSE #1:GOTO 765
555 PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,
560 PRINT #1,"Sample Name = ";N$(1):PRINT #1,:TB=1:IF BSRT=1 THEN 580
565 FOR Z=1 TO C:PRINT #1,USING "###";Z;:PRINT #1,":";D(1,Z);
570 TB=TB+13:IF TB>PMAX THEN TB=1
575 PRINT #1,TAB(TB);:NEXT:GOTO 595
580 FOR Z=1 TO T(1):PRINT #1,USING "###";CS(1,Z);:PRINT #1,": ";D(1,CS(1,Z));
585 TB=TB+13:IF TB>PMAX THEN TB=1
590 PRINT #1,TAB(TB);:NEXT
595 IF T(1)=0 THEN MN=0 ELSE MN=X(1)/T(1)
600 PRINT #1,:PRINT #1,:PRINT #1,TAB(5);"TOTAL =";T(1);TAB(26);"MEAN =";MN;TAB(55);"MEDIAN =";MD(1)
605 PRINT #1,:PRINT #1,TAB(20);"STANDARD DEVIATION =";SD(1):CLOSE #1:GOTO 765
610 AR=CSRLIN:FOR AS=0 TO INT((A-1)*10/PMAX):A2=(AS+1)*PMAX/10:IF A2>A THEN A2=A
615 A1=AS*PMAX/10+1:IF PO$="SCRN:" THEN SCREEN ,,AS,AS:LOCATE AR,1
620 PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,
625 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);"Sample";T;:NEXT:PRINT #1,
630 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);N$(T);:NEXT:PRINT #1,:PRINT #1,
635 IF BSRT=1 THEN 650
640 FOR Z=1 TO C:PRINT #1,USING "###";Z;:PRINT #1,":";
645 FOR T=A1 TO A2: PRINT #1,TAB((T-A1+1)*10-3);D(T,Z);:NEXT:PRINT #1,:NEXT:GOTO 660
650 FOR Z=1 TO T(NS):PRINT #1,USING "###";CS(NS,Z);:PRINT #1,":";
655 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,CS(NS,Z));:NEXT:PRINT #1,:NEXT
660 GOSUB 665:NEXT AS:CLOSE #1:GOTO 20
665 PRINT #1,:PRINT #1,"NO.";:P$="#####"
670 FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;T(T);:NEXT
675 PRINT #1,:PRINT #1,"MEAN";
680 FOR T=A1 TO A2:IF T(T)>0 THEN MN=X(T)/T(T) ELSE MN=0
685 MB=ABS(MN):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MN;:NEXT
690 PRINT #1,:PRINT #1,"MED";
695 FOR T=A1 TO A2:MB=ABS(MD(T)):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MD(T);:NEXT
700 PRINT #1,:PRINT #1,"SDEV";
705 FOR T=A1 TO A2:MB=SD(T):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;SD(T);:NEXT
710 PRINT #1,:PRINT:IF A2=A THEN 725
715 IF PO$="LPT1:" THEN PRINT #1,CHR$(12)
720 LOCATE 24,23:PRINT "Press `P' to print next page:";
725 LOCATE 25,21:PRINT "Press space bar to return to menu.";
730 A$=INKEY$:IF A$="" THEN 730 ELSE IF A$="p" OR A$="P" THEN LOCATE 24,1:PRINT TAB(80):LOCATE 25,1:PRINT TAB(79):RETURN ELSE IF A$=CHR$(32) THEN CLOSE #1:GOTO 20 ELSE BEEP:GOTO 730
735 CLS:PRINT TAB(28);"SAVING DATA TO DISK":PRINT TAB(28);STRING$(19,205)
740 PRINT:AR=CSRLIN:GOSUB 4100
745 PRINT:PRINT:PRINT TAB(20); "Your data has been saved in ";FILE$:GOTO 765
750 CLS:PRINT TAB(26);"LOADING DATA FROM DISK":PRINT TAB(26);STRING$(22,205)
755 PRINT:GOSUB 4000
760 PRINT:PRINT:PRINT TAB(20); FILE$;" has been loaded from disk."
765 LOCATE 25,10:PRINT TAB(19);"Press any key to return to main menu:";TAB(75);
770 A$=INKEY$:IF A$="" THEN 770 ELSE SCREEN ,,0:GOTO 20
775 PRINT:PRINT TAB(10);:INPUT "Have you saved your current data to disk? (Y or N)    ",A$
780 IF A$<>"y" AND A$<>"Y" THEN 20
785 END
4025 ERASE D,CS,T,N$,X,X2,MD,SD
4030 DIM D(A,2000/A),CS(A,2000/A),T(A),N$(A),X(A),X2(A),MD(A),SD(A)
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