PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #268)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “DATA BASE OF STEEL 4 OF 4 (214,215,267)”
This is the first volume of Potomac Engineering's database, spreadsheet
and expert system offerings, all grouped under the title "... of
Steel". The first two disks contain the Database Management System
which includes Accounting, Payroll, Inventory, and A/R Applications
Programmable, Relational. The documentation for the whole system is on
Disk No 215.
The Spreadsheet (No 267) includes 21 ways to calculate numbers or write
your own subroutine. It is written in BASIC for easy modification, and
a compiled version is available.
The Expert System (No 268) provides for inference engines, designing
your own expert systems, and intelligent search patterns. The entire
system is menu driven, so all the options are displayed on the screen.
Features:
~ Written in BASIC for easy modification
~ Compiled version provided (192k)
~ Sample checkbook application
~ Automatic recalculation
~ Bar charts
~ Full cursor control
~ Report generator
~ Customizable screens
~ ASCII output
~ Tax tables
~ Create subfiles
~ Sort on 3 fields
~ 3 files open simultaneously
~ Global field changes
~ Transfer data between files
~ Inference engine
~ Design expert systems
~ Assigns probability with rules
~ Intellignet search pattern with manual override
~ Detects contradictory evidence
~ Explanation of reasoning
System Requirements: Two disk drives (Hard disk recommended)
How to Start: Consult the README file for documentation and
directions. To run the BASIC programs follow the GETTING STARTED
instructions for your configuration.
Suggested Registration: $20.00
File Descriptions:
The First Disk Contains:
-------- --- Database of Steel - Source Code
SCAN BAS Database extract and select program
MAIN BAS Main database program
CHANGE BAS Global database change and replacement
FORM BAS Report format program
TRANSFER BAS Transfer data from one file to another
CFILE BAS Creates (defines) database file
SORT BAS Sorts database
CTRANSFE BAS Customizes transfers between files
CINPUT BAS Sets up new data entry for the file
CLIMITS BAS Sets range limts for numeric fields
CFORM BAS Creates print forms
TESTASCI BAS Reads file created from above and display it
ASCII BAS Convert from random access format to ASCII
CSCREEN BAS Sets up screen display for record
CREAL BAS Realtime transfers between files
READ ME Descriptions of files on disk
The Second Disk Contains:
READ ME Descriptions of files on disk
-------- --- Database of Steel - sample programs and files, doc
MASTER TXT Manual (WordStar format - 153K)
REMARKS4 BAS Program remarks
REMARKS3 BAS Program remarks
REMARKS2 BAS Program remarks
REMARKS1 BAS Program remarks
PRINTMAN BAS Procedure to print the manual
??? OBJ Part of Database of Steel
??? BAS Part of Database of Steel
??? Various data files for Database of Steel
The Third Disk Contains:
-------- --- Spreadsheet of Steel and Compiled Database Program
READ ME Description of files on this disk
REMARKST BAS Sort remarks
MAIN EXE Compiled database program
CHECK Sample spreadsheet
TAX Sample spreadsheet
SORTINT BAS Sort source for database
SORT BAS Sort source for database
SS EXE Compiled spreadsheet
SSREMARK BAS Spreadsheet remarks
SS BAS Spreadsheet source
SORTSTR BAS Sort source for database
The Fourth Disk Contains:
-------- --- Expert System of Steel
EXPERT BAS Source code for expert system
EXPERT EXE Compiled program for expert system
REM BAS Remarks for source program (33K)
READ ME Description of files on this disk
FORM EXE Compiled program for database
SCAN EXE Compiled program for database
TEMP BAS Part of expert system disk
CLS OBJ Part of expert system disk
??? Sample program for Database of Steel
CRC.TXT
PC-SIG Disk No. #268, version v1
The following is a list of the file checksums which should be produced by
the CRCK4 program on this disk. If the CRC numbers do not match the following
list you may have a bad file. To use type: CRCK4 <filespec>
CRCK4 output for this disk:
CRCK ver 4.2B (MS DOS VERSION )
CTL-S pauses, CTL-C aborts
--> FILE: REM .BAS CRC = E7 0B
--> FILE: FFILE . CRC = 1F A7
--> FILE: SCTEST . CRC = 05 98
--> FILE: KYLIST . CRC = 3A 32
--> FILE: KEYLISTS. CRC = 16 B5
--> FILE: FORMLIST. CRC = E4 EC
--> FILE: IDEX . CRC = C5 2B
--> FILE: REALTIME. CRC = 8F C4
--> FILE: IPUTD4 . CRC = 91 A7
--> FILE: IPUTD5 . CRC = 91 A7
--> FILE: IPUTD6 . CRC = 91 A7
--> FILE: IPUTD7 . CRC = 91 A7
--> FILE: IPUTD9 . CRC = 91 A7
--> FILE: IPUTD10 . CRC = 91 A7
--> FILE: IPUTD11 . CRC = 91 A7
--> FILE: IPUTD12 . CRC = 91 A7
--> FILE: IPUTD13 . CRC = 91 A7
--> FILE: IPUTD8 . CRC = 91 A7
--> FILE: IPUTD14 . CRC = 91 A7
--> FILE: IPUTD1 . CRC = 10 DE
--> FILE: IPUTD2 . CRC = DD F1
--> FILE: IPUTD3 . CRC = A6 9E
--> FILE: SCREEN2 . CRC = 14 1A
--> FILE: QUESTION. CRC = C2 E9
--> FILE: SOLUTION. CRC = 78 A7
--> FILE: PROBLEMS. CRC = DA 1F
--> FILE: FORM .EXE CRC = B8 B4
--> FILE: TEST . CRC = D9 50
--> FILE: SCAN .EXE CRC = F9 EE
--> FILE: JACK . CRC = A6 E7
--> FILE: EXPERT .BAS CRC = 75 15
--> FILE: TEMP .BAS CRC = 75 1D
--> FILE: CLS .OBJ CRC = 00 00
--> FILE: EXPERT .EXE CRC = 9D 68
--> FILE: READ .ME CRC = C9 A4
---------------------> SUM OF CRCS = 1C 86
DONE
These and other Public Domain and user-supported programs from:
PC Software Interest Group (PC-SIG)
1125 Stewart Ct Suite G
Sunnyvale, CA 94086
(408) 730-9291
EXPERT.BAS
3 PRINT FRE(0)
4 DEFINT B-D,G-Z
5 DIM ANS(3000)
13 DIM SB(1000)
16 DIM PRI(1000)
35 DIM K$(80)
40 DIM PFOR(1000)
45 DIM PA(1000)
50 DIM EVAL(1000)
60 DIM PBM(200)
65 DIM ACT(25)
70 CH = 29
75 PRINT FRE(0)
80 GOSUB 52000
100 GOSUB 50000
150 IF DT# = 2 THEN GOSUB 36000
200 GOSUB 53000
300 IF DT# = 1 THEN GOSUB 10000
310 GOSUB 12000
320 GOTO 20000
500 REM CLEAR SCREEN
510 CLS
520 RETURN
8000 REM ***** FILE NAME ACCEPLABLE TEST ************
8010 TEST = 1
8100 FOR Q = 1 TO LEN(A$)
8110 K$(Q) = MID$(A$,Q,1)
8120 C = ASC(K$(Q))
8130 IF C < 48 OR C > 122 THEN TEST = 4
8140 IF Q = 1 AND ( C < 65 OR C > 122 ) THEN TEST = 4
8150 NEXT Q
8190 RETURN
10000 REM INITAL ASK ALL QUESTIONS
10010 GOSUB 500
10020 NEFLG = 5
10030 PRINT " START A NEW ANALYSIS "
10035 PRINT ""
10040 PRINT " The computer will ask you the introductory questions "
10045 PRINT ""
10050 PRINT " Answer the questions by entering the answer then press return "
10055 PRINT ""
10060 PRINT " You may enter N for no answer"
10065 PRINT ""
10070 PRINT " PRESS ANY KEY TO CONTINUE "
10080 IF INKEY$ = "" THEN 10080
10100 FOR R = 1 TO MRN1
10103 ANS(R) = -999
10104 RN = R
10105 GOSUB 54100
10110 IF Q2 = 2 THEN GOSUB 10200
10120 NEXT R
10125 NEFLG = 0
10130 RETURN
10200 REM ASK QUESTION
10210 GOSUB 500
10240 PRINT Q$
10250 IF ABS(Q3) > 1 THEN 10400
10260 GOSUB 60120
10265 IF DT# = -999 AND NFLG = 0 THEN 10500
10270 ANS(R) = DT#
10290 RETURN
10400 REM PRINT CONTINUED QUESTIONS
10410 RN = ABS(Q3)
10420 GOSUB 54100
10430 PRINT Q$
10440 GOTO 10250
10500 REM DONT ACCEPT -999
10510 PRINT " THE COMPUTER WILL NOT ACCEPT -999 FOR AN ANSWER BECAUSE IT IS THE "
10520 PRINT " CODE FOR NO ANSWER "
10530 PRINT " PLEASE GIVE ANOTHER ANSWER FOR THE QUESTION "
10540 GOTO 10260
10600 REM DONT ACCEPT -999
10610 PRINT " THE COMPUTER WILL NOT ACCEPT -999 FOR AN ANSWER BECAUSE IT IS THE "
10620 PRINT " CODE FOR NO ANSWER "
10630 PRINT " PLEASE GIVE ANOTHER ANSWER FOR THE QUESTION "
10640 GOTO 31130
11000 REM READ OLD DATA
12000 REM READ SUBPROBLEMS AND PRIORITY
12100 FOR T = 1 TO MRN2
12110 GET #2,T
12120 SB(T) = CVI(P2$)
12130 PRI(T) = CVI(P3$)
12140 NEXT T
12150 RETURN
17000 REM CHECK FOR CONTINUED QUESTIONS
17100 IF ABS(Q3) <= 1 THEN RETURN
17110 RN = ABS(Q3)
17120 GOSUB 54000
17122 KTQ = KTQ - 1
17130 PRINT TAB(8) Q$
17135 IF PRTFLG = 2 THEN LPRINT TAB(8)Q$
17140 GOTO 17100
17200 RN = T
17208 IF ABS(Q3) <= 1 THEN RETURN
17210 RN = ABS(Q3)
17220 GOSUB 54000
17230 LPRINT TAB(8) Q$
17240 GOTO 17200
18000 REM PRINT SINGLE PROBLEM AND SUPPORTING EVIDENCE
18010 PRINT "****** MAKE SURE YOUR PRINTER IS ON ******"
18100 PRINT "WHICH PROBLEM DO YOU WANT PRINTED ON PAPER ?"
18105 PRINT " ENTER 0 TO RETURN "
18110 GOSUB 60060
18115 IF DT# = 0 THEN 20000
18120 RN = DT#
18130 GOSUB 54200
18140 LPRINT RN;P1$;TAB(60) PFOR(RN);TAB(65) PA(RN)
18145 T = RN
18150 GOSUB 34000
18160 GOTO 20000
19000 REM **** OPTIONS MENU
19100 PRINT "** OPTIONS ** 0 - NONE 1 - SAVE 2 - PRINT OPTIONS DISPLAYED ON PAPER "
19110 PRINT "3 - REVIEW ALL PROBLEMS 4 - ALL QUESTIONS & ANSWERS 5 - PRINT PROBLEM 6-EXIT"
19150 GOSUB 60000
19160 IF DT# < 0 OR DT# > 6 THEN 19150
19170 IF DT# = 0 THEN 20000
19180 ON DT# GOTO 35000,24000,37000,41000,18000,51000
20000 REM START SEARCH
20005 LPRTFLG = 0
20007 KTQ = 0
20008 PRTFLG = 0
20010 H = 0
20020 GOSUB 500
20030 KT = 0
20035 IF SB(ND) > 3000 THEN ND = 0
20040 GOSUB 21000
20050 PRINT " # PROBLEM ";TAB(60) " + - P CK CONT"
20055 IF LPRTFLG = 1 THEN LPRINT " # PROBLEM ";TAB(60) " + - P CK CONT"
20100 FOR T = 1 TO MRN2
20110 IF SB(T) = ND OR SB(T) = -ND THEN GOSUB 20500
20120 NEXT T
20140 IF ND = 0 AND H = 0 THEN PRINT "END OF COMPUTER RECOMMENDATIONS, EXIT OR CONDUCT MANUAL SEARCH"
20150 IF ND <> 0 AND H = 0 THEN PRINT "COMPUTER RECOMMENDS BACKTRACK TO SUBPROBLEM";SB(ND)
20200 PRINT "BRANCH ? * NEGATIVE NBR TO OVERRIDE * 9999 TO OPTIONS *";
20205 IF H > 0 THEN PRINT " COMPUTER RECOMMENDS";H ELSE PRINT " "
20210 RN = P12
20250 GOSUB 60060
20252 IF DT# > 9998 THEN 19000
20253 IF ABS(DT#) > MRN2 THEN 20250
20255 IF DT# > 0 THEN 30000
20260 ND = -DT#
20265 IF SB(ND) < 0 THEN 20250
20270 GOTO 20000
20500 REM PRINT STARTING NODE ON SCREEN
20504 PB = T
20505 GOSUB 22000
20510 RN = T
20520 GOSUB 54200
20530 PRINT RN;TAB(6) P1$;TAB(60) PFOR(T);TAB(65) PA(T);TAB(70) P3;
20532 IF EVAL(T) = 1 THEN PRINT TAB(73) "PC ";
20533 IF EVAL(T) = 0 THEN PRINT TAB(73) "NC ";
20534 IF EVAL(T) = 2 THEN PRINT TAB(73) "C ";
20535 IF SB(T) >-1 THEN PRINT "CONT" ELSE PRINT "END"
20537 IF PFOR(T) > 89 AND PA(T) > 89 THEN PRINT " PROBABLE CONTRADICTORY EVIDENCE "
20540 KT = KT + 1
20545 IF PRI(T) > PRI(H) AND EVAL(T) = 0 THEN H = T
20547 IF LPRTFLG = 1 THEN GOSUB 20600
20550 RETURN
20600 REM PRINT ON PAPER
20630 LPRINT RN;TAB(6) P1$;TAB(60) PFOR(T);TAB(65) PA(T);TAB(70) P3;
20632 IF EVAL(T) = 1 THEN LPRINT TAB(73) "PC ";
20633 IF EVAL(T) = 0 THEN LPRINT TAB(73) "NC ";
20634 IF EVAL(T) = 2 THEN LPRINT TAB(73) "C ";
20635 IF SB(T) >-1 THEN LPRINT "CONT" ELSE LPRINT "END"
20637 IF PFOR(T) > 89 AND PA(T) > 89 THEN LPRINT " PROBABLE CONTRADICTORY EVIDENCE "
20650 RETURN
21000 REM PRINT SUBRECORDS UP TO 0
21005 IF ND = 0 THEN PRINT "AT STARTING NODE 0"
21006 IF ND = 0 THEN RETURN
21010 PRINT "SUBPROBLEMS OF :"
21015 IF LPRTFLG = 1 THEN LPRINT "SUBPROBLEMS OF :"
21100 T = ND
21105 T = ABS(T)
21110 RN = T
21115 IF RN = 0 THEN RETURN
21120 GOSUB 54200
21130 PRINT RN;TAB(6) P1$,TAB(60) PFOR(T);TAB(65) PA(T)
21135 IF LPRTFLG = 1 THEN LPRINT RN;TAB(6) P1$,TAB(60) PFOR(T);TAB(65) PA(T)
21140 T = SB(T)
21145 T = ABS(T)
21150 GOTO 21110
22000 REM compute probability
22010 PA(PB) = 0
22020 PFOR(PB) = 0
22030 DCHKFLG = 0
22100 RN = PB
22105 RNH = RN
22110 T4= RN
22120 S = SB(T4)
22125 S = ABS(S)
22128 IF S > 2000 THEN RETURN
22130 IF S = 0 THEN 22300
22140 IF PA(S) > PA(RN) THEN PA(RN) = PA(S)
22150 S = SB(S)
22155 S = ABS(S)
22160 GOTO 22130
22300 GOSUB 54200
22310 IF ANS(P8) = -999 THEN 22410
22315 ANS = ANS(P8)
22320 RT = P7
22330 QN = P8
22340 FV = P9!
22350 PB = P10
22360 GOSUB 23000
22410 IF ANS(P12) = -999 THEN 22510
22415 ANS = ANS(P12)
22420 RT = P11
22430 QN = P12
22440 FV = P13!
22450 PB = P14
22460 GOSUB 23000
22510 IF ANS(P16) = -999 THEN 22610
22515 ANS = ANS(P16)
22520 RT = P15
22530 QN = P16
22540 FV = P17!
22550 PB = P18
22560 GOSUB 23000
22610 IF ANS(P20) = -999 THEN 22710
22615 ANS = ANS(P20)
22620 RT = P19
22630 QN = P20
22640 FV = P21!
22650 PB = P22
22660 GOSUB 23000
22710 IF ANS(P24) = -999 THEN 22800
22715 ANS = ANS(P24)
22720 RT = P23
22730 QN = P24
22740 FV = P25!
22750 PB = P26
22760 GOSUB 23000
22800 REM REDUCE EVALUATION TO PARTIAL CHECK
22810 IF EVAL(RN) = 0 THEN 22880
22820 IF EVAL(RN) = 1 THEN 22880
22830 IF ANS(P8) = -999 THEN EVAL(RN) = 1
22835 IF P11 = 0 THEN 22880
22840 IF ANS(P12) = -999 THEN EVAL(RN) = 1
22845 IF P15 = 0 THEN 22880
22850 IF ANS(P16) = -999 THEN EVAL(RN) = 1
22855 IF P19 = 0 THEN 22880
22860 IF ANS(P20) = -999 THEN EVAL(RN) = 1
22865 IF P23 = 0 THEN 22880
22870 IF ANS(P24) = -999 THEN EVAL(RN) = 1
22880 IF ABS(P5) > 1 THEN GOTO 22910
22890 IF DCHKFLG = 5 THEN 22950
22900 RETURN
22910 REM COMPUTE PROBABILITY FOR CONTINUED PROBLEMS
22915 RNH = RN
22918 DCHKFLG = 5
22920 RN = ABS(P5)
22930 GOSUB 54200
22935 RN = RNH
22940 GOTO 22310
22950 REM RETURN FOR CONTINUED PROBLEMS
22960 RN = RNH
22970 GOSUB 54200
22980 RETURN
23000 REM CALCULATE
23010 TEST = 0
23020 IF RT = 0 THEN RETURN
23100 ON RT GOSUB 23500,23600,23700,23800:REM PRINT RT;QN;FV;PB N;TEST;"-"
23120 IF TEST = 0 THEN RETURN
23130 IF PB < 0 THEN 23300
23140 PFOR(RN) = INT(PFOR(RN) + (100 - PFOR(RN))*(PB/100))
23150 RETURN
23300 PA(RN) = INT(PA(RN) + (100 - PA(RN))*ABS(PB/100))
23310 RETURN
23500 REM EQUALS TEST
23510 IF ANS = FV THEN TEST = 1
23520 RETURN
23600 REM LESS THEN TEST
23610 IF ANS < FV THEN TEST = 1
23620 RETURN
23700 IF ANS > FV THEN TEST = 1
23710 RETURN
23800 REM LESS THEN TEST
23810 IF ANS <> FV THEN TEST = 1
23820 RETURN
24000 REM ***** PRINT NODE
24100 LPRTFLG = 1
24110 PRINT " MAKE SURE YOUR PRINTER IS ON "
24120 PRINT " PRESS ANY KEY TO CONTINUE "
24130 IF INKEY$ = "" THEN 24130
24200 GOTO 20010
30000 REM ASK SEARCH QUESTIONS
30100 RN = ABS(DT#)
30101 IF SB(RN) > 3000 THEN 20000
30102 HRN = RN
30105 EVAL(RN) = 2
30110 GOSUB 54200
30120 RN = P8
30130 GOSUB 54000
30140 PRINT KTQ;P8;TAB(10) Q$;
30145 IF ANS(P8) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P8);
30150 R = P7
30160 GOSUB 32000
30170 PRINT P9!;" ";TAB(75)P10
30180 GOSUB 17000
30200 IF P11 = 0 THEN 31000
30210 RN = P12
30220 GOSUB 54000
30230 PRINT KTQ;P12;TAB(10) Q$;
30245 IF ANS(P12) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P12);
30250 R = P11
30260 GOSUB 32000
30270 PRINT P13!;" ";TAB(75)P14
30280 GOSUB 17000
30300 IF P15 = 0 THEN 31000
30310 RN = P16
30320 GOSUB 54000
30330 PRINT KTQ;P16;TAB(10) Q$;
30345 IF ANS(P16) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P16);
30350 R = P15
30360 GOSUB 32000
30370 PRINT P17!;" ";TAB(75) P18
30380 GOSUB 17000
30400 IF P19 = 0 THEN 31000
30410 RN = P20
30420 GOSUB 54000
30430 PRINT KTQ;P20;TAB(10) Q$;
30445 IF ANS(P20) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P20);
30450 R = P19
30460 GOSUB 32000
30470 PRINT P21!;" ";TAB(75) P22
30480 GOSUB 17000
30500 IF P23 = 0 THEN 31000
30510 RN = P24
30520 GOSUB 54000
30530 PRINT KTQ;P24;TAB(10) Q$;
30545 IF ANS(P24) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P24);
30550 R = P23
30560 GOSUB 32000
30570 PRINT P25!;" ";TAB(75) P26
30580 GOSUB 17000
30600 GOTO 32300
31000 PRINT "WHAT QUESTION ? ";"1 TO ";KTQ;", 0 for NONE, THEN ENTER THE ANSWER"
31100 GOSUB 60000
31110 IF DT# < 1 THEN 33000
31115 IF DT# > KTQ THEN 31000
31120 H = ACT(DT#)
31122 NEFLG = 5
31130 GOSUB 60120
31132 IF DT# = -999 AND NFLG = 0 THEN 10600
31133 NEFLG = 0
31140 ANS(H) = DT#
31500 GOTO 31000
31600 REM CHECK FOR ACCEPTABLE QUESTION TO ANSWER
31605 TEST = 0
31610 FOR T1 = 1 TO KTQ
31620 IF H = ACT(T1) THEN TEST = 1
31630 NEXT T1
31640 IF TEST = 0 THEN 31000
31650 GOTO 31130
32000 REM PRINT RULE
32100 IF R = 1 THEN PRINT "=";
32110 IF R = 2 THEN PRINT "<";
32120 IF R = 3 THEN PRINT ">";
32130 IF R = 4 THEN PRINT "<>";
32140 RETURN
32200 IF R = 1 THEN LPRINT "=";
32210 IF R = 2 THEN LPRINT "<";
32220 IF R = 3 THEN LPRINT ">";
32230 IF R = 4 THEN LPRINT "<>";
32240 RETURN
32300 REM ***** ADDITIONAL RULES FOR THE PROBLEM
32310 IF ABS(P5) < 2 THEN 31000
32320 RN = ABS(P5)
32330 GOTO 30110
32400 REM ***** ADDITIONAL RULES FOR THE PROBLEM
32410 IF ABS(P5) < 2 THEN 34600
32420 RN = ABS(P5)
32430 GOTO 34110
33000 REM
33100 PB = HRN
33110 GOSUB 22000
33115 IF SB(HRN) < 0 THEN 33130
33120 IF PFOR(HRN) > 40 AND PA(HRN) <40 THEN ND=HRN
33130 GOTO 20000
34000 REM PRINT ON PAPER QUESTIONS
34100 RN = T
34102 HRN = RN
34110 GOSUB 54200
34120 RN = P8
34130 GOSUB 54000
34140 LPRINT P8;TAB(8) Q$;
34145 IF ANS(P8) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P8);
34150 R = P7
34160 GOSUB 32200
34170 LPRINT P9!;" ";P10
34180 GOSUB 17200
34200 IF P11 = 0 THEN 34600
34210 RN = P12
34220 GOSUB 54000
34230 LPRINT P12;TAB(8) Q$;
34245 IF ANS(P12) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P12);
34250 R = P11
34260 GOSUB 32200
34270 LPRINT P13!;" ";P14
34280 GOSUB 17200
34300 IF P15 = 0 THEN 34600
34310 RN = P16
34320 GOSUB 54000
34330 LPRINT P16;TAB(8) Q$;
34345 IF ANS(P16) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P16);
34350 R = P15
34360 GOSUB 32200
34370 LPRINT P17!;" ";P18
34380 GOSUB 17200
34400 IF P19 = 0 THEN 34600
34410 RN = P20
34420 GOSUB 54000
34430 LPRINT P20;TAB(8) Q$;
34445 IF ANS(P20) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P20);
34450 R = P19
34460 GOSUB 32200
34470 LPRINT P21!;" ";P22
34480 GOSUB 17200
34500 IF P23 = 0 THEN 34600
34510 RN = P24
34520 GOSUB 54000
34530 LPRINT P24;TAB(8) Q$;
34545 IF ANS(P24) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P24);
34550 R = P23
34560 GOSUB 32200
34570 LPRINT P25!;" ";P26
34580 GOSUB 17200
34590 GOTO 32400
34600 RETURN
35000 REM SAVE
35010 GOSUB 500
35100 PRINT " WHAT FILE NAME DO YOU WANT TO SAVE THIS ANALYSIS UNDER"
35110 PRINT " Eight Characters or less no spaces "
35115 PRINT "Just Press return if you do not want to save at this time"
35120 MAX = 8
35130 GOSUB 62030
35135 IF A$ = "" THEN 20000
35140 GOSUB 8000
35150 IF TEST = 4 THEN 35000
35160 CLOSE #3
35170 OPEN "O",#3,A$
35180 WRITE #3, MRN1,MRN2,MRN3
35190 FOR T = 1 TO MRN1
35200 WRITE #3, ANS(T)
35210 NEXT T
35220 FOR T = 1 TO MRN2
35230 WRITE #3, PFOR(T),PA(T),EVAL(T)
35240 NEXT T
35245 CLOSE #3
35250 GOSUB 53300
35260 GOTO 20000
36000 REM READ SAVED FILES
36100 GOSUB 500
36110 PRINT "DIRECTORY OF ALL FILES ON THE DEFAULT DISK DRIVE :"
36115 PRINT ""
36120 FILES
36130 PRINT "ENTER THE NAME OF THE FILE THAT YOU PREVIOUSLY STORED AN ANALYSIS ON"
36135 PRINT ""
36140 MAX = 8
36150 GOSUB 62030
36160 GOSUB 8000
36165 IF TEST = 4 THEN 36000
36170 OPEN "I",#3,A$
36180 INPUT #3, MRN1,MRN2,MRN3
36190 FOR T = 1 TO MRN1
36200 INPUT #3, ANS(T)
36210 NEXT T
36220 FOR T = 1 TO MRN2
36230 INPUT #3, PFOR(T),PA(T),EVAL(T)
36240 NEXT T
36245 CLOSE #3
36260 RETURN
37000 REM PRINT OUT ALL PROBLEMS
37010 NBRT = 0
37100 GOSUB 500
37110 PRINT " PRINT OUT PROBLEMS "
37115 PRINT ""
37120 PRINT " DO YOU WANT TO CHECK ALL PROBLEMS OR ONLY THOSE SEARCHED ?"
37125 PRINT " 0 - RETURN"
37130 PRINT " 1 - ONLY THOSE AREADY SEARCHED "
37140 PRINT " 2 - ALL - TAKES A LOT LONGER "
37150 GOSUB 60000
37155 IF DT# < 0 OR DT# > 2 THEN 37100
37160 IF DT# = 0 THEN 20000
37170 PEVAL = DT#
37200 PRINT " PRINT OUT ALL PROBLEMS WITH A PROBABLILY FOR HIGHER THEN "
37210 PRINT " ENTER A NUMBER FROM -1 TO 100"
37220 GOSUB 60060
37222 IF DT# = -1 THEN 37230
37225 IF DT# < 0 OR DT# > 100 THEN 37200
37230 FMIN = DT#
37240 PRINT " AND WHOSE PROBABLITY AGAINST IS LOWER THEN "
37250 PRINT " ENTER A NUMBER FROM 0 TO 101 "
37260 GOSUB 60060
37265 IF DT# < 0 OR DT# > 101 THEN 37240
37270 AMAX = DT#
37300 PRINT " DO YOU WANT THE PROBLEMS "
37310 PRINT " 1 - SHOWN ON THE SCREEN ONLY "
37320 PRINT " 2 - PRINTED ON PAPER AND SHOWN ON THE SCREEN"
37325 PRINT " 3 - PRINTED ON PAPER WITH SUPPORTING RULES "
37330 GOSUB 60000
37340 IF DT# < 1 OR DT# > 3 THEN 37300
37350 PPRT = DT#
37400 REM ***** START LOOP
37410 FOR T = 1 TO MRN2
37420 IF PEVAL = 1 AND EVAL(T) = 0 THEN 37600
37422 PB = T
37424 GOSUB 22000
37430 IF PFOR(T) > FMIN AND PA(T) < AMAX THEN GOSUB 38000
37600 NEXT T
37610 GOTO 39000
38000 REM **** SUBROUTINE FOR PROBLEMS THAT MEET THE LIMITS
38005 NBRT = NBRT + 1
38006 IF NBRT > 250 THEN NBRT = 250
38007 PBM(NBRT) = T
38010 RN = T
38020 GOSUB 54200
38025 IF P5 < 0 THEN RETURN
38030 PRINT T;P1$; TAB(55) PFOR(T); TAB(60) PA(T)
38040 IF PPRT > 1 THEN LPRINT T;P1$;TAB(55) PFOR(T);TAB(60) PA(T)
38050 RN = P4
38060 GOSUB 54427
38065 GOSUB 40000
38067 RN = P4
38068 GOSUB 54427
38070 PRINT P4;TAB(6)"SOLUTION ";S1$;" SUCCESS ";SS
38080 IF PPRT > 1 THEN LPRINT P4;TAB(6)"SOLUTION ";S1$;" SUCCESS ";SS
38085 IF PPRT = 3 THEN GOSUB 34000
38200 RETURN
38218 S2H = S2
39000 REM CONT
39010 IF NBRT = 250 THEN PRINT " THERE ARE TOO MANY PROBLEMS TO DO A SEARCH "
39020 IF NBRT = 250 THEN PRINT " A SEARCH MAY ONLY BE CONDUCTED ON 249 OR LESS PROBLEMS "
39100 PRINT "DO YOU WANT TO CONDUCT A SEARCH FOR ALL AND MULTIPLE SOLUTIONS ?"
39110 PRINT " 1 - YES SEARCH "
39120 PRINT " 2 - NO "
39130 GOSUB 60000
39140 IF DT# < 1 OR DT# > 2 THEN 39100
39150 IF DT# = 2 THEN 20000
39200 REM **** START SEARCH
39210 FOR S = 1 TO MRN3
39215 NPRT = 1
39217 RN = S
39220 GOSUB 54427
39225 IF S2 < 1 THEN 39290
39230 FOR N = 1 TO NBRT
39235 IF ABS(S2H) > 1 THEN RN = S
39237 IF ABS(S2H) > 1 THEN GOSUB 54427
39240 T = PBM(N)
39250 SS = 0
39260 GOSUB 40000
39270 IF ABS(SS) > 0 THEN GOSUB 39500
39280 NEXT N
39290 NEXT S
39300 PRINT "******* PRESS ANY KEY TO CONTINUE *******"
39310 IF INKEY$ = "" THEN 39310
39480 GOTO 20000
39500 REM PRINT PROBLEM
39502 RN = S
39504 GOSUB 54427
39510 RN = T
39520 GOSUB 54200
39530 IF NPRT = 1 THEN PRINT S;"SOLUTION ";S1$;" SOLVES :"
39535 IF NPRT = 1 AND PPRT > 1 THEN LPRINT S;"SOLUTION ";S1$;" SOLVES :"
39540 PRINT T;TAB(6) P1$;" SUCCESS RATE";SS
39545 IF PPRT > 1 THEN LPRINT T;TAB(6) P1$;" SUCCESS RATE";SS
39550 NPRT = 0
39560 RETURN
39980 GOTO 20000
40000 REM * DETERMINE PROBABILIYTY OF SUCCESS
40100 IF T = S4 THEN SS = S5
40110 IF T = S6 THEN SS = S7
40120 IF T = S8 THEN SS = S9
40130 IF T = S10 THEN SS = S11
40140 IF T = S12 THEN SS = S13
40145 IF ABS(S2) > 1 THEN GOTO 40200
40150 RETURN
40200 REM *** SOLUTIONS CONTINUED
40210 RN = ABS(S2)
40215 S2H = S2
40220 GOSUB 54427
40230 GOTO 40000
41000 REM ** PRINT OUT QUESTIONS
41100 GOSUB 500
41110 PRINT " DO YOU WANT "
41120 PRINT " 1 - ONLY QUESTIONS ANSWERED SHOWN"
41130 PRINT " 2 - ALL QUESTIONS SHOWN "
41140 GOSUB 60000
41150 IF DT# < 0 OR DT# > 2 THEN 41000
41155 IF DT# = 0 THEN 20000
41160 QT = DT#
41170 PRINT " DO YOU WANT "
41180 PRINT " 1 - SHOWN ON THE SCREEN ONLY "
41190 PRINT " 2 - SHOWN ON THE SCREEN AND PRINTED ON PAPER"
41195 PRINT " MAKE SURE YOUR PRINTER IS ON "
41200 GOSUB 60000
41210 IF DT# < 1 OR DT# > 2 THEN 41170
41220 PRTFLG = DT#
41300 REM *** START LOOP
41310 FOR T = 1 TO MRN1
41315 IF INKEY$ >< "" THEN GOSUB 42000
41320 IF ANS(T) = -999 AND QT = 1 THEN 41700
41330 RN = T
41340 GOSUB 54000
41345 IF Q3 < 0 THEN 41700
41350 PRINT T;TAB(5);Q$;
41355 IF ANS(T) = -999 THEN PRINT TAB(60) "NA" ELSE PRINT TAB(60) ANS(T)
41360 IF PRTFLG = 2 THEN LPRINT T;TAB(5);Q$;
41362 IF PRTFLG = 2 THEN GOSUB 41800
41364 GOSUB 17000
41365 REM IF PRTFLG = 2 THEN GOSUB 17200
41700 NEXT T
41710 PRINT " PRESS ANY KEY TO CONTINUE "
41720 IF INKEY$ = "" THEN 41720
41730 GOTO 20000
41800 IF ANS(T) = -999 THEN LPRINT TAB(60) "NA" ELSE LPRINT TAB(60) ANS(T)
41810 RETURN
42000 REM ****** PAUSE SUBROUTINE
42100 PRINT " PRESS ANY KEY TO CONTINUE "
42110 IF INKEY$ = "" THEN 42110
42120 RETURN
50000 REM ********** INTRO
50010 GOSUB 500
50100 PRINT " E X P E R T S Y S T E M P R O G R A M 1.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50950 PRINT "*********************** DO YOU WANT TO ************************"
50960 PRINT " 1 - START A NEW PROBLEM "
50970 PRINT " 2 - CONTINUE WITH A PROIR ANALYSIS "
50975 PRINT "*************** ENTER THE NUMBER THEN PRESS RETURN *************"
50980 GOSUB 60000
50985 IF DT# <1 OR DT# > 2 THEN 50000
50990 RETURN
51000 REM ***** EXIT TO SYSTEM
51010 GOTO 51200
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
51200 REM WANRING
51210 GOSUB 500
51220 PRINT " YOU WILL LOSE YOUR ANSWERS UNLESS YOU HAVE PREVIOUSLY SAVED THEM"
51230 PRINT ""
51240 PRINT " DO YOU WANT TO :"
51250 PRINT " 1 - EXIT THE PROGRAM "
51260 PRINT " 2 - RETURN TO OPTIONS "
51270 PRINT " ENTER THE NUMBER THEN PRESS RETURN "
51280 GOSUB 60000
51290 IF DT# < 1 OR DT# > 2 THEN 51280
51300 ON DT# GOTO 51100,19000
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT " Put the Expert System disk the default disk drive "
52110 PRINT ""
52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
52130 PRINT ""
52140 PRINT " The Expert System ONLY uses the Expert System Disk "
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
53000 REM OPEN AND FIELD FILES
53100 OPEN "R",#1,"QUESTION",56
53110 FIELD #1, 50 AS Q$,2 AS Q2$,2 AS Q3$,2 AS Q4$
53200 OPEN "R",#2,"PROBLEMS",120
53210 FIELD #2, 50 AS P1$,2 AS P2$,2 AS P3$,2 AS P4$,2 AS P5$,2 AS P6$, 2 AS P7$, 2 AS P8$,4 AS P9$,4 AS P10$,2 AS P11$,2 AS P12$,4 AS P13$,4 AS P14$,2 AS P15$,2 AS P16$
53220 FIELD #2,88 AS DY$,4 AS P17$,4 AS P18$,2 AS P19$,2 AS P20$,4 AS P21$,4 AS P22$,2 AS P23$,2 AS P24$,4 AS P25$,4 AS P26$
53300 OPEN "R",#3,"SOLUTION",74
53310 FIELD #3, 50 AS S1$, 2 AS S2$,2 AS S3$,2 AS S4$,2 AS S5$,2 AS S6$,2 AS S7$,2 AS S8$,2 AS S9$,2 AS S10$,2 AS S11$,2 AS S12$,2 AS S13$
53350 REM GET MAXIMUM NUMBER OF RECORDS
53360 MRN1 = LOF(1) / 56
53370 MRN2 = LOF(2) / 120
53380 MRN3 = LOF(3) / 74
53400 RETURN
54000 REM get and convert files
54010 KTQ = KTQ + 1
54100 REM question file
54105 GET #1,RN
54110 Q2 = CVI(Q2$)
54120 Q3 = CVI(Q3$)
54130 Q4 = CVI(Q4$)
54140 ACT(KTQ) = RN
54160 IF KTQ > 24 THEN KTQ = 1
54170 RETURN
54200 REM PROBLEM FILE
54203 GET #2,RN
54205 P2 = CVI(P2$)
54210 P3 = CVI(P3$)
54220 P4 = CVI(P4$)
54230 P5 = CVI(P5$)
54240 P6 = CVI(P6$)
54250 P7 = CVI(P7$)
54260 P8 = CVI(P8$)
54270 P9!= CVS(P9$)
54280 P10 = CVS(P10$)
54290 P11 = CVI(P11$)
54300 P12 = CVI(P12$)
54310 P13!= CVS(P13$)
54320 P14 = CVS(P14$)
54330 P15 = CVI(P15$)
54340 P16 = CVI(P16$)
54350 P17!= CVS(P17$)
54360 P18 = CVS(P18$)
54370 P19 = CVI(P19$)
54380 P20 = CVI(P20$)
54390 P21!= CVS(P21$)
54400 P22 = CVS(P22$)
54410 P23 = CVI(P23$)
54420 P24 = CVI(P24$)
54422 P25!= CVS(P25$)
54424 P26 = CVS(P26$)
54426 RETURN
54427 GET #3, RN
54428 S2 = CVI(S2$)
54430 S3 = CVI(S3$)
54440 S4 = CVI(S4$)
54450 S5 = CVI(S5$)
54460 S6 = CVI(S6$)
54470 S7 = CVI(S7$)
54480 S8 = CVI(S8$)
54490 S9 = CVI(S9$)
54500 S10 = CVI(S10$)
54510 S11 = CVI(S11$)
54520 S12 = CVI(S12$)
54530 S13 = CVI(S13$)
54540 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60245 NFLG = 0
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60425 IF W$ = "N" OR W$ = "n" THEN GOTO 63100
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM ********** RETURN **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 IF SPRT >< 5 THEN PRINT ""
60655 SPRT = 0
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM ******* INPUT NOT ACCEPTABLE ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# = -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 SS4$ = INKEY$
61915 IF SS4$ = "" THEN RETURN
61920 C2 = ASC(SS4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM ********** ALPHANUMERIC CHECK **************
62010 REM MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ******** MAX SET IN PROGRAM ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4 GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM ********** RETURN **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT > KTMAX GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
63100 REM N for no answer
63110 IF NEFLG >< 5 THEN 60430
63120 DT# = -999
63130 PRINT "NA"
63135 NFLG = 5
63140 RETURN
REM.BAS
3 PRINT FRE(0) / PRINT FREE MEMORY
4 DEFINT B-D,G-Z / DEFINE AS INTEGERS
5 DIM ANS(3000) / ANSWERS
13 DIM SB(1000) / SUBPROBLEM TO
16 DIM PRI(1000) / PRIORITY
35 DIM K$(80) / COUNT FOR STRING LENGTH
40 DIM PFOR(1000) / PROBABILITY FOR
45 DIM PA(1000) / PROBABILITY AGAINST
50 DIM EVAL(1000) / EVALUATED
60 DIM PBM(200) / PROBLEM NUMBER
65 DIM ACT(25) / ACCEPTABLE PROBLEM NUMBER
70 CH = 8 / BACKSPACE CHARACTER
75 PRINT FRE(0) / PRINT FREE MEMORY
80 GOSUB 52000 / INTRODUCTION
100 GOSUB 50000 / ASK IF START A NEW PROBLEM / CONTINUE WITH OLD PROBLEM
150 IF DT# = 2 THEN GOSUB 36000 / IF OLD PROBLEM THEN READ FILE
200 GOSUB 53000 / OPEN AND FIELD FILES
300 IF DT# = 1 THEN GOSUB 10000 /IN NEW ANALYSIS THEN ASK INTRODUCTORY QUESTIONS
310 GOSUB 12000 / READ SUBPROBLEMS AND PRIORITY INTO MEMORY
320 GOTO 20000 / START
500 REM ******* CLS
510 CLS /CLEAR SCREEN
520 RETURN
8000 REM ***** FILE NAME ACCEPLABLE TEST ************
8010 TEST = 1 / INITIALIZE TO TEST OK
8100 FOR Q = 1 TO LEN(A$) / FOR THE LENGTH OF THE STRING
8110 K$(Q) = MID$(A$,Q,1) / THE Q'th character in the string
8120 C = ASC(K$(Q)) / ASCII VALUE
8130 IF C < 48 OR C > 122 THEN TEST = 4 / IF NOT A LETTER OR NUMBER THEN TEST NOT OK
8140 IF Q = 1 AND ( C < 65 OR C > 122 ) THEN TEST = 4 / IF FIRST CHARACTER AND TEST NOT A LETTER THEN FAIL TEST
8150 NEXT Q / NEXT CHARACTER
8190 RETURN
10000 REM INITAL ASK ALL QUESTIONS
10010 GOSUB 500 / CLEAR SCREEN
10020 NEFLG = 5
10030 PRINT " START A NEW ANALYSIS "
10035 PRINT ""
10040 PRINT " The computer will ask you the introductory questions "
10045 PRINT ""
10050 PRINT " Answer the questions by entering the answer then press return "
10055 PRINT ""
10060 PRINT " You may enter N for no answer"
10065 PRINT ""
10070 PRINT " PRESS ANY KEY TO CONTINUE "
10080 IF INKEY$ = "" THEN 10080 / STAY HERE UNTILL ANY KEY IS PRESSED
10100 FOR R = 1 TO MRN1 / FOR ALL RECORDS IN THE SOLUTION FILE
10103 ANS(R) = -999 / ANSWER EQUALS NO ANSWER
10104 RN = R / RECORD NUMBER EQUALS R
10105 GOSUB 54100 / GET QUESTION
10110 IF Q2 = 2 THEN GOSUB 10200 / IF AN INTRODUCTORY QUESTION, ALWAYS ASKED THEN ASK
10120 NEXT R
10125 NEFLG = 0 /NEW ENTRY FLAG OFF
10130 RETURN
10200 REM ASK QUESTION
10210 GOSUB 500 /CLEAR SCREEN
10240 PRINT Q$ /PRINT QUESTION
10250 IF ABS(Q3) > 1 THEN 10400 /IF QUESTION IS CONTINUED
10260 GOSUB 60120 / INPUT ANSWER TO THE QUESTION
10265 IF DT# = -999 AND NFLG = 0 THEN 10500 / DO NOT ACCEPT -999 AS AN ANSWER
10270 ANS(R) = DT# / ANSWER
10290 RETURN
10400 REM PRINT CONTINUED QUESTIONS
10410 RN = ABS(Q3)
10420 GOSUB 54100 /GET RECORD
10430 PRINT Q$ /PRINT CONTINUED QUESTION
10440 GOTO 10250 / BACK TO ANSWER QUESTION
10500 REM DONT ACCEPT -999
10510 PRINT " THE COMPUTER WILL NOT ACCEPT -999 FOR AN ANSWER BECAUSE IT IS THE "
10520 PRINT " CODE FOR NO ANSWER "
10530 PRINT " PLEASE GIVE ANOTHER ANSWER FOR THE QUESTION "
10540 GOTO 10260
10600 REM DONT ACCEPT -999
10610 PRINT " THE COMPUTER WILL NOT ACCEPT -999 FOR AN ANSWER BECAUSE IT IS THE "
10620 PRINT " CODE FOR NO ANSWER "
10630 PRINT " PLEASE GIVE ANOTHER ANSWER FOR THE QUESTION "
10640 GOTO 31130
11000 REM READ OLD DATA
12000 REM READ SUBPROBLEMS AND PRIORITY
12100 FOR T = 1 TO MRN2 / FOR ALL PROBLEMS
12110 GET #2,T / GET PROBLEM RECORD
12120 SB(T) = CVI(P2$) / SUBPROBLEM TOO
12130 PRI(T) = CVI(P3$) / PRIORITY
12140 NEXT T
12150 RETURN
17000 REM CHECK FOR CONTINUED QUESTIONS
17100 IF ABS(Q3) <= 1 THEN RETURN /IF QUESTION NOT CONTINUED THEN RETURN
17110 RN = ABS(Q3) / RECORD NUMBER EQUALS ABSOLUTE VALUE OF Q3
17120 GOSUB 54000 / GET QUESTION
17122 KTQ = KTQ - 1 / DECREMENT QUESTION COUNT
17130 PRINT TAB(8) Q$ / PRINT CONTINUED QUESTION
17135 IF PRTFLG = 2 THEN LPRINT TAB(8)Q$ / IF LINE PRINT FLAG THEN PRINT ON PAPER
17140 GOTO 17100 / GO BACK TO SEE IF QUESTION IS CONTINUED FURTHER
17200 RN = T
17208 IF ABS(Q3) <= 1 THEN RETURN /IF QUESTION NOT CONTINUED THEN RETURN
17210 RN = ABS(Q3) / RECORD NUMBER EQUALS ABSOLUTE VALUE OF Q3
17220 GOSUB 54000 / GET RECORD NUMBER
17230 LPRINT TAB(8) Q$ / PRINT QUESSTION
17240 GOTO 17200 / GO BACK TO CHECK IF FURTHER CONTINUED
18000 REM PRINT SINGLE PROBLEM AND SUPPORTING EVIDENCE
18010 PRINT "****** MAKE SURE YOUR PRINTER IS ON ******"
18100 PRINT "WHICH PROBLEM DO YOU WANT PRINTED ON PAPER ?"
18105 PRINT " ENTER 0 TO RETURN "
18110 GOSUB 60060 /INPUT INTEGER SUBROUTINE
18115 IF DT# = 0 THEN 20000 / OPTION TO RETURN
18120 RN = DT# / RECORD NUMBER EQUALS NUMBER ENTERED
18130 GOSUB 54200 /GET PROBLEM
18140 LPRINT RN;P1$;TAB(60) PFOR(RN);TAB(65) PA(RN) /PRINT RECORD NUMBER, PROBLEM DESCRIPTION, PROBABLITY FOR AND AGAINST
18145 T = RN
18150 GOSUB 34000 / PRINT SUPPORTING QUESTIONS
18160 GOTO 20000 /BACK TO START
19000 REM **** OPTIONS MENU
19100 PRINT "** OPTIONS ** 0 - NONE 1 - SAVE 2 - PRINT OPTIONS DISPLAYED ON PAPER "
19110 PRINT "3 - REVIEW ALL PROBLEMS 4 - ALL QUESTIONS & ANSWERS 5 - PRINT PROBLEM 6-EXIT"
19150 GOSUB 60000
19160 IF DT# < 0 OR DT# > 6 THEN 19150 /LIMIT CHECK
19170 IF DT# = 0 THEN 20000 /BACK TO START
19180 ON DT# GOTO 35000,24000,37000,41000,18000,51000 /ON OPTION GOTO
20000 REM START SEARCH
20005 LPRTFLG = 0 /LINE PRINT FLAG = NO
20007 KTQ = 0 / QUESTION COUNT 0
20008 PRTFLG = 0 / PRINT FLAG 0
20010 H = 0 / HOLD 0
20020 GOSUB 500 /CLEAR SCREEN
20030 KT = 0 / COUNT 0
20035 IF SB(ND) > 3000 THEN ND = 0 / IF SUBPROBLEM TO > 3000 THEN LET NODE = 0
20040 GOSUB 21000 /PRINT SUBPROBLEMS
20050 PRINT " # PROBLEM ";TAB(60) " + - P CK CONT"
20055 IF LPRTFLG = 1 THEN LPRINT " # PROBLEM ";TAB(60) " + - P CK CONT"
20100 FOR T = 1 TO MRN2 / FOR ALL PROBLEMS
20110 IF SB(T) = ND OR SB(T) = -ND THEN GOSUB 20500 / IF SUBPROBLEM TO THEN PRINT
20120 NEXT T / NEXT PROBLEM
20140 IF ND = 0 AND H = 0 THEN PRINT "END OF COMPUTER RECOMMENDATIONS, EXIT OR CONDUCT MANUAL SEARCH" /ALL START PATHS ALREADY CHECKEC
20150 IF ND <> 0 AND H = 0 THEN PRINT "COMPUTER RECOMMENDS BACKTRACK TO SUBPROBLEM";SB(ND) /ALL PATHS ALREADY CHECKED
20200 PRINT "BRANCH ? * NEGATIVE NBR TO OVERRIDE * 9999 TO OPTIONS *";
20205 IF H > 0 THEN PRINT " COMPUTER RECOMMENDS";H ELSE PRINT " " /PRINT UNEXPLORED PATH WITH HIGHEST PRIORITY
20210 RN = P12 /RECORD NUMBER EQUALS QUESTION RULE 1
20250 GOSUB 60060 / INPUT SUBROUTINE
20252 IF DT# > 9998 THEN 19000 / TO OPTIONS SUBROUTINE
20253 IF ABS(DT#) > MRN2 THEN 20250 / LIMIT CHECK
20255 IF DT# > 0 THEN 30000 / IF GREATER THEN ZERO THEN ASK QUESTIONS
20260 ND = -DT# / NODE
20265 IF SB(ND) < 0 THEN 20250 /REFUSE CONTINUED OR END NODES
20270 GOTO 20000 /START
20500 REM PRINT STARTING NODE ON SCREEN
20504 PB = T /PROBLEM
20505 GOSUB 22000 / COMPUTE PROBABILITY
20510 RN = T /RECORD NUMBER EQUALS T
20520 GOSUB 54200 /GET RECORD
20530 PRINT RN;TAB(6) P1$;TAB(60) PFOR(T);TAB(65) PA(T);TAB(70) P3; /PRINT RECORD NUMBER,PROBLEM,PROBABILTY FOR, AGAINST,
20532 IF EVAL(T) = 1 THEN PRINT TAB(73) "PC "; /PARTIALLY CHECKED
20533 IF EVAL(T) = 0 THEN PRINT TAB(73) "NC "; /NOT CHECKED
20534 IF EVAL(T) = 2 THEN PRINT TAB(73) "C "; / CHECKED
20535 IF SB(T) >-1 THEN PRINT "CONT" ELSE PRINT "END" /
20537 IF PFOR(T) > 89 AND PA(T) > 89 THEN PRINT " PROBABLE CONTRADICTORY EVIDENCE " /IF BOTH PROBABILTY FOR AND AGAINST ARE HIGH THEN PRINT CONTRADICTORY EVIDENCE
20540 KT = KT + 1 /INCREMENT COUNT
20545 IF PRI(T) > PRI(H) AND EVAL(T) = 0 THEN H = T /IF HIGHER PRIORITY THEN
20547 IF LPRTFLG = 1 THEN GOSUB 20600 /IF LINE PRINT FLAG
20550 RETURN
20600 REM PRINT ON PAPER
20630 LPRINT RN;TAB(6) P1$;TAB(60) PFOR(T);TAB(65) PA(T);TAB(70) P3; /PRINT REOCD NUMBER PROBLEM PROBABILTY FOR PROBABILTY AGAINST
20632 IF EVAL(T) = 1 THEN LPRINT TAB(73) "PC "; /PARTIALY CHECKED
20633 IF EVAL(T) = 0 THEN LPRINT TAB(73) "NC "; /NOT CHECKED
20634 IF EVAL(T) = 2 THEN LPRINT TAB(73) "C "; / CHECKED
20635 IF SB(T) >-1 THEN LPRINT "CONT" ELSE LPRINT "END"
20637 IF PFOR(T) > 89 AND PA(T) > 89 THEN LPRINT " PROBABLE CONTRADICTORY EVIDENCE "
20650 RETURN
21000 REM PRINT SUBRECORDS UP TO 0
21005 IF ND = 0 THEN PRINT "AT STARTING NODE 0" /AT STARTING NODE
21006 IF ND = 0 THEN RETURN / IF AT STARTING NODE THEN RETURN
21010 PRINT "SUBPROBLEMS OF :"
21015 IF LPRTFLG = 1 THEN LPRINT "SUBPROBLEMS OF :"
21100 T = ND / NODE
21105 T = ABS(T) / CHANGE NEGITIVES TO POSITIVE
21110 RN = T /RECORD NUMBER
21115 IF RN = 0 THEN RETURN /IF AT STARTING NODE THEN RETURN
21120 GOSUB 54200
21130 PRINT RN;TAB(6) P1$,TAB(60) PFOR(T);TAB(65) PA(T) /PRINT RECORD NUMBER, PROBLEM, PROBABILTY FOR AND PROBABILITY AGAINST
21135 IF LPRTFLG = 1 THEN LPRINT RN;TAB(6) P1$,TAB(60) PFOR(T);TAB(65) PA(T)
21140 T = SB(T) / SUBPROBLEM OF
21145 T = ABS(T) / CHANGE NEGITIVE TO POSITIVE
21150 GOTO 21110 / PRINT NEXT SUBPROBLEM
22000 REM compute probability
22010 PA(PB) = 0 /INITIALIZE TO 0
22020 PFOR(PB) = 0 /INITIALIZE TO 0
22030 DCHKFLG = 0 / DOUBLECHECK FLAG = 0
22100 RN = PB / RECORD NUMBER = PROBLEM NUMBER
22105 RNH = RN /RECORD NUMBER HOLD = RECORD NUMBER
22110 T4= RN
22120 S = SB(T4) / SUBPROBLEM TO RECORD
22125 S = ABS(S) / CHANGE NEGITIVES TO POSITIVE
22128 IF S > 2000 THEN RETURN / IF SUBPROBLEM > 30000 THEN RETURN
22130 IF S = 0 THEN 22300 /END OF SUBPROBLEMS
22140 IF PA(S) > PA(RN) THEN PA(RN) = PA(S) /FIND MAXIMUM PROBILITY AGAINST OF ALL THE SUBPROBLEMS
22150 S = SB(S) / SUBPROBLEM OF
22155 S = ABS(S) / CHANGE NEGITIVES TO POSITIVE
22160 GOTO 22130 / CONTINUE UNTILL AT NODE 0
22300 GOSUB 54200 / GET RECORD
22310 IF ANS(P8) = -999 THEN 22410 /IF NO ANSWER
22315 ANS = ANS(P8) /ANSWER
22320 RT = P7 /RULE TYPE
22330 QN = P8 /QUESTION
22340 FV = P9! /FACT VALUE
22350 PB = P10 /PROBABILITY
22360 GOSUB 23000 /COMPUTE PROBABILITY
22410 IF ANS(P12) = -999 THEN 22510 / IF NO ANSWER
22415 ANS = ANS(P12) / ANSWER
22420 RT = P11 /RULE TYPE
22430 QN = P12 /QUESTION NUMBER
22440 FV = P13! /FACT VALUE
22450 PB = P14 /PROBABILITY
22460 GOSUB 23000 / COMPUTER PROBABILITY
22510 IF ANS(P16) = -999 THEN 22610 / NO ANSWER
22515 ANS = ANS(P16) /ANSWER
22520 RT = P15 /RULE TYPE
22530 QN = P16 /QUESTION NUMBER
22540 FV = P17! /FACT VALUE
22550 PB = P18 PROBABILITY
22560 GOSUB 23000 / COMPUTE PROBABILITY
22610 IF ANS(P20) = -999 THEN 22710 / IF NO ANSWER
22615 ANS = ANS(P20) /ANSWER
22620 RT = P19 / RULE TYPE
22630 QN = P20 / QUESTION NUMBER
22640 FV = P21! FACT VALUE
22650 PB = P22 / PROBABILTY
22660 GOSUB 23000 / COMPUTE PROBABILITY
22710 IF ANS(P24) = -999 THEN 22800 /IF NO ANSWER
22715 ANS = ANS(P24) /ANSWER
22720 RT = P23 /RULE TYPE
22730 QN = P24 /QUESTION NUMBER
22740 FV = P25! /FACT VALUE
22750 PB = P26 /PROBABILITY
22760 GOSUB 23000
22800 REM REDUCE EVALUATION TO PARTIAL CHECK
22810 IF EVAL(RN) = 0 THEN 22880 /SKIP IF NOT EVALUATED
22820 IF EVAL(RN) = 1 THEN 22880 /SKIP IF ALREADY A PARTIAL CHECK
22830 IF ANS(P8) = -999 THEN EVAL(RN) = 1 /IF NOT ANSWERED THEN REDUCE TO A PARTIAL CHECK
22835 IF P11 = 0 THEN 22880 /IF NO QUESTION
22840 IF ANS(P12) = -999 THEN EVAL(RN) = 1 /IF NOT ANSWERED THEN REDUCE TO PARTIAL CHECK
22845 IF P15 = 0 THEN 22880 / IF NO QUESTION THEN CONTINUE
22850 IF ANS(P16) = -999 THEN EVAL(RN) = 1 / IF NOT ANSWERED THE REDUCE TO PARTIAL CHECK
22855 IF P19 = 0 THEN 22880 / IF NO QUESTION THEN CONTINUE
22860 IF ANS(P20) = -999 THEN EVAL(RN) = 1 / IF NOT ANSWERED THEN REDUCE TO PARTIAL CHECK
22865 IF P23 = 0 THEN 22880 / IF NO QUESTION THEN CONTINUE
22870 IF ANS(P24) = -999 THEN EVAL(RN) = 1 /IF NOT ANSWERED THEN REDUCE TO PARTIAL CHECK
22880 IF ABS(P5) > 1 THEN GOTO 22910 / IF CONTINUED
22890 IF DCHKFLG = 5 THEN 22950 / IF DOUBLECHECKED THEN
22900 RETURN
22910 REM COMPUTE PROBABILITY FOR CONTINUED PROBLEMS
22915 RNH = RN /RECORD NUMBER HOLD EQUALS RECORD NUMBER
22918 DCHKFLG = 5 /DOUBLECHECK FLAG
22920 RN = ABS(P5) / RECORD NUMBER EQUALS THE CONTINUED ON
22930 GOSUB 54200 / GET RECORD
22935 RN = RNH /RESTORE RECORD NUMBER
22940 GOTO 22310 / CONTINE TO COMPUTER PROBABILITY
22950 REM RETURN FOR CONTINUED PROBLEMS
22960 RN = RNH /RESTORE RECORD NUMBER
22970 GOSUB 54200 /RESTORE RECORD
22980 RETURN
23000 REM CALCULATE
23010 TEST = 0 / INITIALIZE TO TESET
23020 IF RT = 0 THEN RETURN /IF RULE TYPE 0 NO RULE THEN RETURN
23100 ON RT GOSUB 23500,23600,23700,23800 /ON RULE TYPE
23120 IF TEST = 0 THEN RETURN / IF FAILED TEST THEN RETURN
23130 IF PB < 0 THEN 23300 / IF NEGITIVE PROBABILITY
23140 PFOR(RN) = INT(PFOR(RN) + (100 - PFOR(RN))*(PB/100)) /COMPUTES NEW PROBABILITY FOR
23150 RETURN
23300 PA(RN) = INT(PA(RN) + (100 - PA(RN))*ABS(PB/100)) / COMPUTES NEW PROBABILTY AGAINST
23310 RETURN
23500 REM EQUALS TEST
23510 IF ANS = FV THEN TEST = 1 / IF ANSWER EQUALS FACT VALUE THEN TEST GOOD
23520 RETURN
23600 REM LESS THEN TEST
23610 IF ANS < FV THEN TEST = 1 / IF ANSWER LESS THEN FACT VALUE THEN TEST GOOD
23620 RETURN
23700 IF ANS > FV THEN TEST = 1 / IF ANSWER GREATER THEN FACT VALUE THEN TEST GOOD
23710 RETURN
23800 REM LESS THEN TEST
23810 IF ANS <> FV THEN TEST = 1 / IF ANSWER NOT EQUAL TO FACT VALUE THEN TEST GOOD
23820 RETURN
24000 REM ***** PRINT NODE
24100 LPRTFLG = 1 /LINE PRINT FLAG IS ON
24110 PRINT " MAKE SURE YOUR PRINTER IS ON "
24120 PRINT " PRESS ANY KEY TO CONTINUE "
24130 IF INKEY$ = "" THEN 24130 / STAY HERE UNTILL ANY KEY IS PRESSED
24200 GOTO 20010
30000 REM ASK SEARCH QUESTIONS
30100 RN = ABS(DT#) / CHANGE NEQITIVES TO POSITIVE
30101 IF SB(RN) > 3000 THEN 20000 / IF SUBPROBLEM TO > 3000 THEN BACK TO START
30102 HRN = RN / HOLD RECORD NUMBER EQUALS RECORD NUMBER
30105 EVAL(RN) = 2 / EVALUATION FLAQ = YES
30110 GOSUB 54200 /QET PROBLEM
30120 RN = P8 / RECORD NUMBER
30130 GOSUB 54000 /QET QUESTION
30140 PRINT KTQ;P8;TAB(10) Q$; /PRINT QUESTION
30145 IF ANS(P8) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P8); /PRINT NO ANSWER OR ANSWER
30150 R = P7 /RULE
30160 GOSUB 32000 / PRINT = OR < OR >
30170 PRINT P9!;" ";TAB(75)P10 /PRINT FACT VALUE, PROBABILITY
30180 GOSUB 17000 / CHECK FOR CONTINUED QUESTION
30200 IF P11 = 0 THEN 31000 / IF NO MORE QUESTIONS THEN
30210 RN = P12 / RECORD NUMBER
30220 GOSUB 54000 / GET QUESTION
30230 PRINT KTQ;P12;TAB(10) Q$; /PRINT QUESTION
30245 IF ANS(P12) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P12);
30250 R = P11
30260 GOSUB 32000 /PRINT = > <
30270 PRINT P13!;" ";TAB(75)P14 /PRINT FACT VALUE PROBABLITY
30280 GOSUB 17000 / CHECK FOR CONTINUED PROBLEM
30300 IF P15 = 0 THEN 31000 / IF NO MORE QUESTIONS THEN
30310 RN = P16 / RECORD NUMBER
30320 GOSUB 54000 / GET QUESTION
30330 PRINT KTQ;P16;TAB(10) Q$; / PRINT QUESTION
30345 IF ANS(P16) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P16);
30350 R = P15 /RULE
30360 GOSUB 32000 /PRINT = < >
30370 PRINT P17!;" ";TAB(75) P18 /PRINT FACT VALUE, PROBABILITY
30380 GOSUB 17000 / CHECK FOR CONTINUED QUESTIONS
30400 IF P19 = 0 THEN 31000 / IF NO MORE QUESTIONS THEN
30410 RN = P20 / RECORD NUMBER
30420 GOSUB 54000 / GET QUESTION
30430 PRINT KTQ;P20;TAB(10) Q$; / PRINT QUESTION
30445 IF ANS(P20) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P20);
30450 R = P19 / RULE
30460 GOSUB 32000 / PRINT = > <
30470 PRINT P21!;" ";TAB(75) P22 / PRINT FACT VALUE PROBABILITY
30480 GOSUB 17000 / CHECK FOR CONTINUED QUESTION
30500 IF P23 = 0 THEN 31000 / IF NO MORE QUESTIONS THEN
30510 RN = P24 / RECORD NUMBER
30520 GOSUB 54000 /GET QUESTION
30530 PRINT KTQ;P24;TAB(10) Q$; /PRINT QUESTION
30545 IF ANS(P24) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P24);
30550 R = P23 /RULE
30560 GOSUB 32000 / PRINT = > <
30570 PRINT P25!;" ";TAB(75) P26
30580 GOSUB 17000 /CHECK FOR CONTINED QUESTION
30600 GOTO 32300 / CHECK FOR CONTINUED PROBLEM
31000 PRINT "WHAT QUESTION ? ";"1 TO ";KTQ;", 0 for NONE, THEN ENTER THE ANSWER"
31100 GOSUB 60000 / INPUT SUBROUTINE
31110 IF DT# < 1 THEN 33000 / IF NO ANSWERS
31115 IF DT# > KTQ THEN 31000 / IF NUMBER EXCEEDS MAXIMUM QUESTION THEN
31120 H = ACT(DT#) / THE QUESTION RECORD NUMBER
31122 NEFLG = 5 / FLAG ON
31130 GOSUB 60120 / INPUT SINGLE PRECISION SUBROUTINE
31132 IF DT# = -999 AND NFLG = 0 THEN 10600 / DONT ACCEPT -999 AS AN ANSWER
31133 NEFLG = 0 / FLAG OFF
31140 ANS(H) = DT# / ANSWER EQUALS VALUE ENTERED
31500 GOTO 31000 / ASK FOR ANOTHER QUESTION
31600 REM CHECK FOR ACCEPTABLE QUESTION TO ANSWER / not used anymore
31605 TEST = 0
31610 FOR T1 = 1 TO KTQ
31620 IF H = ACT(T1) THEN TEST = 1
31630 NEXT T1
31640 IF TEST = 0 THEN 31000
31650 GOTO 31130
32000 REM PRINT RULE
32100 IF R = 1 THEN PRINT "=";
32110 IF R = 2 THEN PRINT "<";
32120 IF R = 3 THEN PRINT ">";
32130 IF R = 4 THEN PRINT "<>";
32140 RETURN
32200 IF R = 1 THEN LPRINT "=";
32210 IF R = 2 THEN LPRINT "<";
32220 IF R = 3 THEN LPRINT ">";
32230 IF R = 4 THEN LPRINT "<>";
32240 RETURN
32300 REM ***** ADDITIONAL RULES FOR THE PROBLEM
32310 IF ABS(P5) < 2 THEN 31000 / IF NO MORE RULES THEN ASK QUESTION
32320 RN = ABS(P5) / RECORD NUMBER EQUALS RECORD NUMBER CONTINED ON
32330 GOTO 30110 / SHOW QUESTIONS ON SCREEN AGAIN
32400 REM ***** ADDITIONAL RULES FOR THE PROBLEM
32410 IF ABS(P5) < 2 THEN 34600 / IF NO MORE RULES
32420 RN = ABS(P5) / RECORD NUMBER EQUALS RECORD NUMBER CONTINUED ON
32430 GOTO 34110
33000 REM / change nodes
33100 PB = HRN / PROBLEM EQUALS HOLD RECORD NUMBER
33110 GOSUB 22000 / COMPUTE PROBABILITY
33115 IF SB(HRN) < 0 THEN 33130 / IF NO MORE SUBRECORDS
33120 IF PFOR(HRN) > 40 AND PA(HRN) <40 THEN ND=HRN / IF PROBABILTY FOR IS GREATER THEN 40 AND PROBABILITY AGAINS IS LESS THEN 40 THEN NODE EQUALS HOLD RECORD
33130 GOTO 20000
34000 REM PRINT ON PAPER QUESTIONS / this section is the same as the 30000
34100 RN = T / SECTION EXCEPT FOR THE PRINTS ARE
34102 HRN = RN / LPRINT
34110 GOSUB 54200
34120 RN = P8
34130 GOSUB 54000
34140 LPRINT P8;TAB(8) Q$;
34145 IF ANS(P8) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P8);
34150 R = P7
34160 GOSUB 32200
34170 LPRINT P9!;" ";P10
34180 GOSUB 17200
34200 IF P11 = 0 THEN 34600
34210 RN = P12
34220 GOSUB 54000
34230 LPRINT P12;TAB(8) Q$;
34245 IF ANS(P12) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P12);
34250 R = P11
34260 GOSUB 32200
34270 LPRINT P13!;" ";P14
34280 GOSUB 17200
34300 IF P15 = 0 THEN 34600
34310 RN = P16
34320 GOSUB 54000
34330 LPRINT P16;TAB(8) Q$;
34345 IF ANS(P16) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P16);
34350 R = P15
34360 GOSUB 32200
34370 LPRINT P17!;" ";P18
34380 GOSUB 17200
34400 IF P19 = 0 THEN 34600
34410 RN = P20
34420 GOSUB 54000
34430 LPRINT P20;TAB(8) Q$;
34445 IF ANS(P20) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P20);
34450 R = P19
34460 GOSUB 32200
34470 LPRINT P21!;" ";P22
34480 GOSUB 17200
34500 IF P23 = 0 THEN 34600
34510 RN = P24
34520 GOSUB 54000
34530 LPRINT P24;TAB(8) Q$;
34545 IF ANS(P24) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P24);
34550 R = P23
34560 GOSUB 32200
34570 LPRINT P25!;" ";P26
34580 GOSUB 17200
34590 GOTO 32400
34600 RETURN
35000 REM SAVE
35010 GOSUB 500 / CLEAR SCREEN
35100 PRINT " WHAT FILE NAME DO YOU WANT TO SAVE THIS ANALYSIS UNDER"
35110 PRINT " Eight Characters or less no spaces "
35115 PRINT "Just Press return if you do not want to save at this time"
35120 MAX = 8 / STRING LENGTH EQUALS 8
35130 GOSUB 62030 / STRING INPUT SUBROUTINE
35135 IF A$ = "" THEN 20000 / BACK TO START
35140 GOSUB 8000 /CHECK FOR ACCEPTABLE FILE NAME
35150 IF TEST = 4 THEN 35000 / IF BAD FILE NAME
35160 CLOSE #3 / CLOSE FILE 3
35170 OPEN "O",#3,A$ / OPEN A SEQUENTIAL ACCESS FILE WITH NAME THAT WAS JUST ENTERED
35180 WRITE #3, MRN1,MRN2,MRN3 / STORE NUMBER OF QUESTIONS, NUMBER OF PROBLEMS, NUMBER OF SOLUTINS
35190 FOR T = 1 TO MRN1 / FOR ALL QUESTION
35200 WRITE #3, ANS(T) / SAVE ANSWERS
35210 NEXT T
35220 FOR T = 1 TO MRN2 / FOR ALL PROBLEMS
35230 WRITE #3, PFOR(T),PA(T),EVAL(T) / SAVE PROBABILITY FOR, PROBABILTY AGAINST AND EVALUATION
35240 NEXT T
35245 CLOSE #3
35250 GOSUB 53300 / REOPEN SOLUTION FILE
35260 GOTO 20000 / TO START
36000 REM READ SAVED FILES
36100 GOSUB 500 /CLEAR SCREEN
36110 PRINT "DIRECTORY OF ALL FILES ON THE DEFAULT DISK DRIVE :"
36115 PRINT ""
36120 FILES
36130 PRINT "ENTER THE NAME OF THE FILE THAT YOU PREVIOUSLY STORED AN ANALYSIS ON"
36135 PRINT ""
36140 MAX = 8 /LENGTH OF STRING TO INPUT
36150 GOSUB 62030 /INPUT STRING SUBROUTINE
36160 GOSUB 8000 / CHECK FOR VALID FILE NAME
36165 IF TEST = 4 THEN 36000 /IF TEST BAD THEN ASK FOR A NEW FILE NAME
36170 OPEN "I",#3,A$ / OPEN THE FILE
36180 INPUT #3, MRN1,MRN2,MRN3 / READ MAXIMUM RECORD NUMBER FOR QUESTION PROBLEM AND SOLUTIONS
36190 FOR T = 1 TO MRN1 / FOR ALL QUESTIONS
36200 INPUT #3, ANS(T) /READ ANSWERS
36210 NEXT T
36220 FOR T = 1 TO MRN2 / FOR ALL PROBLEMS
36230 INPUT #3, PFOR(T),PA(T),EVAL(T) / READ PROBABILITY FOR, PROBABILTY AGAINST AND EVALUATION
36240 NEXT T
36245 CLOSE #3
36260 RETURN
37000 REM PRINT OUT ALL PROBLEMS
37010 NBRT = 0 / NUMBER OF PROBLEMS EQUALS
37100 GOSUB 500 /CLEAR SCREEN
37110 PRINT " PRINT OUT PROBLEMS "
37115 PRINT ""
37120 PRINT " DO YOU WANT TO CHECK ALL PROBLEMS OR ONLY THOSE SEARCHED ?"
37125 PRINT " 0 - RETURN"
37130 PRINT " 1 - ONLY THOSE AREADY SEARCHED "
37140 PRINT " 2 - ALL - TAKES ALOT LONGER "
37150 GOSUB 60000 / INPUT INTEGER SUBROUTINE
37155 IF DT# < 0 OR DT# > 2 THEN 37100 / LIMITS CHECK
37160 IF DT# = 0 THEN 20000 / TO START
37170 PEVAL = DT# / PROBLEM EVALUTION EQUALS NUMBER INPUT
37200 PRINT " PRINT OUT ALL PROBLEMS WITH A PROBABLILY FOR HIGHER THEN "
37210 PRINT " ENTER A NUMBER FROM -1 TO 100"
37220 GOSUB 60060
37222 IF DT# = -1 THEN 37230
37225 IF DT# < 0 OR DT# > 100 THEN 37200 / LIMITS CHECK
37230 FMIN = DT# /FOR MINIMUM
37240 PRINT " AND WHOSE PROBABLITY AGAINST IS LOWER THEN "
37250 PRINT " ENTER A NUMBER FROM 0 TO 101 "
37260 GOSUB 60060 /INPUT SUBROUTIME FOR INTEGERS
37265 IF DT# < 0 OR DT# > 101 THEN 37240 /LIMITS CHECK
37270 AMAX = DT# /AGAINST MAXIMUM
37300 PRINT " DO YOU WANT THE PROBLEMS "
37310 PRINT " 1 - SHOWN ON THE SCREEN ONLY "
37320 PRINT " 2 - PRINTED ON PAPER AND SHOWN ON THE SCREEN"
37325 PRINT " 3 - PRINTED ON PAPER WITH SUPPORTING RULES "
37330 GOSUB 60000 / INPUT SUBROUTINE
37340 IF DT# < 1 OR DT# > 3 THEN 37300 /LIMITS CHECK
37350 PPRT = DT# /PRINT FLAG
37400 REM ***** START LOOP
37410 FOR T = 1 TO MRN2 / FOR ALL PROBLEMS
37420 IF PEVAL = 1 AND EVAL(T) = 0 THEN 37600 / IF NOT EVALUATED AND ON TO CHECK EVALUATED PROBLEMS THEN SKIP
37422 PB = T / PROBLEM
37424 GOSUB 22000 / COMPUTE PROBABILITY
37430 IF PFOR(T) > FMIN AND PA(T) < AMAX THEN GOSUB 38000 / IF MEETS THE PROBABILTY LIMITS
37600 NEXT T
37610 GOTO 39000
38000 REM **** SUBROUTINE FOR PROBLEMS THAT MEET THE LIMITS
38005 NBRT = NBRT + 1 / INCREMENT PROBLEM COUNT
38006 IF NBRT > 250 THEN NBRT = 250 / AT LIMIT OF DIMENSION
38007 PBM(NBRT) = T / THE NBRT'th problem that meets the limits is
38010 RN = T / RECORD NUMBER
38020 GOSUB 54200 / GET PROBLEM
38025 IF P5 < 0 THEN RETURN / IF IS A CONTINUATION THEN RETURN
38030 PRINT T;P1$; TAB(55) PFOR(T); TAB(60) PA(T)
38040 IF PPRT > 1 THEN LPRINT T;P1$;TAB(55) PFOR(T);TAB(60) PA(T)
38050 RN = P4 /RECORD NUMBER
38060 GOSUB 54427 / GET SOLUTION
38065 GOSUB 40000 / DETERMINE PROBABILITY OF SUCCESS
38067 RN = P4 / RECORD NUMBER
38068 GOSUB 54427 / GET SOLUTIN
38070 PRINT P4;TAB(6)"SOLUTION ";S1$;" SUCCESS ";SS
38080 IF PPRT > 1 THEN LPRINT P4;TAB(6)"SOLUTION ";S1$;" SUCCESS ";SS
38085 IF PPRT = 3 THEN GOSUB 34000 / PRINT SUPPORTING QUESTIONS ON PAPER
38200 RETURN
38218 S2H = S2 / SOLUTIN HOLD
39000 REM CONT
39010 IF NBRT = 250 THEN PRINT " THERE ARE TOO MANY PROBLEMS TO DO A SEARCH "
39020 IF NBRT = 250 THEN PRINT " A SEARCH MAY ONLY BE CONDUCTED ON 249 OR LESS PROBLEMS "
39100 PRINT "DO YOU WANT TO CONDUCT A SEARCH FOR ALL AND MULTIPLE SOLUTIONS ?"
39110 PRINT " 1 - YES SEARCH "
39120 PRINT " 2 - NO "
39130 GOSUB 60000 / INPUT SUBROUTINE
39140 IF DT# < 1 OR DT# > 2 THEN 39100 /LIMITS CHECK
39150 IF DT# = 2 THEN 20000 / BACK TO START
39200 REM **** START SEARCH
39210 FOR S = 1 TO MRN3 / FOR ALL SOLUTIONS
39215 NPRT = 1
39217 RN = S /RECORD NUMBER
39220 GOSUB 54427 / GET SOLUTION
39225 IF S2 < 1 THEN 39290 / SKIP IF A CONTINUED SOLUTION
39230 FOR N = 1 TO NBRT / FOR ALL PROBLEMS THAT MEET THE LIMITS
39235 IF ABS(S2H) > 1 THEN RN = S / RESTORE RECORD NUMBER
39237 IF ABS(S2H) > 1 THEN GOSUB 54427 / REGET RECORD
39240 T = PBM(N) / PROBLEM
39250 SS = 0
39260 GOSUB 40000 / GET SUCCESS RATE
39270 IF SS > 0 THEN GOSUB 39500 / PRINT SOLUTION
39280 NEXT N / NEXT PROBLEM
39290 NEXT S / NEXT SOLUTION
39300 PRINT "******* PRESS ANY KEY TO CONTINUE *******"
39310 IF INKEY$ = "" THEN 39310 / STAY HERE UNTILL ANY KEY IS PRESSED
39480 GOTO 20000 / BACK TO START
39500 REM PRINT PROBLEM
39502 RN = S / RECORD NUMBER
39504 GOSUB 54427 / GET SOLUTION
39510 RN = T / RECORD NUMBER
39520 GOSUB 54200 / GET PROBLEM
39530 IF NPRT = 1 THEN PRINT S;"SOLUTION ";S1$;" SOLVES :" / IF NOT ALREADY PRINTED THEN PRINT
39535 IF NPRT = 1 AND PPRT > 1 THEN LPRINT S;"SOLUTION ";S1$;" SOLVES :" / IF NOT ALREADY PRINTED THEN PRINT
39540 PRINT T;TAB(6) P1$;" SUCCESS RATE";SS
39545 IF PPRT > 1 THEN LPRINT T;TAB(6) P1$;" SUCCESS RATE";SS
39550 NPRT = 0 / ALREADY PRINTED
39560 RETURN
39980 GOTO 20000
40000 REM * DETERMINE PROBABILIYTY OF SUCCESS
40100 IF T = S4 THEN SS = S5 / IF THE PROBLEM NUMBER THEN SUCCESS RATE IS
40110 IF T = S6 THEN SS = S7 / " "
40120 IF T = S8 THEN SS = S9 / " "
40130 IF T = S10 THEN SS = S11/ " "
40140 IF T = S12 THEN SS = S13/ " "
40145 IF ABS(S2) > 1 THEN GOTO 40200 / IF CONTINUED SOLUTIONS
40150 RETURN
40200 REM *** SOLUTIONS CONTINUED
40210 RN = ABS(S2) / CHANGE NEGATIVES TO POSITIVE
40215 S2H = S2 / SOLUTION HOLD
40220 GOSUB 54427 / GET NEW SOLUTION
40230 GOTO 40000 / CONTINUE TO LOOK FOR SUCCESS RATE
41000 REM ** PRINT OUT QUESTIONS
41100 GOSUB 500 / CLEAR SCREEN
41110 PRINT " DO YOU WANT "
41120 PRINT " 1 - ONLY QUESTIONS ANSWERED SHOWN"
41130 PRINT " 2 - ALL QUESTIONS SHOWN "
41140 GOSUB 60000 / INPUT INTEGERS
41150 IF DT# < 0 OR DT# > 2 THEN 41000 / LIMITS CHECK
41155 IF DT# = 0 THEN 20000 / RETURN TO START
41160 QT = DT#
41170 PRINT " DO YOU WANT "
41180 PRINT " 1 - SHOWN ON THE SCREEN ONLY "
41190 PRINT " 2 - SHOWN ON THE SCREEN AND PRINTED ON PAPER"
41195 PRINT " MAKE SURE YOUR PRINTER IS ON "
41200 GOSUB 60000
41210 IF DT# < 1 OR DT# > 2 THEN 41170 / LIMITS CHECK
41220 PRTFLG = DT# / PRINTFLAG
41300 REM *** START LOOP
41310 FOR T = 1 TO MRN1 / FOR ALL QUESTIONS
41315 IF INKEY$ >< "" THEN GOSUB 42000 / TO PAUSE SUBROUTINE
41320 IF ANS(T) = -999 AND QT = 1 THEN 41700 / SKIP IF NO ANSWER AND OPTION TO SKIP THOSE NOT ANSWERED
41330 RN = T / RECORD NUMBER
41340 GOSUB 54000 /GET QUESTION
41345 IF Q3 < 0 THEN 41700 / IF A CONTINUED QUESTION THEN SKIP
41350 PRINT T;TAB(5);Q$; / PRINT QUESTION
41355 IF ANS(T) = -999 THEN PRINT TAB(60) "NA" ELSE PRINT TAB(60) ANS(T) / PRINT ANSWER
41360 IF PRTFLG = 2 THEN LPRINT T;TAB(5);Q$; / IF PRINTFLAG 1 THEN PRINT
41362 IF PRTFLG = 2 THEN GOSUB 41800
41364 GOSUB 17000 / CHECK FOR CONTINUED QUESTION
41365 REM IF PRTFLG = 2 THEN GOSUB 17200
41700 NEXT T
41710 PRINT " PRESS ANY KEY TO CONTINUE "
41720 IF INKEY$ = "" THEN 41720 / STAY HERE UNTILL A KEY IS PRESSED
41730 GOTO 20000 / BACK TO START
41800 IF ANS(T) = -999 THEN LPRINT TAB(60) "NA" ELSE LPRINT TAB(60) ANS(T)
41810 RETURN
42000 REM ****** PAUSE SUBROUTINE
42100 PRINT " PRESS ANY KEY TO CONTINUE "
42110 IF INKEY$ = "" THEN 42110 / STAY HERE UNTILL A KEY IS PRESSED
42120 RETURN
50000 REM ********** INTRO
50010 GOSUB 500 / CLEAR SCREEN
50100 PRINT " E X P E R T S Y S T E M P R O G R A M 1.0 "
50105 PRINT ""
50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT " See the manual for more information on the license."
50167 PRINT ""
50950 PRINT "*********************** DO YOU WANT TO ************************"
50960 PRINT " 1 - START A NEW PROBLEM "
50970 PRINT " 2 - CONTINUE WITH A PROIR ANALYSIS "
50975 PRINT "*************** ENTER THE NUMBER THEN PRESS RETURN *************"
50980 GOSUB 60000 / INPUT SUBROUTINE
50985 IF DT# <1 OR DT# > 2 THEN 50000 / LIMITS CHECK
50990 RETURN
51000 REM ***** EXIT TO SYSTEM
51010 GOTO 51200 / GIVE WARNING
51100 GOSUB 500 / CLEAR SCREEN
51110 CLOSE / CLOSE ALL FILES
51120 PRINT " -BYE, Have a nice day"
51130 END
51200 REM WANRING
51210 GOSUB 500 / CLEAR SCREEN
51220 PRINT " YOU WILL LOSE YOUR ANSWERS UNLESS YOU HAVE PREVIOUSLY SAVED THEM"
51230 PRINT ""
51240 PRINT " DO YOU WANT TO :"
51250 PRINT " 1 - EXIT THE PROGRAM "
51260 PRINT " 2 - RETURN TO OPTIONS "
51270 PRINT " ENTER THE NUMBER THEN PRESS RETURN "
51280 GOSUB 60000 / INPUT SUBROUTINE
51290 IF DT# < 1 OR DT# > 2 THEN 51280 / LIMITS CHECK
51300 ON DT# GOTO 51100,19000 / ON NUMBER ENTERED GOTO
52000 REM ***** INTRO 1
52010 GOSUB 500 / CLEAR SCREEN
52100 PRINT " Put the Expert System disk the default disk drive "
52110 PRINT ""
52120 PRINT " ***** THEN PRESS ANY KEY TO CONTINUE *****"
52130 PRINT ""
52140 PRINT " The Expert System ONLY uses the Expert System Disk "
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200 /STAY HERE UNTILL ANY KEY IS PRESSED
52210 RETURN
53000 REM OPEN AND FIELD FILES
53100 OPEN "R",#1,"QUESTION",56 / OPEN QUESTON FILE
53110 FIELD #1, 50 AS Q$,2 AS Q2$,2 AS Q3$,2 AS Q4$
53200 OPEN "R",#2,"PROBLEMS",120 / OPEN PROBLEM FILE
53210 FIELD #2, 50 AS P1$,2 AS P2$,2 AS P3$,2 AS P4$,2 AS P5$,2 AS P6$, 2 AS P7$, 2 AS P8$,4 AS P9$,4 AS P10$,2 AS P11$,2 AS P12$,4 AS P13$,4 AS P14$,2 AS P15$,2 AS P16$
53220 FIELD #2,88 AS DY$,4 AS P17$,4 AS P18$,2 AS P19$,2 AS P20$,4 AS P21$,4 AS P22$,2 AS P23$,2 AS P24$,4 AS P25$,4 AS P26$
53300 OPEN "R",#3,"SOLUTION",74 / OPEN SOLUTION FILE
53310 FIELD #3, 50 AS S1$, 2 AS S2$,2 AS S3$,2 AS S4$,2 AS S5$,2 AS S6$,2 AS S7$,2 AS S8$,2 AS S9$,2 AS S10$,2 AS S11$,2 AS S12$,2 AS S13$
53350 REM GET MAXIMUM NUMBER OF RECORDS
53360 MRN1 = LOF(1) / 56 / NUMBER OF QUESTION
53370 MRN2 = LOF(2) / 120 / NUMBER OF PROBLEMS
53380 MRN3 = LOF(3) / 74 / NUMBER OF SOLUTIONS
53400 RETURN
54000 REM get and convert files
54010 KTQ = KTQ + 1 / INCREMENT QUESTION COUNT
54100 REM question file
54105 GET #1,RN / GET QUESTION WITH RECORD
54110 Q2 = CVI(Q2$) / ALWAYS ASKED
54120 Q3 = CVI(Q3$) / CONTINUED ON
54130 Q4 = CVI(Q4$) / DUMMY
54140 ACT(KTQ) = RN / ACCEPTABLE QUESTION EQUALS RECORD NUMBER
54160 IF KTQ > 20 THEN KTQ = 1
54170 RETURN
54200 REM PROBLEM FILE
54203 GET #2,RN
54205 P2 = CVI(P2$) / SUBPROBLEM TO
54210 P3 = CVI(P3$) / PRIORITY
54220 P4 = CVI(P4$) / PRIMARY SOLUTION
54230 P5 = CVI(P5$) / CONTINUED ON RECORD NUMBER
54240 P6 = CVI(P6$) / DUMMY
54250 P7 = CVI(P7$) / RULE TYPE
54260 P8 = CVI(P8$) / QUESTION
54270 P9!= CVS(P9$) / FACT VALUE
54280 P10 = CVS(P10$) / PROBABILITY
54290 P11 = CVI(P11$) / RULE TYPE 2
54300 P12 = CVI(P12$) / QUESTION 2
54310 P13!= CVS(P13$) / FACT VALUE 2
54320 P14 = CVS(P14$) / PROBABILIY 2
54330 P15 = CVI(P15$) / RULE TYPE 3
54340 P16 = CVI(P16$) / QUESTION 3
54350 P17!= CVS(P17$) / FACT VALUE 3
54360 P18 = CVS(P18$) / PROBABILITY 3
54370 P19 = CVI(P19$) / RULE TYPE 4
54380 P20 = CVI(P20$) / QUESTION 4
54390 P21!= CVS(P21$) / FACT VALUE 4
54400 P22 = CVS(P22$) / PROBABILITY 4
54410 P23 = CVI(P23$) / RULE TYPE
54420 P24 = CVI(P24$) / QUESTION
54422 P25!= CVS(P25$) / FACT VALUE
54424 P26 = CVS(P26$) / PROBABILITY
54426 RETURN
54427 GET #3, RN / GET SOLUTION
54428 S2 = CVI(S2$) / CONTINUED ON
54430 S3 = CVI(S3$) / DUMMY
54440 S4 = CVI(S4$) / PROBLEM 1
54450 S5 = CVI(S5$) / SUCCESS RATE 1
54460 S6 = CVI(S6$) / PROBLEM 2
54470 S7 = CVI(S7$) / SUCCESS RATE 2
54480 S8 = CVI(S8$) / PROBLEM 3
54490 S9 = CVI(S9$) / SUCCESS RATE 3
54500 S10 = CVI(S10$) / PROBLEM 4
54510 S11 = CVI(S11$) / SUCCESS RATE 4
54520 S12 = CVI(S12$) / PROBLEM 5
54530 S13 = CVI(S13$) / SUCCESS RATE 5
54540 RETURN
60000 REM ******* INTEGER LESS THEN 100 CHECK ********
60010 MAX = 2 / SEE THE REMARKS FOR THE MAIN PROGAM IF YOU WANT TO SEE HOW THIS INPUT SUBROUTINE WORKS
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM ******* INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM ******* SINGLE PRECISION *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM ******* DOUBLE PRECISION *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60245 NFLG = 0
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
TEMP.BAS
55 ON ERROR GOTO 64200
315 ON ERROR GOTO 64000
500 REM CLEAR SCREEN
510 CALL CSCREEN
520 RETURN
64000 REM
64010 PRINT " ERROR NUMBER ";ERR ; " ON LINE ";ERL
64070 CLOSE
64075 GOSUB 53000
64080 PRINT " PRESS ANY KEY TO CONTINUE"
64090 IF INKEY$ = "" THEN 64090
64100 RESUME 20000
64200 REM
64210 PRINT " ERROR NUMBER ";ERR ; " ON LINE ";ERL
64270 CLOSE
64280 PRINT " PRESS ANY KEY TO CONTINUE"
64290 IF INKEY$ = "" THEN 64290
64300 RESUME 70
Directory of PC-SIG Library Disk #0268
Volume in drive A has no label
Directory of A:\
CLS OBJ 98 1-01-80
CRC TXT 2227 1-10-85 10:56a
EXPERT BAS 29184 1-01-80
EXPERT EXE 72960 6-17-80 12:14a
FFILE 1536 1-01-80
FORM EXE 53504 1-01-80
FORMLIST 128 1-01-80
IDEX 384 1-01-80
IPUTD1 256 1-01-80
IPUTD10 128 1-01-80
IPUTD11 128 1-01-80
IPUTD12 128 1-01-80
IPUTD13 128 1-01-80
IPUTD14 128 1-01-80
IPUTD2 1152 1-01-80
IPUTD3 512 1-01-80
IPUTD4 128 1-01-80
IPUTD5 128 1-01-80
IPUTD6 128 1-01-80
IPUTD7 128 1-01-80
IPUTD8 128 1-01-80
IPUTD9 128 1-01-80
JACK 896 1-01-80
KEYLISTS 578 1-01-80
KYLIST 128 3-10-83 12:50a
PROBLEMS 5160 1-01-80
QUESTION 5600 1-01-80
READ ME 2213 1-01-85 12:30p
REALTIME 128 1-01-80
REM BAS 33920 1-01-80
SCAN EXE 80768 1-01-80
SCREEN2 1024 1-01-80
SCTEST 128 1-01-80
SOLUTION 1280 1-01-80
TEMP BAS 512 6-17-80 12:04a
TEST 896 1-01-80
36 file(s) 296580 bytes
0 bytes free