10 REM This program written by John Porter
20 REM copyright (c) 1984 by John Porter
30 REM NOT TO BE SOLD
40 REM  3/13/84 
50 VERSION= 2
60 DIM ISTR$(30),AUTH$(200),DATE$(200) 
70 DEFINT I-N
80 REM DEFINE CLEAR SCREEN CHARACTER
90 CLS$=CHR$(26)
100 REM DEFINE BELL CHARACTER
110 BELL$=CHR$(7)
120 REM DEFINE DELIMITER USED TO SEPARATE COMMENTS FROM THE REFERENCES
130 NCHAR$="|"
135 IF ASC(NCHAR$)<128 THEN ICHAR$= CHR$(ASC(NCHAR$)+128) ELSE ICHAR$=CHR$(ASC(NCHAR$)-128)
140 REM SET SUBROUTINE TO CAPTURE ERROR CODES FOR INPUT FILES
150 ON ERROR GOTO 3000
160 PRINT CLS$:PRINT:PRINT "LITCIT - VERSION ";VERSION:PRINT
170  PRINT  "This  program locates references based on  the  first author and date"
180 PRINT " References should have single vertical spacing and"
190 PRINT " be separated from one another by double spacing."
200 PRINT 
210 PRINT "References will be written to another file in the same format."
220 PRINT "  and comments will be stripped off when they follow a: ";NCHAR$:PRINT 
230 PRINT:PRINT "You will be able to use multiple input files on different"
240 PRINT "   disks (or, if you want, the same disk). BUT YOU CAN NOT "
250 PRINT "   CHANGE THE DISK THE OUTPUT FILE IS ON!!!!!"
260 IFILE=1
270 PRINT:PRINT:PRINT "PUT IN THE DISKS YOU WANT TO READ FROM OR WRITE TO"
280 INPUT " AND HIT A CARRIAGE RETURN";A$
290 RESET
300 PRINT:PRINT
310 INPUT "What is the file name for INPUT";F1$
320 DUM$=F1$
330 GOSUB 1000
340 F1$=DUM$
350 INPUT "What is the file name for OUTPUT";F2$
360 DUM$=F2$
370 GOSUB 1000
380 F2$=DUM$
390 OPEN "I",#1,F1$
400 OPEN "O",#2,F2$
410 REM go read in authors and dates
420 PRINT 
430 PRINT "Input the first author's last name and the year"
440 PRINT "     for references to be listed"
450 PRINT
460 PRINT  "Separate them by a comma"
470 PRINT "When done, put in just a comma"
480 PRINT
490 NKEY=1
500 INPUT "Author,date (just , to end)";AUTH$(NKEY),DATE$(NKEY)
510 IF AUTH$(NKEY)="" THEN 560
520 IF LEN(DATE$(NKEY))<4 THEN DATE$(NKEY)="19"+ DATE$(NKEY)
530 IF LEN(DATE$(NKEY))<>4 THEN PRINT "BAD DATE - REDO":GOTO 500
540 NKEY=NKEY+1
550 GOTO 500
560 PRINT CLS$
570 NKEY=NKEY-1
580 REM this section reads in the references
590 REM the raw references are stored in array istr$
600 WHILE NOT EOF(1)
610 NB=1
620 NREF=NREF+1
630 LINE INPUT #1, ISTR$(NB)
640 IF ISTR$(NB)="" OR ISTR$(NB)=SPACE$(LEN(ISTR$(NB))) THEN 670
650 NB=NB+1
660 GOTO 630
670 GOSUB 2000
680 PRINT CLS$:PRINT:PRINT :PRINT
690 PRINT ,"REFS CHECKED = ";NREF,"NUMBER OF MATCHES = ";NFOU
700 IF MC < 1 THEN GOTO 850
710 NFOU=NFOU+1
720 PRINT CLS$:PRINT:PRINT :PRINT
730 PRINT ,"REFS CHECKED = ";NREF,"NUMBER OF MATCHES = ";NFOU
740 PRINT:PRINT:PRINT 
750 FOR I1=1 TO NB
760 I2=INSTR(ISTR$(I1),NCHAR$)
770 IF I2=0 THEN I2=INSTR(ISTR$(I1),ICHAR$)
775 IF I2=0 THEN 820
780 PRINT #2, LEFT$(ISTR$(I1),I2-1)
790 PRINT LEFT$(ISTR$(I1),(I2-1))
800 IF I2>1 THEN PRINT #2
810 GOTO 600
820 IF LEN(ISTR$(I1))=255 THEN PRINT #2,ISTR$(I1); :ELSE PRINT #2, ISTR$(I1)
830 IF LEN(ISTR$(I1))=255 THEN PRINT ISTR$(I1); :ELSE PRINT ISTR$(I1)
840 NEXT I1
850 WEND
860 CLOSE #1
870 FOR I= 1 TO 10:PRINT BELL$:NEXT I : PRINT CLS$
880 IFILE=IFILE+1
890 PRINT:PRINT:PRINT "Place the disk with input file #";IFILE;" in a disk drive"
900 PRINT" DO NOT remove the disk containing the output file!!!!!"
910 PRINT: PRINT
920 PRINT:INPUT "What is the new INPUT file name (Hit 'RETURN' to end)";F1$   
930 DUM$=F1$: GOSUB 1000: F1$=DUM$
940 IF F1$ = "" THEN CLOSE:PRINT BELL$,BELL$:PRINT "FINISHED":PRINT:PRINT NREF;"References checked",NFOU;"put on output file: ";F2$:PRINT:PRINT:SYSTEM:END
950 OPEN "I",#1,F1$
960 GOTO 600
970 END
1000 REM this subroutine converts strings to upper case. It also eliminates
1005 REM    spaces and resets the high order bit to 0
1010 REM input the string to be cleaned as DUM$
1020 DUM1$=""
1030 FOR I1=1 TO LEN(DUM$)
1040 I2=ASC(MID$(DUM$,I1,1))
1050 IF I2>90 THEN IF I2>127 THEN I2=I2-128:GOTO 1050:ELSE I2=I2-32: GOTO 1050
1060 DUM1$=DUM1$ + CHR$(I2)
1070 NEXT I1
1080 DUM$=DUM1$
1090 RETURN
2000 REM this section checks for matches with keys
2010 MC=0
2020 FOR I2=1 TO NKEY
2030 IF AUTH$(I2)=LEFT$(ISTR$(1),LEN(AUTH$(I2))) THEN IF INSTR(ISTR$(1),DATE$(I2))<>0 THEN:MC=MC+1:GOTO 2050
2040 NEXT I2
2050 RETURN
3000 REM ERROR TRAPPING ROUTINE
3010 IF ERR=53 AND ERL=950 THEN PRINT "INPUT FILE NOT FOUND - TRY AGAIN":PRINT:RESUME 890
3015 IF ERR=62 THEN CLOSE #1:PRINT"IMPROPER END TO FILE - LAST REF MAY HAVE BEEN MISSED":RESUME 880
3020 REM RE-ENABLE ERROR TRAPPING FOR OTHER FATAL ERRORS
3030 ON ERROR GOTO 0
E - LAST REF MAY HAVE BEEN MISSED":RESUME 880
3020 REM RE-ENABLE ERROR TRAPPING FOR OTHER F