DataMuseum.dk

top - metrics - download

    Length: 8176 (0x1ff0)
    Notes: OS65UFile, OSU65U-BASIC
    Names: »IFGETI«

└─⟦2f57871a3⟧ Bits:30009355 Ohio Scientific OS-OMS Nucleus, delvist oversat til dansk
    └─⟦this⟧ »IFGETI« 

BASIC

00001 REM IFGETI 'CONDITIONAL RETURN RECORD PROGRAM'
00002 CLEAR: RESTORE: REM STANDARD STARTING LINE
00003 K0=0: K1=1: K2=2: K3=3: K4=4: K5=5: K6=6: K7=7: K8=8: K9=9
00004 REM LINE 10 > 99 FOR FLAGS AND POKES
00005 CLOSE: POKE 2888,0: REM CLOSE ALL FILES AND PERMIT <CR> ONLY ON INPUT
00006 PRINT: INPUT"CONSOLE OR PRINTER ";QA$
00007 PD=1:SW=80:IF LEFT$(QA$,1)="P" THEN PD=5:SW=132
00010 REM FD$(X)=FIELD DESCRIPTOR/FP(X)=RELATIVE OFFSET POSTION OF FIELD
00040 FLAG 6: FLAG 9: FLAG 11: FLAG 21: REM ***********************
00050 FOR X=1 TO 30: PRINT: NEXT X
00070 DV(1)=PEEK(11686):IF LEFT$(QA$,1)="P" THEN DV(1)=5
00080 DV(2)=PEEK(9832):IF DV(2)>127 THEN DV(2)=DV(2)-128+4
00090 REM SUB AT 31000 PERFORMS THE FOLLOWING TASKS
00100 REM PICKS UP AND VERIFYS FILENAME,PASSWORD
00110 REM PICKS UP EODF,BODF,NR,RL,TYPE, AND NAME IN FILE HEADER
00120 REM THE ONLY VARIABLE TO BE SET BEFORE CALLING IS 'CH' (CHANNEL #)
00130 CH=1: GOSUB 31000: REM GO OPEN UP FILE
00140 POKE 2972,13: POKE 2976,13: REM R1* ALLOW , & : IN DATA FIELD
00200 REM ENTER HEADER OR TITLE TO BE PRINTED AT TOP OF PAGE
00205 PRINT
00210 INPUT"ENTER HEADER STATEMENT ";H$:PRINT:IF LEN(H$)<SW-15 THEN GOTO 220
00215 PRINT"**MAXIUM LENGTH OF STATEMENT IS ";SW-15;:PRINT" CHARACTERS**":GOTO210
00220 REM
00290 REM
00300 REM PICKUP CONDITIONAL STUFF
00310 REM
00315 PRINT: INPUT"FIELD NAME ";F1$: IF F1$="" THEN PRINT: PRINT"WHAT": GOTO 315
00320 PRINT: PRINT F1$;" VS CONSTANT (1)"
00330 PRINT F1$;: INPUT" VS CONTENTS (2) ";T1$
00335 T1=VAL(T1$): REM R1* NO MORE 'REDO FROM START'
00340 IF T1<1 OR T1>2 THEN PRINT: PRINT"WHAT": GOTO 320
00350 IF T1<>INT(T1) THEN PRINT: PRINT"WHAT": GOTO 320
00360 IF T1<2 GOTO 400
00370 REM
00380 PRINT: PRINT"NAME OF FIELD ";F1$;: INPUT" IS TO BE COMPARED AGAINST ";C1$
00385 IF C1$="" THEN PRINT: PRINT"WHAT": GOTO 380
00390 REM
00400 NF=1: IF T1>1 THEN NF=NF+1
00410 DIM FD$(NF+1),FP(100),L$(100): REM FD=FIELD NAME/FP=FIELD OFFSET
00420 REM
00460 REM
00470 REM PICKUP CONDTION SPECIFIER
00475 A$="6": IF T1<K2 THEN A$="7"
00480 PRINT:PRINT"IF CONDITIONS POSSIBLE (3-";A$;" FOR NUMERIC VARIABLES ONLY)"
00485 PRINT
00490 PRINT"(1)  ";F1$;" IS EQUAL TO"
00495 PRINT"(2)  ";F1$;" IS NOT EQUAL TO"
00500 PRINT"(3)  ";F1$;" IS LESS THAN"
00505 PRINT"(4)  ";F1$;" IS LESS THAN OR EQUAL TO"
00510 PRINT"(5)  ";F1$;" IS GREATER THAN"
00515 PRINT"(6)  ";F1$;" IS GREATER THAN OR EQUAL TO ";
00516 IF T1<K2 THEN PRINT: GOTO 520
00517 INPUT T2$: T2=VAL(T2$): IF T2<1 OR T2>6 THEN PRINT: PRINT"WHAT": GOTO 480
00519 GOTO 540
00520 PRINT"(7)  ";F1$;: INPUT" IS WITHIN A SPECIFIC RANGE ";T2$
00525 T2=VAL(T2$)
00530 IF T2<1 OR T2>7 THEN PRINT: PRINT"WHAT": GOTO 480
00540 IF T2<>INT(T2) THEN PRINT: PRINT"WHAT": GOTO 480
00550 ON T2 GOTO 580,580,580,580,580,580,560
00560 PRINT: PRINT F1$;: INPUT" CANNOT BE LESS THAN ";R1$: R1=VAL(R1$)
00562 FOR X=1 TO LEN(R1$): T$=MID$(R1$,X,1)
00564 IF (T$="-" OR T$="+") AND LEN(R1$)>1 AND X=1 THEN GOTO 568
00566 IF T$<"0" OR T$>"9" THEN PRINT:PRINT"WHAT": GOTO 560
00568 NEXT X
00570 PRINT F1$;:INPUT" CANNOT BE GREATER THAN ";R2$:R2=VAL(R2$):GOTO590
00572 FOR X=1 TO LEN(R2$): T$=MID$(R2$,X,1)
00574 IF (T$="-" OR T$="+") AND LEN(R2$)>1 AND X=1 THEN GOTO 578
00576 IF T$<"0" OR T$>"9" THEN PRINT: PRINT"WHAT": GOTO 570
00578 NEXT X: GOTO 590
00580 IF T1>1 GOTO 590: REM SKIP ? IF 'COMPARE AGAINST FIELD'
00585 PRINT: PRINT "CONSTANT ";F1$;: INPUT" IS TO BE COMPARED AGAINST ";C1$
00586 IF C1$="" THEN PRINT: PRINT"WHAT": GOTO 585
00590 PRINT: PRINT"PLEASE WAIT": REM VERIFY FIELDS EXIST !!!
00600 FOR X=1 TO NF: FP(X)=1E8: NEXT X: FD$(1)=F1$: FD$(2)=C1$
00610 CH=1: GOSUB 30000: REM GSUB TO VARIFY FIELDS EXIST
00640 REM
00650 IF T1=1 THEN L2=VAL(C1$): REM CHG TO # VAR
00660 REM
00670 GOSUB 33000: REM GOTO SUB TO PICKUP ALL FIELDS AND OFFSETS
00700 REM
00710 KPR=BODF(CH)
00720 GOSUB 32010: REM GOTO 'CONDITIONAL RETURN SUB'
00725 ON F1 GOTO 730,735
00730 FOR X=K1 TO TF: PRINT #PD,L$(X): NEXT
00735 PRINT#PD: PRINT#PD
00740 ON F2 GOTO 720,750
00750 PRINT: PRINT"DONE": GOTO 51110
30000 REM VARIFY FIELDS AND PICKUP THE RELATIVE OFFSETS (FD$(X)&FP(X))
30010 TT=0: FL=0: REM TT=RUNNNING TOTAL / FL=FIELD LENGTH
30020 INDEX<CH>=53: REM PNT AT START OF FIELD DESCRIPTORS
30030 INPUT %CH,X$: REM GET A FIELD DESCRIPTOR
30040 REM NF=# OF FIELDS DESIRED TO BE FOUND
30050 FOR X=1 TO NF: IF FD$(X)=X$ GOTO 30090
30070 NEXT X
30080 GOTO 30100: REM SKIP SINCE NOT FOUND
30090 FP(X)=TT: REM EQUATE TOTAL OFFSET TO APP. FIELD DESCRIPTOR
30100 INPUT %CH,FL: REM UPDATE RUNNING TOTAL OFFSET
30110 TT=TT+FL: REM UPDATE RUNNING TOTAL OFFSET
30120 IF INDEX(CH)<BODF(CH) GOTO 30030: REM GOTO TILL END
30130 IF INDEX(CH)>BODF(CH) THEN ERR$="FILE HEADER ERROR": GOTO 40000
30140 FE=0: FOR X=1 TO NF: IF FP(X)<1E8 GOTO 30160
30150 PRINT: PRINT"NOT ENOUGH DATA IN FILE. FIELD NEEDED IS : ";FD$(X):FE=1
30160 NEXT X: IF FE>0 GOTO 51100
30170 RETURN: REM EVERYTHINGS OK
30180 REM
30190 REM
31000 REM MASTER FILE VERIFICATION SUB
31010 REM PICKUP DEVICE AND VERIFY LEGALITY OF SELECTION
31020 PRINT: INPUT"DEVICE MASTER FILE IS STORED ON ";MD$(CH)
31025 IF MD$(CH)="" THEN PRINT: PRINT"WHAT": GOTO 31020
31030 IF LEN(MD$(CH))>1 THEN PRINT: PRINT"WHAT": GOTO 31020
31040 IF MD$(CH)<"A" OR MD$(CH)>"E" THEN PRINT: PRINT"WHAT": GOTO 31020
31050 REM PICKUP FILENAME,PASSWORD WITH 50000 ERROR CHKING
31060 PRINT: INPUT"MASTER FILE NAME,PASSWORD ";MF$(CH),MP$(CH)
31065 IF MF$(CH)="" OR MP$(CH)="" THEN PRINT: PRINT"WHAT": GOTO 31060
31070 IF LEN(MF$(CH))<5 THEN MF$(CH)=MF$(CH)+" ": GOTO 31070
31080 IF LEN(MF$(CH))=6 AND RIGHT$(MF$(CH),1)="0" GOTO 31100
31085 IF LEN(MF$(CH))>6 THEN PRINT: PRINT"IMPROPER FILENAME": GOTO 31060
31090 IF LEN(MF$(CH))<6 THEN MF$(CH)=MF$(CH)+"0"
31100 IF MP$(CH)="." THEN MP$(CH)="ANAN": REM CHK PASSWORD
31110 IF LEN(MP$(CH))<>4 THEN PRINT: PRINT"IMPROPER PASSWORD": GOTO 31060
31120 REM SELECT DEVICE AND TRY TO OPEN FILE (50000 ERR CHKING)
31130 DEV MD$(CH): REM SELECT NEW DEVICE
31140 OPEN MF$(CH),MP$(CH),CH: REM OPEN FILE 
31150 REM VERIFY FILE NAME IN HEADER MATCHES FILE NAME
31160 INDEX<CH>=0: INPUT %CH,N$: IF N$=LEFT$(MF$(CH),5) GOTO 31180
31170 ERR$="FILE HEADER MISMATCH": GOTO 40000: REM ERR HANDLER
31180 INDEX<CH>=6: INPUT %CH,TY: REM VERIFY MASTER FILE TYPE
31190 IF TY<>10 THEN ERR$="NOT A MASTER FILE TYPE": GOTO 40000
31200 INDEX<CH>=9: INPUT %CH,EODF(CH): REM GET END OF DATA INDEX
31210 INDEX<CH>=20: INPUT %CH,BODF(CH): REM GET START OF DATA INDEX
31220 REM CHK IF DATA EXISTS IN FILE
31230 IF EODF(CH)<=BODF(CH) THEN ERR$="FILE EMPTY": GOTO 40000
31240 INDEX<CH>=31: INPUT %CH,RL(CH): REM GET RECORD LENGTH
31250 INDEX<CH>=42: INPUT %CH,NR(CH): REM GET # OF RECORDS
31260 REM DOUBLE CHK FOR DATA IN FILE
31270 IF NR(CH)<1 THEN ERR$="FILE EMPTY": GOTO 40000
31280 REM EVERYTHING SEEMS TO BE OK
31290 RETURN: REM RETURN TO CALLER
31300 REM
31310 REM
32000 REM 'CONDITIONAL RETURN RECORD'
32010 F2=K1: F1=K2: G1=32900: G2=32950
32015 INDEX<CH>=KPR+FP(P1): INPUT %CH,L$(K1)
32020 ON T1 GOTO 32030,32025
32025 INDEX<CH>=KPR+FP(P2): INPUT %CH,L$(K2)
32030 ON T2 GOTO 32070,32100,32040,32040,32040,32040,32040
32040 ON T1 GOTO 32060,32050
32050 L2=VAL(L$(K2))
32060 L1=VAL(L$(K1))
32065 ON T2 GOTO 32070,32100,32125,32135,32145,32155,32165
32070 ON T1 GOTO 32080,32090
32080 IF L$(K1)=C1$ GOTO G1
32085 GOTO G2
32090 IF L$(K1)=L$(K2) GOTO G1
32095 GOTO G2
32100 ON T1 GOTO 32105,32115
32105 IF L$(K1)<>C1$ GOTO G1
32110 GOTO G2
32115 IF L$(K1)<>L$(K2) GOTO G1
32120 GOTO G2
32125 IF L1<L2 GOTO G1
32130 GOTO G2
32135 IF L1<=L2 GOTO G1
32140 GOTO G2
32145 IF L1>L2 GOTO G1
32150 GOTO G2
32155 IF L1>=L2 GOTO G1
32160 GOTO G2
32165 IF L1>=R1 AND L1<=R2 GOTO G1
32170 GOTO G2
32900 FOR X=K1 TO TF: INDEX<CH>=KPR+FP(X): INPUT %CH,L$(X): NEXT
32910 KPR=KPR+RL(CH): IF KPR>=EODF(CH) THEN F2=K2
32920 F1=K1: RETURN : REM + F1=K1
32950 KPR=KPR+RL(CH): IF KPR<EODF(CH) GOTO 32010
32960 F2=K2: RETURN
32970 REM R1**
33000 REM SUB TO GET ALL FIELD NAMES AND OFFSETS (L$(N) & FP(N))
33010 REM
33020 TT=0: TF=0: FL=0: INDEX<CH>=53
33030 TF=TF+K1: INPUT %CH,X$
33040 ON T1 GOTO 33060,33050
33050 IF C1$=X$ THEN P2=TF
33060 IF F1$=X$ THEN P1=TF
33070 L$(TF)=X$: FP(TF)=TT: INPUT %CH,FL: TT=TT+FL
33080 IF INDEX(K1)<BODF(CH) GOTO 33030
33090 RETURN
33100 REM
33110 REM
40000 REM ERROR EXPANSION GOES HERE
40010 PRINT: PRINT ERR$: PRINT: CLOSE: GOTO 51100: REM COMMON EXIT PATH
40020 REM
40030 REM
50000 REM ERROR HANDLER
50010 ER=PEEK(10226): EL=PEEK(11774)+PEEK(11775)*256
50020 REM
50035 REM CHK FOR 'NON-EXISTANT ENTRY ERROR'
50040 IF ER=128 THEN ERR$="INVALID FILENAME": GOTO 51050
50045 REM CHK FOR 'END OF FILE HIT' ERROR
50050 IF ER=132 THEN ERR$="END OF FILE ERROR": GOTO 51000
50055 REM CHK FOR ACCESS RIGHTS VIOLATION
50060 IF ER=130 THEN ERR$="ACCESS RIGHTS VIOLATION": GOTO 51000
50065 REM MAYBE A SYSTEM ERROR I.E. CHANNEL NOT OPEN ERROR
50070 IF ER=129 THEN ERR$="CANNOT ACCESS FILE ": GOTO 51050
50075 REM OTHER ERRORS ARE HARD ERRORS
50080 ERR$="DISC ERROR CODE "+STR$(ER)+" IN LINE "+STR$(EL)
50090 REM
50092 REM PICKUP DISC ADDR. WHERE ERROR OCCURED
50094 EA=0: FOR I=4 TO 1 STEP -1: EA=EA*256+PEEK(9889+1): NEXT I
50096 DV(3)=PEEK(9832): IF DV(3)>127 THEN DV(3)=DV(3)-128+4
50098 PRINT"ERROR ON DEVICE "+CHR$(DV(3)+65)+" AT DISC ADDRESS";EA
50100 REM
51000 REM ERROR MESSAGE PRINT CODE ENTRY AT '51000' CLOSES FILE
51010 REM
51020 CLOSE
51030 REM
51040 REM ENTRY AT '51050' DOES NOT CLOSE THE CHANNEL
51050 PRINT:PRINT:PRINT"*****  ERROR  *****": PRINT: PRINT
51060 PRINT ERR$: FOR X=1 TO 2000: NEXT X
51100 REM COMMON EXIT PATH
51110 DEV CHR$(DV(2)+65): REM SELECT ORGINAL DEVICE
51115 POKE 2972,58: POKE 2976,44: REM DISALLOW , & :    R1**
51120 FLAG 6: REM ENABLE PROGRAM ABORT ON EOF HIT ERROR
51155 IF ER<1 THEN INPUT"HIT THE RETURN KEY TO EXIT ";QA$
51160 RUN"DBMSYS","PASS",2