'******************************* '* * '* Program DUMP * '* * '******************************* 100 DIM DSK$(15),PK$(150) 105 REM 107 REM FILENAME: DUMP.BAS 110 REM 120 REM THIS PROGRAM DUMPS TEST ITEM BANKS 130 REM 140 REM 150 REM COPYRIGHT 1988 BY OLIVER SEELY, JR. 160 REM DEPARTMENT OF CHEMISTRY 170 REM CALIFORNIA STATE UNIVERSITY DOMINGUEZ HILLS 180 REM CARSON, CA 90747 190 REM 200 REM ALL RIGHTS RESERVED 210 REM '************************************* ' 'Module to read the file PROTOCOL 'File PROTOCOL contains path information and printer protocol information ' '************************************* 306 ON ERROR GOTO 310 OPEN "I",#1,"PROTOCOL" 308 FOR N=1 TO 11 INPUT #1,A$ INDX=VAL(LEFT$(A$,2)) DSK$(INDX)=RIGHT$(A$,LEN(A$)-3) NEXT N LINE INPUT #1,A$ IFORM%=VAL(RIGHT$(A$,LEN(A$)-3)) IFORM%=IFORM%*2 LINE INPUT #1,A$ CR$=CHR$(VAL(RIGHT$(A$,LEN(A$)-3))) LINE INPUT #1,A$ LF$=CHR$(VAL(RIGHT$(A$,LEN(A$)-3))) LINE INPUT #1,A$ FOR M=6 TO LEN(A$) IF ASC(MID$(A$,M,1))=44 THEN 314 NEXT M GOTO 313 314 NC=VAL(MID$(A$,5,M-5)) IIS=M+1 HLF$="" FOR N=1 TO NC IF N=NC THEN 315 FOR M=IIS TO LEN(A$) IF ASC(MID$(A$,M,1))=44 THEN 316 NEXT M FOR M=IIS TO LEN(A$) IF ASC(MID$(A$,M,1))=44 THEN 316 NEXT M GOTO 313 316 HLF$=HLF$+CHR$(VAL(MID$(A$,IIS,M-IIS))) IIS=M+1 NEXT N 315 HLF$=HLF$+CHR$(VAL(RIGHT$(A$,LEN(A$)-IIS+1))) LINE INPUT #1,A$ FF$=CHR$(VAL(RIGHT$(A$,LEN(A$)-3))) CLOSE GOTO 215 310 RESUME 313 313 CLOSE CHAIN "START" '************************************** ' 'End PROTOCOL module ' '************************************** 215 OPEN "LPT1:" AS 1 WIDTH #1,255 COLOR 7,0 CLS 220 PRINT "S O C R A T E S Item Bank Dumping Program" 230 PRINT "Version 3.2" 240 PRINT "This program copies a bank which is in indexed" 250 PRINT "sequential format onto the printer." 260 INPUT "Type item bank filename: ";IB$ 270 ON ERROR GOTO 290 280 GOTO 311 290 PRINT "Cannot find bank ";IB$ 300 RESUME 260 311 OPEN "I",#11,DSK$(11)+IB$ 320 CLOSE #11 330 OPEN "R",#11,DSK$(11)+IB$,80 340 FIELD #11,80 AS PKTXT$ GET #11,1 TITLE$=PKTXT$ 350 GET #11,2 360 CEREC=VAL(LEFT$(PKTXT$,10)) 362 PRINT "Set printer for top of form, then press ENTER"; 364 INPUT A$ 365 ON ERROR GOTO 1400 370 PRINT "Input first and last item numbers to be dumped." 380 INPUT "Type first item number ";ISTART$ 390 PRINT 400 INPUT "Type last item number ";IFIN$ 410 GOSUB 630 415 IL=0 420 GOTO 440 430 R3=R3+1 440 GET #11,R3 450 ID$=LEFT$(PKTXT$,7) 455 IF ID$=STRING$(7,32) THEN 430 460 IF ID$<=IFIN$ AND R3<=CEREC THEN 520 470 IF ID$<>STRING$(7,32) THEN 490 480 GOTO 430 490 PRINT "End of requested dump." CLOSE END 495 PRINT #1, FF$; 496 INPUT "Wait for last page to print, then press ENTER ";A$ 500 CLOSE 510 CHAIN "MICROSOC" 520 MAC=VAL(MID$(PKTXT$,18,1)) PRINT #1,LF$; IL=IL+1 525 GOSUB 1260 530 PRINT #1,LEFT$(PKTXT$,79); PRINT #1, CR$;LF$; IL=IL+1 535 GOSUB 1260 537 IF MAC=1 THEN 540 ELSE 538 538 PRINT #1," ";"MACROITEM STEM";CR$;LF$; IL=IL+1 GOSUB 1260 GOTO 540 539 PRINT #1,CR$;LF$;" ";"MACRO SUB-ITEM #";VAL(MID$(PK$(N),1,1))+1;CR$;LF$; IL=IL+2 GOSUB 1260 GOTO 551 540 GOSUB 950 550 N=0 551 N=N+1 IF N>L THEN 430 560 PRINT #1," ";RIGHT$(PK$(N),LEN(PK$(N))-2); PRINT #1, CR$; IF MID$(PK$(N),1,1)=" " THEN 566 IF MID$(PK$(N),1,1)<>"9" THEN 539 ELSE 563 563 PRINT #1,LF$; IL=IL+1 GOSUB 1260 GOTO 430 566 IF MID$(PK$(N),2,1)="9" THEN 561 ELSE 562 561 PRINT #1,LF$;LF$;" ";"SAMPLE ANSWER FOR THIS QUESTION:"; IL=IL+3 562 IF MID$(PK$(N),2,1)="5" THEN 567 ELSE 568 567 PRINT #1, HLF$; IL=IL+0.5 GOTO 551 568 N=N+1 IF N>L THEN 430 IF MID$(PK$(N),2,1)="3" THEN 560 ELSE 564 564 IF MID$(PK$(N),2,1)="4" THEN 571 ELSE 572 571 PRINT #1, HLF$; IL=IL+0.5 GOTO 560 572 PRINT #1, CR$;LF$; IL=IL+1 GOSUB 1260 GOTO 560 590 END 600 REM 610 REM BEGIN BINARY SEARCH FOR BLOCK TO BE DUMPED 620 REM 630 R2=CEREC 640 R1=3 650 R3=INT((R1+R2)/2) 660 IF R3=R1 THEN 750 670 GET #11,R3 680 L$=LEFT$(PKTXT$,7) 690 IF L$<>STRING$(7,32) THEN 700 692 R3=R3-1 694 GOTO 660 700 IF ISTART$>=L$ THEN 730 710 R2=R3 720 GOTO 650 730 R1=R3 740 GOTO 650 750 GOSUB HEADER 755 GET #11,R3 760 J$=LEFT$(PKTXT$,7) 770 IF J$>=ISTART$ THEN 920 780 R3=R3+1 790 GET #11,R3 800 IF PKTXT$<>STRING$(80,32) THEN 810:R3=R3+1:GOTO 790 810 J$=LEFT$(PKTXT$,7) 820 IF J$>=ISTART$ THEN 920 830 IF R3=CEREC THEN 900 840 PRINT"Inconsistency has been found in binary search." 850 PRINT"An item may be out of sequence" 860 PRINT"Current record number is ";R3 870 PRINT"The three records in the neighborhood are ":FOR ZZ=R3-1 TO R3+1 880 PRINT R3:GET #11,R3:PRINT PKTXT$:NEXT ZZ 890 CLOSE:STOP 900 PRINT"No item available in range specified. Try another." 910 RETURN 370 920 IF J$>IFIN$ THEN 900 930 JEY$=J$ 940 RETURN 950 R4=VAL(MID$(PKTXT$,20,9)) 960 IREC1=R4 970 GET #11,R4 980 QKTXT$=RIGHT$(PKTXT$,LEN(PKTXT$)-8) 990 L=1 1000 PK$(L)="" 1010 FOR N=1 TO LEN(QKTXT$) 1020 IF ASC(MID$(QKTXT$,N,1))=3 THEN 1140 1030 PK$(L)=PK$(L)+MID$(QKTXT$,N,1) 1040 NEXT N 1050 R4=R4+1 1060 GET #11,R4 1070 QKTXT$=PKTXT$ 1080 GOTO 1010 1140 QKTXT$=RIGHT$(QKTXT$,LEN(QKTXT$)-N) 1160 IF LEN(QKTXT$)<>0 THEN 1200 1170 R4=R4+1 1180 GET #11,R4 1190 QKTXT$=PKTXT$ 1200 IF ASC(LEFT$(QKTXT$,1))=3 THEN 1240 1210 L=L+1 1220 PK$(L)="" 1230 GOTO 1010 1240 IREC2=R4 1250 RETURN 1252 REM 1254 REM subroutine to increment page line and to form feed if page 1256 REM length is exceeded 1258 REM 1260 IF IL>56 THEN 1290 1280 RETURN 1290 PRINT #1, FF$; 1300 IL=0 GOSUB HEADER 1310 RETURN HEADER: PRINT #1,CR$;LF$;" ";TITLE$;CR$;LF$;LF$; IL=IL+3 RETURN 1400 IF ERR=24 THEN RESUME 1410 PRINT "Line at which error occurred = ";ERL 1420 PRINT "Error number = ";ERR 1430 END

Disclaimer: The views and opinions expressed on unofficial pages of California State University, Dominguez Hills faculty, staff or students are strictly those of the page authors. The content of these pages has not been reviewed or approved by California State University, Dominguez Hills.