1  ! PROGRAM SUN, VERSION 1A (31-AUG-73)
   !
2  ! PROGRAM SUN IS THE CONTROL PROGRAM FOR DATA EDITING FUNCTIONS.
   ! IT IS ONE OF THE SEVERAL PROGRAMS AND FILES WHICH COMPOSE COSAP,
   ! LAWRENCE UNIVERSITY'S CONVERSATIONALLY ORIENTED STATISTICAL
3  ! ANALYSIS PACKAGE.  COSAP IS DISTRIBUTED FOR EDUCATIONAL USE, ON
   ! THE CONDITION THAT IT NOT BE SOLD, RENTED OR LEASED FOR PROFIT.
   !
4  ! IF YOU DESIRE FURTHER INFORMATION ON COSAP, PLEASE CONTACT THE
   ! LAWRENCE UNIVERSITY COMPUTER CENTER, APPLETON, WISCONSIN, 54911
   !
5 DIM N%(30%) ! FUNCTION TO CREATE FILE EXT. BASED ON JOB #
6 DEF FNZ$ : IF N%(0%)=30% THEN 7 ELSE CHANGE SYS(CHR$(6%)+CHR$(9%)+
   CHR$(0%)) TO N% : Z8$=".J"+RIGHT(NUM$(N%(1%)/2%),2%)
7 FNZ$=Z8$ ! EXTENSION IS ".J" + JOB #
8 FNEND
9 DIM #5%,X(200,50),H$(30)=2%,C(50,50),M4(0),M5(0),M9(0),N(0),J9(0),
          I4(0),I7(0),N6(0),X2(50),L1$(8%)=32%
10 DIM #2%, N$(50%)=8%,M1$(50%)=64%,O%(50%),P%(50%),D$(50%)=8%,
        T(50%),D(10000%)
40 ON ERROR GOTO 30000 : OPEN "DAT1"+FNZ$ AS FILE 5% : PRINT
50 INPUT "NEW DATA OR OLD DATA";A$ : A$=LEFT(A$,3%):IF A$="NEW"
   THEN PRINT "NAME OF NEW "; : GO TO 70
55 IF A$<>"OLD" THEN 50 ELSE PRINT "NAME OF OLD ";
70 PRINT "DATABANK"; : INPUT LINE F$ : I%=INSTR(1%,F$,CHR$(13%)+
   CHR$(10%)) : GOTO 70 UNLESS I% : F$=LEFT(F$,I%-1%) :
   GOTO 70 IF F$="" : L1$(1%)=F$+SPACE$(32%-LEN(F$)) : CLOSE 5%
80 IF A$="NEW" THEN 31000
100 OPEN F$ FOR INPUT AS FILE 2% : S$=F$
110 IF A$="OLD" AND ASCII(M1$(0%))=95% THEN PRINT :
    PRINT RIGHT(M1$(0%),2%) : GOTO 130
120 PRINT:PRINT"DESCRIPTION OF DATABANK (MAXIMUM OF 64 CHARACTERS"
    " - <CR> BEFORE--V)"
121 INPUT LINE V$ : I%=INSTR(1%,V$,CHR$(13%)+CHR$(10%)) :
    GO TO 120 UNLESS I% : V$=LEFT(V$,I%-1%) : M1$(0%)=CHR$(95%)+
    LEFT(V$,63%)
130 ! PROCEDURE *** !
160 D$=SYS(CHR$(0)) : ON ERROR GO TO 0 : PRINT : PRINT "PROCEDURE "
    "('END' IF NO MORE)"; : INPUT P$ : P%=ASCII(P$) : GOTO 160
    UNLESS P% : GO TO 1000 IF P%=76% : GOTO 2000 IF P%=73%
170 GOTO 20500 IF P$="SOS"
190 GOTO 3000 IF P%=67% :  GOTO 32000 IF P%=69% 
220 IF P%=66% THEN CLOSE 2% : F$=S$ : GOTO 100 
250 IF P%=83% THEN R%=0% : GOSUB 20700 : GOTO 160 
280 GOTO 2500 IF P%=68% : GOTO 3900 IF P%=75% : GOTO 2200 IF P%=78% :
	GOTO 5000 IF P%=65% : GOTO 5400 IF P%=88% : GOTO 5500 IF
	P%=77% : GOTO 6700 IF P%=71%
310 PRINT "*NO SUCH PROCEDURE*" : GOTO 160 
340 GOSUB 9800 : GOTO 160 ! EMPTY D.B.
999 ! LIST CONTENTS
1000 IF O%(0%)=0% THEN 340 ELSE PRINT : PRINT "CONTENTS OF DATABANK ";
	S$;" AT ";TIME$(0%);" ON ";DATE$(0%) : PRINT
1003 IF ASCII(M1$(0%))=95% THEN PRINT RIGHT(M1$(0%),2%) : PRINT
1005 PRINT " NAME";"  # OBS";" DATE CREATED";" TIME CREATED";
     " VARIABLE LABEL"
1010 FOR I%=1% TO O%(0%) : PRINT N$(I%);SPACE$(9%-LEN(N$(I%)));O%(I%);
     SPACE$(5%-LEN(NUM$(O%(I%)))-1%);:GOSUB 20000 : PRINT D$;"    ";
     T$;SPACE$(5%); : IF ASCII(M1$(I%))=95% THEN PRINT MID(M1$(I%),2%,
     33%) ELSE PRINT
1015 NEXT I% : PRINT : GOTO 160
1999 ! INPUT NEW SERIES
2000 F$="" : GOSUB 20150 : GOTO 160 IF V$="" : I%=FNF%(V$) :
     IF I% THEN GOSUB 9100 : GOTO 2000
2009 IF O%(0%)=50% THEN GOSUB 9850 : GOTO 160 
2010 I%=O%(0%)+1% : P%,P%(I%)=P%(0%) : O%=0% : R%=0%
2012 PRINT "VARIABLE LABEL (MAX OF 32 CHR.  V)" : INPUT LINE L$
2013 I%=INSTR(1%,L$,CHR$(13%)+CHR$(10%)) : GO TO 2012 UNLESS I% :
     L$=LEFT(L$,I%-1%)
2015 PRINT:PRINT"ENTER DATA FOR ";V$;" -- END WITH CTRL/Z":PRINT
2017 ON ERROR GOTO 30020 
2020 PRINT O%+1%; : INPUT V
2030 O%=O%+1% : D(P%)=V : P%=P%+1% : GOTO 2020 
2060 GOTO 2075 IF O%=0% : GOTO 2065 IF R% : I%=O%(0%)+1% :
     O%(0%)=I% : N$(I%)=V$ : M1$(I%)=CHR$(95%)+LEFT(L$,32%)
2065 O%(I%)=O% : GOSUB 20200 : D$(I%)=D$ : T(I%)=T : P%(0%)=P%
2075 PRINT : GOTO 2000 UNLESS R% : GOTO 160 
2199 ! NAME CHANGE
2200 F$="" : GOSUB 20120 : GOTO 160 IF V$="" : I%=FNF%(V$) :
     IF I%=0% THEN GOSUB 9200 : GOTO 2200
2205 IF ASCII(M1$(I%))=95% THEN PRINT "OLD LABEL:  ";
     MID(M1$(I%),2%,33%)
2210 INPUT "NEW NAME (MAX. OF 8 CHARS.)  *";V$ :IF LEN(V$)>8% THEN
     GOSUB 9500 : GOTO 2210
2220 IF V$="" THEN 160 ELSE J%=I% : I%=FNF%(V$)
2225 PRINT"NEW LABEL (MAX. OF 32 CHARACTERS-V)  *" :INPUT LINE L$:
     I%=INSTR(1%,L$,CHR$(13%)+CHR$(10%)) : GOTO 2225 UNLESS I% :
     L$=LEFT(L$,I%-1%)
2230 N$(J%)=V$ : M1$(J%)=CHR$(95%)+LEFT(L$,32%) : GOTO 160
2500 ! DISPLAY
2510 F$="" : GOSUB 20100 : GOTO 160 IF V$="" : I%=FNF%(V$) :
	IF I%=0% THEN GOSUB 9200 : GOTO 2510 
2520 PRINT : PRINT N$(I%);" --";O%(I%);"OBSERVATIONS -- CREATED AT ";
	: GOSUB 20000 : PRINT T$;" ON ";D$ : PRINT : P%=P%(I%)
2525 IF ASCII(M1$(I%))=95% THEN PRINT "VARIABLE LABEL -- ";
     MID(M1$(I%),2%,33%)
2530 PRINT "OBS #","VALUE" : PRINT : 
	PRINT J%,D(J%+P%-1%) FOR J% =1% TO O%(I%) : PRINT : GOTO 160 
3000 ! CHANGE
3010 F$="" : GOSUB 20100 : GOTO 160 IF V$="" : I%=FNF%(V$) :
	IF I%=0% THEN GOSUB 9200 : GOTO 3010 
3020 INPUT "OBS # (<CR> IF NO MORE)";J% : GOTO 160 IF J%=0% :
     IF J%>O%(I%) OR J%<0% THEN GOSUB 9400 : GOTO 3020
3030 PRINT "OLD:";D(J%+P%(I%)-1%); : INPUT " NEW";V :
	D(J%+P%(I%)-1%)=V : GOTO 3020 
3899 ! KILL
3900 F$="" : GOSUB 20120 : GOTO 160 IF V$="" : I%=FNF%(V$) :
     IF I%=0% THEN GOSUB 9200 : GOTO 3900
3910 IF I%=O%(0%) THEN O%(0%)=I%-1% : P%(0%)=1% IF I%=1% : GOTO 3900 
3920 FOR J%=I% TO O%(0%)-1% : N$(J%)=N$(J%+1%) : M1$(J%)=M1$(J%+1%) :
     O%(J%)=O%(J%+1%) : T%(J%)=T%(J%+1%) : D$(J%)=D$(J%+1%) :
     P%(J%)=P%(J%+1%) : NEXT J%
3930 O%(0%)=O%(0%)-1% : GO TO 3900 
5000 ! APPEND
5010 F$="FIRST" : GOSUB 20100 : GOTO 160 IF V$="" : K%=FNF%(V$) :
	IF K%=0% THEN GOSUB 9200 : GOTO 5010 
5020 F$="SECOND" : GOSUB 20100 : GOTO 160 IF V$="" :
	J%=FNF%(V$) : IF J%=0% THEN GOSUB 9200 : GOTO 5020 
5030 P%=P%(K%) : IF K%=O%(0%) THEN 5100 ELSE
	P%=P%(0%) : D(P%+N%)=D(P%(K%)+N%) FOR N%= 0% TO
	O%(K%)-1% : P%(K%)=P%
5100 P%=P%(K%)+O%(K%) : D(P%+N%)=D(P%(J%)+N%) FOR N%=0% TO
	O%(J%)-1% : O%(K%)=O%(K%)+O%(J%) : GOSUB 20200 :
	D$(K%)=D$ : T(K%)=T : P%(0%)=P%(K%)+O%(K%) : GOTO 160 
5399 ! XTEND
5400 F$="" : GOSUB 20100 : GOTO 160 IF V$="" : I%=FNF%(V$) :
	IF I%=0% THEN GOSUB 9200 : GOTO 5400 
5410 P%=P%(0%) :  O%=O%(I%) :
	D(P%+J%)=D(P%(I%)+J%) FOR J%=0% TO O%-1% :
	P%(I%)=P% : P%=P%+O% : R%=1% : GOTO 2015 
5500 ! MOVE
5510 F$="SOURCE" : GOSUB 20100 : GOTO 160 IF V$="" : K%=FNF%(V$) :
	IF K%=0% THEN GOSUB 9200 : GOTO 5510 
5520 INPUT"RANGE OF OBS # (LOW,HIGH)";J%,L% : GOTO 160 IF J%=0% OR
     L%=0% : IF J%<0% OR L%<0% OR L%<J% OR L%>O%(K%) THEN
     GOSUB 9400 : GOTO 5520
5530 F$="DESTINATION" : GOSUB 20150 : GOTO 160 IF V$="" :
     I%=FNF%(V$) : IF I% THEN IF O%(I%)<>L%-J%+1% THEN
     GOSUB 9700 : GOTO 5530
5535 IF I%=0% THEN IF O%(0%)<50% THEN I%=O%(0%)+1% ELSE
	GOSUB 9850 : GOTO 160 
5537 IF I%=O%(0%)+1% THEN PRINT "LABEL FOR DESTINATION VARIABLE  *";:
     INPUT LINE L$ : Z%=INSTR(1%,L$,CHR$(13%)+CHR$(10%)):GOTO 5537
     UNLESS Z% : L$=LEFT(L$,Z%-1%)
5540 IF I%=O%(0%)+1% THEN P%(I%)=P%(0%) ELSE L$=RIGHT(M1$(I%),2%)
5550 P%=P%(I%) : O%(I%)=L%-J%+1% : GOSUB 20200 : D$(I%)=D$ :
     T(I%)=T : N$(I%)=V$ : M1$(I%)=CHR$(95%)+LEFT(L$,32%)
5560 D(P%+N%-J%)=D(P%(K%)+N%-1%) FOR N%=J% TO L% :
	IF I%=O%(0%)+1% THEN O%(0%)=I% : P%(0%)=P%+L%-J%+1%
5565 GOTO 5510 
5850 IF ERR<>2% AND ERR<>5% AND ERR<>6% THEN ON ERROR GOTO 0 ELSE
	PRINT "CAN'T FIND ";V$ : RESUME 5810 
5870 CLOSE 1%,2% : OPEN S$ FOR INPUT AS FILE 2% : GOTO 160 
6700 CLOSE 1%,2%,3%,4%,5% : CHAIN "SUN2"
6710 OPEN "DAT1"+FNZ$ AS FILE 5% : OPEN L1$(1%) AS FILE 2% :
     F$,S$=L1$(1%) : CLOSE 5% : GOTO 160
9000 ! ERROR PROCESSING
9100 E$="VARIABLE ALREADY EXISTS" : GOTO 9900 
9200 E$= "NO SUCH VARIABLE" : GOTO 9900 
9300 E$="ILLEGAL OPERATION" : GOTO 9900 
9400 E$="NO SUCH OBSERVATION" : GOTO 9900 
9500 E$="NAME TOO LONG" : GOTO 9900 
9600 E$="ILLEGAL NUMBER" : GOTO 9900 
9700 E$="DIFFERENT LENGTH VARIABLES" : GOTO 9900 
9800 E$="DATABANK IS EMPTY" : GOTO 9900 
9850 E$="TOO MANY VARIABLES" : GOTO 9900 
9900 PRINT "*";E$"*" : RETURN
20000 ! GET DATE AND TIME FROM FILE
20010 D$=LEFT(D$(I%),2%)+"-"+RIGHT(D$(I%),3%) :
	T$=TIME$(T(I%)) : RETURN
20100 PRINT F$;" "; UNLESS F$="": PRINT "VARIABLE NAME (<CR> IF NO "
      "MORE)  *"; : INPUT V$: RETURN IF LEN(V$)<=8% : GOSUB 9500 :
      GOTO 20100
20120 PRINT F$;" "; UNLESS F$="" : PRINT "VARIABLE NAME (<CR> IF NO "
      "MORE) "; : INPUT V$:RETURN IF LEN(V$)<=8%:GOSUB 9500:
      GOTO 20120
20150 PRINT F$;" "; UNLESS F$="" : PRINT "VARIABLE NAME (MAX. OF "
      "8 CHRS.; <CR> IF NO MORE)"; : INPUT V$ : RETURN IF 
      LEN(V$)<=8% : GOSUB 9500 : GOTO 20150
20200 D$=DATE$(0%) : D$=LEFT(D$,2%)+RIGHT(D$,4%) :
	T=1440-INT(TIME(0)/60) : RETURN
20300 DEF FNF%(X$) : GOTO 20305 IF X$=N$(I%) FOR I%=1% TO O%(0%) :
	I%=0%
20305 FNF%=I% : FNEND
20500 ! HELP MESSAGE
20510 ON ERROR GO TO 20550 : OPEN "SUN.DOC" FOR INPUT AS FILE 3% : PRINT
20520 INPUT LINE #3%,V$ : PRINT V$; : GOTO 20520 
20550 CLOSE 3% : PRINT : RESUME 160
20700 PRINT : PRINT "VARIABLE","# OBS","VARIABLE LABEL" : PRINT :
      J%=O%(0%) : J%=O1%(0%) IF R% : FOR I%=1% TO J%
20710 IF R% THEN PRINT N1$(I%),O1(I%),MID(M2$(I%),2%,33%) ELSE PRINT
      N$(I%),O%(I%),MID(M1$(I%),2%,33%)
20730 NEXT I% : PRINT : PRINT : RETURN
30000 ! ERROR PROCESSING
30010 IF ERR<>5% THEN 30015 ELSE IF INSTR(1%,F$,"[") THEN 30012 ELSE IF
      A$="NEW" THEN RESUME 31000
30011 PRINT : PRINT "CAN'T FIND OLD DATABANK ";F$ : RESUME 40
30012 PRINT "CAN'T FIND ";F$ : RESUME 6700 
30015 IF ERR<>10% THEN 30017 ELSE PRINT "PROTECTION VIOLATION" :
	GOTO 30018 
30017 IF ERR<>2% AND ERR<>6% THEN ON ERROR GOTO 0 ELSE
	PRINT "ILLEGAL FILE NAME"
30018 RESUME 40 UNLESS INSTR(1%,F$,"[") : RESUME 6700
30020 IF ERR=11% THEN RESUME 2060 ELSE IF ERR<>52% AND ERR<>48%
	THEN ON ERROR GOTO 0 ELSE GOSUB 9600 : RESUME 2020 
31000 ON ERROR GOTO 31010 : OPEN F$ FOR INPUT AS FILE 2% : CLOSE 2% :
      PRINT "DATABANK ";F$;" ALREADY EXISTS!" : GOTO 40
31010 OPEN F$ FOR OUTPUT AS FILE 2% : O%(0%)=0% : P%(0%)=1% : CLOSE 2% :
      RESUME 100
32000 CLOSE 2%,3%,5% : K$=SYS(CHR$(7%)) : N$=LEFT(K$,8%) :
     S0=VAL(RIGHT(K$,9%)) : CHAIN N$ S0
     ! CLOSE UP, GET THE CORE COMMON LINK AND CHAIN
32767 END