|
DataMuseum.dkPresents historical artifacts from the history of: Ohio Scientific Inc. |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Ohio Scientific Inc. Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 14576 (0x38f0)
Notes: OS65UFile, OSU65U-BASIC
Names: »MFMFRP«
└─⟦2f57871a3⟧ Bits:30009355 Ohio Scientific OS-OMS Nucleus, delvist oversat til dansk
└─⟦this⟧ »MFMFRP«
00001 PRINT"THIS IS NOT A EXECUTEABLE PROGRAM":RUN"DBMSYS","PASS
00002 CLOSE:CLEAR:REM 1/79 MULTI-FILE MULTI-FORMAT REPORT (MFMFRP)
00005 REM LINES 10 - 99 ARE RESERVED FOR SETTING UP FLAGS,POKES,ETC.
00006 RZ=PEEK(14457):REM PEEK FOR # OF LINES TO ? PER PAGE
00010 POKE 2888,0:REM ACCEPT NULL INPUT
00020 FLAG19:FLAG9:FLAG11
00021 REM FLAG19 DISABLES ERROR CHECKING
00022 FLAG9:REM ENABLES ERROR CHECKING AT LINE 50,000
00023 REM FLAG11 ENABLES SPACE SUPPRESSION IN NUMERIC OUTPUT
00025 K0=0:K1=1:K2=2:K3=3:K4=4:K5=5:K6=6:K7=7:K8=8:K9=9:KW=10:KX=15:KZ=32
00030 Y=100:CNT=K0:NE$="":TB=K0
00040 REM PEEK FOR CURRENT DEVICE
00050 DV=PEEK (9832):IF DV>127 THEN DV=DV-128+4
00060 DV$=CHR$(DV+65)
00070 SM=K0:REM SCREEN WIDTH VARIABLE
00071 PRINT:PRINT:PRINT
00072 INPUT"\NSKES UDSKRIFT P] SK[RM (S) ELLER PRINTER (P) ";V$:PRINT
00073 IF LEFT$(V$,1)="P" THEN SW=131: GOTO79
00077 VD=PEEK(11665): SW=79: IF VD=2 THEN SW=63
00078 GOTO 80
00079 PRINT:PRINT:INPUT"HVILKEN PORT \NSKES UDSKRIFT P] ";VD:PRINT:PRINT
00080 PRINT:INPUT"VERTIKALT (V) ELLER HORISONTALT (H) FORMAT ";OP$:PRINT
00081 IF OP$<>"V" AND OP$<>"H" GOTO 80
00082 FORI=K1TOKZ:PRINT:NEXT
00083 PRINT" DB-2 - RAPPORT GENERATOR FOR FLERE FILER"
00084 PRINT" ==========================================":PRINT:PRINT
00085 INPUT"KEY FILE (K) OR MASTER FILE (M) ACCESS ";KA$:PRINT
00086 IFKA$=""ORKA$="M"GOTO110
00087 IFKA$<>"K"THENPRINT:PRINT"WHAT!":GOTO85
00088 INPUT"DEVICE KEY FILE IS STORED ON ";KD$:PRINT
00089 IFKD$<"A"ORKD$>"E"THENPRINT:PRINT"WHAT!":GOTO88
00090 IFLEN(KD$)<>1ORKD$=""THENPRINT:PRINT"WHAT!":GOTO88
00091 INPUT"KEY FILE NAME,PASSWORD ";K$,P$:PRINT:IFP$="."ORP$="."THENP$="ANAN"
00092 IFLEN(K$)<1ORLEN(K$)>6THENPRINT:PRINT"IMPROPER FILE NAME":GOTO91
00093 IFLEN(P$)<>4THENPRINT:PRINT"IMPROPER PASSWORD ":GOTO91
00094 INPUT"KEY FILE TYPE (1-7) ";U$:PRINT:U=VAL(U$):U=INT(U)
00095 IFU<1ORU>7THENPRINT:PRINT"WHAT!":GOTO94
00096 IFLEN(K$)<5THENK$=K$+" ":GOTO96
00097 K$=LEFT$(K$,5)+RIGHT$(STR$(U),1):DEVKD$:OPENK$,P$,K4:INDEX<4>=K9
00098 INPUT %K4,EDF: INDEX<K4>=42: INPUT %K4,DUMY$
00099 REM**********
00100 REM
00102 DEVDV$
00106 REM GET # OF FILES TO BE USED
00110 INPUT"DO YOU WISH TO USE 2 0R 3 FILES (2 OR 3)";I:PRINT
00111 IF I<>K2 AND I<>K3 THEN GOTO 110
00112 DIMFL(Y),FP(Y),D$(Y),L$(Y),LL$(Y),C(Y),AY$(Y),AX(Y),AW(Y),MRK(Y)
00115 REM ENTER HEADER OR TITLE TO BE PRINTED AT TOP OF PAGE
00116 FORX=K1TOY:L$(X)=NE$:NEXT
00117 INPUT"ENTER REPORT HEADING ";H$:PRINT:IFLEN(H$)<=SW-KXTHENGOTO119
00118 PRINT"**MAXIUM LENGTH OF STATEMENT IS";SW-KX;:PRINT"CHARACTERS**":GOTO 117
00119 FORZ=K1TOI
00120 REM MASTER FILE VERIFICATION SUB
00121 REM PICKUP DEVICE AND VERIFY LEGALITY OF SELECTION
00122 PRINT:PRINT"DEVICE MASTER FILE #";Z;:INPUT"STORED ON ";DV$(Z)
00123 IF DV$(Z)="" THEN PRINT:PRINT"WHAT!":GOTO 122
00124 IF LEN(FV$(Z))>K1 THEN PRINT:PRINT"WHAT!":GOTO 122
00125 IF DV$(Z)<"A" OR DV$(Z)>"E" THEN PRINT:PRINT"WHAT!":GOTO 122
00130 REM PICKUP FILENAME,PASSWORD WITH 50000 ERROR CHECKING
00131 PRINT:PRINT"MASTER FILE NAME #";Z;", PASSWORD ";:INPUT MN$(Z),P$(Z)
00132 IFMN$(Z)="" OR P$(Z)="" THEN PRINT:PRINT"WHAT!":GOTO 131
00133 IF LEN(MN$(Z))<K5 THEN MN$(Z)=MN$(Z)+" ":GOTO 133
00134 IF LEN(MN$(Z))>=K6 AND RIGHT$(MN$(Z),K1)="0" GOTO 140
00135 IF LEN(MN$(Z))>K6 THEN PRINT:PRINT"IMPROPER FILENAME":GOTO 131
00136 IF LEN(MN$(Z))<K6 THEN MN$(Z)=MN$(Z)+"0":REM XXXXX0
00140 IF P$(Z)="." THEN P$(Z)="ANAN":REM CHK PASSWORD
00141 IF LEN(P$(Z))<>K4 THEN PRINT:PRINT"IMPROPER PASSWORD":GOTO 131
00150 REM SELECT DEVICE AND TRY TO OPEN FILE (50000 ERROR CHK)
00151 DEV DV$(Z):REM SELECT NEW DEVICE
00152 PRINT
00170 IF CNT=K0 THEN OPEN MN$(Z),P$(Z),K1:GOTO 173
00171 IF CNT=K1 THEN OPEN MN$(Z),P$(Z),K2:GOTO 173
00172 IF CNT=K2 THEN OPEN MN$(Z),P$(Z),K3
00173 CNT=CNT+K1
00180 INDEX<Z>=K0
00181 REM VERIFY NAME MATCHES MASTER FILE NAME
00182 INPUT%Z,N$(Z):IF N$(Z)=LEFT$(MN$(Z),K5) GOTO 184
00183 PRINT"ERROR **FILE HEADER MISMATCH**":GOTO 2000
00184 INDEX<Z>=K6:INPUT%Z,TY(Z):REM VERIFY TYPE
00185 IF TY(Z)<>KW THEN PRINT"ERROR **NOT A MASTER FILE**":GOTO 2000
00186 INDEX<Z>=K9:INPUT%Z,EODF(Z):REM GET END OF DATA FILE
00187 INDEX<Z>=20:INPUT %Z,BODF(Z):REM GET BEGINNING OF DATA FILE
00188 REM CHECK IF DATA EXISTS IN FILE
00189 IF EODF(Z)<=BODF(Z) THEN PRINT"ERROR **FILE EMPTY**:GOTO 2000
00190 INDEX<Z>=31:INPUT %Z,RL(Z):REM GET RECORD LENGTH
00191 INDEX<Z>=42:INPUT %Z,NR(Z):REM GET # OF RECORDS
00192 REM DOUBLE CHECK FOR DATA IN FILES NR>0
00193 IF NR(Z)<K1 THEN PRINT"ERROR **FILE EMPTY**":GOTO 2000
00195 GOSUB7000
00201 REM GET LABELS TO KEY ON
00203 IF I=K3 AND Z=K2 GOTO 220
00204 IF I=K3 AND Z=K3 GOTO 220
00205 IF I=K2 AND Z=K2 GOTO 220
00206 PRINT"'^'FIELD # OR KEY LABEL FROM FILE";Z;:INPUTL$(Z):IFL$(Z)=""GOTO206
00207 C(Z)=Z:IFLEFT$(L$(Z),K1)="^"GOTO213
00208 AR=AR+K1:IFAY$(AR)=L$(Z)THENAQ=1
00209 IFAQ=K0ANDAR<AUGOTO208
00210 IFAQ=K1THENAR=K0:AQ=K0:GOTO219
00211 IFAQ=K0THENAR=K0:PRINT:PRINT"WHAT!":GOTO206
00213 IFLEN(L$(Z))<K2ORLEN(L$(Z))>K3THENPRINT:PRINT"WHAT!":GOTO206
00214 AO=VAL(MID$(L$(Z),2)):IFAO<K1ORAO>AUTHENPRINT:PRINT"WHAT!":GOTO206
00216 AP=ASC(MID$(L$(Z),2,1)):IFAP<47ORAP>58THENPRINT:PRINT"WHAT!":GOTO206
00217 AM=ASC(RIGHT$(L$(Z),1)):IFAM<47ORAM>58THENPRINT:PRINT"WHAT!":GOTO206
00218 L$(Z)=AY$(VAL(MID$(L$(Z),2)))
00219 GOTO240
00220 PRINT"'^'FIELD # OR LABEL TO BE KEYED ON IN FILE";Z;:INPUTKL$(Z)
00221 B(Z)=Z:IFLEFT$(KL$(Z),K1)="^"GOTO230
00222 IFKL$(Z)=""THENPRINT:PRINT"WHAT!":GOTO220
00223 AN=AN+K1:IFAY$(AN)=KL$(Z)THENAL=K1
00224 IFAL=K0ANDAN<AUGOTO223
00225 IFAL=K1THENAN=K1:AL=K0:GOTO239
00226 IFAL=K0THENAN=K0:PRINT:PRINT"WHAT!":GOTO220
00230 IFLEN(KL$(Z))<K2ORLEN(KL$(Z))>K3THENPRINT:PRINT"WHAT!":GOTO220
00231 AK=VAL(MID$(KL$(Z),2)):IFAK<K1ORAK>AUTHENPRINT:PRINT"WHAT!":GOTO220
00233 AJ=ASC(MID$(KL$(Z),2,1)):IFAJ<47ORAJ>58THENPRINT:PRINT"WHAT!":GOTO220
00234 AI=ASC(RIGHT$(KL$(Z),1)):IFAI<47ORAI>58THENPRINT:PRINT"WHAT!":GOTO220
00235 KL$(Z)=AY$(VAL(MID$(KL$(Z),K2)))
00239 IFI=K3ANDZ=K2GOTO206
00240 GOSUB7200
00245 NEXTZ
00250 PRINT"******************************************************************
00251 PRINT"* THE FIELD(S) THAT WILL BE DISPLAYED AFTER THIS PARAGRAPH ARE *
00252 PRINT"* THOSE WHICH WERE CHOOSEN TO APPEAR ON THE REPORT. ENTER '^' *
00253 PRINT"* FIELD # OF ANY OR ALL OF THE FIELDS IN THE ORDER THEY SHOULD *
00254 PRINT"* APPEAR ON THE REPORT. IF YOU WANT ALL OF THE FIELDS TO BE ON *
00255 PRINT"* THE REPORT, IN THE SAME ORDER THEY ARE IN NOW, TYPE THE WORD *
00256 PRINT"* 'ALL' INSTEAD OF '^'FIELD NUMBER. *
00257 PRINT"******************************************************************
00260 PRINT:INPUT"ENTER A C TO CONTINUE ";AA$
00265 PRINT:XX=0:FORX=K1TOOF:AE$="("+MID$(STR$(X),2)+") "+MID$(AG$(X),3)
00266 XX=XX+K1:IFXX=K1THENPRINTAE$;:GOTO268
00267 XX=K0:PRINTTAB(38);AE$
00268 NEXTX:XX=K0:PRINT:PRINT
00269 INPUTAB$
00270 IFAB$="ALL"THENTNF=OF:GOTO288
00272 IFLEN(AB$)<K2ORAB$=""THENPRINT:PRINT"WHAT!":GOTO269
00273 IFLEFT$(AB$,K1)<>"^"THENPRINT:PRINT"WHAT!":GOTO269
00274 X=ASC(MID$(AB$,K2,K1)):IFX<47ORX>58THENPRINT:PRINT"WHAT!":GOTO269
00275 V=ASC(RIGHT$(AB$,K1)):IFV<47ORV>58THENPRINT:PRINT"WHAT!":GOTO269
00276 FORX=K1TOLEN(AB$):IFMID$(AB$,X,K1)<>"^"GOTO278
00277 MK(AC+K1)=X:AC=AC+K1
00278 NEXTX
00279 MK(AC+K1)=LEN(AB$)+K1
00280 FORX=K1TOAC
00283 GR=VAL(MID$(AB$,MK(X)+K1,MK(X+K1)-(MK(X)+K1)))
00284 IFGR<K1ORGR<>INT(GR)THENPRINT:PRINT"WHAT!":GOTO269
00285 C(X+K2)=VAL(LEFT$(AG$(VAL(MID$(AB$,MK(X)+1,MK(X+1)-(MK(X)+1)))),2))
00286 L$(X+K2)=MID$(AG$(VAL(MID$(AB$,MK(X)+1,MK(X+1)-(MK(X)+1)))),3)
00287 NEXTX:TNF=AC:GOTO290
00288 FORX=1TOOF:C(X+2)=VAL(LEFT$(AG$(X),2)):L$(X+2)=MID$(AG$(X),3):NEXTX
00289 GOTO316
00290 PRINT:INPUT"DO YOU WISH TO CHANGE ANY HEADINGS (Y OR N) ";BZ$
00291 IFBZ$<>"N"ANDBZ$<>"Y"THENPRINT:PRINT"WHAT!":GOTO290
00292 IFBZ$="N"GOTO316
00295 FORX=K3TOTNF+K2
00296 PRINT:PRINT"DO YOU WISH TO CHANGE HEADING #";X-K2;":";L$(X);:INPUT" ";BY$
00297 IFBY$<>"N"ANDBY$<>"Y"THENPRINT:PRINT"WHAT!":GOTO296
00298 IFBY$="N"GOTO305
00300 INPUT"ENTER NEW HEADING ";LL$(X):IFLL$(X)=""THENPRINT:PRINT"WHAT!":GOTO300
00305 NEXT
00316 FORX=K1TOTNF+K2
00325 FP(X)=1E8:NEXT
00330 PRINT:PRINT:PRINT"PLEASE WAIT"
00350 FORZ=K1TOI
00400 CC=K1
00405 IF Z=K2 GOTO 500
00410 FORX=K3TOTNF+K2
00420 IF L$(K1)=L$(X) AND C(K1)=C(X) THEN CC=K2
00425 IF L$(K1)=L$(X) AND C(K1)=C(X) THEN TNF=TNF+K1
00430 NEXT
00500 FORX=K1TOKZ:PRINT:NEXT
00550 PRINT"PLEASE WAIT"
00600 GOSUB 5000
00609 IF Z=K3 GOTO 645
00610 IF I<>K3 GOTO 626
00611 IF Z<>K2 GOTO 626
00612 FORY=K2 TO K2
00613 FORX=K3 TO TNF+K2
00615 IF C(X)<>Z GOTO 620
00617 IF L$(Y)=L$(X) AND C(Y)=C(X) THEN FP(X)=FP(Y)
00618 IF L$(Y)=L$(X) AND C(Y)=C(X) THEN FL(X)=FL(Y)
00620 NEXT:NEXTY
00622 NEXTZ
00625 GOTO 650
00626 FORY=K1TOK1
00628 FORX=K3 TO TNF+K2
00630 IF C(X)<>Z GOTO 640
00633 IF L$(Y)=L$(X) AND C(Y)=C(X) THEN FP(Y)=FP(X)
00635 IF L$(Y)=L$(X) AND C(Y)=C(X) THEN FP(Y)=FP(X)
00640 NEXT:NEXTY
00645 NEXTZ
00646 KL$(K1)="OK":FORZ=K1TOI
00647 IF KL$(Z)="OK" GOTO 649
00648 PRINT"**ERROR**LABEL TO BE KEYED ON NOT FOUND**":GOTO 2000
00649 NEXT
00680 REM
00685 REM LINES 700 - 2000 FIND DATA ,FIND KEYS,INPUT,&PRINT
00686 IF FP(K1)<1E8 GOTO 691
00687 PRINT"ERROR **KEY LABEL NOT FOUND*TRY AGAIN**"
00688 FORX=K1TOTNF+K2:L$(X)=NE$:TNF=K0:LL$(X)=NE$:Z=K1
00689 TT=K0:NEXT:FORZ=K1TOI
00690 GOTO 201
00691 FORX=K1TOTNF+K2:D$(X)=NE$
00692 IF FP(X+K2)<1E8 GOTO 695
00693 PRINT"ERROR **FIELD NOT FOUND*TRY AGAIN**":L$(X+K2)=NE$
00694 TNF=K0:LL$(X)=NE$:TB=K0:GOTO 265
00695 NEXT
00700 FORZ=K1TOI
00701 FLAG10:FLAG5
00702 IFKA$="K"ANDZ=1THENINPUT%4,DUMY$:INPUT%4,IP:IFINDEX(4)>EDFGOTO3000
00703 IFKA$="K"ANDZ=K1THENIFRIGHT$(DUMY$,1)="*"GOTO702
00705 A(Z)=K1:N=K1
00710 IF L$(Z)=NE$ THEN A(Z)=K3:N=K2
00715 IFKA$="K"ANDZ=K1THENO=IP:GOTO750
00720 IFZ=K1THENO=LR+BODF(K1):GOTO750
00730 FINDLEFT$(D$(Z-K1),KZ),Z
00740 O=INT((INDEX(Z)-BODF(Z))/RL(Z))*RL(Z)+BODF(Z)
00745 INPUT %Z,DDD$
00746 IR(Z)=INDEX(Z)
00747 IF IR(Z)>=EODF(Z)THENPRINT#VD,"*DATA*NOT*FOUND*":Z=1:LR=LR+RL(1):GOTO700
00748 IF DDD$<>D$(Z-K1) GOTO 730
00750 FOR X=A(Z) TO TNF+K1+N
00755 IF Z<>C(X) GOTO 800
00757 FLAG5
00760 INDEX<Z>=O+FP(X)
00765 IF INDEX(Z)>=EODF(Z) AND KA$<>"K" GOTO 3000
00770 INPUT %Z,D$(X)
00774 INDEX<K2>=K0:INDEX<K3>=K0
00775 FLAG6
00800 NEXT:NEXTZ
00801 FLAG9
00802 IF OP$="V" GOTO 6000
00803 REM LINES 805 THRU 1030 ARE HORIZONTAL FORMAT PRINT LINES
00804 REM LOGIC TO RUN THRU PRINT ROUTINE
00805 Z=K1:N=K1
00810 FF=FF+K1:IF FF>K1 GOTO 880
00818 DIM PP(TNF+K4)
00820 FORX=K3TOTNF+K2
00825 IF LEN(LL$(X))=>K1 THEN L$(X)=LL$(X)
00830 IF FL(X)<LEN(L$(X)) GOTO 845
00835 REM FIELD LONGER THAN COLUMN HEADER
00840 PP(X+K1)=FL(X)+PP(X)+K3:GOTO 850
00845 PP(X+K1)=LEN(L$(X))+PP(X)+K3:REM HEADER > FIELD
00850 NEXTX:REM TABS ARE ALL SET AT THIS POINT
00855 Y=100
00860 IF (PP(TNF+K2)-K3)<=SW GOTO 880
00865 PRINT"ERROR **WIDTH OF REPORT WRITER IS";PP(TNF+2)-SW;"CHARACTERS TOO";:
00870 PRINT" LONG**":FORX=K1TOTNF+K2:L$(X)=NE$:D$(X)=NE$:FP(X)=K0:FL(X)=K0
00875 TT=K0:LL$(X)=NE$:NEXT:GOTO 2000
00880 CTR=CTR+K1:IF CTR<K2 GOTO 900
00885 IFVD=K1ANDLC>18THENINPUT"ENTER A C TO CONTINUE ";QA$:GOTO900
00895 IFLC<RZ-K8GOTO940
00900 PG=PG+K1:PRINT#VD:LC=K0
00905 PRINT#VD,H$;TAB(SW-KW);" PAGE ";PG;:PH=POS(X):PRINT#VD
00910 FORX=K0TOPH-K2:PRINT#VD,TAB(X);"-";:NEXT:PRINT#VD
00915 FORX=K0TOPH-K2:PRINT#VD,TAB(X);"-";:NEXT:PRINT#VD
00920 PRINT#VD
00925 FORX=K3TOTNF+K2:PRINT#VD,TAB(PP(X));L$(X);:NEXT
00930 PH=POS(X):PRINT#VD:FORX=K0TOPH-K1:PRINT#VD,TAB(X);"-";:NEXT:PRINT#VD
00935 PRINT#VD
00940 FORX=K3TOTNF+K2:PRINT#VD,TAB(PP(X));D$(X);:NEXT:PRINT#VD
00945 LC=LC+K1
01000 LR=LR+RL(K1): IF LR>EODF(K1) AND KA$<>"K" GOTO 3000
01001 FORZ=K1TOI:IF CTR=NR(Z) GOTO 3000
01002 NEXT
01003 IF INDEX(K1)>EODF(K1) AND KA$<>"K" GOTO 3000
01015 FORZ=K1TOI
01020 FORR=K1TOTNF+K2:D$(R)=NE$
01025 NEXT:NEXTZ
01030 GOTO 685
02000 DEV DV$:CLOSE:FLAG20:FLAG10:FLAG12:GOTO 4000
03000 PRINTCHR$(K7):PRINT"*** END OF FILE ***":CLOSE:DEV DV$:FLAG20:FLAG10:FLAG12
03100 FOR X=1 TO PEEK(15908): PRINT #VD: NEXT
03200 FOR X=1 TO PEEK(15908): PRINT #VD: NEXT
04000 RUN"DBMSYS","PASS"
04001 REM LINE 5000 & ON FINDS THE LABEL & THE RELATIVE FILE POSITION
04002 REM
05000 TT(Z)=K0
05050 INDEX<Z>=53
05100 INPUT %Z,X$(Z):REM GET
05150 FORX=CC TO TNF+K2
05151 IF Z=B(Z) AND KL$(Z)=X$(Z) THEN KL$(Z)="OK"
05155 IF Z<>C(X) GOTO 5250
05200 IF L$(X)=X$(Z) GOTO 5300
05250 NEXT X:GOTO 5350
05300 FP(X)=TT(Z)
05350 INPUT %Z,FL(X)
05400 TT(Z)=TT(Z)+FL(X)
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**"
06000 REM LINES 6000 THRU 7000 ARE VERTICAL FORMAT PRINT LINES
06005 REM
06020 CTR=CTR+K1:IF CTR<K2 GOTO 6040
06030 IFLC<RZ-K6 GOTO 6200
06040 PG=PG+1:PRINT#VD:LC=0
06060 PRINT#VD,H$;TAB(SW-KW);:PRINT#VD," PAGE ";PG;:PH=POS(X):PRINT#VD
06070 FORX=K0TOPH-K2:PRINT#VD,TAB(X);"-";:NEXT:PRINT#VD
06080 FORX=K0TOPH-K2:PRINT#VD,TAB(X);"-";:NEXT:PRINT#VD
06090 PRINT#VD
06100 N=K1
06120 FORX=K3TOTNF+K2
06140 IF LEN(LL$(X))=>K1 THEN L$(X)=LL$(X)
06160 NEXTX:REM TABS ARE ALL SET AT THIS POINT
06180 Y=100
06200 FORX=K3TOTNF+K2:PRINT#VD,TAB(K0+GG);L$(X);TAB(36);D$(X):GG=K2:LC=LC+K1
06210 IFLC>RZ-K6THENCL=LC:LC=K0:PRINT#VD
06215 NEXT:PRINT#VD:GG=K0
06220 IF TNF<55 THEN LC=LC+K1:GOTO 6240
06230 IFCL>K0THENFORX=K1TOPEEK(15908):PRINT#VD:NEXT:CL=K0:LC=RZ-K4:GOTO6260
06240 IFLC+TNF+K1>RZ-K6THENFORX=K1TOPEEK(15908):PRINT#VD:NEXT:LC=RZ-K4
06260 LR=LR+RL(K1): IF LR>EODF(K1) AND KA$<>"K" GOTO 3000
06270 FORZ=K1TOI:IF CTR=NR(Z) GOTO 3000
06280 NEXT
06300 IF INDEX(K1)>EODF(K1) AND KA$<>"K" GOTO 3000
06440 FORZ=K1TOI
06460 FORR=K1TOTNF+K2:D$(R)=NE$
06480 NEXT:NEXTZ
06500 GOTO 680
07000 REM********** PARSE FIELDS ON SCREEN
07001 REM GET FIELD NAMES,LENGTHS & OFFSETS
07002 REM AY$(X)=NAME AX=LENGTH AW=OFFSET
07003 AV=K0:AU=K1:A1=7004:INDEX<Z>=53:REM AV=OFFSET AU=# OF FIELDS
07004 INPUT%Z,AY$(AU):INPUT%Z,AX(AU):AW(AU)=AV
07005 AV=AV+AX(AU):IFINDEX(Z)<BODF(Z)THENAU=AU+K1:GOTOA1
07006 IFINDEX(Z)>BODF(Z)THENPRINT"ERROR** FILE HEADER ERROR":GOTO2000
07007 AS=AS+K1:IFAS>K1GOTO7120
07008 FORX=K1TOKZ:PRINT:NEXT
07009 DIMAG$(100)
07020 PRINT"****************************************************************"
07030 PRINT"* ALL FIELD NAMES WILL BE DISPLAYED WITH THEIR FIELD NUMBER, *"
07040 PRINT"* SPECIFY IF A PARTICULAR FIELD SHOULD APPEAR ON THE REPORT *"
07050 PRINT"* BY ENTERING A '^'FIELD NUMBER FOR EACH FIELD. IF YOU WANT *"
07060 PRINT"* ALL THE FIELDS IN A FILE PRINTED ON THE REPORT, TYPE THE *"
07070 PRINT"* WORD 'ALL' INSTEAD OF '^'FIELD NUMBER. *"
07080 PRINT"* <<NOTICE>> THE ORDER IN WHICH THE FIELDS WILL APPEAR ON THE *"
07090 PRINT"* REPORT MAYBE ARRANGED LATER IN THE PROGRAM!!! *"
07095 PRINT"****************************************************************"
07100 PRINT:INPUT"ENTER A C TO CONTINUE ";AZ$:PRINT
07120 XX=K0:FORX=K1TOAU:AT$="("+MID$(STR$(X),K2)+") "+AY$(X)
07125 XX=XX+K1:IFXX=K1THENPRINTAT$;:GOTO7135
07130 XX=K0:PRINTTAB(38);AT$
07135 NEXTX:XX=K0:PRINT:PRINT
07140 RETURN
07200 PRINT:PRINT"***ENTER '^'FIELD # FOR EACH FIELD YOU WISH TO APPEAR ON THE ";
07205 PRINT"REPORT***"
07210 TP=0:INPUTQS$:IFQS$<>"ALL"GOTO7215
07211 FORX=K1TOAU:AG$(X+OF)=STR$(Z)+AY$(X):NEXTX:OF=OF+AU
07212 GOTO7285
07215 IFLEN(QS$)<K2THENPRINT:PRINT"WHAT!":GOTO7210
07220 IFLEFT$(QS$,K1)<>"^"THENPRINT:PRINT"WHAT!":GOTO7210
07225 IFQS$=""THENPRINT:PRINT"WHAT!":GOTO7210
07230 X=ASC(MID$(QS$,K2,K1)):IFX<47ORX>58THENPRINT:PRINT"WHAT!":GOTO7210
07235 V=ASC(RIGHT$(QS$,K1)):IFV<47ORV>58THENPRINT:PRINT"WHAT!":GOTO7210
07240 FORX=K1TOLEN(QS$):IFMID$(QS$,X,K1)<>"^"GOTO7250
07245 MRK(TP+K1)=X:TP=TP+K1:IFTP>AU+K1THENPRINT:PRINT"WHAT!":GOTO7210
07250 NEXTX
07255 MRK(TP+K1)=LEN(QS$)+K1
07260 FORX=K1TOTP
07265 GAR=VAL(MID$(QS$,MRK(X)+K1,MRK(X+K1)-(MRK(X)+K1)))
07270 IFGAR<K1ORGAR<>INT(GAR)ORGAR>AUTHENPRINT:PRINT"WHAT!":GOTO7210
07275 AG$(X+OF)=AY$(VAL(MID$(QS$,MRK(X)+K1,MRK(X+K1)-(MRK(X)+K1))))
07280 AG$(X+OF)=STR$(Z)+AG$(X+OF):NEXTX:OF=OF+TP
07285 FORX=K1TOKZ:PRINT:NEXT: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 ERR=132 THEN ERRR$="END OF FILE ERROR":CLOSE Z: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 Z: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 PRINT ERR$
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+65):REM SELECT ORGINAL DEVICE
54060 FLAG12:REM DISABLE SPACE SUPPRESSION
54070 FLAG20:REM ENABLE ERROR CHECKING
54090 PRINT:INPUT"ENTER A C TO CONTINUE ";QS$
54100 RUN"DBMSYS","PASS"