1  ! PROGRAM SUN2, VERSION 1A (31-AUG-73)
   !
2  ! PROGRAM SUN2 IS PART OF THE DATA EDITING CHAIN.
   ! 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 ABOUT COSAP, PLEASE CONTACT THE
   ! LAWRENCE UNIVERSITY COMPUTER CENTER, APPLETON, WISCONSIN, 54911.
   !
5 DIM N%(30%) ! FUNCTION TO CREATE EXTENSION 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 OPEN "DAT1"+FNZ$ AS FILE 5% : OPEN L1$(1%) AS FILE 2%
50 GOTO 6700
160 CLOSE 1%,2%,3%,4%,5% : CHAIN "SUN" 6710
6700 PRINT "SOURCE DATABANK"; : INPUT LINE F$ : I%=INSTR(1%,F$,CHR$(13%)
     +CHR$(10%)): GO TO 6700 UNLESS I% : F$=LEFT(F$,I%-1%) :
     ON ERROR GO TO 30010
6710 OPEN F$ FOR INPUT AS FILE 3% : DIM #3%,N1$(50%)=8%,
     M2$(50%)=64%,O1%(50%),P1%(50%),D1$(50%)=8%,T1(50%),D1(10000%)
6720 IF O1%(0%)=0% THEN CLOSE 3% : GOTO 340 
6725 PRINT"LIST CONTENTS OF DATABANK ";F$;:INPUT V$ : IF ASCII(V$)=78%
     THEN 6750 ELSE IF ASCII(V$)<>89% THEN 6725 ELSE PRINT
6730 PRINT "CONTENTS OF DATABANK ";F$;" AT ";TIME$(0);" ON ";DATE$(0):
     R%=1% : GOSUB 20700
6750 F$="SOURCE" : GOSUB 20100 : GOTO 6790 IF V$="" : J%=FNF1%(V$) :
	IF J%=0% THEN GOSUB 9200 : GOTO 6750 
6760 F$="DESTINATION" : GOSUB 20150 : GOTO 6750 IF V$="" :
     K%=FNF%(V$): IF K% THEN GOSUB 9100 : GOTO 6750
6762 PRINT"LABEL FOR DESTINATION VARIABLE  *"; : INPUT LINE L$ :
     Z%=INSTR(1%,L$,CHR$(13%)+CHR$(10%)) : GOTO 6762 UNLESS Z% :
     L$=LEFT(L$,Z%-1%)
6765 IF O%(0%)>=50% THEN GOSUB 9850 : GOTO 160 
6770 I%=O%(0%)+1% : O%(0%)=I% : P%=P%(0%) : P%(0%)=P%+O1%(J%) :
	O%(I%)=O1%(J%) : P%(I%)=P% : N$(I%)=V$ : GOSUB 20200 :
	D$(I%)=D$ : T(I%)=T
6775 M1$(I%)=CHR$(95%)+LEFT(L$,32%)
6780 D(P%+K%)=D1(P1%(J%)+K%) FOR K%=0% TO O1%(J%)-1% : GOTO 6750 
6790 CLOSE 3% : GOTO 160 
6800 DEF FNF1%(V$) : GOTO 6810 IF V$=N1$(I%) FOR I%=1% TO O1%(0%) :
	I%=0%
6810 FNF1%=I% : FNEND
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
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 30012
30011 PRINT : PRINT "CAN'T FIND OLD DATABANK ";F$ : RESUME 50
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 6700
32767 END