⟦44644f1ff⟧

BASIC

00001 PRINT"THIS IS NOT A EXECUTEABLE PROGRAM":RUN"DBMSYS","PASS"
00002 CLOSE:CLEAR:REM 1/79  MERGE OR LOAD  (MERGER)
00009 REM LINES 10-99 ARE RESERVED FOR SETTING UP FLAGS,POKES,VARIABLES,ETC.
00010 Q=100:DIMAY$(Q),AX(Q),AW(Q),BY$(Q),BX(Q),BW(Q)
00015 DIMC$(Q)
00020 K1=1:K2=2:K3=3:K4=4:K5=5:K6=6:K7=7:K8=8:K9=9:K0=0:KI=31:KL=20:KK=42
00040 KJ=53:NE$="":FORX=K1TOKI:PRINT:NEXT:POKE2888,0:REM ACCEPT NULL INPUT
00050 FLAG9:FLAG19:REM FLG9-50000 ERROR FLG19- DISABLE ERROR CHK
00086 PRINT"OS-DMS MASTER FILE MERGE OR LOAD"
00087 PRINT"--------------------------------"
00090 REM PEEK FOR CURRENT DEVICE
00095 DV(K3)=PEEK(9832):IF DV(K3)>127 THEN DV(K3)=DV(3)-128+K4
00096 DV$(K3)=CHR$(DV(K3)+65)
00098 REM**********
00099 REM INPUT BLOCK
00120 PRINT"** A NEW MASTER FILE MUST EXIST BEFORE TRYING TO LOAD A FILE **"
00140 PRINT:INPUT"DEVICE OLD MASTER FILE STORED ON ";DV$(K1):PRINT
00150 IF DV$(K1)<>"A" AND DV$(K1)<>"B" AND DV$(K1)<>"E" THEN GOTO 140
00160 INPUT"OLD MASTER FILE, PASSWORD ";N$(K1),P$(K1):PRINT
00165 IF LEN(N$(K1))<K1 OR LEN(N$(K1))>K6 THEN PRINT:PRINT"WHAT!":PRINT:GOTO 160
00168 IFLEN(N$(K1))<K5THENN$(K1)=N$(K1)+" ":GOTO168
00171 N$(K1)=LEFT$(N$(K1),K5)+"0"
00174 IFP$(K1)="."THENP$(K1)="ANAN"
00177 IF LEN(P$(K1))<>K4 THEN PRINT:PRINT"WHAT!":PRINT:GOTO 160
00180 INPUT"DEVICE NEW MASTER FILE STORED ON ";DV$(K8):PRINT
00190 IF DV$(K8)<>"A" AND DV$(K8)<>"B" AND DV$(K8)<>"E" THEN GOTO 180
00200 INPUT"NEW MASTER FILE, PASSWORD ";N$(K8),P$(K8):PRINT
00205 IFLEN(N$(K8))<K1ORLEN(N$(K8))>K6THENPRINT:PRINT"WHAT!":PRINT:GOTO 200
00208 IFLEN(N$(K8))<K5THENN$(K8)=N$(K8)+" ":GOTO208
00211 N$(K8)=LEFT$(N$(K8),K5)+"0"
00214 IF P$(K8)="." THEN P$(K8)="ANAN"
00217 IFLEN(P$(K8))<>K4THENPRINT:PRINT"WHAT!":PRINT:GOTO 200
00220 DEVDV$(K1):OPENN$(K1),P$(K1),1:DEVDV$(K8):OPENN$(K8),P$(K8),8
00250 INPUT"DO YOU WISH TO LIMIT RANGE OF REC # (Y OR N)";LR$:PRINT
00260 IF LR$="N" GOTO 300
00270 IF LR$<>"Y" GOTO 250
00280 INPUT"BEGINNING REC # IN OLD FILE";BO:PRINT
00285 INPUT"BEGINNING REC # IN NEW FILE";BN:PRINT
00290 INPUT"ENDING REC # IN OLD FILE ";BE:PRINT
00295 ZR=1
00300 INPUT"SEQUENTIAL MERGE (S) OR COUPLED MERGE (C)";MQ$:PRINT
00310 IFMQ$="S"GOTO352
00320 IF MQ$<>"C" GOTO 300
00321 FORX=K1TOKI:PRINT:NEXTX
00322 PRINT"((NOTE)) YOU WILL STILL BE MERGING DATA FROM THE OLD TO NEW FILE";
00323 PRINT" WHAT EVER WAY":PRINT"         YOU CHOOSE TO COUPLE"
00325 INPUT"COUPLE OLD FILE TO NEW (O)  OR  NEW FILE TO OLD (N) ";CC$:PRINT
00326 IF CC$<>"O" AND CC$<>"N" GOTO 325
00327 GOSUB12015
00328 IFCC$="O"THENINPUT"'^'FIELD # OR FIELD TO KEY ON IN OLD FILE ";L$(1)
00329 IFCC$="N"THENINPUT"'^'FIELD # OR FIELD TO KEY ON IN NEW FILE ";L$(1)
00330 IFLEFT$(L$(K1),K1)<>"^"THENFORX=K1TOCU:IFL$(K1)=CY$(X)THENCV=K1
00331 IFLEFT$(L$(K1),K1)<>"^"THENNEXT:IFCV<K1THENPRINT:PRINT"WHAT!":GOTO328
00332 IFLEFT$(L$(K1),K1)<>"^"THENCV=K0:GOTO338
00333 IFLEN(L$(K1))<K2ORLEN(L$(K1))>K3THENPRINT:PRINT"WHAT!":GOTO328
00334 X=ASC(MID$(L$(K1),K2,K1)):IFX<47ORX>58THENPRINT:PRINT"WHAT!":GOTO328
00335 Y=ASC(RIGHT$(L$(K1),K1)):IFY<47ORY>58THENPRINT:PRINT"WHAT!":GOTO328
00336 RD=VAL(MID$(L$(K1),K2)):IFRD<K1ORRD>CUTHENPRINT:PRINT"WHAT!":GOTO328
00337 L$(K1)=CY$(VAL(MID$(L$(K1),K2)))
00338 PRINT:GOSUB12200
00339 PRINT:IFCC$="O"THENPRINT"'^'FIELD # OF FIELD TO BE KEYED ON IN THE NEW FIL";
00340 IFCC$="O"THENINPUT"E ";NL$:PRINT:GOTO342
00341 INPUT"'^'FIELD # OR FIELD TO BE KEYED ON IN THE OLD FILE ";NL$:PRINT
00342 IFLEFT$(NL$,K1)<>"^"THENFORX=K1TODU:IFNL$=DY$(X)THENCV=K1
00343 IFLEFT$(NL$,K1)<>"^"THENNEXT:IFCV<K1THENPRINT:PRINT"WHAT!":GOTO339
00344 IFLEFT$(NL$,K1)<>"^"THENCV=K0:GOTO350
00345 IFLEN(NL$)<K2ORLEN(NL$)>K3THENPRINT:PRINT"WHAT!":GOTO339
00346 X=ASC(MID$(NL$,K2,K1)):IFX<47ORX>58THENPRINT:PRINT"WHAT!":GOTO339
00347 Y=ASC(RIGHT$(NL$,K1)):IFY<47ORY>58THENPRINT:PRINT"WHAT!":GOTO339
00348 RD=VAL(MID$(NL$,K2)):IFRD<K1ORRD>DUTHENPRINT:PRINT"WHAT!":GOTO339
00349 NL$=DY$(VAL(MID$(NL$,K2)))
00350 IFMQ$="C"ORMQ$="C"THENHH$="Y":GOTO360
00352 INPUT"ARE THERE ANY FIELD ENTRIES IN THE NEW FILE YET (Y OR N) ";HH$
00353 PRINT:IFHH$<>"Y"ANDHH$<>"N"GOTO352
00354 GOTO12000
00356 REM END OF INPUT BLOCK
00357 REM**********
00358 REM OPEN THE FILES & INPUT HEADER INFO
00360 Z=K1:GOSUB 380
00370 Z=K8
00380 DEVDV$(Z):INDEX<Z>=K0
00401 REM VERIFY NAME MATCHES MASTER FILE NAME
00402 INPUT %Z,M$(Z):IF M$(Z)=LEFT$(N$(Z),K5) GOTO 404
00403 PRINT"ERROR **FILE HEADER MISMATCH**":GOTO 2000
00404 INDEX<Z>=K6:INPUT %Z,TY(Z):REM VERIFY TYPE
00405 IF TY(Z)=K10 THEN PRINT"ERROR **NOT A MASTER FILE**":GOTO 2000
00406 INDEX<Z>=K9:INPUT %Z,EODF(Z):REM GET END OF FILE
00407 INDEX<Z>=KL:INPUT %Z,BODF(Z):REM GET END OF FILE
00408 REM CHECK IF DATA EXISTS IN FILE
00409 IF EODF(K1)<=BODF(K1) THEN PRINT"ERROR **FILE EMPTY**":GOTO 2000
00410 INDEX<Z>=KI:INPUT %Z,RL(Z):REM GET RECORD LENGTH
00411 INDEX<Z>=KK:INPUT %Z,NR(Z):REM GET # OF RECORDS
00412 REM DOUBLE CHECK FOR DATA IN FILES NR>0
00413 IF NR(K1)<K1 THEN PRINT"ERROR **FILE EMPTY**":GOTO 2000
00414 IFBO<NR(K1) GOTO 416
00415 PRINT"ERROR **BEGINNING RECORD RANGE IS NOT WITHIN LIMITS**":GOTO 2000
00416 IF BE<NR(K1) GOTO 420
00417 PRINT"ERROR **CLOSING RECORD RANGE IS NOT WITHIN LIMITS**":GOTO 2000
00420 IF Z=K1 THEN GOSUB 6000
00440 IFZ=K8THENFORX=K1TONF+K1:IFC$(X)<>NE$THENL$(X)=C$(X)
00441 IFZ=K8THENNEXTX
00450 FORS=K1 TONF+K1:FL(S,Z)=1E8:FP(S,Z)=1E8:NEXT S
00460 GOSUB 5000
00464 REM END OF INPUTING HEADER INFO
00465 REM**********
00466 REM ERROR CHECKING BLOCK
00470 IF NL$="OK" GOTO 476
00472 IF MQ$<>"C" GOTO 476
00473 IF Z=K1 GOTO 476
00474 PRINT"ERROR ** FIELD TO BE KEYED ON NOT FOUND **":GOTO 483
00476 IFXL<>K1 GOTO 480
00477 FORX=K2TONF+K1:IF L$(1)=L$(X) THEN FP(1,Z)=FP(X,Z)
00478 FL(1,Z)=FL(X,Z):NEXTX
00479 IF FL(1,Z)>=1E8 GOTO 481
00480 FORR=K2TONF+K1:IF FL(R,Z)<1E8 GOTO 490
00481 IFZ=K1THENPRINT"ERROR **";L$(R);:PRINT"**  NOT FOUND IN THE OLD FILE"
00482 IFZ=K8THENPRINT"ERROR **";L$(R);:PRINT"**  NOT FOUND IN THE NEW FILE"
00483 XR=XR+1
00490 NEXT R:IF Z=K1 AND CS>1 THEN Z=8:GOTO 370
00491 IFXR>0THENCLOSE:GOTO2000
00495 IF Z=K1 THEN RETURN
00500 IF NR(K1)<=NR(K8) GOTO 535
00510 PRINT"<<NOTICE>> THERE ARE LESS RECORDS IN THE NEW FILE THAN IN THE ";
00515 PRINT"OLD FILE "
00518 PRINT"           (*THIS*IS*NOT*A*ERROR*)"
00519 PRINT
00520 INPUT"EXIT (E) OR CONTINUE (C)";ZZ$
00525 IF ZZ$="E" GOTO 2000
00535 FORX=K1TONF+K1:IF FL(X,K1)<=FL(X,K8) GOTO 545
00538 PRINT
00540 PRINT"<<NOTICE>> SOME OF THE FIELD LENGTHS IN THE OLD FILE ARE LONGER ";
00541 PRINT"THAN IN THE                NEW FILE   (*THIS*IS*NOT*A*ERROR*)"
00543 PRINT
00544 INPUT"EXIT (E) OR CONTINUE (C)";JJ$:PRINT:IF JJ$="E" GOTO 2000
00545 NEXTX
00551 REM END OF ERROR CHECKING BLOCK
00552 REM**********
00553 REM EXECUTION BLOCK FOR A SEQUENTIAL MERGE
00555 IF BN<=1 GOTO 566
00560 IF HH$="N" AND BN>1 THEN EODF(K8)=EODF(K8)+(((BN-1)*RL(K8)))
00561 INDEX<K8>=K9:PRINT%K8,EODF(K8)
00566 IF LR$<>"Y" GOTO 569
00567 LR(K1)=(RL(K1)*(BO-1)):LR(K8)=(RL(K8)*(BN-1))
00568 IFLR$="Y"THENEF=BODF(K1)+(RL(K1)*BE)
00569 IF MQ$="C" GOTO 900
00570 IF HH$="N" THEN EODF(K8)=EODF(K8)+RL(K8):INDEX<K8>=K9:PRINT%K8,EODF(K8)
00575 FORX=K2TONF+K1:INDEX<K1>=BODF(K1)+FP(X,K1)+LR(K1):INPUT%K1,D$(X)
00580 IF LEN(D$(X))<FL(X,K8)-K1 THEN D$(X)=" "+D$(X): GOTO 580
00585 IF LEN(D$(X))>FL(X,K8)-K1 GOTO 587
00586 GOTO 590
00587 PRINT"ERROR **DATA FROM OLD FILE LONGER THEN FIELD LENGTH IN NEW FILE**"
00588 GOTO 2000
00590 NEXT: REM AT THIS POINT RECORD HAS BEEN INPUT FROM OLD FILE
00610 FORX=K2TONF+K1:INDEX<K8>=BODF(K8)+FP(X,K8)+LR(K8):PRINT%K8,D$(X):NEXTX
00820 LR(K1)=LR(K1)+RL(K1):LR(K8)=LR(K8)+RL(K8)
00840 CTR=CTR+K1:IFHH$="Y"ANDCTR=INT((EODF(K8)-BODF(K8))/RL(K8))GOTO3000
00843 IFCTR=INT((EODF(K1)-BODF(K1))/RL(K1))GOTO3000
00844 REM IFCTR=INT((EODF(8)-BODF(8))/RL(8)-(BN-1)GOTO3000
00845 IF(BE-(BO-ZR))=CTR GOTO 3000
00846 IFLR$="Y"ANDINDEX(K1)=EFGOTO3000
00850 IF INDEX(K1)>=EODF(K1) GOTO 3000
00870 IF INDEX(K8)>EODF(K8) GOTO 3000
00880 GOTO 570
00891 REM END OF EXECUTION BLOCK FOR A SEQUENTIAL MERGE
00892 REM**********
00893 REM EXECUTION BLOCK FOR A COUPLE MERGE FROM THE OLD TO NEW FILE
00900 IF CC$="N" GOTO 7000
00910 FLAG10:FLAG5
00920 FORX=K1TONF+K1:INDEX<K1>=BODF(K1)+FP(X,K1)+LR(K1):INPUT%K1,D$(X)
00940 INDEX<K1>=0:NEXTX
00960 INDEX<K8>=BODF(K8)+LR(K8)
00980 FIND D$(1),K8:O=INT((INDEX(K8)-BODF(K8))/RL(K8))*RL(K8)+BODF(K8)
01000 INPUT%K8,DDD$:IR=INDEX(K8)
01020 IF IR<EODF(K8) GOTO 1040
01024 IF BO>0 GOTO 1028
01025 PRINT"*DATA NOT FOUND* *CORRESPONDING RECORD # IN OLD FILE*";CTR+1
01026 IF BO<=0 GOTO 1070
01028 PRINT"*DATA NOT FOUND* *CORRESPONDING RECORD # IN OLD FILE*";CTR+BO
01030 GOTO1070
01040 IF DDD$<>D$(1) GOTO 980
01060 FORX=K2TONF+K1:INDEX<K8>=O+FP(X,K8)
01064 IFLEN(D$(X))<FL(X,K8)-K1THEND$(X)=" "+D$(X):GOTO1064
01065 IF LEN(D$(X))<=FL(X,K8)-K1 GOTO 1068
01066 PRINT"ERROR **DATA FROM OLD FILE LONGER THEN FIELD LENGTH IN NEW FILE**
01067 GOTO 2000
01068 PRINT%K8,D$(X):NEXTX
01070 FLAG9:FLAG6
01080 LR(1)=LR(1)+RL(1):CTR=CTR+1:IFCTR=INT((EO(8)-BO(8))/RL(8))GOTO3000 
01100 IFCTR=INT((EODF(K1)-BODF(K1))/RL(K1))GOTO3000
01110 IF (BE-(BO-ZR))=CTR GOTO 3000
01120 IFCTR=INT((EODF(K8)-BODF(K8))/RL(K8))-(BN-K1)GOTO3000
01140 IF INDEX(K1)>=EODF(K1) GOTO 3000
01160 IFCTR=INT((EODF(K1)-BODF(K1))/RL(K1))GOTO3000
01200 GOTO 910
01400 REM END OF EXECUTION BLOCK FOR COUPLE MERGE OF OLD TO NEW FILE
01500 REM**********
01600 REM CONDITIONAL EXITS
01700 REM LINE 2000 IS A EXIT ON ERROR
01800 REM LINE 3000 IS A EXIT WHEN ALL FIELDS HAVE BEEN MERGED
01850 REM LINE 4000 RUNS THE MENU AFTER AN EXIT
02000 DEVDV$(K3):CLOSE:FLAG20:PRINT:PRINT:GOTO54090
03000 PRINT"*** END OF TRANSFER ***":PRINT:DEVDV$(3):CLOSE:GOTO54070
04200 REM**********
04300 REM  A VERIFY SUBROUTINE (VERIFIES FIELDS DO EXIST)
05000 TT(Z)=K0
05050 INDEX<Z>=KJ
05100 INPUT %Z,X$:REM GET FIELDS OUT OF THE HEADER
05150 FORX=K1+XLTONF+K1+XL
05175 IF NL$=X$ THEN NL$="OK"
05200 IF L$(X)=X$ GOTO 5300
05250 NEXT X:GOTO 5350
05300 FP(X,Z)=TT(Z)
05350 INPUT %Z,FL(X,Z)
05400 TT(Z)=TT(Z)+FL(X,Z)
05450 IF INDEX(Z)<BODF(Z) GOTO 5100
05500 IF INDEX(Z)=BODF(Z) THEN RETURN
05600 IF INDEX(Z)>BODF(Z) THEN PRINT"ERROR **FILE HEADER ERROR**"
05800 REM END OF VERIFY SUBROUTINE
05900 REM**********
05910 REM A SUBROUTINE TO INPUT FIELDS TO BE MERGED
06000 XX=K0:FORX=K1TOAU:AT$="("+MID$(STR$(X),K2)+") "+AY$(X)
06010 XX=XX+K1:IFXX=K1THENPRINTAT$;:GOTO6030
06020 XX=K0:PRINTTAB(38);AT$
06030 NEXTX:XX=K0:PRINT:PRINT
06040 PRINT"ENTER '^'FIELD # FOR EACH FIELD FROM THE OLD FILE TO BE MERGED";
06050 PRINT" IN THE NEW FILE":PRINT:INPUTBQ$
06055 IFLEN(BQ$)<K2ORBQ$=""THENPRINT:PRINT"WHAT!":GOTO6040
06056 IFLEFT$(BQ$,1)<>"^"THENPRINT:PRINT"WHAT!":GOTO6040
06057 X=ASC(MID$(BQ$,2,1)):IFX<47ORX>58THENPRINT:PRINT"WHAT!":GOTO6040
06058 Y=ASC(RIGHT$(BQ$,1)):IFX<47ORX>58THENPRINT:PRINT"WHAT!":GOTO6040
06065 FORX=K1TOLEN(BQ$):IFMID$(BQ$,X,K1)<>"^"GOTO6075
06070 MK(AC+K1)=X:AC=AC+K1:IFAC>AU+K1THENPRINT:PRINT"WHAT!":GOTO6040
06075 NEXTX
06080 MK(AC+K1)=LEN(BQ$)+K1
06085 FORX=K1TOAC
06090 GAR=VAL(MID$(BQ$,MK(X)+K1,MK(X+K1)-(MK(X)+K1)))
06095 IFGAR<K1ORGAR<>INT(GAR)ORGAR>AUTHENPRINT:PRINT"WHAT!":GOTO6040
06100 L$(X+K1)=AY$(VAL(MID$(BQ$,MK(X)+K1,MK(X+K1)-(MK(X)+K1)))):NEXT
06105 INPUT"FIELD NAME CHANGE IN THE NEW FILE (Y OR N) ";B$
06110 IFB$<>"N"ANDB$<>"Y"GOTO6105
06111 DIMD$(AC+K1)
06115 IFB$="N"GOTO6300
06120 FORX=K2TOAC+K1
06125 PRINT:PRINT"FIELD NAME CHANGE FOR THE FIELD :";L$(X);:INPUT" ";ZA$:PRINT
06130 IFZA$<>"N"ANDZA$<>"Y"GOTO6125
06135 IFZA$="N"GOTO6145
06140 INPUT"ENTER FIELD NAME CHANGE AS IT APPEARS IN THE NEW FILE ";C$(X)
06145 D$(X)=NE$:NEXT
06300 NF=AC:XL=K0:FORX=K2TONF+K1
06320 IF L$(K1)=L$(X) THEN XL=K1:NEXTX
06340 CS=CS+1:IF CS>1 GOTO 6400
06350 DIMFL(Q+K1,K8),FP(Q+K1,K8)
06400 FORM=K1TOKI:PRINT:NEXTM
06430 PRINT"PLEASE WAIT"
06450 IFZ=K1 THEN RETURN
06600 REM END OF SUBROUTINE TO INPUT FIELDS TO BE MERGED
06700 REM**********
06800 REM EXECUTION BLOCK TO COUPLE MERGE NEW TO OLD FILE
07000 FLAG10:FLAG5
07200 INDEX<K8>=BODF(K8)+FP(1,K8)+LR(K8):INPUT%K8,D$(1)
07400 INDEX<K8>=0:INDEX<K1>=BODF(K1)+LR(K1)
07600 FIND D$(1),K1:O=INT((INDEX(K1)-BODF(K1))/RL(K1))*RL(K1)+BODF(K1)
07800 INPUT%K1,DDD$:IR=INDEX(K1)
08000 IF IR<EODF(K1) GOTO 9200
08200 IF BO>0 GOTO 8800
08400 PRINT"*DATA NOT FOUND* *CORRESPONDING RECORD # IN OLD FILE*";CTR+1
08600 IF BO<=0 GOTO 10000
08800 PRINT"*DATA NOT FOUND* *CORRESPONDING RECORD # IN OLD FILE*";CTR+BO
09000 GOTO 10000
09200 IF DDD$<>D$(1) GOTO 7600
09400 FORX=K2TONF+K1:INDEX<K1>=O+FP(X,K1):INPUT%K1,D$(X)
09600 IF LEN(D$(X))<FL(X,K8)-K1 THEN D$(X)=" "+D$(X):GOTO 9600
09650 IF LEN(D$(X))<=FL(X,K8) GOTO 9800
09700 PRINT"ERROR **DATA FROM OLD FILE LONGER THEN FIELD LENGTH IN NEW FILE**
09750 GOT0 2000
09800 INDEX<K8>=BODF(K8)+FP(X,K8)+LR(K8):PRINT%K8,D$(X):NEXTX
10000 FLAG9:FLAG6
10100 LR(8)=LR(8)+RL(8):CTR=CTR+1:IFCTR=INT((EO(8)-BO(8))/RL(8))GOTO3000
10200 IFCTR=INT((EODF(K1)-BODF(K1))/RL(K1))GOTO3000
10300 IF (BE-(BO-ZR))=CTR GOTO 3000
10400 IFCTR=INT((EODF(K8)-BODF(K8))/RL(K8))-(BN-K1)GOTO3000
10500 IF INDEX(K8)>EODF(K8) GOTO 3000
10550 IFCTR=INT((EODF(K8)-BODF(K8))/RL(K8))GOTO3000
10600 GOTO 7000
11000 REM END OF EXECUTION BLOCK TO COUPLE MERGE NEW TO OLD FILE
12000 REM**********
12005 REM GET FIELD NAMES,LENGTHS & OFFSETS
12010 REM AY$(N)=NAME  AX(N)=LENGTH  AW(N)=OFFSET
12015 INDEX<K1>=K9:INPUT%K1,EODF(K1):INDEX<K1>=KL:INPUT%K1,BODF(K1)
12020 AV=K0:AU=K1:A1=12030:INDEX<K1>=53:REM AV=OFFSET AU=# OF FIELDS
12030 INPUT%K1,AY$(AU):INPUT%K1,AX(AU):AW(AU)=AV
12040 AV=AV+AX(AU):IFINDEX(K1)<BODF(K1)THENAU=AU+K1:GOTOA1
12050 IFINDEX(K1)>BODF(K1)THENPRINT"ERROR** FILE HEADER ERROR":GOTO2000
12055 DEVDV$(K8):INDEX<K8>=K9:INPUT%K8,EO(8):INDEX<K8>=KL:INPUT%K8,BO(8)
12060 REM GET FIELD NAMES,LENGTHS & OFFSETS FOR THE NEW FILE
12065 REM BY$(N)=NAME BX(N)=LENGTH BW(N)=OFFSET
12070 BV=K0:BU=K1:B1=12075:INDEX<K8>=53:REM BV=OFFSET BU=# OF FIELDS
12075 INPUT%K8,BY$(BU):INPUT%K8,BX(BU):BW(BU)=BV
12080 BV=BV+BX(BU):IFINDEX(K8)<BODF(K8)THENBU=BU+K1:GOTOB1
12085 IFINDEX(K8)>BODF(K8)THENPRINT"ERROR** FILE HEADER ERROR":GOTO2000
12090 FORX=K1TOKI:PRINT:NEXT
12095 Q=AU+K1:IFBU>AUTHENQ=BU+K1
12100 REM PARSE THE FIELDS FROM THE OLD FILE ON THE SCREEN
12105 DIMCY$(Q),CX(Q),CW(Q),DY$(Q),DX(Q),DW(Q),L$(Q),MK(Q)
12110 PRINT"****************************************************************
12115 PRINT"*  EACH FILE WILL HAVE ITS FIELD NAMES DISPLAYED WITH THE FI-  *
12120 PRINT"*  ELD NUMBERS, ONE MUST SIMPLY SPECIFY IF A PARTICULAR FIELD  *
12125 PRINT"*  SHOULD BE KEYED ON, MERGED OR LOADED IN A FILE BY ENTERING  *
12130 PRINT"*  A '^' WITH THE FIELD NUMBER AFTER EACH '^'.                 *
12135 PRINT"****************************************************************
12140 PRINT:INPUT"ENTER A  C  TO CONTINUE ";UY$:PRINT:IFMQ$="S"GOTO360
12145 CU=AU:IFCC$="N"GOTO12155
12150 FORX=K1TOAU:CY$(X)=AY$(X):CX(X)=AX(X):CW(X)=AW(X):NEXT:GOTO12160
12155 FORX=K1TOBU:CY$(X)=BY$(X):CX(X)=BX(X):CW(X)=BW(X):NEXT:CU=BU
12160 XX=K0:FORX=K1TOCU:AT$="("+MID$(STR$(X),K2)+") "+CY$(X)
12165 XX=XX+K1:IFXX=K1THENPRINTAT$;:GOTO12175
12170 XX=K0:PRINTTAB(38);AT$
12175 NEXTX:XX=K0:PRINT:PRINT:RETURN
12200 DU=AU:IFCC$="O"GOTO12220
12210 FORX=K1TOAU:DY$(X)=AY$(X):DX(X)=AX(X):DW(X)=AW(X):NEXT:GOTO12230
12220 FORX=K1TOBU:DY$(X)=BY$(X):DX(X)=BX(X):DW(X)=BW(X):NEXT:DU=BU
12230 XX=K0:FORX=K1TODU:AT$="("+MID$(STR$(X),K2)+") "+DY$(X)
12240 XX=XX+K1:IFXX=K1THENPRINTAT$;:GOTO12260
12250 XX=K0:PRINTTAB(38);AT$
12260 NEXTX:XX=K0:PRINT:PRINT:RETURN
50000 REM ERROR HANDLING
50010 ER=PEEK(10226):EL=PEEK(11774)+PEEK(11775)*256
50020 REM CHK FOR CHANNEL ALREADY OPEN
50030 IF ER=133 THEN CLOSEZ:CLOSE
50040 REM CHK FOR NON-EXISTANT ENTRY ERROR
50050 IF ER=128 THEN ERR$="INVALID FILE NAME":GOTO 52000
50060 REM CHK FORR END OF FILE HIT ERROR
50070 IF ER=132 THEN ERR$="END OF FILE ERROR":CLOSEZ:CLOSE:GOTO 52000
50080 REM CHK FOR SYSTEM ERROR I.E. CHANNEL NOT OPEN ERROR
50090 IF ER=129 THEN ERR$="CANNOT ACCESS FILE":GOTO 52000
50100 ERR$="DISC ERROR CODE "+STR$(ER)+" IN LINE "+STR$(EL)
50200 CLOSE
52000 PRINT:PRINT"******ERROR*****":PRINT:PRINT
52010 XC=XC+1:IFXC<2GOTO53000
52020 PRINT"** CHECK TO SEE IF THE DISKETTE(S) ARE IN THE PROPER DRIVE **":PRINT
53000 PRINTERR$
54000 REM PICKUP DISC ADDRESS WHERE ERROR OCCURED
54010 EA=0:FOR I=4 TO 1 STEP -1:EA=EA*256+PEEK(9889+I):NEXT I
54020 D=PEEK(9832): IF D>127 THEN D=D-128 + 4
54030 PRINT"ON DEVICE "+CHR$(D+65)+" AT DISC ADDRESS";EA
54040 REM COMMON EXIT PATH
54050 DEV CHR$(DV(K3)+65):REM SELECT ORGINAL DEVICE
54070 FLAG20:REM ENABLE ERROR CHECKING
54090 INPUT"ENTER A  C  TO CONTINUE ";QS$:PRINT:PRINT
54100 RUN"DBMSYS","PASS"
DataMuseum.dk

Ohio Scientific Inc.

⟦44644f1ff⟧

Derivation

BASIC

Full view
