1 '                   HISTOGRAM GRAPHING 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),N$(1),X(1),X2(1),T(1),MD(1),SD(1),CT(1),EX(1),BP(201)
22 DATA "HISTOGRAM GRAPHING PROGRAM",22,28
30 GOSUB 4000
35 PRINT:AR=CSRLIN:PRINT "   What is the SAMPLE NUMBER of the variable you want to graph?";:AC=66:GOSUB 4200
40 CLS:PRINT TAB(25);DTTL;:PRINT TAB(25);STRING$(26,205):AR=CSRLIN+1
45 LOCATE 25,35:COLOR CLR2,CLR1:PRINT " F1 = PRINT COPY ";:LOCATE 25,55:PRINT " F10 = RETURN ";:COLOR CLR1,CLR2:LOCATE AR,1
50 N=T(NS):D1=D(NS,CS(NS,1)):D2=D(NS,CS(NS,N)):FD=VAL(D2)-VAL(D1)
55 PRINT TAB(6);"The";N;"VALUES in ";N$(NS);" range from ";D1;" to ";D2;":"
60 PRINT TAB(27);"The difference between these values is";FD;"."
65 PRINT:PRINT TAB(6);:INPUT "Enter the full name of the variable to be graphed:   ",DV
70 PRINT TAB(26);"What are the units of ";DV;:INPUT DU
75 PRINT:AR=CSRLIN:LOCATE 24,12:PRINT "The maximum number of intervals I can graph is 60.";
80 LOCATE AR,13:PRINT "Enter WIDTH of each cell (in ";DU;:INPUT "):  ",FU
85 IF FD/FU>65 THEN BEEP:GOTO 75
90 LOCATE 22,32:COLOR 23:PRINT "CALCULATING";:COLOR CLR1
95 BT=INT(FD/FU)+7:HD=1:CC=1:ERASE CT,EX:DIM CT(BT),EX(BT)
100 EX(1)=VAL(D1)-3*FU:IF VAL(D1)>=0 AND EX(1)<=0 THEN EX(1)=0:SN=FU ELSE SN=EX(1)
105 EN=EX(1)+BT*FU
110 IF EN>99 THEN HD=HD*10:SN=SN/10:EN=EN/10:GOTO 110
115 IF ABS(SN)<.1 THEN HD=HD/10:SN=SN*10:GOTO 115
120 IF SN<-99 THEN HD=HD*10:SN=SN/10:GOTO 120
125 IF EX(1)<>0 THEN EX(1)=INT(SN*10)*(HD/10)
130 FOR T=1 TO N:VX=VAL(D(NS,CS(NS,T)))
135 IF VXCMX THEN CMX=CT(Z)
155 NEXT
160 SCREEN 2,1:OUT 985,(CLR1-(CLR1=0)):CLS:PRINT TAB(35);FILE$
165 XI=20/CMX:CIX=1:CI=INT(XI):IF XI>5 THEN CI=5 ELSE IF XI<1 THEN CIX=INT(1/XI+1):CI=1
170 LV=(CMX+1)*CI/CIX:LINE(34,171)-(34,171-LV*8)
175 FOR Z=1 TO CMX/CIX:HL=171-Z*8*CI:LINE (30,HL)-(34,HL):NEXT:NH=0
180 FOR Z=1 TO CMX/CIX:HL=22-Z*CI:NH=NH+CIX:IF CI=1 THEN IF Z MOD 2=0 THEN 190
185 LOCATE HL,1:PRINT USING "###";NH
190 NEXT
195 CH=INT(70/BT):IF CH>5 THEN CH=5 ELSE IF CH<1 THEN CH=1
200 LH=(BT+1)*CH:LINE (34,171)-(LH*8+34,171):ZH=5/CH:IF CH=4 THEN ZH=2
205 FOR Z=1 TO BT:HL=34+8*CH*Z:IF Z MOD ZH=1 THEN LINE (HL,171)-(HL,175) ELSE LINE (HL,171)-(HL,173)
210 NEXT
215 EXH=EX(BT)/HD:IF ABS(EXH)<10 THEN P$="###.##" ELSE P$="###.#"
220 FOR Z=1 TO BT:IF (Z-1) MOD ZH<>0 THEN 230
225 HL=2+CH*Z:LOCATE 23,HL:PRINT USING P$;EX(Z)/HD;
230 NEXT
235 TB=LEN(DV)+LEN(DU)-8*(HD<>1):LOCATE 25,HL/2-TB/2+3:PRINT DV;"  (";DU;:IF HD<>1 THEN PRINT " x";:PRINT USING "##^^^^";HD;
240 PRINT ")";:CHP=CH*8
245 FOR Z=1 TO BT:LLC=34+CHP*(Z-1):RLC=LLC+CHP:UC=171-INT(CT(Z)*CI*8/CIX):LINE (LLC,171)-(RLC,UC),,BF:NEXT
250 A$=INKEY$:IF A$="" THEN 250 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN 310 ELSE IF AI=59 THEN 260
255 BEEP:GOTO 250
260 ON ERROR GOTO 5070:OPEN "LPT1:" AS #1:WIDTH #1,255:DEF SEG=&HB800
265 PRINT #1,CHR$(27)+"@";CHR$(13);CHR$(27)+"3"+CHR$(23);CHR$(27)+"U"+CHR$(1);
270 FOR Z=0 TO 79:PRINT #1,CHR$(27)+"L"+CHR$(32)+CHR$(3);
275 FOR AY=0 TO 99:AX=80*AY+Z:BP(AY+1)=PEEK(AX):BP(AY+101)=PEEK(8192+AX):NEXT
285 FOR AY=100 TO 1 STEP -1:PRINT #1,STRING$(4,BP(AY+100));STRING$(4,BP(AY));:NEXT
290 PRINT #1,CHR$(13);CHR$(10);:NEXT
295 FOR Z=41 TO 26 STEP -1:PLAY "MB L32 N=Z;":NEXT:PLAY "MB L3 N18"
300 PRINT #1,CHR$(27)+"3"+CHR$(36);CHR$(13);CHR$(12);
305 PRINT #1,CHR$(27)+"U"+CHR$(0);CHR$(27)+"@";:CLOSE #1:DEF SEG:GOTO 250
310 SCREEN 0,SCRN:COLOR CLR1,CLR2,CLR3:CLS
315 DQ="Would you like another HISTOGRAM using ":LOCATE 25,8:PRINT DQ;:INPUT "the SAME sample?  ",A$
320 IF A$="y" OR A$="Y" THEN 40 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP:GOTO 310
325 LOCATE 25,47:INPUT "a DIFFERENT sample?  ",A$
330 IF A$="N" OR A$="n" THEN 345 ELSE IF A$<>"y" AND A$<>"Y" THEN BEEP:GOTO 325
335 LOCATE 25,5:PRINT TAB(75):LOCATE 25,20:PRINT "Is the sample you want in ";FILE$;:INPUT;A$
340 IF A$="Y" OR A$="y" THEN LOCATE 2,1:GOTO 35 ELSE IF A$="n" OR A$="N" THEN 20 ELSE BEEP:GOTO 335
345 LOCATE 23,1:END
4025 ERASE D,CS,N$,X,X2,T,MD,SD
4030 DIM D(A,C),CS(A,C),N$(A),X(A),X2(A),T(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
5072 A$=INKEY$:IF A$="" THEN 5072 ELSE CLOSE #1:RESUME 160