100 REM 140 REM SOCRATES MICROCOMPUTER TEST ITEM RETRIEVAL PROGRAM 150 REM 160 REM VERSION 8.2 170 REM 180 REM COPYRIGHT 1988 BY OLIVER SEELY, JR. 190 REM DEPARTMENT OF CHEMISTRY 200 REM CALIFORNIA STATE UNIVERSITY DOMINGUEZ HILLS 210 REM CARSON, CA 90747 230 REM ALL RIGHTS RESERVED 231 REM 232 REM FILES 233 REM 'DSK$(1) THREE FUNCTIONS: PATH AND PRINTER PROTOCOL FILE AND PRINTER OUTPUT 'DSK$(2) TEST FILE WITH ITEM POINTERS 'DSK$(3) Disk which gets copy of #2 with different name -- scoring file 'DSK$(4) TEMPORARY STORAGE OF ITEMS: RECORD WHERE LOCATED, KEY OF FIRST LINE, 'NUMBER OF SUBITEMS. 'DSK$(5) TEMPORARY STORAGE OF ITEMS. NOT SURE ABOUT FORMAT. TWO RECORD 'NUMBERS: ITEM KEY AND # OF SUBITEMS. 'DSK$(6) TEMPORARY STORAGE OF ITEM KEY AND OTHER DATA 'DSK$(7) FACSIMILE FILE 'DSK$(8) MYLOGO FILE (Customized test header) 'DSK$(9) NOTHING 'DSK$(10) DELETION FILE 'DSK$(11) TEST ITEM BANK IN CURRENT USE FOR ITEM SELECTION. 250 DIM DSK$(15), IPG%(7), JLN%(7), IN$(150, 3), KWD$(3), SC$(3), PROT%(10) 270 DIM SPCHR%(3), JTRAN%(150), ITRAN%(150), ICAT$(7) 280 DIM JN$(150, 3), TKEY$(8), NOSHO$(150, 3), KWD%(3) 290 DIM ISUB%(150), JSUB$(150), DKEY$(2) 300 DIM IIA$(150, 3), IIB$(150, 3), LOGO$(2) 301 DIM RECKEY$(2), CODE%(5), JD$(20), NCR%(100) 303 REM 304 REM FILE NAMING SECTION 305 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 326 310 RESUME 313 313 CLOSE CHAIN "START" '************************************** ' 'End PROTOCOL module ' '************************************** 326 MYLOGO$ = DSK$(8) + "MYLOGO" XDT$ = DATE$ 327 REM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 328 REM ! 329 REM FORMAT SECTION ! 330 REM ! 331 REM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 340 FRM382$ = " * * * * * * * * * * * *" 341 FRM381$ = " ***********************" 342 FRM52$ = "###. ! \ \ \ \-\\ ! ! \ \ \ \ \ \ \\ \\ \\ ! ! \ \\ \\ \" 343 FRM18$ = " ###. &" 344 FRM254$ = "The following items were not found" 345 FRM902$ = "\ \ \ \ \ \ PAGE K##" 346 FRM6$ = "\ \ \ \ PAGE T##" 347 FRM246$ = "\ \ \ \ # ### to ###" 348 FRM272$ = "\ \ \ \ # ###" 370 REM 372 REM END OF FILE DEFINITION SECTION 374 REM 380 KEYMES$ = "KEYWORD" 390 SPCMES$ = "SPECIAL CHARACTERISTIC" 400 DIFMES$ = "DIFFICULTY LEVEL(3,5,7)" 410 BHVMES$ = "BEHAVIOR LEVEL(1,2)" 420 MESMES$ = "MACRO/ENHANCED SUPPRESS(1,2,3)" 430 NZER$ = "" 431 JRSDU% = 0 432 LFLAG% = 0 433 NFLAG% = 0 434 LLFLAG% = 0 435 JFIN% = 0 441 ITST$ = "" 530 IMAX = 150 760 JLAST% = IFORM% - 20 770 IPOB$ = " " 790 D$ = "D" 810 FOR N% = 1 TO 2 820 LOGO$(N%) = "" 825 NEXT N% 828 ON ERROR GOTO 850 830 OPEN "I", #8, MYLOGO$ 840 GOTO 870 850 RESUME 860 860 LOGO$(1) = STRING$(30, " ") + "S O C R A T E S" 865 GOTO 920 870 FOR N% = 1 TO 2 880 LINE INPUT #8, LOGO$(N%) 900 NEXT N% 910 CLOSE #8 920 CLS 922 LOCATE 10, 10, 1, 6, 7 924 PRINT "Microcomputer S O C R A T E S Version 8.2" 926 LOCATE 13, 10, 1, 6, 7 1240 EFLAG% = 0 1250 MAXQ% = 0 1260 MAXIT% = 0 1265 OLDT% = 0 1270 PRINT "DO YOU WISH TO ACCESS AN OLD TEST "; 1280 GOSUB 17940 1290 IF IBRCH% = 2 OR IBRCH% = 3 THEN 1600 ELSE 1300 1300 PRINT "TYPE NAME OF TEST FILE "; 1310 GOSUB 18250 1315 ITST$ = IR$ 1320 IF NCHAR% = 0 THEN 1270 1330 REM 1340 REM GET OLD TEST FILE 1350 REM 1360 ON ERROR GOTO 1390 1365 OPEN "I", #2, DSK$(2) + ITST$ 1380 GOTO 8750 1390 PRINT "FILE NOT FOUND, ERR,ERL= "; ERR; ERL 1400 RESUME 1270 1410 REM TEST FOR OLD TEST 1420 IF OLDT% = 0 THEN 1600 1430 DITST$ = D$ + ITST$ 1440 REM 1450 REM GET OLD DELETE FILE (ITEMS DELETED FROM PREVIOUS GENERATIONS) 1460 REM 1470 ON ERROR GOTO 1490 1471 OPEN "I", #10, DSK$(10) + DITST$ 1472 CLOSE #10 1473 OPEN "R", #10, DSK$(10) + DITST$, 21 1474 FIELD #10, 21 AS DKEY$ 1475 GET #10, 1 1476 DREC% = VAL(DKEY$) 1478 GOTO 1610 1490 PRINT "DELETION FILE CANNOT BE FOUND" 1500 PRINT "THIS TEST FILE MAY HAVE BEEN CREATED FOR SCORING PURPOSES ONLY." 1510 PRINT "IF YOU WOULD LIKE TO MANIPULATE ITEMS IN THIS FILE AND/OR" 1520 PRINT "PRINT A TEST FROM THIS FILE, CREATE A 'DUMMY' DELETION FILE" 1530 PRINT "BY CHANGING THE NAME$ OF ANOTHER DELETION FILE TO 'D' FOLLOWED" 1540 PRINT "BY THE NAME$ OF THIS TEST FILE. JOB WILL NOW BE ABORTED." 1550 RESUME 3510 1600 ITST$ = "TAPE2" 1610 PRINT "INDIVIDUAL ITEM REQUEST. (CR) IF NO MORE ITEMS" 1620 PRINT "BANK NUMBER "; 1630 INPUT IBANK$ 1640 IF IBANK$ = "" THEN 2870 1650 BFILE$ = IBANK$ 1670 REM 1680 REM GET INDEXED SEQUENTIAL FILE HERE 1690 REM 1700 ON ERROR GOTO 1840 1702 OPEN "I", #11, DSK$(11) + BFILE$ 1703 CLOSE #11 1705 OPEN "R", #11, DSK$(11) + BFILE$, 80 1706 FIELD #11, 80 AS PKTXT$ 1707 GET #11, 2 1711 NREC = VAL(LEFT$(PKTXT$, 10)) 1730 GOTO 2060 1840 PRINT "CAN'T FIND "; IBANK$ 1845 PRINT ERR 1850 RESUME 1610 2030 REM 2040 REM INPUT ITEM NUMBERS 2050 REM 2060 PRINT "INPUT 7-DIGIT ITEM NUMBER." 2070 PRINT "CR IF YOU WANT A NEW BANK OR YOU WANT TO END" 2080 PRINT "ITEM "; 2090 MAXQ% = MAXQ% + 1 2100 IF MAXQ% <= IMAX THEN 2140 2110 PRINT "MAXIMUM NUMBER OF ITEMS REACHED." 2120 MAXQ% = MAXQ% - 1 2130 GOTO 7700 2140 INPUT IN$(MAXQ%, 2) 2150 IF IN$(MAXQ%, 2) <> "" THEN 2220 2160 MAXQ% = MAXQ% - 1 2170 CLOSE #11 2180 GOTO 1610 2190 REM 2200 REM PUT ZEROS IN LAST THREE CHARACTERS OF ITEM NUMBER 2210 REM 2220 IN$(MAXQ%, 1) = IBANK$ 2250 IN$(MAXQ%, 2) = IN$(MAXQ%, 2) 2260 REM 2270 REM CHECK TO SEE IF ITEM IS PRESENT 2280 REM 2290 JEY$ = IN$(MAXQ%, 2) 2300 REM 2310 REM HAS THIS ITEM ALREADY BEEN SELECTED? 2320 REM 2330 JDUM% = MAXQ% - 1 2340 IF JDUM% = 0 THEN 2430 2350 FOR N% = 1 TO JDUM% 2360 IF IN$(N%, 1) = IBANK$ AND IN$(N%, 2) = JEY$ THEN 2390 2370 NEXT N% 2380 GOTO 2430 2390 IN$(MAXQ%, 1) = "" IN$(MAXQ%, 2) = "" 2400 MAXQ% = MAXQ% - 1 2410 PRINT USING "ITEM \ \ ALREADY SELECTED. CHOOSE ANOTHER."; LEFT$(JEY$, 7) 2420 GOTO 2090 2430 JEY$ = IN$(MAXQ%, 2) 2435 GOSUB 19660 2440 IF IFETCH% = 0 THEN 2530 ELSE 2450 2450 PRINT USING "RECORD \ \ NOT FOUND. PLEASE TYPE NEW ITEM NUMBER."; JEY$ 2460 MAXQ% = MAXQ% - 1 2470 GOTO 2090 2490 REM 2500 REM CHECKING TO SEE IF ITEM HAS BEEN DELETED PREVIOUSLY 2510 REM FROM TEST 2520 REM 2530 IF OLDT% <> 1 GOTO 2720 2540 IKEY$ = IN$(MAXQ%, 1) + IN$(MAXQ%, 2) 2550 GOSUB 20040 2560 IF IFETCH% = 0 THEN 2720 ELSE 2570 2570 PRINT "ITEM HAS PREVIOUSLY BEEN DELETED FROM" 2580 PRINT "TEST. DO YOU STILL WANT IT"; 2590 GOSUB 17940 2600 IF IBRCH% = 1 THEN 2650 2602 IF IBRCH% = 2 THEN 2670 2604 GOTO 23510 2610 REM 2620 REM PREVIOUSLY SELECTED ITEM IS DESIRED. REMOVE 2630 REM RECORD FROM DELETE FILE. 2640 REM 2650 GOSUB 21030 2660 GOTO 2720 2670 MAXQ% = MAXQ% - 1 2680 GOTO 2090 2690 REM 2700 REM INCREMENT ITEM NUMBER 2710 REM 2720 MFLAG% = VAL(MID$(PKTXT$, 18, 1)) 2730 MAXIT% = MAXIT% + MFLAG% 2740 ISUB%(MAXQ%) = MFLAG% 2745 IN$(MAXQ%, 3) = STR$(R3) 2750 IF MAXIT% <= IMAX THEN 2780 2760 PRINT USING "TOTAL NUMBER OF ITEMS ON TEST NOW EQUALS "; MAXIT% 2762 PRINT "THIS NUMBER WILL BE ALLOWED, BUT FURTHER SELECTION IS" 2764 PRINT "NOW TERMINATED." 2770 GOTO 2140 2780 PRINT "ITEM "; 2790 GOTO 2090 2800 REM 2810 REM************************************* 2820 REM 2830 REM BEGIN BLOCK REQUEST 2840 REM 2850 REM************************************* 2860 REM 2870 PRINT "BLOCK REQUEST. (CR) IF NO BLOCKS DESIRED." 2880 PRINT "BANK NUMBER ", 2900 REM 2910 REM READ BANK NUMBER. (CR) IF BLOCK SELECT NOT DESIRED. 2920 REM 2930 INPUT IBANK$ 2940 IF IBANK$ = "" THEN 7700 2950 CLOSE #4, #5 2952 OPEN "O", #4, DSK$(4) + "TAPE4" 2960 OPEN "O", #5, DSK$(5) + "TAPE5" 2980 BFILE$ = IBANK$ 2990 REM 3000 REM ATTACH AND OPEN FILES 3010 REM 3020 ON ERROR GOTO 3150 3025 OPEN "R", #11, DSK$(11) + BFILE$, 80 3026 FIELD #11, 80 AS PKTXT$ 3027 GET #11, 2 3028 NREC = VAL(LEFT$(PKTXT$, 6)) 3030 GOTO 3350 3150 PRINT "CAN'T FIND BANK "; IBANK$ 3155 PRINT "THE NUMBER OF THIS ERROR IS "; ERR 3156 PRINT "THE LINE NUMBER WHERE IT OCCURRED IS "; ERL 3159 CLOSE #11, #4, #5 3160 RESUME 2870 3350 PRINT "INDICATE OPTIONAL CONSTRAINTS YOU WISH TO USE IN THIS" 3360 PRINT "BLOCK REQUEST. USE THE FOLLOWING CODES:" 3370 PRINT "KEYWORD: 1" 3380 PRINT "SPECIAL CHARACTERISTIC: 2" 3390 PRINT "DIFFICULTY LEVEL: 3" 3400 PRINT "BEHAVIOR LEVEL: 4" 3410 PRINT "MACRO/ENHANCED SUPPRESSION: 5" 3420 PRINT "TYPE THE CODES FOR THE CONSTRAINTS THAT YOU WANT WITHOUT " 3430 PRINT "COMMAS OR SPACES. FOR EXAMPLE: 153" 3440 PRINT "IF YOU DON'T WANT TO EXERCISE ANY CONSTRAINTS, " 3450 PRINT "SIMPLY PRESS (cr)" 3460 PRINT "ENTER THE CODES THAT YOU WANT ", 3470 FOR N% = 1 TO 5 3480 CODE%(N%) = 0 3485 NEXT N% 3490 INPUT CODE$ 3500 IF CODE$ = "" GOTO 3670 3502 IF LEN(CODE$) > 5 GOTO 3570 3510 FOR N% = 1 TO LEN(CODE$) 3515 CODE%(N%) = VAL(MID$(CODE$, N%, 1)) 3520 REM 3530 REM CHECK TO BE SURE THAT CODES ARE BETWEEN 1 AND 5 3540 REM 3550 IF CODE%(N%) <= 5 AND CODE%(N%) >= 1 THEN 3590 3570 PRINT "CODES MUST BE BETWEEN 1 AND 5. PLEASE RETYPE." 3580 GOTO 3490 3590 NEXT N% 3600 IF N% = 5 GOTO 3670 3660 REM SELECT CONSTRAINTS 3670 KEYSEL% = 10000 3671 SPCSEL% = 10000 3672 DIFSEL% = 10000 3673 BHVSEL% = 10000 3674 MESSEL% = 10000 3680 FOR N% = 1 TO LEN(CODE$) 3690 IF CODE%(N%) = 0 THEN 3800 3700 ON CODE%(N%) GOTO 3710, 3730, 3750, 3770, 3790 3710 KEYSEL% = 0 3720 GOTO 3800 3730 SPCSEL% = 0 3740 GOTO 3800 3750 DIFSEL% = 0 3760 GOTO 3800 3770 BHVSEL% = 0 3780 GOTO 3800 3790 MESSEL% = 0 3800 NEXT N% 3850 REM 3860 REM INPUT CATEGORY 3870 REM 3880 CLOSE #4 3882 CLOSE #5 3884 OPEN "O", #4, DSK$(4) + "TAPE4" 3886 OPEN "O", #5, DSK$(5) + "TAPE5" 3900 PRINT "TYPE 5-DIGIT CATEGORY ", 3910 NITEM% = 0 NQ% = 0 NRET% = 0 NALTQ% = 0 NALTIT% = 0 3920 INPUT JCAT$ 3930 IF JCAT$ <> "" THEN 3960 3940 CLOSE #11 3950 GOTO 2870 3960 FOR N% = 1 TO 6 3962 IF N% > LEN(JCAT$) THEN 3968 3964 ICAT$(N%) = MID$(JCAT$, N%, 1) 3966 NEXT N% 3968 FOR N% = 1 TO 5 3970 IF ICAT$(N%) < "0" OR ICAT$(N%) > "9" THEN 4000 3972 NEXT N% 3980 GOTO 4050 4000 PRINT "CATEGORY NOT BETWEEN 00000 AND 99999. PLEASE RETYPE " 4010 GOTO 3880 4020 REM 4030 REM ENCODE ISTART WITH TRAILING ZEROS 4040 REM 4050 LICAT = 0 4060 FOR N% = 1 TO 5 4065 LICAT = LICAT + VAL(ICAT$(N%)) * (10 ^ (5 - N%)) 4070 NEXT N% 4090 ISTART$ = LEFT$(JCAT$, 5) + "01" 4100 REM 4110 REM PUT TRAILING 9'S IN ICAT$ -- BYPASS IF CATEGORY REQUEST IS EXCLUSIVE 4120 REM 4130 IF ICAT$(6) = "E" OR ICAT$(6) = "e" THEN 4210 4140 FOR N% = 1 TO 5 4150 JDUM% = 5 - N% + 1 4160 IF ICAT$(JDUM%) <> "0" THEN 4210 4170 ICAT$(JDUM%) = "9" 4175 NEXT N% 4180 REM 4190 REM DECODE HICAT AS INTEGER 4200 REM 4210 HICAT = 0 4220 FOR N% = 1 TO 5 4230 HICAT = HICAT + VAL(ICAT$(N%)) * (10 ^ (5 - N%)) 4235 NEXT N% 4240 REM 4250 REM ENCODE IFIN$ WITH 99 (HIGHEST INTERNAL QUESTION NUMBER 4260 REM AND LINE NUMBER IN KEY FILE FOR CATEGORY BLOCK. 4270 REM 4271 IFIN$ = "" 4272 FOR N% = 1 TO 5 4273 IFIN$ = IFIN$ + ICAT$(N%) 4275 NEXT N% 4276 IFIN$ = IFIN$ + "99" 4277 REM SET KEY 4278 REM 4280 REM LOOP FROM BEGINNING OF FILE UP TO FIRST APPROPRIATE RECORD 4282 REM 4284 JEY$ = ISTART$ 4290 REM 4292 REM BEGIN BINARY SEARCH FOR BLOCK OF ITEMS. 4294 REM 4296 R2 = NREC 4298 R1 = 3 4302 REM PROGRAM MARKER (27) 4304 R3 = INT((R1 + R2) / 2) 4306 IF R3 = R1 THEN 4326 4308 GET #11, R3 L$ = LEFT$(PKTXT$, 7) IF L$ <> " " THEN 4312 ELSE 4309 4309 R3 = R3 - 1 GOTO 4306 4310 GOTO 4306 4312 IF ISTART$ >= L$ THEN 4320 4314 R2 = R3 4316 GOTO 4304 4318 REM PROGRAM MARKER (29) 4320 R1 = R3 4322 GOTO 4304 4324 REM PROGRAM MARKER (28) 4325 REM MUST BE FIXED UP WITH BLANK FAIL-SAFE********************** 4326 GET #11, R3 4328 J$ = LEFT$(PKTXT$, 7) 4330 IF J$ >= ISTART$ THEN 4376 4334 R3 = R3 + 1 4336 GET #11, R3 4337 J$ = LEFT$(PKTXT$, 7) IF J$ <> " " THEN 4340 4338 R3 = R3 + 1 4339 GOTO 4334 4340 IF J$ >= ISTART$ THEN 4376 4341 R1 = R3 GOTO 4304 4342 IF R3 = NREC THEN 4372 4344 PRINT "INCONSISTENCY HAS BEEN FOUND IN BINARY SEARCH" 4346 REM PROGRAM MARKER (32) 4348 PRINT "AN ITEM MAY BE OUT OF SEQUENCE" 4352 GOTO 2870 4354 REM PROGRAM MARKER (12) 4364 REM 4366 REM END BINARY SEARCH 4368 REM 4370 REM PROGRAM MARKER (13) 4372 PRINT "NO ITEMS AVAILABLE IN RANGE SPECIFIED. TRY ANOTHER." 4374 GOTO 3880 4376 IF J$ > IFIN$ THEN 4372 4460 JEY$ = J$ 4470 REM 4480 REM DETERMINE NUMBER OF QUESTIONS 4490 REM 4500 PRINT "NUMBER OF QUESTIONS", 4510 INPUT IQUANT% 4520 IF IQUANT% = 0 THEN 4530 4525 GOTO 4550 4530 PRINT "QUANTITY NOT SPECIFIED. RETURN TO CATEGORY REQUEST." 4540 GOTO 3880 4550 IF IQUANT% <= IMAX THEN 4610 4560 PRINT "150 ITEMS MAXIMUM, PLEASE RETYPE "; 4570 GOTO 4510 4580 REM 4590 REM DETERMINE SELECTION CONSTRAINTS 4600 REM 4610 KEYLO% = 0 4620 KEYHI% = 9999 4630 PARSEL% = KEYSEL% 4631 PARFLG% = KEYFLG% 4632 PARMES$ = KEYMES$ 4633 PARLO% = KEYLO% 4634 PARHI% = KEYHI% 4635 GOSUB 17730 4637 KEYFLG% = PARFLG% KEYSEL% = PARSEL% 4640 SPCLO% = 0 4650 SPCHI% = 99 4660 PARSEL% = SPCSEL% 4661 PARFLG% = SPCFLG% 4662 PARMES$ = SPCMES$ 4663 PARLO% = SPCLO% 4664 PARHI% = SPCHI% 4665 GOSUB 17730 4667 SPCFLG% = PARFLG% SPCSEL% = PARSEL% 4670 DIFLO% = 3 4680 DIFHI% = 7 4690 PARSEL% = DIFSEL% 4691 PARFLG% = DIFFLG% 4692 PARMES$ = DIFMES$ 4693 PARLO% = DIFLO% 4694 PARHI% = DIFHI% 4695 GOSUB 17730 4697 DIFFLG% = PARFLG% DIFSEL% = PARSEL% 4700 BHVLO% = 1 4710 BHVHI% = 2 4720 PARSEL% = BHVSEL% 4721 PARFLG% = BHVFLG% 4722 PARMES$ = BHVMES$ 4723 PARLO% = BHVLO% 4724 PARHI% = BHVHI% 4725 GOSUB 17730 4727 BHVFLG% = PARFLG% BHVSEL% = PARSEL% 4730 MESLO% = 1 4740 MESHI% = 3 4750 PARSEL% = MESSEL% 4751 PARFLG% = MESFLG% 4752 PARMES$ = MESMES$ 4753 PARLO% = MESLO% 4754 PARHI% = MESHI% 4755 GOSUB 17730 4757 MESFLG% = PARFLG% MESSEL% = PARSEL% 4760 REM 4770 REM DECODE KEY LINE 4780 REM 4790 MAC% = VAL(MID$(PKTXT$, 18, 1)) 4791 MAC$ = MID$(PKTXT$, 18, 1) 4792 DIFF% = VAL(MID$(PKTXT$, 29, 1)) 4794 BEHAV% = VAL(MID$(PKTXT$, 30, 1)) 4796 ENH$ = MID$(PKTXT$, 32, 1) 4798 FOR N% = 1 TO 3 4800 KWD%(N%) = VAL(MID$(PKTXT$, 34 + (N% - 1) * 4, 4)) 4802 SPCHR%(N%) = VAL(MID$(PKTXT$, 46 + (N% - 1) * 2, 2)) 4804 NEXT N% 4806 REM 4810 REM DETERMINE IF ITEM MEETS CONDITIONS OF CONSTRAINT 4820 REM 4830 IF KEYFLG% = 0 THEN 4880 4840 FOR N% = 1 TO 3 4850 IF KEYSEL% = KWD%(N%) THEN 4880 4860 NEXT N% 4870 GOTO 5400 4880 IF SPCFLG% = 0 THEN 4930 4890 FOR N% = 1 TO 3 4900 IF SPCSEL% = SPCHR%(N%) THEN 4930 4910 NEXT N% 4920 GOTO 5400 4930 IF DIFFLG% = 0 THEN 4960 4940 IF DIFF% = DIFSEL% THEN 4960 4950 GOTO 5400 4960 IF BHVFLG% = 0 THEN 4990 4970 IF BHVSEL% = BEHAV% THEN 4990 4980 GOTO 5400 4990 IF MESFLG% = 0 THEN 5150 5000 ON MESSEL% GOTO 5010, 5060, 5110 5010 IF MAC% = 1 THEN 5150 5020 GOTO 5400 5030 REM 5040 REM BRANCH IF THIS IS AN ENHANCED ITEM. 5050 REM 5060 IF ENH$ <> " " THEN 5400 5070 GOTO 5150 5080 REM 5090 REM BRANCH EITHER IF THIS IS A MACRO OR IF IT IS AN ENHANCED ITEM 5100 REM 5110 IF MAC% > 1 OR ENH$ <> " " THEN 5400 5120 REM 5130 REM IS ITEM ALREADY ON TEST? 5140 REM 5150 FOR N% = 1 TO MAXQ% 5160 IF IN$(N%, 1) = IBANK$ AND IN$(N%, 2) = JEY$ THEN 5400 5170 NEXT N% 5180 REM 5190 REM CHECK TO SEE IF ITEM HAS BEEN PREVIOUSLY DELETED 5200 REM 5210 IF OLDT% <> 1 THEN 5340 5220 IKEY$ = IBANK$ + JEY$ 5230 GOSUB 20040 5240 IF IFETCH% = 0 THEN 5340 5250 WRITE #5, RD%, R3, JEY$, MAC$ 5260 NALTQ% = NALTQ% + 1 5270 NALTIT% = NALTIT% + MAC% 5280 GOTO 5400 5290 REM 5300 REM ITEM IS SELECTED 5310 REM 5320 REM WRITE KEY AND NUMBER OF SUBITEMS ON TAPE 4 5330 REM 5340 WRITE #4, R3, JEY$, MAC$ 5350 NQ% = NQ% + 1 5360 NITEM% = NITEM% + MAC% 5370 REM 5380 REM READ UP TO FIRST LINE OF NEXT WHOLE ITEM IN BANK 5390 REM 5400 R3 = R3 + 1 5410 IF R3 > NREC THEN 5500 5420 GET #11, R3 5430 JEY$ = LEFT$(PKTXT$, 7) 5432 IF JEY$ = " " THEN 5400 5470 CURCAT = VAL(LEFT$(PKTXT$, 5)) 5480 IF CURCAT > HICAT THEN 5500 5490 GOTO 4790 5500 IF NITEM% <> 0 GOTO 5820 5510 REM 5520 REM NO NEW ITEMS AVAILABLE 5530 REM 5540 IF OLDT% <> 1 GOTO 5760 5550 IF NALTIT% = 0 GOTO 5760 5560 PRINT "THERE ARE NO ITEMS AVAILABLE WHICH HAVE NOT BEEN " 5570 PRINT "USED PREVIOUSLY. HOWEVER, THERE ARE ", NALTIT%, " ITEMS" 5580 PRINT "WHICH HAVE BEEN USED AND DELETED EARLIER. DO YOU" 5590 PRINT "WANT TO SELECT THESE ITEMS?" 5600 GOSUB 17940 5610 ON IBRCH% GOTO 5650, 5760, 23510 5620 REM 5630 REM TRANSFER ITEMS PREVIOUSLY USED AND DELETED TO FILE TAPE 4. 5640 REM 5650 CLOSE #5 5652 OPEN "I", #5, DSK$(5) + "TAPE5" 5654 ON ERROR GOTO 5715 5660 INPUT #5, RD%, R3, JEY$, MAC$ 5680 WRITE #4, R3, JEY$, MAC$ 5690 LSET DKEY$ = "" 5695 PUT #10, RD% 5710 GOTO 5660 5715 RESUME 5716 5716 CLOSE #5 5718 REM 5720 REM CONSOLIDATE DELETION FILE 5721 REM PRINT "Consolidation of Deletion File now in progress" PRINT "Please stand by" 5722 M% = 0 5724 FOR N% = 1 TO DREC% 5726 GET #10, N% 5728 IF DKEY$ = " " THEN 5732 5729 M% = M% + 1 5730 PUT #10, M% 5732 NEXT N% 5734 RSET DKEY$ = STR$(M%) 5735 PUT #10, 1 5736 NQ% = NQ% + NALTQ% 5740 NITEM% = NITEM% + NALTIT% 5750 GOTO 5850 5760 PRINT "NO ITEMS AVAILABLE IN SPECIFIED BLOCK." 5770 GOTO 3880 5780 REM 5790 REM THERE ARE SOME ITEMS. NOW TO FIND OUT HOW MANY. 5800 REM 5810 REM 5820 IF OLDT% <> 1 GOTO 5850 5830 IF NALTIT% = 0 GOTO 5850 5840 NRET% = 1 5850 IF NITEM% > IQUANT% GOTO 6390 5860 REM 5870 REM THERE ARE AN EQUAL NUMBER OR FEWER ITEMS AVAILABLE THAN WERE REQUESTED 5880 REM 5890 JDUM% = NITEM% + MAXIT% 5900 IF JDUM% > IMAX GOTO 5950 5910 PRINT "EXACTLY "; NITEM%; " ITEMS FOUND FOR THIS BLOCK;" 5920 REM THE USER REQUESTED 5930 REM 5940 GOTO 5980 5950 NITEM% = IMAX - MAXIT% 5960 PRINT "TOTAL ITEMS REQUESTED EXCEEDS "; IMAX; ". THIS SELECTION" 5970 PRINT "LIMITED TO ", NITEM% 5980 CLOSE #4 5985 OPEN "I", #4, DSK$(4) + "TAPE4" 5990 FOR J% = 1 TO NQ% 6000 INPUT #4, R3, IN$(MAXQ% + 1, 2), MAC$ 6010 IN$(MAXQ% + 1, 1) = IBANK$ 6020 ISUB%(MAXQ% + 1) = VAL(MAC$) 6030 IN$(MAXQ% + 1, 3) = STR$(R3) 6050 MAXQ% = MAXQ% + 1 6060 REM 6070 REM INCREMENT MAXIT% BY NUMBER OF ITEMS 6080 REM 6090 MAXIT% = MAXIT% + VAL(MAC$) 6100 PRINT USING "& & ,NUMBER OF QUESTIONS = #"; IN$(MAXQ%, 1); IN$(MAXQ%, 2); ISUB%(MAXQ%) 6110 IF MAXIT% <= IMAX THEN 6140 6112 PRINT "TOTAL NUMBER OF ITEMS ON TEST NOW EQUALS "; MAXIT%; ". THIS" 6114 PRINT "NUMBER WILL BE ALLOWED, BUT FURTHER SELECTION IS NOW TERMINATED." 6130 GOTO 7700 6140 NEXT J% 6150 IF NITEM% = IQUANT% THEN 3880 6160 IF NRET% <> 1 THEN 3880 6170 REM 6180 REM RETURN TO ALTERNATE FILE IF DESIRED 6190 REM 6200 NRET% = 0 6210 PRINT "THERE ARE "; NALTIT%; "ITEMS AVAILABLE WHICH WERE " 6220 PRINT "PREVIOUSLY DELETED FROM THE TEST. WOULD YOU LIKE TO " 6230 PRINT "SELECT FOR THESE FOR THE REMAINDER OF THIS BLOCK" 6240 PRINT "REQUEST", 6250 GOSUB 17940 6260 ON IBRCH% GOTO 6270, 3880, 23510 6270 IQUANT% = IQUANT% - NITEM% 6280 CLOSE #4 6285 OPEN "O", #4, DSK$(4) + "TAPE4" 6290 NQ% = 0 6300 NITEM% = 0 6310 GOTO 5650 6320 REM 6330 REM SELECT FROM POOL LARGER THAN THE ONE REQUESTED 6340 REM 6350 REM 6360 REM THE NEXT STATEMENT IS NECESSARY FOR THOSE INFREQUENT CASES 6370 REM IN WHICH NITEM%>IQUANT% BUT NQ%= IQUANT% THEN 6460 6400 IQUANT% = NQ% 6410 PRINT "AN INFREQUENT SITUATION HAS OCCURRED. THE POOL OF INDIVIDUAL" 6420 PRINT "QUESTIONS IS LARGER THAN THE NUMBER YOU HAVE REQUESTED, BUT" 6430 PRINT "THE NUMBER OF WHOLE ITEMS IS SMALLER. YOU MAY GET MORE " 6440 PRINT "OR FEWER QUESTIONS THAN THE NUMBER YOU REQUESTED, DEPENDING" 6450 PRINT "ON THE OUTCOME OF RANDOM SELECTION" 6460 JDUM% = IQUANT% + MAXIT% 6470 IF JDUM% <= IMAX THEN 6550 6480 IQUANT% = IMAX - MAXIT% 6490 PRINT "TOTAL NUMBER OF ITEMS REQUESTED EXCEEDS "; IMAX 6500 PRINT "NUMBER IN THIS BLOCK REDUCED TO ", IQUANT% 6510 REM 6520 REM BEGIN RANDOM SELECTION 6530 REM SET UP TABLE OF LOCATIONS OF ITEMS TO BE SELECTED 6540 REM 6550 MQ% = NQ% 6560 NCT% = 0 6590 NCT% = NCT% + 1 6600 IF NCT% > IQUANT% THEN 6680 6610 ITRAN%(NCT%) = INT(RND(VAL(RIGHT$(TIME$, 2))) * MQ%) + 1 6620 MQ% = MQ% - 1 6630 GOTO 6590 6640 REM 6650 REM READJUST VALUES TO THOSE FOR UNIQUE RANDOM SELECTION FOR 6660 REM WHOLE LIST 6670 REM 6680 FOR N% = 1 TO IQUANT% 6690 J% = IQUANT% - N% + 1 6700 KK% = J% 6710 KK% = KK% - 1 6720 IF KK% = 0 THEN 6750 6730 IF ITRAN%(KK%) <= ITRAN%(J%) THEN ITRAN%(J%) = ITRAN%(J%) + 1 6740 GOTO 6710 6750 NEXT N% 6760 REM 6770 REM NOTE: IF TAPE4 WERE MADE INDEXED SEQUENTIAL, ALL THE GARBAGE ABOUT 6780 REM SORTING AND RE-RANDOMIZING WOULDN'T BE NECESSARY 6790 REM 6800 REM SORT NEXT SO THAT JTRAN% ARRAY HAS ITEM ID'S IN SEQUENCE FOR TAPE4 6810 REM 6820 MQUANT% = IQUANT% 6830 M% = 0 6840 M% = M% + 1 6850 MIN% = 30000 6860 FOR N% = 1 TO MQUANT% 6870 IF ITRAN%(N%) > MIN% THEN 6900 6880 MIN% = ITRAN%(N%) 6890 NMIN% = N% 6900 NEXT N% 6910 JTRAN%(M%) = MIN% 6920 JQUANT% = MQUANT% - 1 6930 FOR N% = NMIN% TO JQUANT% 6940 ITRAN%(N%) = ITRAN%(N% + 1) 6945 NEXT N% 6950 ITRAN%(MQUANT%) = 0 6960 MQUANT% = MQUANT% - 1 6970 IF (MQUANT% <> 0) GOTO 6840 6980 JCT% = 0 6990 REM 7000 REM FILL UP DUMMY ARRAY IIA$ WITH ID'S OF SELECTED ITEMS FROM TAPE4 7010 REM BEFORE RE-RANDOMIZING 7020 REM 7030 CLOSE #4 7035 OPEN "I", #4, DSK$(4) + "TAPE4" 7040 FOR N% = 1 TO IQUANT% 7050 REM 7060 REM NREAD% IS THE NUMBER OF TIMES TAPE4 MUST BE READ TO GET 7070 REM TO A SELECTED ITEM. 7080 REM 7090 NREAD% = JTRAN%(N%) - JCT% 7100 FOR M% = 1 TO NREAD% 7110 INPUT #4, KDUM, IIA$(N%, 2), IIA$(N%, 3) 7115 IIA$(N%, 1) = STR$(KDUM) 7120 JCT% = JCT% + 1 7130 NEXT M% 7150 NEXT N% 7160 REM 7170 REM RE-RANDOMIZE IN IIB$ 7180 REM 7190 REM RE-RANDOMIZING IS NECESSARY BECAUSE THE SELECTED ITEMS MUST BE 7200 REM SORTED TO GET ID'S SEQUENTIALLY FROM TAPE4. BUT MACRO ITEMS WILL 7210 REM CAUSE DESIRED QUANTITY TO BE SELECTED BEFORE ALL ITEMS IN IIA$ IS USED. 7220 REM CONSEQUENTLY, ITEMS WITH LOWER CATEGORY NUMBERS WOULD BE FAVORED 7230 REM IF RE-RANDOMIZING WERE NOT CARRIED OUT. 7240 NCT% = 0 7250 JQUANT% = IQUANT% 7280 NCT% = NCT% + 1 7290 IF NCT% > IQUANT% THEN 7470 7300 IDUM% = INT(RND(VAL(RIGHT$(TIME$, 2))) * JQUANT%) + 1 7310 FOR M% = 1 TO 3 7320 IIB$(NCT%, M%) = IIA$(IDUM%, M%) 7325 NEXT M% 7330 REM 7340 REM SHRINK IIA$ BY ONE ELEMENT 7350 REM 7360 FOR N% = IDUM% TO JQUANT% 7370 FOR M% = 1 TO 3 7380 IF N% = JQUANT% THEN 7410 7390 IIA$(N%, M%) = IIA$(N% + 1, M%) 7395 NEXT M% 7400 NEXT N% 7410 JQUANT% = JQUANT% - 1 7420 GOTO 7280 7430 REM 7440 REM FILL UP ARRAY IN 7450 REM USING RANDOMIZED ARRAY IIB$ 7460 REM 7470 JDUM% = 0 7480 PRINT "ITEMS SELECTED FROM "; NQ%; " AVAILABLE:" 7490 FOR N% = 1 TO NQ% 7495 IN$(MAXQ% + 1, 1) = IBANK$ 7497 IN$(MAXQ% + 1, 2) = IIB$(N%, 2) 7499 IN$(MAXQ% + 1, 3) = IIB$(N%, 1) 7520 ISUB%(MAXQ% + 1) = VAL(IIB$(N%, 3)) 7550 MAXQ% = MAXQ% + 1 7560 MAXIT% = MAXIT% + VAL(IIB$(N%, 3)) 7570 JDUM% = JDUM% + VAL(IIB$(N%, 3)) 7580 REM 7590 REM PLACE PRINTOUT OF ITEM HERE AT SOME FUTURE TIME. 7600 REM 7610 PRINT USING "\ \ \ \ NO. OF QUESTIONS = #"; IN$(MAXQ%, 1); IN$(MAXQ%, 2); ISUB%(MAXQ%) 7620 IF MAXIT% > IMAX THEN 7660 7630 IF JDUM% >= IQUANT% THEN 3880 7640 NEXT N% 7650 GOTO 3880 7660 PRINT USING "TOTAL NUMBER OF ITEMS ON TEST NOW EQUALS ###"; MAXIT% 7662 PRINT "THIS NUMBER WILL BE ALLOWED, BUT FURTHER SELECTION IS" 7664 PRINT "NOW TERMINATED." 7700 CLOSE #10 7702 IF MAXQ% = 0 THEN 16140 7710 IF LFLAG% = 1 AND LLFLAG% = 1 AND OLDT% = 1 GOTO 10310 7720 PRINT "TYPE THE TOTAL NUMBER OF VERSIONS YOU WISH TO" 7730 PRINT "HAVE PREPARED. 10 MAXIMUM"; 7740 INPUT NVERS% 7760 IF NVERS% < 1 OR NVERS% > 10 GOTO 7790 7770 NVERS% = NVERS% - 1 7780 GOTO 7860 7790 PRINT "ANSWER MUST BE 1 TO 10. PLEASE RETYPE" 7800 GOTO 7740 7810 REM 7820 REM PREPARATION OF VERSIONS 7830 REM 7860 CLOSE #2 7865 OPEN "O", #2, DSK$(2) + ITST$ 7870 LVERS$ = "VERSION " 7880 IVERS$ = "0" 7890 MVERS$ = LVERS$ + IVERS$ 7900 PRINT #2, MVERS$; ",A,A,A" 7910 FOR N% = 1 TO MAXQ% 7920 PRINT #2, IN$(N%, 1); ","; IN$(N%, 2); ","; STR$(ISUB%(N%)); ","; IN$(N%, 3) 7925 NEXT N% 7930 IVERS$ = RIGHT$(STR$(VAL(IVERS$) + 1), 1) 7940 NDUM% = VAL(IVERS$) 7950 IF NDUM% > NVERS% THEN 8230 7960 REM 7970 REM TRANSFER ITEMS TO DUMMY ARRAY JN$ 7980 REM 7990 FOR N% = 1 TO MAXQ% 8000 JSUB$(N%) = STR$(ISUB%(N%)) 8010 FOR M% = 1 TO 3 8020 JN$(N%, M%) = IN$(N%, M%) 8025 NEXT M% 8027 NEXT N% 8030 I% = 0 8040 REM 8050 REM MAXV% IS A DUMMY VARIABLE WHICH DECREMENTS BY ONE 8060 REM EVERY TIME AN ITEM IS SELECTED FOR A SCRAMBLED VERSION. 8070 MAXV% = MAXQ% 8080 REM 8090 ISEL% = INT(RND(VAL(RIGHT$(TIME$, 2))) * MAXV%) + 1 8100 I% = I% + 1 8110 ISUB%(I%) = VAL(JSUB$(ISEL%)) 8120 IN$(I%, 1) = JN$(ISEL%, 1) 8130 IN$(I%, 2) = JN$(ISEL%, 2) 8140 IN$(I%, 3) = JN$(ISEL%, 3) 8150 FOR N% = ISEL% TO MAXV% 8160 JSUB$(N%) = JSUB$(N% + 1) 8170 JN$(N%, 1) = JN$(N% + 1, 1) 8180 JN$(N%, 2) = JN$(N% + 1, 2) 8190 JN$(N%, 3) = JN$(N% + 1, 3) 8195 NEXT N% 8200 MAXV% = MAXV% - 1 8210 IF MAXV% = 0 THEN 7890 8220 GOTO 8090 8230 CLOSE #2 8240 IF OLDT% <> 1 THEN 8390 8250 CLOSE #10 8330 IF LLFLAG% = 1 AND LFLAG% = 1 THEN 10310 8340 PRINT "IF, ON SECOND THOUGHT, YOU WOULD LIKE TO DELETE (AND ADD)" 8350 PRINT "ITEMS AGAIN BEFORE PRINTING THE TEST, YOU MAY, AT THIS TIME" 8360 PRINT "DO YOU WISH TO DELETE AND/OR ADD ITEMS"; 8370 GOSUB 17940 8380 ON IBRCH% GOTO 8760, 10310, 23510 8390 PRINT "DO YOU WANT TO SAVE THIS TEST "; 8400 GOSUB 17940 8410 ON IBRCH% GOTO 8420, 10310, 23510 8420 PRINT "INPUT SIX CHARACTER NAME FOR THIS TEST IDENTIFIER." 8430 GOSUB 18250 8435 ITST$ = IR$ 8440 IF NCHAR% = 0 THEN 8390 8450 IF NCHAR% = 6 THEN 8490 8460 PRINT "SORRY, YOU MUST GIVE THE TEST FILE A NAME" 8470 PRINT "WITH SIX CHARACTERS. PLEASE RETYPE." 8480 GOTO 8430 8490 ON ERROR GOTO 8520 8500 NAME DSK$(2) + "TAPE2" AS DSK$(2) + ITST$ 8510 GOTO 8620 8520 PRINT "FILE WITH THIS NAME ALREADY EXISTS. PLEASE ASSIGN ANOTHER NAME." 8530 RESUME 8420 8550 REM 8560 REM DEFINE FILE F DELETIONS 8570 REM 8620 DITST$ = "D" + ITST$ 8630 OPEN "R", #10, DSK$(10) + DITST$, 21 8640 FIELD #10, 21 AS DKEY$ 8650 LSET DKEY$ = STRING$(20, "0") + "1" 8660 PUT #10, 1 8670 CLOSE #10 8720 REM 8730 REM GET FILE HOLDING ID OF DELETED ITEMS. 8740 REM 8750 OLDT% = 1 8760 LFLAG% = 0 NFLAG% = 0 LLFLAG% = 0 8770 PRINT "DO YOU WISH TO DELETE ANY ITEMS (YES OR NO)? "; 8780 GOSUB 17940 8790 ON IBRCH% GOTO 8850, 8830, 23510 8800 REM 8810 REM LFLAG%=1 IF NO ITEMS ARE TO BE DELETED. 8820 REM 8830 LFLAG% = 1 8850 ON ERROR GOTO 8880 8862 DITST$ = "D" + ITST$ 8864 OPEN "R", #10, DSK$(10) + DITST$, 21 8866 FIELD #10, 21 AS DKEY$ 8868 GET #10, 1 8870 DREC% = VAL(DKEY$) 8872 GOTO 8950 8880 PRINT "DELETION FILE FOR THIS TEST CANNOT BE FOUND. " 8890 PRINT "THIS TEST FILE MAY HAVE BEEN CREATED FOR SCORING PURPOSES ONLY." 8900 PRINT "IF YOU WOULD LIKE TO MANIPULATE ITEMS IN THIS FILE AND/OR" 8910 PRINT "PRINT A TEST FROM THIS FILE, CREATE A 'DUMMY' DELETION FILE" 8920 PRINT "BY CHANGING THE NAME OF ANOTHER DELETION FILE TO 'D' FOLLOWED" 8930 PRINT "BY THE NAME OF YOUR TEST FILE. JOB WILL NOW BE ABORTED." 8940 RESUME 23510 8950 IF LFLAG% = 1 THEN 9200 9000 PRINT "DO YOU WISH TO DELETE ALL ITEMS ON THE TEST"; 9010 GOSUB 17940 9020 ON IBRCH% GOTO 9030, 9200, 23510 9030 ON ERROR GOTO 9120 9031 NEWREC% = DREC% 9032 CLOSE #2 OPEN "I", #2, DSK$(2) + ITST$ 9033 INPUT #2, IDUM$, JDUM$, KDUM$, LDUM$ 9050 IF IDUM$ = "VERSION 0" THEN 9033 9060 IF IDUM$ = "VERSION 1" THEN 9130 9070 LSET DKEY$ = IDUM$ + JDUM$ 9078 NEWREC% = NEWREC% + 1 9080 PUT #10, NEWREC% 9100 GOTO 9033 9120 RESUME 9130 9130 DREC% = NEWREC% 9131 RSET DKEY$ = STR$(DREC%) 9132 PUT #10, 1 9134 REM 9136 REM SORT DELETION FILE 9138 REM 9140 GOSUB 23026 9142 PRINT "ALL ITEMS DELETED" 9150 CLOSE #10 9170 CLOSE #2 9175 OPEN "O", #2, DSK$(2) + ITST$ 9180 MAXQ% = 0 MAXIT% = 0 9190 GOTO 10170 9200 MAXQ% = 0 MAXIT% = 0 9210 CLOSE #2 9215 OPEN "I", #2, DSK$(2) + ITST$ 9220 IF LFLAG% = 1 THEN 9340 9230 PRINT "DO YOU WISH TO RECEIVE A LIST OF ITEM IDENTIFIERS" 9240 PRINT "TO ASSIST YOU IN ITEM DELETION", 9250 GOSUB 17940 9260 ON IBRCH% GOTO 9300, 9340, 23510 9270 REM 9280 REM NFLAG%=1 IF ITEM IDENTIFIERS ARE TO BE PRINTED 9290 REM 9300 NFLAG% = 1 9310 PRINT " " 9320 PRINT "BANK ITEM ID # QUEST SEQ. ON VERS. 0" 9330 PRINT " " 9340 ON ERROR GOTO 9515 9342 INPUT #2, IDUM$, JDUM$, KDUM$, LDUM$ 9360 IF IDUM$ = "VERSION 0" THEN 9340 9370 IF IDUM$ = "VERSION 1" THEN 9520 9380 MAXQ% = MAXQ% + 1 9390 IN$(MAXQ%, 1) = IDUM$ 9400 IN$(MAXQ%, 2) = JDUM$ 9410 IN$(MAXQ%, 3) = LDUM$ 9420 ISUB%(MAXQ%) = VAL(KDUM$) 9430 LDUM% = MAXIT% + 1 9440 MAXIT% = MAXIT% + VAL(KDUM$) 9450 IF LFLAG% = 1 THEN 9340 9460 IF NFLAG% <> 1 THEN 9340 9470 IF VAL(KDUM$) > 1 THEN 9500 9480 PRINT USING FRM272$; IDUM$; LEFT$(JDUM$, 7); VAL(KDUM$); LDUM% 9490 GOTO 9340 9500 PRINT USING FRM246$; IDUM$; LEFT$(JDUM$, 7); VAL(KDUM$); LDUM%; MAXIT% 9510 GOTO 9340 9515 RESUME 9520 9520 IF LFLAG% <> 1 THEN 9550 9530 CLOSE #10 9540 GOTO 10200 9550 PRINT "INDICATE SPECIFIC ITEMS TO BE DELETED FROM THIS" 9560 PRINT "TEST BY SEQ. NUMBER ON VERSION 0. (CR) WHEN FINISHED." 9570 NAXQ% = MAXQ% 9580 NAXIT% = MAXIT% 9585 NEWREC% = DREC% 9590 REM 9600 INPUT IREJ% 9610 IF IREJ% <> 0 THEN 9770 9620 LNZ% = 0 9630 CLOSE #10 9660 FOR N% = 1 TO NAXQ% 9670 IF IN$(N%, 1) = "" THEN 9720 9680 LNZ% = LNZ% + 1 9690 FOR M% = 1 TO 3 9700 IN$(LNZ%, M%) = IN$(N%, M%) 9702 NEXT M% 9710 ISUB%(LNZ%) = ISUB%(N%) 9720 NEXT N% 9730 IF LNZ% <> 0 THEN 10200 9740 CLOSE #2 9745 OPEN "I", #2, DSK$(2) + ITST$ 9750 MAXQ% = 0 MAXIT% = 0 9760 GOTO 10200 9770 IF IREJ% <= NAXIT% THEN 9830 9780 PRINT "THERE IS NO ITEM # ", IREJ%, " ON TEST. PLEASE RETYPE." 9790 GOTO 9600 9800 REM 9810 REM CALCULATE INDEX HOLDING ITEM TO BE REJECTED 9820 REM 9830 ICOMP% = 0 9840 FOR N% = 1 TO NAXQ% 9850 ICOMP% = ICOMP% + ISUB%(N%) 9860 IF IREJ% <= ICOMP% THEN 9890 9870 NEXT N% 9890 IF ISUB%(N%) = 1 THEN 9940 9900 PRINT "ITEM ", IREJ%; " IS PART OF MACRO. YOU MUST DELETE" 9910 PRINT "WHOLE MACRO. DO YOU WISH TO DO THIS?"; 9920 GOSUB 17940 9930 ON IBRCH% GOTO 9940, 9600, 23510 9940 LSET DKEY$ = IN$(N%, 1) + IN$(N%, 2) 9950 IBEG% = ICOMP% - ISUB%(N%) + 1 9960 IF IN$(N%, 1) = "" THEN 10030 9970 MAXIT% = MAXIT% - ISUB%(N%) 9980 IF IBEG% = ICOMP% THEN 10010 9990 PRINT "ITEMS "; IBEG%; " TO "; ICOMP%; " DELETED." 10000 GOTO 10080 10010 PRINT "ITEM"; IBEG%; "DELETED" 10020 GOTO 10080 10030 IF IBEG% <> ICOMP% GOTO 10060 10040 PRINT USING "ITEM ### HAS ALREADY BEEN DELETED"; IBEG% 10050 GOTO 9600 10060 PRINT USING "ITEMS ### TO ### HAVE ALREADY BEEN DELETED"; IBEG%; ICOMP% 10070 GOTO 9600 10080 IN$(N%, 1) = "" IN$(N%, 2) = "" 10090 MAXQ% = MAXQ% - 1 10100 NEWREC% = NEWREC% + 1 10110 PUT #10, NEWREC% 10111 DREC% = NEWREC% 10112 RSET DKEY$ = STR$(DREC%) 10114 PUT #10, 1 10116 REM 10117 REM SORT DELETION FILE 10118 REM 10119 GOSUB 23026 10120 IF MAXQ% = 0 GOTO 10160 10130 GOTO 9600 10160 PRINT "YOU HAVE DELETED ALL ITEMS ON TEST." 10170 PRINT "IF YOU ANSWER NO TO THE NEXT QUESTION, THE FILE" 10180 PRINT "FOR THIS TEST WILL BE DELETED FROM YOUR ACCOUNT" 10190 GOTO 9620 10200 PRINT "DO YOU WISH TO ADD ITEMS TO THIS TEST?"; 10210 GOSUB 17940 10220 ON IBRCH% GOTO 1420, 10260, 23510 10230 REM 10240 REM LLFLAG%=1 IF NO ITEMS ARE TO BE ADDED 10250 REM 10260 LLFLAG% = 1 10270 GOTO 7700 10275 REM ************************************ 10280 REM 10290 REM BEGIN TEST OUTPUT 10300 REM 10305 REM ************************************ 10310 IF OLDT% <> 1 OR LFLAG% <> 1 OR LLFLAG% <> 1 GOTO 10380 10320 PRINT "YOU MAY GENERATE THE SAME VERSIONS AS WERE REQUESTED" 10330 PRINT "EARLIER. DO YOU WISH TO DO THIS"; 10340 GOSUB 17940 10350 IF IBRCH% <> 2 THEN 10360 10352 LFLAG% = 0 LLFLAG% = 0 10360 ON IBRCH% GOTO 10380, 7700, 23510 10370 REM 10380 PRINT "ENTER A FILE NAME IF YOU WISH TO STORE A SCORING FILE." 10390 PRINT " (cr) IF YOU DON'T" 10400 GOSUB 18250 10410 IF NCHAR% = 0 GOTO 10500 10420 IF NCHAR% <= 7 GOTO 10450 10430 PRINT "FILENAME MUST BE 7 CHARACTERS OR LESS. PLEASE RETYPE." 10440 GOTO 10380 10450 CLOSE #2 10452 OPEN "I", #2, DSK$(2) + ITST$ 10453 ON ERROR GOTO 10456 10454 OPEN "I", #3, DSK$(3) + IR$ 10455 CLOSE #3 PRINT "FILE WITH NAME "; IR$; " ALREADY EXISTS. TRY ANOTHER." GOTO 10380 10456 RESUME 10457 10457 OPEN "O", #3, DSK$(3) + IR$ ON ERROR GOTO 10470 10458 LINE INPUT #2, IDUM$ 10460 PRINT #3, IDUM$ 10462 GOTO 10458 10470 RESUME 10472 10472 CLOSE #2 10474 CLOSE #3 10500 PRINT "YOU MAY PRINT YOUR TEST NOW, CREATE A " 10520 PRINT "FACSIMILE COPY IN YOUR ACCOUNT FOR DELAYED" 10530 PRINT "PRINTING OR EXIT AND COME BACK LATER." 10540 PRINT "WHAT IS IT TO BE (PRINT,FACS OR EXIT)"; 10550 GOSUB 18250 10560 IF NCHAR% = 0 THEN 10380 10570 IF IR$ = "PRINT" THEN IOUT% = 1 10580 IF IR$ = "FACS" THEN IOUT% = 7 10590 IF IR$ = "EXIT" THEN 16140 10600 IF IOUT% = 1 OR IOUT% = 7 THEN 11040 10610 PRINT "ANSWER MUST BE PRINT,FACS OR EXIT. PLEASE RETYPE." 10620 GOTO 10550 11040 PRINT "TYPE TITLE FOR THIS TEST (40 CHARACTERS OR LESS)" 11050 LINE INPUT NME$ PRINT "INPUT DATE THAT WILL APPEAR ON YOUR TEST" PRINT "IN THE FOLLOWING FORMAT: 02-29-1988" PRINT "PRESS (cr) TO USE TODAY'S DATE" INPUT YDT$ IF YDT$ = "" THEN 11440 XDT$ = YDT$ 11440 IBANK$ = "" 11441 CLOSE 11442 REM 11444 REM RESET TAPE2 (LIST OF TEST ITEM IDENTIFIERS) 11446 REM 11450 CLOSE #2 11451 OPEN "I", #2, DSK$(2) + ITST$ 11453 REM 11454 REM RESET TAPE7 (FACSIMILE OF TEST) 11456 REM 11460 CLOSE #7 11461 OPEN "O", #7, DSK$(7) + "TAPE7" 11462 REM 11464 REM RESET TAPE6 11466 REM 11470 CLOSE #6 11471 OPEN "O", #6, DSK$(6) + "TAPE6" 11960 CLOSE #2 11962 OPEN "I", #2, DSK$(2) + ITST$ 11964 ON ERROR GOTO 12050 11970 INPUT #2, IDUM$, JDUM$, KDUM$, LDUM$ 11980 IVERS$ = IDUM$ 11990 MAXQ% = 0 IBANK$ = "" 12000 ON ERROR GOTO 12050 12002 INPUT #2, IDUM$, JDUM$, KDUM$, LDUM$ 12020 MDUM$ = LEFT$(IDUM$, 7) 12030 IF MDUM$ = "VERSION" THEN 12160 12040 GOTO 12070 12050 RESUME 12055 12055 EFLAG% = 1 12060 GOTO 12160 12070 MAXQ% = MAXQ% + 1 12080 IN$(MAXQ%, 1) = IDUM$ 12090 IN$(MAXQ%, 2) = JDUM$ 12100 ISUB%(MAXQ%) = VAL(KDUM$) 12110 IN$(MAXQ%, 3) = LDUM$ 12120 GOTO 12002 12130 REM 12140 REM INITIALIZE PAGE COUNT, ITEM COUNT AND LINE COUNT 12150 REM 12160 IF IVERS$ <> "VERSION 0" THEN 12280 12170 IF IOUT% <> 7 THEN 12190 12180 GOTO 12280 12190 PRINT "PLEASE ORIENT PAGE AND HIT CARRIAGE RETURN" 12195 OPEN "LPT1:" FOR RANDOM AS 1 12197 WIDTH #1, 255 12200 IBANK$ = "" 12210 INPUT N$ 12220 IF N$ = "" THEN 12280 12230 PRINT "CR ONLY ALLOWED HERE. " 12240 GOTO 12160 12280 NODEX% = 0 12290 FOR N% = 1 TO 7 12300 IPG%(N%) = 0 12305 NEXT N% 12310 ICT% = 0 12320 JCT% = 0 12360 IF IVERS$ <> "VERSION 0" THEN 12400 12362 JLN%(1) = IFORM% JLN%(6) = IFORM% JLN%(7) = IFORM% 12370 REM 12380 REM INITIAL HEADER CALL 12390 REM 12400 JOUT% = IOUT% 12410 GOSUB 17240 12420 REM 12430 REM INITIAL KEY HEADER CALL 12440 REM 12450 JOUT% = 6 12460 GOSUB 17240 12480 ICT% = ICT% + 1 12490 REM 12500 REM CALL HEADER FOR BOTH OUTPUT DEVICE AND KEY FILE IF NECESSARY 12510 REM 12520 JOUT% = IOUT% 12530 IF JLN%(JOUT%) > JLAST% THEN GOSUB 17240 12540 JOUT% = 6 12550 IF JLN%(JOUT%) > JLAST% THEN GOSUB 17240 12560 REM 12570 REM RESET OUTPUT DEVICE TO THAT PRINTING TEXT OF TEST 12580 REM 12590 JOUT% = IOUT% 12600 JCT% = JCT% + 1 12610 REM 12620 REM WHEN MFLAG%>1 A MACRO ITEM IS BEING PROCESSED 12630 REM 12640 IF ICT% <= MAXQ% THEN 12690 12650 JFIN% = 1 12660 GOSUB 17240 12670 CLOSE #6 12675 OPEN "I", #6, DSK$(6) + "TAPE6" 12680 GOTO 15760 12690 IFLAG% = 0 12700 REM 12710 REM A NEW HEADER IS PRINTED WHEN AN ITEM OR A PORTION OF A MACRO 12720 REM IS FINISHED BEYOND PRINTED LINE NUMBER 48 (JLN(JOUT%)>96). 12730 REM 12750 REM 12760 REM THIS READ STATEMENT IS ACTIVATED TO SEARCH FOR A BRAND NEW ITEM. 12770 REM 12780 IF IBANK$ = IN$(JCT%, 1) THEN 12880 12790 IBANK$ = IN$(JCT%, 1) 12795 CLOSE #11 12800 IF ICT% = 1 AND IVERS$ = "VERSION 0" THEN 12820 12810 CLOSE #11 12820 B$ = "B:" 12830 BFILE$ = IBANK$ 12870 OPEN "R", #11, DSK$(11) + BFILE$, 80 12875 FIELD #11, 80 AS PKTXT$ 12877 GET #11, 2 12878 NREC = VAL(LEFT$(PKTXT$, 10)) 12880 R3 = VAL(IN$(JCT%, 3)) 12882 GET #11, R3 12884 GOTO 12960 12910 NODEX% = NODEX% + 1 12920 NOSHO$(NODEX%, 2) = JEY$ 12930 NOSHO$(NODEX%, 1) = IN$(JCT%, 1) 12940 GOTO 12480 12960 TKEY$ = PKTXT$ 12980 XTRAL% = 0 12990 ENH$ = MID$(TKEY$, 52, 1) 13000 XTRAL% = 12 * VAL(ENH$) 13010 REM 13020 REM IF THIS IS A MACRO, SET MFLAG% TO NUMBER OF ITEMS IN MACRO. 13030 REM 13050 ITYPE$ = MID$(PKTXT$, 18, 1) 13060 MFLAG% = VAL(ITYPE$) 13065 IF MFLAG% > 1 THEN MMFLAG% = 0 ELSE MMFLAG% = 1 13070 IF ITYPE$ > "1" AND ITYPE$ <= "9" THEN 13130 13080 GOTO 13220 13090 REM 13100 REM COUNT NUMBER OF LINES FOR MACRO STEM. SET ILOC% FOR PROPER CNTLINE 13110 REM TREATMENT AND TERMINATION. 13120 REM 13130 ILOC% = 1 13132 R4 = VAL(MID$(TKEY$, 20, 9)) 13134 GET #11, R4 13136 QKTXT$ = RIGHT$(PKTXT$, LEN(PKTXT$) - 8) 13140 GOSUB 19060 13150 LNID% = 0 13160 IF NLINE% <= IFORM% - JLN%(JOUT%) - 8 THEN 13175 13170 GOSUB 17240 13175 PRINT #JOUT%, FRM381$; 13176 PRINT #JOUT%, CR$; LF$; 13180 JLN%(JOUT%) = JLN%(JOUT%) + 2 13190 REM 13200 REM IF THIS IS A MACRO, READJUST VALUE FOR MAXIMUM NUMBER OF QUESTIONS 13210 REM 13220 IF MFLAG% > 1 AND MFLAG% <= 9 THEN MAXQ% = MAXQ% + VAL(ITYPE$) - 1 13230 REM 13240 REM THIS READ STATEMENT IS ACTIVATED AFTER A DESIRED ITEM HAS BEEN FOUND. 13242 R4 = VAL(MID$(TKEY$, 20, 9)) 13243 QKTXT$ = "" 13244 GET #11, R4 IF LEFT$(TKEY$, 7) = LEFT$(PKTXT$, 7) THEN 13246 13245 GOTO 12910 13246 QKTXT$ = RIGHT$(PKTXT$, LEN(PKTXT$) - 8) 13248 GOTO 13260 13260 IF LEN(QKTXT$) >= 80 THEN 13272 13262 R4 = R4 + 1 13263 GET #11, R4 13264 QKTXT$ = QKTXT$ + PKTXT$ 13272 IT$ = MID$(QKTXT$, 1, 1) 13440 IPCTL$ = MID$(QKTXT$, 2, 1) 13450 KDUM% = VAL(IPCTL$) 13460 REM 13470 REM IF THIS IS A MACRO AND MMFLAG%=0 13480 REM THEN MAKE IFLAG = 1 SO THAT A SEQUENCE NUMBER WON'T 13490 REM BE PRINTED 13500 REM 13510 IF MFLAG% > 1 AND MMFLAG% = 0 THEN IFLAG% = 1 13520 REM 13530 REM TRANSFER TO PRINT STATEMENT FOR ITEM SEQUENCING IF IFLAG%=0 13540 REM 13550 IF IFLAG% = 0 THEN 14930 14291 REM 14292 REM TERMINAL 4 (FORWARD HALF LINE FEED) PRINT ROUTINE 14293 REM 14298 KDUM% = VAL(IPCTL$) 14300 IF KDUM% = 3 THEN 14378 ELSE 14304 14304 IF KDUM% = 4 THEN 14306 ELSE 14312 14306 PRINT #JOUT%, HLF$; 14308 JLN%(JOUT%) = JLN%(JOUT%) + 1 14310 GOTO 14378 14312 IF JFLAG% <> 1 THEN 14370 14314 PRINT #JOUT%, HLF$; 14316 JFLAG% = 0 14318 JLN%(JOUT%) = JLN%(JOUT%) + 1 14320 IF KDUM% = 5 THEN JFLAG% = 1 14322 GOTO 14378 14336 REM 14337 REM OUTPUT BLOCK FOR OTHER THAN FIRST LINES FOR ITEMS. 14338 REM JLN(JOUT%) IS INCREMENTED BY 2 FOR EVERY LINE THAT IS PRINTED. 14339 REM JLN(JOUT%) IS DECREMENTED BY 1 WHEN SUBSCRIPTS OR LINES BELOW 14340 REM SUPERSCRIPTS ARE PRINTED. 14350 REM 14360 REM 14370 IF JOUT% = 6 THEN 14378 14371 PRINT #JOUT%, LF$; 14372 JLN%(JOUT%) = JLN%(JOUT%) + 2 14378 IF KDUM% = 5 THEN JFLAG% = 1 14380 LNID% = LNID% + 1 14381 IF NCR%(LNID%) > LEN(QKTXT$) THEN 14383 14382 N = NCR%(LNID%) GOTO 14384 14383 R4 = R4 + 1 GET #11, R4 QKTXT$ = QKTXT$ + PKTXT$ GOTO 14381 14384 PRINT #JOUT%, IPOB$; MID$(QKTXT$, 3, N - 3); 14385 PRINT #JOUT%, CR$; 14386 NF = N 14390 IPOB$ = " " 14400 REM 14410 REM SKIP TO NEW PAGE IF PRINT CONTROL=1 14420 REM 14440 IF KDUM% = 1 THEN GOSUB 17240 14450 IF KDUM% = 9 THEN JOUT% = 6 14455 IF JOUT% = 6 AND MID$(QKTXT$, 1, 1) <> "9" THEN JLN%(JOUT%) = JLN%(JOUT%) + 2 14460 REM 14470 REM BRANCH TO 14510 IF THIS WAS THE FINAL LINE OF AN ITEM 14480 REM 14490 IF MID$(QKTXT$, 1, 1) = "9" THEN 14510 14500 GOTO 14660 14510 IF MFLAG% > 1 THEN 14602 14520 REM 14530 REM EXPERIMENTAL CHANGE. USED TO WRITE TO JOUT%, BUT PUT SPACES 14540 REM IN KEY AFTER NON M/C ANSWER. CHANGED TO IOUT% 14550 REM 14560 PRINT #IOUT%, LF$; LF$; 14570 JLN%(IOUT%) = JLN%(IOUT%) + 4 14580 GOSUB 19530 14590 GOTO 12480 14602 PRINT #IOUT%, CR$; LF$; PRINT #JOUT%, FRM382$; 14604 PRINT #IOUT%, CR$; LF$; 14610 JLN%(IOUT%) = JLN%(IOUT%) + 4 14620 GOTO 12480 14630 REM 14640 REM BRANCH IF A MACRO AND THIS WAS THE LAST LINE OF A SUBITEM. 14650 REM 14660 IF MFLAG% > 1 AND MID$(QKTXT$, 1, 1) > "0" AND MID$(QKTXT$, 1, 1) <= "9" THEN 14850 14680 REM 14690 REM BRANCH IF A MACRO AND THIS WAS THE LAST LINE OF A MACRO STEM. 14700 REM 14710 IF MFLAG% > 1 AND MID$(QKTXT$, 1, 1) = "0" THEN 14770 14712 REM 14714 REM A MID-LINE OF AN ITEM OR SUB ITEM OR STEM HAS BEEN PRINTED 14716 REM 14720 QKTXT$ = RIGHT$(QKTXT$, LEN(QKTXT$) - NF) 14730 IF LEN(QKTXT$) >= 80 THEN 13272 14732 R4 = R4 + 1 14734 GET #11, R4 14736 QKTXT$ = QKTXT$ + PKTXT$ 14738 GOTO 13272 14740 REM 14750 REM MAKE A BLANK LINE AFTER MACRO STEM AND CHECK FOR PAGE LINE LIMIT. 14760 REM 14770 IFLAG% = 0 14771 PRINT #JOUT%, CR$; LF$; LF$; 14772 JLN%(JOUT%) = JLN%(JOUT%) + 4 14773 QKTXT$ = RIGHT$(QKTXT$, LEN(QKTXT$) - NF) 14775 MMFLAG% = MMFLAG% + 1 14780 GOSUB 19530 14790 GOTO 13260 14800 REM 14810 REM MAKE A BLANK LINE AFTER MACRO SUB-ITEM AND CHECK FOR PAGE LINE LIMIT. 14850 PRINT #IOUT%, CR$; LF$; LF$ 14860 JLN%(IOUT%) = JLN%(IOUT%) + 4 14870 ICT% = ICT% + 1 14880 IFLAG% = 0 14885 QKTXT$ = RIGHT$(QKTXT$, LEN(QKTXT$) - NF) 14890 GOTO 13260 14900 REM 14910 REM PRINT FIRST LINE OF ITEM WITH ITEM SEQUENCE NUMBER. 14920 REM 14930 KDUM% = VAL(IPCTL$) 14940 IF KDUM% = 5 THEN JFLAG% = 1 14950 MAC$ = "" 14960 REM 14970 REM FROM HERE TO STATEMENT 909 THE PROGRAM WORKS OK, BUT THE LOGIC 14980 REM INVOLVING A CHECK ON ONE LINE MACRO SUBITEMS IS COMPLICATED, 14990 REM DIFFICULT TO FOLLOW AND SOMEWHAT REDUNDANT. 15000 REM 15010 JOUT% = IOUT% 15020 REM 15030 REM COUNT LINES OF CURRENT ITEM OR SUBITEM. 15040 REM 15050 MMCAT$ = LEFT$(TKEY$, 5) 15051 MMPART$ = MID$(TKEY$, 6, 2) 15052 DIFF$ = MID$(TKEY$, 29, 1) 15053 BEH$ = MID$(TKEY$, 30, 1) 15054 ENH$ = MID$(TKEY$, 32, 1) 15055 FOR N% = 1 TO 3 15056 KWD$(N%) = MID$(TKEY$, 34 + (N% - 1) * 4, 4) 15057 SC$(N%) = MID$(TKEY$, 46 + (N% + 1) * 2, 2) 15058 NEXT N% 15059 TXT$ = MID$(TKEY$, 62, 7) 15060 RCH$ = MID$(TKEY$, 69, 7) 15065 SRC$ = MID$(TKEY$, 76, 4) 15070 XTRAL% = 0 15080 IF ENH$ <> " " THEN XTRAL% = 12 * VAL(ENH$) 15090 ILOC% = 2 15100 GOSUB 19060 15105 LNID% = 0 15110 IF NLINE% <= IFORM% - JLN%(JOUT%) - 8 THEN 15130 15120 GOSUB 17240 15130 IF MFLAG% > 1 THEN MAC$ = "M" 15140 IF IT$ = "9" OR MFLAG% = 1 THEN 15170 15150 IDIST% = MMFLAG% 15160 GOTO 15180 15170 IDIST% = MFLAG% 15180 ANS$ = MID$(TKEY$, 8 + IDIST%, 1) 15200 PRINT #6, USING FRM52$; ICT%; ANS$; IN$(JCT%, 1); MMCAT$; MMPART$; DIFF$; BEH$; KWD$(1); KWD$(2); KWD$(3); SC$(1); SC$(2); SC$(3); MAC$; ENH$; RCH$; TXT$; SRC$; 15205 PRINT #6, CR$; LF$; 15210 MMFLAG% = MMFLAG% + 1 15220 JLN%(6) = JLN%(6) + 2 15222 LNID% = LNID% + 1 15223 IF NCR%(LNID%) > LEN(QKTXT$) THEN 15228 15224 N = NCR%(LNID%) 15226 GOTO 15235 15228 R4 = R4 + 1 15230 GET #11, R4 15232 QKTXT$ = QKTXT$ + PKTXT$ 15234 GOTO 15223 15235 IF JLN%(JOUT%) > JLAST% THEN GOSUB 17240 PRINT #JOUT%, USING FRM18$; ICT%; MID$(QKTXT$, 3, N - 3); PRINT #JOUT%, CR$; 15236 IF N < LEN(QKTXT$) THEN 15245 15237 QKTXT$ = "" 15245 NF = N 15250 REM 15260 REM SKIP IF PRINT CONTROL CHARACTER=1 15270 REM 15280 IF KDUM% = 1 THEN GOSUB 17240 15290 IF KDUM% = 9 THEN JOUT% = 6 15300 IFLAG% = 1 15310 REM 15320 REM BRANCH TO 137 IF THIS WAS THE FINAL LINE OF AN ITEM OF A MACRO. 15330 REM 15340 IF MID$(QKTXT$, 1, 1) = "9" AND MFLAG% > 1 THEN 15410 15360 REM 15370 REM BRANCH TO 139 IF THIS ITEM HAS ONLY ONE LINE 15380 REM 15390 IF MID$(QKTXT$, 1, 1) = "9" THEN 15470 15400 GOTO 15550 15410 PRINT #JOUT%, CR$; LF$; PRINT #JOUT%, FRM382$; 15415 PRINT #JOUT%, CR$; LF$; 15420 JLN%(JOUT%) = JLN%(JOUT%) + 4 15430 GOTO 12480 15440 REM 15450 REM EXPERIMENTAL CHANGE. JOUT% TO IOUT%. 15460 REM 15470 PRINT #IOUT%, CR$; LF$; 15480 JLN%(IOUT%) = JLN%(IOUT%) + 2 15490 GOSUB 19530 15500 GOTO 12480 15510 REM 15520 REM TRANSFER IF A MACRO AND THIS WAS LAST LINE OF A SUB-ITEM. 15530 REM (USED FOR MACRO SUBITEMS HAVING ONLY ONE LINE) 15540 REM 15550 IF MFLAG% > 1 AND MID$(QKTXT$, 1, 1) > "0" AND MID$(QKTXT$, 1, 1) < "9" THEN 15600 15555 QKTXT$ = RIGHT$(QKTXT$, LEN(QKTXT$) - NF) 15560 GOTO 13260 15570 REM 15580 REM TRANSFER IF MACRO SUBITEM HAS ONE LINE AND IT IS LAST LINE OF ITEM 15590 REM 15600 PRINT #JOUT%, CR$; LF$; 15602 JLN%(JOUT%) = JLN%(JOUT%) + 2 15604 IF MID$(QKTXT$, 1, 1) = "9" THEN 15620 15605 QKTXT$ = RIGHT$(QKTXT$, LEN(QKTXT$) - NF) 15610 GOTO 15650 15620 PRINT #JOUT%, FRM382$; 15625 PRINT #JOUT%, CR$; LF$; 15630 JLN%(JOUT%) = JLN%(JOUT%) + 2 15640 GOTO 12480 15650 IFLAG% = 0 15660 REM 15670 REM EXPERIMENTAL CHANGE. JOUT% TO IOUT% 15680 REM 15690 PRINT #IOUT%, LF$; 15700 JLN%(IOUT%) = JLN%(IOUT%) + 2 15710 ICT% = ICT% + 1 15720 GOTO 13260 15730 REM 15740 REM PRINT OUT KEY PAGES. 15750 REM 15760 JOUT% = IOUT% 15770 MKEY$ = "" 15775 ON ERROR GOTO 15890 15780 LINE INPUT #6, MKEY$ 15810 M% = 16 15860 PRINT #JOUT%, MKEY$; 15865 PRINT #JOUT%, CR$; LF$; 15870 GOTO 15770 15890 RESUME 15895 15895 JLN%(JOUT%) = JLN%(6) 15900 GOSUB 17240 15910 JLN%(1) = IFORM% JLN%(6) = IFORM% JLN%(7) = IFORM% 15920 JFIN% = 0 15930 CLOSE #6 15935 OPEN "O", #6, DSK$(6) + "TAPE6" 15940 IF NODEX% = 0 OR EFLAG% = 0 THEN 16120 15950 REM 15960 REM CALL HEADER TO STATE ABSENCE OF SOME ITEMS IN BANK 15970 REM 15980 GOSUB 17240 15995 NAME DSK$(7) + "TAPE7" AS DSK$(7) + F$ 16000 JLN%(JOUT%) = JLN%(JOUT%) + 8 16010 FOR N% = 1 TO NODEX% 16020 PRINT #JOUT%, NOSHO$(N%, 1); NOSHO$(N%, 2); 16025 PRINT #JOUT%, CR$; LF$; 16030 JLN%(JOUT%) = JLN%(JOUT%) + 2 16040 IF JLN%(JOUT%) > JLAST% THEN GOSUB 17240 ELSE 16120 16050 REM 16060 REM HEADER CALL IF MORE THAN ONE PAGE OF NO-SHOWS IS NEEDED 16070 REM 16090 PRINT #JOUT%, FRM254$; 16095 PRINT #JOUT%, CR$; LF$; LF$; LF$; LF$; 16100 JLN%(JOUT%) = JLN%(JOUT%) + 8 16110 NEXT N% 16120 IF EFLAG% = 0 THEN 11980 16130 CLOSE #11 16140 IF IOUT% <> 7 THEN 23510 ON ERROR GOTO 16190 16160 INPUT "INPUT 6-CHARACTER NAME FOR FACSIMILE FILE "; F$ 16165 CLOSE #7 16170 NAME DSK$(7) + "TAPE7" AS DSK$(7) + F$ 16180 GOTO 23510 16190 PRINT "Facsimile "; F$; " already exists, or there is" PRINT "not enough space at destination "; DSK$(7); ". Use another name." GOTO 16160 17150 REM 17160 REM SUBROUTINE HEADER SKIPS TO A NEW PAGE AND PRINTS A TEST HEADER. 17170 REM 17180 REM SUBROUTINE HEADER 17240 IF IPG%(JOUT%) = 0 THEN 17250 PRINT #JOUT%, FF$; 17250 IPG%(JOUT%) = IPG%(JOUT%) + 1 JLN%(JOUT%) = 0 PRINT #JOUT%, LF$ JLN%(JOUT%) = JLN%(JOUT%) + 2 17430 IF IPG%(JOUT%) <> 1 THEN 17520 17440 PRINT #JOUT%, LOGO$(1); CR$; LF$; 17460 PRINT #JOUT%, LOGO$(2); CR$; LF$; 17490 PRINT #JOUT%, NME$; CR$; LF$; 17500 JLN%(JOUT%) = JLN%(JOUT%) + 6 17520 IF JFIN% = 1 THEN RETURN 17530 IF JOUT% <> 6 THEN 17615 17550 PRINT #JOUT%, USING FRM902$; XDT$; ITST$; IVERS$; IPG%(JOUT%); 17555 PRINT #JOUT%, CR$; LF$; LF$; 17560 PRINT #JOUT%, " ANS BANK CAT. P D B KWDS SP. CHR. M E RCH R TXT R SOURCE "; 17580 PRINT #JOUT%, CR$; LF$; LF$; 17590 JLN%(JOUT%) = JLN%(JOUT%) + 8 17600 RETURN 17615 PRINT #JOUT%, USING FRM6$; XDT$; IVERS$; IPG%(JOUT%); 17630 PRINT #JOUT%, CR$; LF$; LF$; 17640 JLN%(JOUT%) = JLN%(JOUT%) + 4 17650 RETURN 17670 REM SUBROUTINE SELECT(PARSEL,PARFLG,PARMES,PARLO,PARHI) 17690 REM 17700 REM SELECTION CONSTRAINT SUBROUTINE 17710 REM 17730 IF PARSEL% = 10000 THEN 17810 17740 PRINT PARMES$ 17760 INPUT PARSEL% 17770 IF PARSEL% = 0 THEN 17810 17780 IF PARSEL% >= PARLO% AND PARSEL% <= PARHI% THEN 17830 17790 PRINT "PARAMETER OUTSIDE ALLOWED RANGE, PLEASE RETYPE "; 17800 GOTO 17760 17810 PARFLG% = 0 17820 RETURN 17830 PARFLG% = 1 17840 RETURN 17845 REM 17860 REM SUBROUTINE YESNO(IBRCH%) 17865 REM 17940 INPUT IR$ 17945 IF IR$ = "" THEN 18190 18100 IF LEFT$(IR$, 1) = "n" OR LEFT$(IR$, 1) = "N" THEN 18150 18110 IF LEFT$(IR$, 1) = "y" OR LEFT$(IR$, 1) = "Y" THEN 18170 18120 IF LEFT$(IR$, 1) = "s" OR LEFT$(IR$, 1) = "S" THEN 18190 18130 PRINT "YES, NO OR STOP ONLY ALLOWED HERE. PLEASE RETYPE "; 18140 GOTO 17940 18150 IBRCH% = 2 18160 RETURN 18170 IBRCH% = 1 18180 RETURN 18190 IBRCH% = 3 18200 RETURN 18220 REM SUBROUTINE COMMENT(ITST$,NCHAR%) 18250 NCHAR% = 0 18280 INPUT IR$ 18290 IF IR$ = "" THEN 18470 18294 FOR N% = 1 TO 20 18296 JD$(N%) = "" 18298 NEXT N% 18300 FOR N% = 1 TO 20 18302 IF N% > LEN(IR$) THEN 18310 18303 NCHAR% = N% 18304 JD$(N%) = MID$(IR$, N%, 1) 18308 NEXT N% 18310 IR$ = "" 18320 FOR N% = 1 TO 20 18330 IF ASC(JD$(N%)) < 97 OR ASC(JD$(N%)) > 122 THEN 18350 18340 JD$(N%) = CHR$(ASC(JD$(N%)) - 32) 18350 IR$ = IR$ + JD$(N%) 18352 IF N% = NCHAR% THEN 18450 18355 NEXT N% 18450 RETURN 18470 NCHAR% = 0 18480 RETURN 18930 REM SUBROUTINE CNTLINE 18950 REM 18960 REM THIS SUBROUTINE COUNTS THE NUMBER OF LINES IN A MACRO ITEM STEM 18970 REM OR IN A SINGLE ITEM OR SINGLE SUBITEM OF A MACRO. THEN IT GETS 18980 REM THE LINE HAVING THE ENTRY KEY AND DEPENDING UPON THE LOCATION OF 18990 REM ENTRANCE, EITHER PUTS BACK THE LAST BYTE (CONTROLLING UNDERLINING) 19000 REM OR DOES NOT, DEPENDING UPON THE LOCATION OF ENTRANCE (ILOC%). 19010 REM THE REASON FOR THIS IS THAT IN THE CASE OF A MACRO STEM, THERE 19020 REM IS STILL NO VALUE FOR LSTWRD%, WHICH IS USED AS AN INDEX HERE. 19030 REM 19060 RTMP = R4 19063 LNID% = 0 19065 QKTMP$ = QKTXT$ 19070 NLINE% = 2 19080 IHALF% = 0 19085 EFL% = 0 19090 IF KFLAG% >= 1 AND KFLAG% <= 4 OR KFLAG% >= 6 AND KFLAG% <= 7 THEN IHALF% = 1 19100 POS11$ = MID$(QKTXT$, 2, 1) 19110 IF POS11$ = "4" OR LSTP11$ = "5" AND IHALF% = 1 THEN NLINE% = NLINE% - 1 19120 IF POS11$ = "3" AND IHALF% = 1 OR POS11$ = "3" AND KFLAG% = 5 THEN NLINE% = NLINE% - 2 19140 LAST2$ = MID$(QKTMP$, 1, 1) 19150 IF LAST2$ = "9" OR POS11$ = "1" THEN EFL% = 1 19160 LSTP11$ = POS11$ 19163 M = 3 19164 FOR N = M TO LEN(QKTMP$) 19166 IF ASC(MID$(QKTMP$, N, 1)) = 3 THEN 19174 19167 NEXT N 19168 RTMP = RTMP + 1 19169 GET #11, RTMP 19170 QKTMP$ = QKTMP$ + PKTXT$ M = N + 1 19172 GOTO 19164 19174 NLINE% = NLINE% + 2 LNID% = LNID% + 1 NCR%(LNID%) = N IF EFL% = 1 THEN 19210 19176 IF LEFT$(QKTMP$, 1) >= "0" AND LEFT$(QKTMP$, 1) <= "9" THEN 19210 19178 QKTMP$ = RIGHT$(QKTMP$, LEN(QKTMP$) - N) 19180 IF LEN(QKTMP$) >= 80 THEN 19190 19182 RTMP = RTMP + 1 19183 GET #11, RTMP 19185 QKTMP$ = QKTMP$ + PKTXT$ 19190 GOTO 19100 19210 GET #11, R4 19240 IF ILOC% = 1 THEN NLINE% = NLINE% + 4 19250 NLINE% = NLINE% + XTRAL% 19260 RETURN 19450 REM SUBROUTINE ENHSPC 19470 REM 19480 REM THIS SUBROUTINE MAKES THE APPROPRIATE NUMBER OF SPACES AFTER 19490 REM (1) EITHER A SINGLE ENHANCED ITEM, OR 19500 REM (2) THE STEM PORTION OF A MACRO ITEM WHICH IS ALSO AN ENHANCED ITEM 19510 REM 19530 IF XTRAL% = 0 THEN RETURN 19560 JLN%(IOUT%) = JLN%(IOUT%) + XTRAL% + 2 19570 XTRAL% = INT(XTRAL% / 2) 19580 IF XTRAL% = 1 THEN 19589 19582 FOR N% = 1 TO XTRAL% - 1 19584 PRINT #IOUT%, LF$; 19586 NEXT N% 19589 PRINT #IOUT%, LF$; 19590 XTRAL% = 0 19600 RETURN 19620 REM 19630 REM BEGIN BINARY SEARCH FOR INDIVIDUAL ITEM 19640 REM 19650 REM PROGRAM MARKER (4) 19660 IFETCH% = 0 19670 R1 = 3 19680 R2 = NREC 19690 REM PROGRAM MARKER (2) 19700 R3 = INT((R1 + R2) / 2) 19710 IF R3 = R1 THEN 19810 19720 GET #11, R3 19721 DUM$ = LEFT$(PKTXT$, 7) 19722 L$ = LEFT$(PKTXT$, 7) 19723 IF L$ <> STRING$(7, 32) THEN 19740 19724 R3 = R3 - 1 19726 GOTO 19710 19740 IF JEY$ >= L$ THEN 19780 19750 R2 = R3 19760 GOTO 19700 19770 REM PROGRAM MARKER (24) 19780 IF JEY$ = L$ THEN 19850 19785 R1 = R3 19790 GOTO 19700 19800 REM PROGRAM MARKER (23) 19810 FOR R3 = R1 TO R2 19812 GET #11, R3 19820 J$ = LEFT$(PKTXT$, 7) 19830 IF J$ <> JEY$ THEN 19835 19833 RETURN 19835 NEXT R3 19840 IFETCH% = 1 19850 RETURN 20000 REM 20010 REM BEGIN BINARY SEARCH FOR DELETED ITEM 20020 REM 20030 REM PROGRAM MARKER (4) 20040 IFETCH% = 0 20045 IF DREC% = 1 THEN RETURN 20050 R1% = 2 20060 R2% = DREC% 20070 REM PROGRAM MARKER (2) 20080 RD% = INT((R1% + R2%) / 2) 20090 IF RD% = R1% THEN 20200 20100 GET #10, RD% 20110 L$ = LEFT$(DKEY$, 12) 20120 IF IKEY$ >= L$ THEN 20160 20130 R2% = RD% 20140 GOTO 20080 20150 REM PROGRAM MARKER (24) 20160 IF IKEY$ = L$ THEN 20162 ELSE 20170 20162 IFETCH% = 1 20164 RETURN 20170 R1% = RD% 20180 GOTO 20080 20190 REM PROGRAM MARKER (23) 20200 GET #10, RD% 20210 J$ = LEFT$(DKEY$, 12) 20220 IF J$ = IKEY$ THEN 20230 ELSE 20222 20222 GET #10, R2% 20226 J$ = LEFT$(DKEY$, 12) 20227 RD% = R2% 20228 IF J$ = IKEY$ THEN 20230 ELSE RETURN 20230 IFETCH% = 1 20240 RETURN 21000 REM 21010 REM DELETE AN ITEM IDENTIFIER FROM DELETE FILE 21020 REM 21030 FOR N% = RD% TO DREC% 21040 IF N% = DREC% THEN 21080 21050 GET #10, N% + 1 21060 PUT #10, N% 21070 NEXT N% 21080 LSET DKEY$ = STRING$(21, 32) 21090 PUT #10, DREC% 21100 DREC% = DREC% - 1 21110 RSET DKEY$ = STR$(DREC%) 21120 PUT #10, 1 21130 RETURN 23000 REM 23010 REM SORT DELETION FILE (MODIFIED 11/26/89) 23020 REM 23026 IF DREC% <= 2 THEN 23330 PRINT "Deletion file now being sorted." PRINT "Please stand by." OPEN "O", #12, "TAPE12" NEWREC% = DREC% FOR N% = 2 TO DREC% GET #10, N% ADUM$ = LEFT$(DKEY$, 12) IF ADUM$ <> STRING$(12, 32) THEN 23100 NEWREC% = NEWREC% - 1 GOTO 23110 23100 PRINT #12, ADUM$ 23110 NEXT N% CLOSE #12 SPATH$ = "SORT /+1 TAPE13" SHELL SPATH$ SHELL "DEL TAPE12" SHELL "REN TAPE13 TAPE12" OPEN "I", #12, "TAPE12" IF NEWREC% <= 2 THEN 23320 DREC% = NEWREC% REM REM The following section rewrites the randomly accessible deletion REM file but also checks for duplicate entries and eliminates them REM The use of ADUM$ and BDUM$ and their comparisons is what does that. REM INPUT #12, ADUM$ M% = 2 FOR N% = 3 TO DREC% INPUT #12, BDUM$ IF ADUM$ <> BDUM$ THEN 23310 ELSE 23315 23310 LSET DKEY$ = ADUM$ PUT #10, M% M% = M% + 1 ADUM$ = BDUM$ 23315 NEXT N% ADUM$ = BDUM$ LSET DKEY$ = ADUM$ PUT #10, M% 23320 RSET DKEY$ = STR$(M%) PUT #10, 1 CLOSE #12 23330 RETURN 23510 CLOSE 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.