⟦205fd055a⟧

BASIC

00001 PRINT"THIS PROGRAM IS NOT EXECUTEABLE FROM THE CONSOLE":RUN"DBMSYS","PASS"
00002 CLOSE: CLEAR: RESTORE: REM 1/79  CONDITIONAL REPORT (STAT)
00003 K0=0: K1=1: K2=2: K3=3: K4=4: K5=5: K6=6: K7=7: K8=8: K9=9
00004 FOR X=1 TO 33: PRINT: NEXT X: REM 3800 BYTE(S) FREE
00005 CLOSE: POKE 2888,0: REM CLOSE ALL FILES AND PERMIT <CR> ONLY ON INPUT
00006 PRINT:INPUT"CONSOLE OR PRINTER ";QA$:PD=PEEK(11665):SW=79:IFPD=2THENSW=63
00007 UX=PEEK(14457): IF LEFT$(QA$,1)="C"ORQA$=""GOTO10
00008 PD=5: SW=131: IF LEFT$(QA$,1)<>"P" THEN PRINT: PRINT "WHAT": GOTO 6
00010 PRINT: INPUT"SINGLE OR DOUBLE SPACED REPORT ";SKIP$
00015 SKIP=0: IF LEFT$(SKIP$,1)="S" OR SKIP$="" THEN GOTO 20
00017 SKIP=2: IF LEFT$(SKIP$,1)<>"D" THEN PRINT: PRINT "WHAT": GOTO 10
00020 PRINT:INPUT"VERTICAL OR HORIZONTAL FORMAT (V OR H) ";OP$
00021 IF LEFT$(OP$,1)="H" OR OP$="" THEN OP$="H": GOTO 40
00030 IF LEFT$(OP$,1)<>"V" THEN PRINT: PRINT "WHAT": GOTO 20
00035 OP$="V"
00040 FLAG 6: FLAG 9: FLAG 11: FLAG 21: REM ***********************
00050 FOR X=1 TO 30: PRINT: NEXT X
00060 PRINT "OS-DMS MULTI-CONDITIONAL REPORT WRITER"
00065 PRINT"--------------------------------------":PRINT
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 PRINT: INPUT"KEY FILE OR MASTER FILE ACCESS ";QA$: KEY=2
00095 IF LEFT$(QA$,1)="M" OR QA$="" THEN KEY=2: GOTO 99
00096 KEY=1: IF LEFT$(QA$,1)<>"K" THEN PRINT: PRINT"WHAT": GOTO 90
00099 ON KEY GOTO 100,130
00100 GOSUB 35020: REM GO OPEN AND VERIFY KEYFILE
00120 REM THE ONLY VARIABLE TO BE SET BEFORE CALLING IS 'CH' (CHANNEL #)
00130 CH=1: GOSUB 31000: REM GO OPEN UP FILE
00132 CH=1: GOSUB 30012: REM GET F NAMES, LENGTHS, & OFFSETS
00133 FOR X=1 TO 33: PRINT: NEXT
00140 PRINT: INPUT"ENTER REPORT HEADING ";H$: PRINT: IFLEN(H$)<SW-15GOTO150
00145 PRINT"**MAXIUM LENGTH OF STATEMENT IS ";SW-15;:PRINT" CHARACTERS**":GOTO140
00150 FOR X=1 TO 33: PRINT: NEXT
00160 PRINT"*****************************************************************"
00161 PRINT"*  ALL FIELD NAMES WILL BE DISPLAYED WITH THEIR FIELD NUMBER    *"
00162 PRINT"*  SPECIFY IF A PARTICULAR FIELD SHOULD APPEAR ON THE REPORT    *"
00163 PRINT"*  BY ENTERING A '^'FIELD NUMBER FOR EACH FIELD. IF YOU WANT    *"
00164 PRINT"*  ALL THE FIELDS IN A FILE PRINTED ON THE REPORT IN THE SAME   *"
00165 PRINT"*  ORDER THEY APPEAR IN THE FILE, TYPE THE WORD 'ALL' INSTEAD   *"
00166 PRINT"*  OF '^'FIELD NUMBER. <<NOTICE>>  ENTER THE FIELD NUMBERS IN   *"
00167 PRINT"*  THE ORDER YOU WISH THE FIELDS TO BE PRINTED ON THE REPORT!   *"
00168 PRINT"*****************************************************************"
00169 PRINT:INPUT"ENTER A  C  TO CONTINUE ";DF$:FORX=1TO33:PRINT:NEXTX
00170 XX=0: FOR X=1 TO TF: T$="("+MID$(STR$(X),2)+")  "+L$(X)
00171 XX=XX+1: IF XX=1 THEN PRINT T$;: GOTO 173
00172 XX=0: PRINT TAB(38);T$
00173 NEXT X: XX=0: PRINT: PRINT
00180 NF=1: TP=0: PRINT: INPUT QS$
00181 FOR X=1 TO TF: TYPE(X)=2: NEXT: IF QS$="ALL" GOTO 222
00182 FORX=1TOLEN(QS$):T$=MID$(QS$,X,1): IF T$=" " OR T$="^"GOTO184
00183 IFT$<"0" OR T$>"9" THEN PRINT:PRINT"WHAT!":GOTO 180
00184 NEXTX
00185 IF LEN(QS$)<K2 THEN PRINT:PRINT"WHAT!":GOTO 180
00186 IF LEFT$(QS$,1)<>"^" THEN PRINT:PRINT"WHAT!":GOTO 180
00187 IF QS$="" THEN PRINT:PRINT"WHAT!":GOTO 180
00188 X=ASC(MID$(QS$,2,1)):IF X<47 OR X>58 THEN PRINT:PRINT"WHAT!":GOTO 180
00189 IF RIGHT$(QS$,1)="^" THEN PRINT:PRINT"WHAT!":GOTO 180
00190 FORX=K1TOLEN(QS$):IF MID$(QS$,X,K1)<>"^" GOTO 195
00192 MRK(TP+K1)=X: TP=TP+K1: IF TP>TF+K1 THEN PRINT:PRINT"WHAT":GOTO180
00195 NEXTX
00196 MRK(TP+K1)=LEN(QS$)+K1
00198 FORX=K1TOTP
00200 GAR=VAL(MID$(QS$,MRK(X)+K1,MRK(X+K1)-(MRK(X)+K1)))
00201 IF GAR<1 OR GAR<>INT(GAR) OR GAR>TF THENPRINT:PRINT"WHAT":GOTO180
00202 LL$(X)=L$(VAL(MID$(QS$,MRK(X)+K1,MRK(X+K1)-(MRK(X)+K1))))
00203 FF(X)=FP(VAL(MID$(QS$,MRK(X)+K1,MRK(X+K1)-(MRK(X)+K1))))
00204 LF(X)=FL(VAL(MID$(QS$,MRK(X)+K1,MRK(X+K1)-(MRK(X)+K1))))
00206 TYPE(X)=1: REM SET THIS FIELD SELECTED FLAG
00210 NEXTX
00220 GOTO 230
00222 FOR X=1 TO TF: LL$(X)=L$(X):FF(X)=FP(X):LF(X)=FL(X):TYPE(X)=1
00224 NEXTX:TP=TF
00230 PRINT:INPUT"DO YOU WISH TO CHANGE ANY HEADINGS (Y OR N) ";QT$
00231 IF LEFT$(QT$,1)="N" OR QT$="" GOTO 260
00232 IF LEFT$(QT$,1)<>"Y" THEN PRINT: PRINT "WHAT": GOTO 230
00235 FORX=K1TOTP
00240 PRINT:PRINT"DO YOU WISH TO CHANGE HEADING # ";X;" :";LL$(X);:INPUT" ";QA$
00241 IF LEFT$(QA$,1)="N" OR QA$="" GOTO 255
00243 IF LEFT$(QA$,1)<>"Y" THEN PRINT: PRINT "WHAT": GOTO 240
00250 INPUT"ENTER NEW HEADING ";PR$:IFPR$=""THENPRINT:PRINT"WHAT":GOTO250
00252 LL$(X)=PR$: REM LABEL NOW SET TO NEW NAME
00255 NEXTX
00260 CO=0: FOR X=1 TO TP: CO=CO+LEN(LL$(X)): NEXT X
00264 IF LEFT$(OP$,1)="V" THEN GOTO 279
00265 IF CO<=SW THEN CO=0: GOTO 279
00266 ERR$="WIDTH OF REPORT IS "+STR$(CO-SW)+" CHARACTERS TOO LONG"
00267 GOTO 40000
00279 FOR X=1 TO 33: PRINT: NEXT X
00280 PRINT: INPUT"HOW MANY CONDITIONS DO YOU WISH TO SET  (0>4) ";K$
00282 K=VAL(K$):IFK<0ORK>4ORK<>INT(K)THENPRINT:PRINT"INVAILD SELECTION":GOTO280
00285 IF K<>INT(K) OR K<0 OR K>4 THEN PRINT: PRINT"WHAT": GOTO 280
00287 NO=1: YES=2: TEST=YES: IF K=0 THEN TEST=NO: REM SET CONDIT FLG
00290 IF K=0 GOTO 760
00300 REM PICKUP CONDITIONAL STUFF
00301 PRINT: FOR Y=1 TO K: FOR X=1 TO 33: PRINT: NEXT
00303 XX=0: FOR X=1 TO TF: T$="("+MID$(STR$(X),2)+")  "+L$(X)
00304 XX=XX+1: IF XX=1 THEN PRINT T$;: GOTO 306
00305 XX=0: PRINT TAB(38); T$
00306 NEXT X: XX=0: PRINT: PRINT
00307 PRINT"'^'FIELD # OR LABEL TO KEY ON FOR CONDITION #";Y;:INPUTBB$
00308 IF BB$="" THEN PRINT:PRINT"WHAT!":GOTO 307
00309 IF LEN(BB$)=K1 AND BB$="^" THEN PRINT:PRINT"WHAT!":GOTO 307
00310 IF LEFT$(BB$,1)<>"^" GOTO 315
00311 X=ASC(MID$(BB$,2,1)):IFX<47ORX>58THENPRINT:PRINT"WHAT!":GOTO307
00312 IFX>47ANDX<58GOTO 317
00313 PRINT:PRINT"WHAT!":GOTO 307
00315 FORZ=K1TOTF:IF BB$=L$(Z) THEN F1$(Y)=BB$:Z=TF:GOTO 320
00316 NEXTZ:PRINT:PRINT"WHAT!":GOTO 307
00317 BB=VAL(MID$(BB$,2)):IF BB<>INT(BB) THEN PRINT:PRINT"WHAT!":GOTO 307
00318 IF BB<1 OR BB>TF THEN PRINT:PRINT"WHAT!":GOTO 307
00319 F1$(Y)=L$(BB)
00320 PRINT:PRINT F1$(Y);" VS CONSTANT (1)"
00330 PRINT F1$(Y);: INPUT" VS CONTENTS (2) ";T1$: T1(Y)=VAL(T1$)
00340 IF T1(Y)<1 OR T1(Y)>2 THEN PRINT:PRINT"WHAT!":GOTO 320
00350 IF T1(Y)<>INT(T1(Y)) THEN PRINT:PRINT"WHAT!":GOTO 320
00360 IF T1(Y)<2 GOTO 400
00380 PRINT:PRINT"('^'FIELD # OR LABEL)"
00381 PRINT"THE FIELD  ";F1$(Y);
00382 INPUT"  IS TO BE COMPARED AGAINST ";BC$
00383 IF BC$="" THEN PRINT:PRINT"WHAT!":GOTO 380
00384 IF LEN(BC$)=K1 AND BB$="^" THEN PRINT:PRINT"WHAT!":GOTO 380
00385 IFLEFT$(BC$,1)<>"^" GOTO 390
00386 X=ASC(MID$(BC$,2,1)):IFX<47ORX>58THENPRINT:PRINT"WHAT!":GOTO 380
00387 IF X>47 AND X<58 GOTO 392
00388 PRINT:PRINT"WHAT!":GOTO 380
00389 REM
00390 FORZ=K1TOTF:IF BC$=L$(Z) THEN C1$(Y+K4)=BC$:Z=TF:GOTO 400
00391 NEXTZ:PRINT:PRINT"WHAT!":GOTO 380
00392 BC=VAL(MID$(BC$,2)):IF BC<>INT(BC)THENPRINT:PRINT"WHAT!":GOTO 380
00393 IF BC<1 OR BC>TF THEN PRINT:PRINT"WHAT!":GOTO 380
00394 C1$(Y+K4)=L$(BC)
00400 NF=1:IF T1(Y)>1 THEN NF=NF+1
00470 REM PICKUP CONDTION SPECIFIER
00475 A$="6": IF T1(Y)<K2 THEN A$="7"
00480 PRINT:PRINT"IF CONDITIONS POSSIBLE (3-";A$;" FOR NUMERIC VARIABLES ONLY)"
00485 PRINT
00490 PRINT"(1)  ";F1$(Y);" IS EQUAL TO"
00495 PRINT"(2)  ";F1$(Y);" IS NOT EQUAL TO"
00500 PRINT"(3)  ";F1$(Y);" IS LESS THAN"
00505 PRINT"(4)  ";F1$(Y);" IS LESS THAN OR EQUAL TO"
00510 PRINT"(5)  ";F1$(Y);" IS GREATER THAN"
00515 PRINT"(6)  ";F1$(Y);" IS GREATER THAN OR EQUAL TO ";
00516 IF T1(Y)<K2 THEN PRINT:GOTO 520
00517 INPUTT2$:T2(Y)=VAL(T2$):IFT2(Y)<1ORT2(Y)>6THENPRINT:PRINT"WHAT":GOTO480
00519 GOTO 540
00520 PRINT"(7)  ";F1$(Y);: INPUT" IS WITHIN A SPECIFIC RANGE ";T2$
00525 T2(Y)=VAL(T2$): REM R1++
00530 IF T2(Y)<1 OR T2(Y)>7 THEN PRINT:PRINT"WHAT!":GOTO 480
00540 IF T2(Y)<>INT(T2(Y)) THEN PRINT:PRINT"WHAT!":GOTO 480
00550 ON T2(Y) GOTO 580,580,580,580,580,580,560
00560 PRINT: PRINT F1$(Y);: INPUT" CANNOT BE LESS THAN ";R1$: R1(Y)=VAL(R1$)
00570 PRINTF1$(Y);:INPUT" CANNOT BE GREATER THAN ";R2$:R2(Y)=VAL(R2$):GOTO590
00580 IF T1(Y)>1 GOTO 640: REM SKIP ? IF 'COMPARE AGAINST FIELD'
00585 PRINT:PRINT"CONSTANT ";F1$(Y);:INPUT" IS TO BE COMPARED AGAINST ";C1$(Y+K4)
00586 IF C1$(Y+K4)="" THEN PRINT: PRINT"WHAT!": GOTO 585
00590 REM
00605 REM
00640 IF T1(Y)=K1 THEN L2(Y)=VAL(C1$(Y+K4)):REM CHG TO # VAR
00650 NEXT Y
00700 REM VERIFY 'CONDITIONAL' FIELDS & PICK UP OFFSETS AS  QQ(ZZ)
00720 TMP=K:FORX=K1 TO K:CMP$(X)=F1$(X):CMP$(X+K4)=C1$(X+K4):NEXTX
00730 GOSUB33020:FORX=K1TOK:QQ(X)=FP(SUB(X)):QQ(X+K4)=FP(SUB(X+K4)):NEXTX
00740 REM
00750 REM CHK FOR STAT WANTED
00760 S1=2: AV=2: MU=2: FOR X=1 TO 33: PRINT: NEXT
00770 INPUT"DO YOU WISH TO GENERATE ANY STATISTICAL INFORMATION ";QA$
00780 IF LEFT$(QA$,1)="N" OR QA$="" GOTO 910
00785 IF LEFT$(QA$,1)<>"Y" THEN PRINT: PRINT "WHAT": GOTO 770
00790 GOSUB 36020: REM GO GET STATISTICAL PARTICULARS
00800 REM REMOVED 'IF K=0 GOTO 5000'
00810 REM
00820 REM
00900 REM LOGIC TO RUN > FILE FOLLOWS
00910 FORX=K1TO34:PRINT:NEXTX
00915 POKE 2972,13: POKE 2976,13: REM PERMIT , & : IN DATA FIELD
00920 IF OP$="V" GOTO 2000:REM GOTO PRINT REPORT IN VERTICAL FORMAT
00940 REM REMOVED DIM PP(TP+1)
00950 FORX=K1 TO TP
00960 IF LF(X)<LEN(LL$(X)) GOTO 1000
00980 PP(X+1)=LF(X)+PP(X)+3:GOTO 1020
01000 PP(X+1)=LEN(LL$(X))+PP(X)+3:REM HEADER > FIELD
01020 NEXTX:REM TABS ARE SET AT THIS POINT
01040 IF (PP(TP+1)-3)<=SW GOTO 1140
01060 PRINT"ERROR **WIDTH OF REPORT WRITER IS ";PP(TP+1)-SW;" CHARACTERS TO";
01080 PRINT"O LONG**":GOTO 40000
01130 REM GOTO CONDITIONAL SUB LOGIC FOLLOWS
01135 REM TEST=1==NON CONDITIONAL/ TEST=2==CONDITIONAL
01136 REM KEY=1==KEY FILE ACCESS/ KEY=2==DIRECT MASTER FILE ACCESS
01140 KPR=BODF(CH): FOUND=2: REM FOUND=2==NO CONDITIONS MET
01160 GOSUB 32002: REM GOTO 'CONDITIONAL RETURN SUB'
01180 ON F1 GOTO 1200,1380
01200 FOUND=1: CTR=CTR+K1: IF CTR<2 GOTO 1240: REM FOUND=1==COND MET
01205 IFPD<3ANDLC>18THENPRINT"ENTER A  C  TO CONTINUE"
01210 XX=PEEK(11686)
01215 IF PD<3 AND LC>18 THEN POKE 11686,0:INPUTQA$:POKE11686,XX:GOTO1240
01220 IFLC<UX-8GOTO1340
01240 PG=PG+K1: PRINT#PD: LC=0
01260 PRINT#PD,H$;TAB(SW-10);" PAGE ";PG;: PH=POS(X): PRINT#PD
01290 FORX=K0 TO PH-K2:PRINT#PD,TAB(X);"-";:NEXT:PRINT#PD
01295 FOR X=K0 TO PH-K2: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
01296 PRINT#PD
01300 FOR X=K1 TO TP: PRINT#PD,TAB(PP(X));LL$(X);: NEXT
01310 PH=POS(X):PRINT#PD:FORX=K0TOPH-K1:PRINT#PD,TAB(X);"-";:NEXT:PRINT#PD
01320 PRINT#PD
01340 FORX=K1 TO TP:PRINT#PD,TAB(PP(X));L$(X);:NEXTX:PRINT#PD
01360 IF SKIP>0 THEN PRINT #PD: LC=LC+K1
01370 LC=LC+K1: GOSUB 38020: REM UPDATE STAT
01380 ON F2 GOTO 1160,25000: REM F2=1==LOOP BAC FOR MORE
01400 REM
02000 REM ? CONDITIONAL REPORT IN VERTICAL FORMAT INSTEAD OF HORIZONTAL
02050 REM
02100 REM GOTO CONDITIONAL SUB LOGIC FOLLOWS
02120 KPR=BODF(CH): FOUND=2: REM FOUND=2==NO CONDITIONS MET
02140 GOSUB 32002: REM GOTO 'CONDITIONAL RETURN SUB'
02160 ON F1 GOTO 2180,2420
02180 FOUND=1: CTR=CTR+K1: IF CTR<2 GOTO 2240: REM FOUND=1==COND MET
02200 IFLC<UX-6GOTO2320
02240 PG=PG+K1:PRINT#PD:LC=0
02260 PRINT#PD,H$;TAB(SW-10);" PAGE ";PG;:PH=POS(X):PRINT#PD
02300 FORX=K0 TO PH-K2:PRINT#PD,TAB(X);"-";:NEXT:PRINT#PD
02310 FOR X=K0 TO PH-K2: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
02315 PRINT#PD
02320 FORX=K1TOTP:PRINT#PD,TAB(0+GG);LL$(X);TAB(36);L$(X):GG=2:LC=LC+K1
02322 IF SKIP>0 THEN PRINT #PD: LC=LC+K1
02325 IFLC>UX-6THENCL=LC:LC=0:PRINT#PD
02330 NEXTX:PRINT#PD:GG=0
02332 GOSUB 38020: REM GO UPDATE STAT STUFF
02335 IFTP<UX-5THENLC=LC+1:GOTO2350
02340 IFCL>K0THENFORX=1TOPEEK(15908):PRINT#PD:NEXTX:CL=0:LC=UX-4:GOTO2400
02350 IFLC+TP+1>UX-6THENFORX=1TOPEEK(15908):PRINT#PD:NEXTX:LC=UX-4
02420 ON F2 GOTO 2140,25000: REM F2=1==LOOP BAC FOR MORE
02440 REM
02450 REM
24990 REM SECTION TO PRINT OUT STAT STUFF
25000 P=2: IF SU=1 OR AV=1 OR NU=1 OR MU=1 THEN P=1
25020 ON P GOTO25030,25900:REM 1==DO STAT STUFF/ 2==DONT
25030 ON FOUND GOTO 25035,25900: REM FOUND=1==CONDITION MET
25035 IF PD<3 THEN PRINT: INPUT"ENTER A  C  TO CONTINUE ";QA$
25040 FOR X=1 TO PEEK(15908): PRINT #PD: NEXT 
25100 GOSUB 34030: IF LEFT$(OP$,1)="V" GOTO 25610
25120 REM HORIZ
25140 ON SUMFLG GOTO 25160,25300
25155 REM SUM
25160 PRINT#PD, TAB(INT((SW-10)/2));"SUMMATIONS"
25170 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
25190 FOR X=1 TO CNT(1): PRINT#PD,TAB(P1(X));LL$(S1(X));: NEXT
25200 PH=POS(X): PRINT#PD: FOR X=0 TO PH-K1: PRINT#PD,TAB(X);"-";: NEXT
25210 FOR X=1 TO CNT(1): S2(X)=INT((S2(X)+.000000005)*1E8)/1E8:NEXT
25220 PRINT#PD: FOR X=1 TO CNT(1): PRINT#PD,TAB(P1(X));S2(X);: NEXT
25225 PRINT#PD: FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
25226 IF SKIP>0 THEN PRINT #PD
25290 REM AVG
25300 ON AVERGE GOTO 25320,25500
25320 PRINT#PD,TAB(INT((SW-10)/2));"AVERAGES"
25330 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
25350 FOR X=1 TO CNT(2): PRINT#PD,TAB(P2(X));LL$(A1VG(X));: NEXT
25360 PH=POS(X): PRINT#PD: FOR X=0 TO PH-1: PRINT#PD,TAB(X);"-";: NEXT
25370 FOR X=1 TO CNT(2): S3(X)=INT((S3(X)+.000000005)*1E8)/1E8/S4:NEXT
25380 PRINT#PD: FOR X=1 TO CNT(2): PRINT#PD,TAB(P2(X));S3(X);: NEXT
25385 PRINT#PD: FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
25386 IF SKIP>0 THEN PRINT #PD
25490 REM (F1*F2)
25500 ON MU GOTO 25520,25900
25520 PRINT#PD,TAB(10);"SUM OF ";LL$(P3);" MULTIPLIED BY ";LL$(P4)
25530 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
25550 PRINT#PD,LL$(P3);" * ";LL$(P4);"=";INT((S5+.000000005)*1E8)/1E8
25560 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
25561 IF SKIP>0 THEN PRINT #PD
25585 GOTO 25900: REM COMMON EXIT POINT
25600 REM VERT
25610 ON SUMFLG GOTO 25630,25720
25630 PRINT#PD,TAB(INT((SW-10)/2));"SUMMATIONS"
25640 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
25660 FOR X=1 TO CNT(1): S2(X)=INT((S2(X)+.000000005)*1E8)/1E8:NEXT
25670 FOR X=1 TO CNT(1): PRINT#PD,TAB(GG);LL$(S1(X));TAB(36);S2(X):GG=2
25680 IF SKIP>0 THEN PRINT #PD: LC=LC+K1
25700 NEXT: GG=0: FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
25710 REM VERTICAL RPINT AVERAGES SECTION
25720 ON AVERGE GOTO 25740,25820
25740 PRINT#PD,TAB(INT((SW-10)/2));"AVERAGES"
25750 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
25760 FOR X=1 TO CNT(2): S3(X)=INT((S3(X)+.000000005)*1E8)/1E8/S4:NEXTX
25770 FOR X=1 TO CNT(2): PRINT#PD,TAB(GG);LL$(A1(X));TAB(36);S3(X):GG=2
25780 IF SKIP>0 THEN PRINT #PD: LC=LC+K1
25790 NEXT X: GG=0: FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
25810 REM (F1*F2)
25820 ON MU GOTO 25840,25900
25840 PRINT#PD,TAB(10);"SUM OF ";LL$(P3);" MULTIPLIED BY ";LL$(P4)
25850 FOR X=0 TO SW: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
25860 PRINT#PD,LL$(P3);" * ";LL$(P4);"=";INT((S5+.000000005)*1E8)/1E8
25870 GG=0: FOR X=0 TO SW: PRINT #PD,TAB(X);"-";: NEXT: PRINT #PD
25895 REM EXIT . 
25900 IF FOUND<>2 OR K=0 GOTO 25910
25905 PRINT "NO RECORD(S) FOUND THAT MET THE CONDITION(S) SPECIFIED"
25910 PRINT: PRINT "DONE": PRINT: INPUT"ENTER A  C  TO CONTINUE ";QA$
25920 GOTO 51110: REM COMMON EXIT POINT
25950 REM
25970 REM +++++++ SUBROUTINES FOLLOW +++++++
30000 REM SUBROUTINE TO PICKUP ALL FIELDS 'NAME',LENGTH,OFFSET
30005 REM
30010 REM L$(N)='NAME'/FL(N)=LENGTH/FP(N)=OFFSET
30012 INDEX<CH>=53: TF=K0
30014 INPUT %CH,DUMY$: INPUT %CH,DUMY
30016 TF=TF+K1: IF INDEX(CH)<BODF(CH) GOTO 30014
30017 DIM L$(TF+1),LL$(TF+1),FL(TF+1),FP(TF+1),MRK(TF+1)
30018 DIM PF(TF+1),TYPE(TF+1),PP(TF+1),LF(TF+1),FF(TF+1),TMP$(TF+1)
30020 TT=K0: TF=K1: G1=30030: INDEX<CH>=53: REM TT=OFFSET TF=# OF F'S
30030 INPUT %CH,L$(TF): INPUT %CH,FL(TF): FP(TF)=TT
30040 TT=TT+FL(TF): IF INDEX(CH)<BODF(CH) THEN TF=TF+1: GOTO G1
30050 IF INDEX(CH)>BODF(CH) THEN ERR$="FILE HEADER ERROR": GOTO 40000
30060 RETURN: REM BAC WE GO
31000 REM MASTER FILE VERIFICATION SUB
31020 PRINT: INPUT"DEVICE MASTER FILE IS STORED ON ";MD$(CH)
31025 IF MD$(CH)="" THEN MD$(CH)=CHR$(DV(2)+65): GOTO 31060
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
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": REM XXXXX0
31100 IF MP$(CH)="." THEN MP$(CH)="ANAN": REM CHK PASSWORD
31110 IF LEN(MP$(CH))<>4 THEN PRINT: PRINT"IMPROPER PASSWORD": GOTO 31060
31130 DEV MD$(CH): REM SELECT NEW DEVICE
31140 OPEN MF$(CH),MP$(CH),CH: REM OPEN FILE 
31145 PRINT:PRINT"PLEASE WAIT"
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
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
31270 IF NR(CH)<1 THEN ERR$="FILE EMPTY": GOTO 40000
31290 RETURN: REM RETURN TO CALLER
32000 REM 'CONDITIONAL RETURN RECORD'
32002 G1=32900: G2=32950: REM GOTO'S
32004 F2=K1: F1=K2: ON KEY GOTO 32005,32010: REM KEY=1==NON-CONDIT
32005 DEVKD$:INPUT%8,D$:IFRIGHT$(D$,1)<>"*"THENINPUT%8,KPR:GOTO32010
32006 INPUT %8,DUMY$: IF INDEX(8)<EDF GOTO 32005
32007 GOTO 32965: REM EXIT 'CAUSE EODF OF KEY FILE HIT 
32010 DEV MD$(CH): ON TEST GOTO 32905,32015: REM 1==NON/ 2==CONDITION
32015 FOR ZZ=K1 TO K: INDEX<CH>=KPR+QQ(ZZ): INPUT %CH,DUMY$(ZZ)
32020 ON T1(ZZ) GOTO 32030,32025
32025 INDEX<CH>=KPR+QQ(ZZ+K4): INPUT %CH,DUMY$(ZZ+K4)
32030 ON T2(ZZ) GOTO 32070,32100,32040,32040,32040,32040,32040
32040 ON T1(ZZ) GOTO 32060,32050
32050 L2(ZZ)=VAL(DUMMY$(ZZ+K4))
32060 L1=VAL(DUMY$(ZZ))
32065 ON T2(ZZ) GOTO 32070,32100,32125,32135,32145,32155,32165
32070 ON T1(ZZ) GOTO 32080,32090
32080 IF DUMY$(ZZ)=C1$(ZZ+K4) GOTO G1
32085 GOTO G2
32090 IF DUMY$(ZZ)=DUMY$(ZZ+K4) GOTO G1
32095 GOTO G2
32100 ON T1(ZZ) GOTO 32105,32115
32105 IF DUMY$(ZZ)<>C1$(ZZ+K4) GOTO G1
32110 GOTO G2
32115 IF DUMY$(ZZ)<>DUMY$(ZZ+K4) GOTO G1
32120 GOTO G2
32125 IF L1<L2(ZZ) GOTO G1
32130 GOTO G2
32135 IF L1<=L2(ZZ) GOTO G1
32140 GOTO G2
32145 IF L1>L2(ZZ) GOTO G1
32150 GOTO G2
32155 IF L1>=L2(ZZ) GOTO G1
32160 GOTO G2
32165 IF L1>=R1(ZZ) AND L1<=R2(ZZ) GOTO G1
32170 GOTO G2
32900 NEXT: REM THIS LINE EMPTY ON PURPOSE
32905 FOR X=K1 TO TP: INDEX<CH>=KPR+FF(X):INPUT%CH,L$(X):NEXTX
32910 ON KEY GOTO 32920,32930
32920 IF INDEX(8)>=EDF THEN F2=K2: REM EDF IN K HIT
32925 F1=K1: RETURN: REM F1=K1==ALL CONDITION(S) MET (IF ANY SET)
32930 KPR=KPR+RL(CH): IF KPR>=EODF(CH) THEN F2=K2: REM EODF IN MASTER ?
32940 F1=K1: RETURN: REM F1=1==RECORD MET ALL CONDITION(S)
32950 ON KEY GOTO 32960,32970: REM 1==KEY/ 2==DIRECT
32960 IF INDEX(8)<EDF GOTO 32004: REM EDF IN KEY HIT ?/ NO=GOTO
32965 F2=K2: RETURN: REM F2=K2==EDF HIT ON KEY FILE
32970 KPR=KPR+RL(CH): IF KPR<EODF(CH) GOTO 32004: REM EODF IN MASTER
32980 F2=K2: RETURN: REM F2=K2==EODF HIT IN MASTER
33000 REM SUBROUTINE TO VERIFY FIELDS EXIST AND RETURN SUB(N)
33010 REM WHERE SUB(N)=SUBSCRIPT FOR THE PROPER L$,FL,FP
33020 FOR X=K1 TO TMP: SUB(X)=0: SUB(X+K4)=0: FOR Y=K1 TO TF
33030 IF CMP$(X)=L$(Y) THEN SUB(X)=Y
33040 IF CMP$(X+K4)=L$(Y) THEN SUB(X+K4)=Y
33050 NEXT: NEXT X: REM NEXT WE VERIFY FIELDS WERE FOUND
33060 FE=K0: FOR X=K1 TO TMP: IF SUB(X)>K0 OR CMP$(X)="" GOTO 33080
33070 PRINT:PRINT"NOT ENOUGH DATA IN FILE. FIELD NEEDED IS : ";CMP$(X):FE=1
33080 ON T1(X) GOTO 33110,33090: REM T1(X)=2==(F)
33090 IF SUB(X+K4)>K0 OR CMP$(X)="" GOTO 33110
33100 PRINT:PRINT"NOT ENOUGH DATA IN FILE. FIELD NEEDED IS : ";CMP$(X+K4):FE=1
33110 NEXT X: IF FE>K0 GOTO 40000: REM FE>0==FIELD(S) NOT FOUND
33120 RETURN: REM BAC WE GO
34010 REM PAGE HEADING CNTRL SUB
34030 PG=PG+1: LC=0: PRINT#PD
34040 PRINT#PD,H$;TAB(SW-10);" PAGE ";PG;:PH=POS(X)-3:PRINT#PD
34050 FOR X=0 TO PH-K2: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD
34060 FOR X=0 TO PH-K2: PRINT#PD,TAB(X);"-";: NEXT: PRINT#PD: PRINT#PD
34070 RETURN: REM BAC WE GO
35000 REM KEY FILE OPEN AND VERIFICATION SUB
35020 PRINT: INPUT"DEVICE KEY FILE IS STORED ON ";KD$
35022 IF LEN(KD$)<>1 THEN PRINT: PRINT "INVAILD DEVICE": GOTO 35020
35024 IF KD$<"A" OR KD$>"E" THEN PRINT: PRINT"INVAILD DEVICE":GOTO35020
35030 PRINT: INPUT"KEY FILE NAME,PASSWORD ";KF$,KP$
35032 IF LEN(KF$)<1 ORLEN(KF$)>5THENPRINT:PRINT"INVAILD FILE NAME":GOTO35030
35040 IF KP$="." THEN KP$="ANAN": REM .==ANAN
35050 IF LEN(KP$)<>4 THEN PRINT: PRINT"INVAILD PASSWORD":GOTO35030
35060 PRINT: INPUT"KEY FILE TYPE ";KT$: KT=VAL(KT$)
35070 IF KT<1 OR KT>7 OR KT<>INT(KT) THEN PRINT: PRINT "WHAT": GOTO 35060
35110 IF LEN(KF$)<5 THEN KF$=KF$+" ": GOTO 35110
35120 KF$=KF$+MID$(STR$(KT),2): REM ADD TYPE TO NAME
35130 DEV KD$: OPEN KF$,KP$,8: REM OPEN KEY FILE
35140 INPUT %8,DUMY$: IF DUMY$=LEFT$(KF$,5) GOTO 35160
35150 ERR$="FILE HEADER MISMATCH": GOTO 40000
35160 INPUT %8,DUMY$: DUMY=VAL(DUMY$): IF DUMY=KT+10 GOTO 35180
35170 ERR$="KEY FILE TYPE MISMATCH": GOTO 40000
35180 INPUT %8,EDF$: EDF=VAL(EDF$)
35185 REM DUMY INPUT MASTER REC LEN,BODF AND INPUT KEY LABEL
35190 INDEX<8>=42: INPUT %8, LABEL$
35200 IF EDF<INDEX(8) THEN ERR$="FILE EMPTY": GOTO 40000
35210 RETURN: REM BAC WE GO
36000 REM
36010 REM SUBROUTINE TO HANDLE PICKUP OF STAT SPECIFICS
36020 FOR X=1 TO 33: PRINT: NEXT: PRINT
36030 PRINT"ENTER THE SELECTIONS WHICH YOU WOULD LIKE TO SUM"
36040 PRINT"IF NONE, SIMPLY HIT THE RETURN KEY"
36050 TT=TF: FOR X=1 TO TF: TMP$(X)=LL$(X): NEXT
36060 FOR X=1 TO TT: ON TYPE(X) GOTO 36100,36080
36080 FOR Y=X TO TT-1: TMP$(Y)=TMP$(Y+1): TYPE(Y)=TYPE(Y+1)
36090 NEXT: TT=TT-1: GOTO 36060
36100 NEXT X
36130 PRINT:PRINT: GOSUB 37020
36150 REM EQUATE VAR(S)
36160 SUMFLG=2: ON P GOTO 36180,36220
36180 SUMFLG=1: CNT(1)=WW: FOR X=1 TO WW: S1UM(X)=TMP(X)
36185 P1(X)=PNTR(X): NEXT: REM P1 USED FOR TABS
36200 REM AVG
36220 FOR X=1 TO 33: PRINT: NEXT: PRINT
36230 PRINT"ENTER THE SELECTIONS YOU WOULD LIKE TO HAVE AVERAGED"
36240 PRINT"IF NONE, SIMPLY HIT THE RETURN KEY"
36250 PRINT:PRINT: GOSUB 37020: REM GO GET USER PARTICULARS
36270 AVERAG=2: ON P GOTO 36290,36420
36290 AVERGE=1: CNT(2)=WW: FOR X=1 TO WW: A1VERG(X)=TMP(X)
36295 P2(X)=PNTR(X): NEXT: REM P2 USED FOR TABS
36410 REM MULTI
36420 FOR X=1 TO 33: PRINT: NEXT: FOR X=1 TO TF: TMP$(X)=LL$(X):NEXT
36425 PRINT:PRINT"YOU MAY NOW SELECT ANY TWO FIELDS. THESE TWO FIELDS"
36430 PRINT"WILL THEN BE MULTIPLIED TOGETHER AND THE SUM OF THEIR"
36440 PRINT"PRODUCTS WILL BE DISPLAYED AT THE END OF THIS REPORT"
36450 PRINT"IF YOU DO NOT DESIRE THIS OPTION SIMPLY HIT THE RETURN KEY"
36470 MU=2: PRINT: GOSUB 37020: REM GO TO GET USER'S CHOICE
36480 ON P GOTO 36500,36600
36500 IF WW>2 THEN PRINT"TWO FIELDS ONLY": GOTO 36470
36505 IF WW<2 THEN PRINT"TWO FIELDS REQUIRED": GOTO 36470
36510 MU=1: P3=TMP(1): P4=TMP(2): REM PICK UP SUBSCRIPTS
36600 RETURN: REM BAC WE GO
37000 REM
37010 REM SUB TO PARSE OUT USER'S CHOICE(S)
37020 XX=0: FOR X=1 TO TT: T$="("+MID$(STR$(X),2)+")  "+TMP$(X)
37030 XX=XX+1: IF XX=1 THEN PRINT T$;: GOTO 37050
37040 XX=0: PRINT TAB(38);T$
37050 NEXT: PRINT
37090 REM PARSE OUT USER'S CHOICE(S)
37110 PRINT"ENTER YOUR SELECTION(S)": INPUT QA$
37120 P=1: WW=0: IF QA$="" THEN P=2: GOTO 37600
37122 FOR X=1 TO LEN(QA$): T$=MID$(QA$,X,1)
37124 IF T$=" " OR T$="^" GOTO 37128
37126 IF T$<"0" OR T$>"9" GOTO 37150
37128 NEXT X
37130 IF LEN(QA$)=1 AND QA$="^" GOTO 37150
37135 IF LEFT$(QA$,1)<>"^" GOTO 37150
37140 GOTO 37170
37150 XX=0: WW=0: PRINT: PRINT"WHAT": GOTO 37020
37170 FOR X=1 TO LEN(QA$): IF MID$(QA$,X,1)<>"^" GOTO 37190
37180 MRK(WW+K1)=X: WW=WW+K1: IF WW>TF+K1 THEN GOTO 37150
37190 NEXT: MRK(WW+1)=LEN(QA$)+1
37195 IF WW<=9 GOTO 37230
37196 PRINT: PRINT"SORRY, ONLY 9 FIELDS PERMITTED": WW=0: XX=0: GOTO 37020
37200 REM
37210 REM PICK OUT STRINGS
37230 FOR X=1 TO WW: MRK$(X)=MID$(QA$,MRK(X)+K1,MRK(X+K1)-(MRK(X)+1))
37240 T=VAL(MRK$(X))
37250 IF T<>INT(T) OR T<1 OR T>TT GOTO 37150
37260 NEXT
37270 FOR X=1 TO WW: PNTR(X)=0: NEXTX
37280 Z=0: FOR X=1 TO WW: TMP(X)=0: FOR Y=1 TO TF
37290 IF TMP$(VAL(MRK$(X)))<>LL$(Y) GOTO 37310
37300 TMP(X)=Y: PNTR(X)=Z: T=LEN(LL$(Y)): IF T<11 THEN T=11
37305 Z=Z+T+3
37310 NEXT
37320 NEXT X
37340 IF OP$="V" OR PNTR(WW)-3<=SW GOTO 37600
37350 PRINT: PRINT"REPORT IS ";PNTR(WW)-SW;" CHARACTERS TOO LONG": GOTO 37020
37600 RETURN: REM BAC WE GO
38000 REM
38010 REM SUB TO UPDATE REGISTERS FOR SUMS,AVERGAES, & # OF OCCURENCES
38020 ON SUMFLG GOTO 38040,38100
38040 FOR X=K1 TO CNT(K1): S2(X)=S2(X)+VAL(L$(S1UM(X))): NEXT
38100 ON AV GOTO 38120,38200
38120 FOR X=K1 TO CNT(K2): S3(X)=S3(X)+VAL(L$(A1VG(X))):NEXT:S4=S4+K1
38200 ON MU GOTO 38220,38300
38220 S5=S5+(VAL(L$(P3))*VAL(L$(P4)))
38240 IF OP$<>"V" GOTO 38300
38260 PRINT#PD,TAB(2);LL$(P3);" * ";LL$(P4);" SUBTOTAL";
38270 PRINT#PD,TAB(36);INT((S5+.000000005)*1E8)/1E8: PRINT#PD: LC=LC+K2
38300 RETURN: REM BAC WE GO
40000 ER=.5: REM ERROR CODE TO HOLD
40010 PRINT: PRINT ERR$: PRINT: CLOSE: GOTO 51100: REM COMMON EXIT PATH
50000 REM ERROR HANDLER
50010 ER=PEEK(10226): EL=PEEK(11774)+PEEK(11775)*256
50020 REM
50040 IF ER=128 THEN ERR$="INVALID FILENAME": GOTO 51050
50050 IF ER=132 THEN ERR$="END OF FILE ERROR": GOTO 51000
50060 IF ER=130 THEN ERR$="ACCESS RIGHTS VIOLATION": GOTO 51000
50070 IF ER=129 THEN ERR$="CANNOT ACCESS FILE ": GOTO 51050
50080 ERR$="DISC ERROR CODE "+STR$(ER)+" IN LINE "+STR$(EL)
50090 REM
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
51040 FOR X=1 TO 33: PRINT: NEXT X
51050 PRINT:PRINT:PRINT"*****  ERROR  *****": PRINT: PRINT
51060 PRINTERR$
51100 IF ER>0 THEN PRINT: INPUT"ENTER A  C  TO CONTINUE ";QA$
51110 DEV CHR$(DV(2)+65): REM SELECT ORGINAL DEVICE
51111 ZA=ZA+1: IF ZA>1 GOTO 51120
51113 FOR X=1 TO PEEK(15908): PRINT #PD: NEXT
51115 FOR X=1 TO PEEK(15908): PRINT #PD: NEXT
51120 FLAG 6: REM ENABLE PROGRAM ABORT ON EOF HIT ERROR
51130 POKE 2972,58: POKE 2976,44: REM DISABLE , & : IN DATA  FIELD
51160 CLOSE: RUN"DBMSYS","PASS"
DataMuseum.dk

Ohio Scientific Inc.

⟦205fd055a⟧

Derivation

BASIC

Full view
