|
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: 10224 (0x27f0)
Notes: OS65UFile, OSU65U-BASIC
Names: »MAILER«
└─⟦2f57871a3⟧ Bits:30009355 Ohio Scientific OS-OMS Nucleus, delvist oversat til dansk
└─⟦this⟧ »MAILER«
00001 PRINT"THIS PROGRAM NOT EXECUTABLE FROM THE CONSOLE.":RUN"DBMSYS","PASS" 00002 CLOSE:CLEAR:REM 1/79 GENERATE MAILING LABELS (MAILER) 00005 PC=PEEK(14457): POKE 14457,66: REM SAVE PAGE CNT AND DISABLE PAGEING 00010 REM FD$(X)=FIELD DESCRIPTOR/FP(X)=RELATIVE OFFSET POSTION OF FIELD 00015 NF=5 00020 DIM FD$(NF+1),FP(NF+1),TY$(NF+1): 00029 FOR X=1 TO 30: PRINT: NEXT X 00030 FT=5: REM # OF PRINTING FIELDS 00031 PRINT"******************************************************" 00032 PRINT"* *" 00033 PRINT"* DETTE PROGRAM UDSKRIVER ETIKETTER (1,2 ELLER 3). *" 00034 PRINT"* DER STILLES KRAV OM EN MASTERFIL MED MINDST 3 *" 00035 PRINT"* DATANAVNE: 1. ADRESSE 2. POSTNR *" 00036 PRINT"* 3. POSTDR *" 00037 PRINT"* EVT. 4. NAVN 5. C/O *" 00038 PRINT"* *" 00039 PRINT"******************************************************" 00040 FLAG 6: FLAG 9: FLAG 11: FLAG 21: REM *********************** 00041 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT 00042 INPUT"\NSKES UDSKRIFT P] SK[RM (S) ELLER PRINTER (P) ";QA$:PRINT 00043 IF LEFT$(QA$,1)="P" GOTO 48 00044 DV(1)=PEEK(11686) 00045 GOTO 52 00048 INPUT"HVILKEN PORT \NSKES UDSKRIFT P] ";DV(1):PRINT:PRINT:PRINT 00052 INPUT"TILGANG MED N\GLE FIL (N) ELLER MASTER FIL (M) ";KA$:PRINT 00053 IF KA$="" OR KA$="M" GOTO 80 00054 IFKA$<>"N"THENPRINT:PRINT"*** FORKERT !!":GOTO 52 00055 INPUT"INDTAST HVOR N\GLE FILEN LIGGER ";KD$:PRINT:PRINT 00056 IFKD$<"A"ORKD$>"E"THENPRINT:PRINT"*** FORKERT !!":GOTO 55 00057 IFLEN(KD$)>1ORKD$=""THENPRINT:PRINT"*** FORKERT !!":PRINT:GOTO 55 00058 INPUT"N\GLE FIL, KODEORD ";K$,P$:PRINT:IFP$="."ORP$="."THENP$="ANAN" 00059 IF LEN(K$)<1ORLEN(K$)>6THENPRINT:PRINT"** UGYLDIGT FILNAVN":GOTO 58 00060 IFK$=""ORP$=""THENPRINT:PRINT"*** FORKERT !!":GOTO 58 00061 IF LEN(P$)<>4THENPRINT"*** UGYLDIGT KODEORD !!":GOTO 58 00062 INPUT"N\GLE FIL NR. (1-7) ";U$:PRINT:U=VAL(U$):U=INT(U) 00063 IFU<1ORU>7THENPRINT:PRINT"*** FORKERT !!":GOTO 62 00064 IFLEN(K$)<5THENK$=K$+" ":GOTO64 00065 K$=LEFT$(K$,5)+RIGHT$(STR$(U),1):DEVKD$:OPENK$,P$,2 00066 INDEX<2>=9:INPUT%2,EDF 00080 PRINT: INPUT"INDTAST P] HVILKEN STATION MASTER FILEN LIGGER ";MD$ 00085 IF LEN(MD$)>1 THEN PRINT:PRINT"*** FORKERT !!":PRINT:GOTO 80 00090 IFLEFT$(MD$,1)<"A"ORLEFT$(MD$,1)>"E" THENPRINT"*** FORKERT !":GOTO80 00092 DV(2)=PEEK(9832): IF DV(2)>127 THEN DV(2)=DV(2)-128+4 00094 DEV MD$: REM SELCT DEVICE SPECIFIED 00096 PRINT 00100 REM NAME,PASS 00110 INPUT"INDTAST MASTER FIL NAVN, KODEORD ";MN$,MP$ 00115 IF LEN(MN$)<5 THEN MN$=MN$+" ": GOTO 115: REM ADD SPACES IF NEEDED 00116 IFLEN(MN$)>5THENPRINT:PRINT"*** UGYLDIGT FIL NAVN": GOTO 110 00118 IF LEN(MN$)<6 THEN MN$=MN$+"0" 00120 REM PASS 00130 IF MP$="." OR MP$="." THEN MP$="ANAN" 00140 IFLEN(MP$)<>4 THEN PRINT"*** UGYLDIGT KODEORD": GOTO 110 00150 REM OPEN WITH ERR 00160 OPEN MN$,MP$,1: REM OPEN MASTER FILE 00165 REM FILE NAME CHK 00170 INDEX<1>=0:INPUT%1,N$:IFN$=LEFT$(MN$,5)GOTO190 00180 ERR$="FILE HEADER MISMATCH": GOTO 40000: REM ERR HANDLER 00190 INDEX<1>=6:INPUT%1,TY:REM VERIFY TYPE AS MASTER FILE TYPE 00200 IF TY<>10 THEN ERR$="NOT A MASTER FILE TYPE": GOTO 40000 00210 INDEX<1>=9:INPUT%1,EODF:REM GET END OF DATA FILE 00220 INDEX<1>=20:INPUT%1,BODF:REM GET BEGINNING OF DATA FILE 00230 REM CHK IF DATA EXISTS IN FILE 00240 IF EODF<=BODF THEN ERR$="FILE EMPTY": GOTO 40000 00250 INDEX<1>=31:INPUT%1,RL:REM GET RECORD LENGTH 00260 INDEX<1>=42:INPUT%1,NR:REM GET NUMBER OF RECORDS 00270 REM DOUBLE CHK FOR DATA I.E. NR>0 00280 IF NR<1 THEN ERR$="FILE EMPTY": GOTO 40000 00300 REM MUST HAVE 'STREET','CITY','STATE',AND 'ZIP' OR NO GO 00310 REM NF=# OF DESIRED FIELDS, LABELS=FD$,POSTION=FP,LB$=STRING OUT 00350 FD$(1)="NAVN": TY$(1)="OPTIONAL" 00360 FD$(2)="C/O": TY$(2)="OPTIONAL" 00370 FD$(3)="ADRESSE":TY$(3)="NEEDED" 00380 FD$(4)="POSTNR": TY$(4)="NEEDED" 00390 FD$(5)="POSTDR": TY$(5)="NEEDED" 00420 FOR X=1 TO NF: FP(X)=1E8: NEXT X 00430 GOSUB 30000: REM VARIFY FIELDS EXISTANCE 00600 REM VERIFY THAT MIN. AMOUNT OF DATA EXISTS 00620 T1=NF: REM TMP=# OF FIELDS 00630 T=0: FOR X=1 TO NF: REM R1* ADDED MULTIPLE FIELD MISSING ERR MESS 00640 IF FP(X)<1E8 GOTO 720 00650 IF TY$(X)="OPTIONAL" GOTO 690 00660 REM NOT ENOUGH DATA IN FILE TO PRINT LABELS 00670 PRINT"EJ NOK FELTER I FILEN, TIL AT LAVE ETIKETTER":GOTO40000 00680 IF T=1 GOTO 40000: REM EXIT ON ERROR PNT 00690 FOR Y=X TO NF-1 00700 FD$(Y)=FD$(Y+1): FP(Y)=FP(Y+1): TY$(Y)=TY$(Y+1) 00710 NEXT Y: T1=T1-1: GOTO 630: REM ONE LESS FIELD 00720 NEXT X: IF T=1 THEN ERR$="NOT ENOUGH DATA IN FILE.": GOTO 40000 00730 NF=T1: REM PICKUP NEW TOTAL # OF FIELDS 00790 REM 02000 REM GET USER SPECIFIED INPUT 02010 PRINT:INPUT"ANTAL ETIKETTER PR. LINIE (1,2 ELLER 3) ";NL$:PRINT 02015 NL=VAL(NL$): REM R1* CHANGED SO NO 'REDO FROM START' MESSAGES 02020 IF NL<>INT(NL) THEN PRINT:PRINT"*** FORKERT !!":GOTO 2010 02022 IF NL<1ORNL>3 THEN PRINT:PRINT"*** FORKERT !!":GOTO 2010 02025 DIM HT(NL),PP(NL): REM DIM OUT H LIST AND TAB LIST 02026 DIM HT$(NL): REM SET FOR R1* 02030 REM GET HORIZONAL TAB IF NEEDED 02040 IF NL<2 GOTO 2120: REM GOTO IF ONLY ONE LABEL PER LINE 02050 SM=0: FOR X=2 TO NL 02060 PRINT:PRINT"HORISONTAL AFSTAND TIL ETIKET NR.";X;" ": 02061 INPUT HT$(X) 02065 HT(X)=VAL(HT$(X)): REM R1* NO MORE 'REDO FROM START' 02070 IF HT(X)<>INT(HT(X)) GOTO 2090 02080 IF HT(X)>0 AND HT(X)<133 GOTO 2095 02090 PRINT: PRINT"WHAT": GOTO 2060 02095 PP(X)=SM+HT(X): SM=SM+HT(X): REM CALCULATE PRINT TABS 02100 NEXT X 02110 REM GET VERTICAL TAB 02120 PRINT:INPUT"VERTIKAL AFSTAND MELLEM ETIKETTERNE ";VT$ 02125 VT=VAL(VT$): REM R1* NO MORE 'REDO FROM START' MESSAGES 02127 FOR X=1 TO LEN(VT$): X$=MID$(VT$,X,1) 02128 IF X$<"0" OR X$>"9" THEN PRINT:PRINT"*** FORKERT !!":GOTO2120 02130 IF VT<>INT(VT) THEN PRINT: PRINT"WHAT": GOTO 2120 02140 IF VT<0 THEN PRINT: PRINT"WHAT": GOTO 2120 02150 VT=VT-NF: REM ADJUST VERT. TAB DEPENDENT ON (FILE) 02155 IF VT>=1 GOTO 2190 02160 PRINT:PRINT"ER DET I ORDEN AT ETIKETTERNE BLIVER UDSKREVET" 02162 INPUT"LIGE EFTER HINANDEN ";QA$ 02164 IF LEFT$(QA$,1)="N" GOTO 2120 02170 REM CALCULATE # OF ROWS TO PRINT AND SET VARIABLE GOTO ACCORDINGLY 02190 NR=INT((EODF-BODF)/RL):RC=INT(NR/NL) 02200 EX=INT(NR-(RC*NL)): REM CALCULATE # OF EXTRA LABELS 02220 POKE 2972,13: POKE 2976,13: REM ALLOW , & : IN DATA FIELD 02230 FOR X=1 TO 33: PRINT: NEXT 02240 IFKA$="K"THENDIML$(NF+1,NL+1):GOTO31020 03999 REM 04000 REM BEGINING OF LOGIC TO GET RECORDS 04010 S=6-NF: K1=1-S: K2=2-S: K3=3-S: K4=4-S: K5=5-S: K6=6-S 04020 KPR=BODF: R2=INT(RL*2): R3=INT(RL*3): P1=1: P2=2: P3=3 04030 Z=6-NF+1: K0=0: V=1: G1=4060: G2=4410: G3=4810: REM ******** 04040 ON NL GOTO 4060,4410,4810 04050 REM 1 CODE 04060 ON Z GOTO 4070,4080,4090 04070 INDEX<V>=KPR+FP(K1):INPUT%V,L$:PRINT#DV(V),L$ 04080 INDEX<V>=KPR+FP(K2):INPUT%V,L$:PRINT#DV(V),L$ 04090 INDEX<V>=KPR+FP(K3):INPUT%V,L$:PRINT#DV(V),L$ 04100 INDEX<V>=KPR+FP(K4):INPUT%V,L1$:INDEX<V>=KPR+FP(K5):INPUT%V,L2$ 04110 PRINT#DV(V),L1$:INDEX<V>=KPR+FP(K6):INPUT%V,L$ 04115 PRINT#DV(V),L2$;" ";L$ 04120 IF VT>K0 THEN FOR X=V TO VT: PRINT#DV(V): NEXT 04130 KPR=KPR+RL: IF KPR<EODF GOTO G1 04140 GOTO 19999 04400 REM TWO LABEL CODE 04410 ON Z GOTO 4420,4440,4460 04420 INDEX<V>=KPR+FP(K1):INPUT%V,L1$:INDEX<V>=KPR+FP(K1)+RL 04430 INPUT%V,L2$:PRINT#DV(V),L1$;TAB(PP(P2));L2$ 04440 INDEX<V>=KPR+FP(K2):INPUT%V,L1$:INDEX<V>=KPR+FP(K2)+RL 04450 INPUT%V,L2$:PRINT#DV(V),L1$;TAB(PP(P2));L2$ 04460 INDEX<V>=KPR+FP(K3):INPUT%V,L1$:INDEX<V>=KPR+FP(K3)+RL 04470 INPUT%V,L2$:PRINT#DV(V),L1$;TAB(PP(P2));L2$ 04480 INDEX<V>=KPR+FP(K4):INPUT%V,L1$:INDEX<V>=KPR+FP(K5) 04490 INPUT%V,L3$:INDEX<V>=KPR+FP(K4)+RL:INPUT%V,L2$ 04500 INDEX<V>=KPR+FP(K5)+RL:INPUT%V,L4$ 04510 PRINT#DV(V),L1$;TAB(PP(P2));L2$ 04520 INDEX<V>=KPR+FP(K6):INPUT%V,L1$:INDEX<V>=KPR+FP(K6)+RL 04530 INPUT%V,L2$:PRINT#DV(V),L3$;" "L1$;TAB(PP(P2));L4$;" ";L2$ 04540 IF VT>K0 THEN FOR X=V TO VT: PRINT#DV(V): NEXT 04550 KPR=KPR+R2: RC=RC-V: IF RC>K0 GOTO G2 04560 ON EX GOTO 4060,19999,19999 04570 GOTO 19999 04800 REM THREE LABEL CODE 04810 ON Z GOTO 4820,4860,4900 04820 INDEX<V>=KPR+FP(K1):INPUT%V,L1$:INDEX<V>=KPR+FP(K1)+RL 04830 INPUT%V,L2$:INDEX<V>=KPR+FP(K1)+R2:INPUT%V,L3$ 04840 PRINT#DV(V),L1$;TAB(PP(P2));L2$;TAB(PP(P3));L3$ 04860 INDEX<V>=KPR+FP(K2):INPUT%V,L1$:INDEX<V>=KPR+FP(K2)+RL 04870 INPUT%V,L2$:INDEX<V>=KPR+FP(K2)+R2:INPUT%V,L3$ 04880 PRINT#DV(V),L1$;TAB(PP(P2));L2$;TAB(PP(P3));L3$ 04900 INDEX<V>=KPR+FP(K3):INPUT%V,L1$:INDEX<V>=KPR+FP(K3)+RL 04910 INPUT%V,L2$:INDEX<V>=KPR+FP(K3)+R2:INPUT%V,L3$ 04920 PRINT#DV(V),L1$;TAB(PP(P2));L2$;TAB(PP(P3));L3$ 04930 INDEX<V>=KPR+FP(K4):INPUT%V,L1$:INDEX<V>=KPR+FP(K5) 04940 INPUT%V,L4$:INDEX<V>=KPR+FP(K4)+RL:INPUT%V,L2$ 04950 INDEX<V>=KPR+FP(K5)+RL:INPUT%V,L5$:INDEX<V>=KPR+FP(K4)+R2 04960 INPUT%V,L3$:INDEX<V>=KPR+FP(K5)+R2:INPUT%V,L6$ 04970 PRINT#DV(V),L1$;TAB(PP(P2));L2$;TAB(PP(P3));L3$ 04980 INDEX<V>=KPR+FP(K6):INPUT%V,L1$:INDEX<V>=KPR+FP(K6)+RL 04990 INPUT%V,L2$:INDEX<V>=KPR+FP(K6)+R2:INPUT%V,L3$ 05000 PRINT#DV(V),L4$;" ";L1$;TAB(PP(P2));L5$;" ";L2$; 05005 PRINT#DV(V),TAB(PP(P3));L6$;" ";L3$ 05010 IF VT>K0 THEN FOR X=V TO VT: PRINT#DV(V): NEXT 05020 KPR=KPR+R3: RC=RC-V: IF RC>K0 GOTO G3 05030 ON EX GOTO 4060,4410,19999 05040 GOTO 19999 05156 PRINT"*** KONTROLER AT DISKETTERNE ER PLACERET RIGTIGT ***" 19999 FLAG 6: CLOSE 1: GOTO 51100: REM COMMON EXT 30000 REM VARIFY FIELDS AND PICKUP THE RELATIVE OFFSETS (FD$(X)&FP(X)) 30010 TT=0: REM RUNNING TOTAL OFFSET INTO RECORD 30020 INDEX<1>=53: REM PNT TO STR OF FIELD DESCRIPTORS IN HEADER 30030 INPUT %1,X$: REM GET A FIELD DESCRIPTOR 30040 REM NF=NUMBER OF FIELDS DESIRED TO BE FOUND 30050 FOR X=1 TO NF 30060 IF FD$(X)=X$ GOTO 30090: REM GOTO IF FIELD FOUND 30070 NEXT X 30080 GOTO 30100: REM SKIP SINCE NOT FOUND 30090 FP(X)=TT: REM EQUATE TOTAL OFFSET TO APP. FILED DESCRIPTOR 30100 INPUT %1,FL: REM GET THIS FIELDS LENGTH 30110 TT=TT+FL: REM UPDATE RUNNING TOTAL OFFSET 30120 IF INDEX(1)<BODF GOTO 30030: REM GOTO TILL END 30130 IF INDEX(1)>BODF THEN ERR$="FILE HEADER ERROR": GOTO 40000 30140 RETURN: REM RETURN TO CALLER 31000 REM SUBROUTINE TO PRINT LABELS VIA KEY ACCESS 31010 REM 31020 V=1: INDEX<2>=42: INPUT%2, DUMMY$:G1=31050: EX=1 31030 FORX=1TONL:TL=X 31035 INPUT%2,DUMY$:INPUT%2,PNTR(X):IFINDEX(2)>=EDFTHENEX=2:GOTOG1 31040 IFRIGHT$(DUMY$,1)="*"GOTO31035 31045 NEXT 31050 FORX=1TOTL:INDEX<1>=PNTR(X):FORY=1TONF 31060 INDEX<1>=PNTR(X)+FP(Y):INPUT%1,L$(Y,X):NEXT:NEXTX 31080 FORY=1TONF:FORX=1TOTL 31090 PRINT#DV(V),TAB(PP(X));L$(Y,X);:NEXT:PRINT#DV(V):NEXTY 31095 IFVT>K0THENFORX=VTOVT:PRINT#DV(V):NEXT 31100 ONEXGOTO31030,19999 40000 REM ERROR EXPANSION GOES HERE 40010 PRINT: PRINT ERR$: PRINT: CLOSE 1: GOTO 51100: REM COMMON EXIT PATH 50000 REM ERROR HANDLER 50010 ER=PEEK(10226): EL=PEEK(11774)+PEEK(11775)*256 50020 REM 50025 REM CHK FOR 'CHANNEL ALREADY OPEN ERROR' 50030 IF ER=133 AND EL=160 THEN CLOSE 1: GOTO EL 50035 REM CHK FOR 'NON-EXISTANT ENTRY ERROR' 50040 IF ER=128 AND EL=160 THEN ERR$="INVALID FILE NAME": 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 50100 REM 51000 REM ERROR MESSAGE PRINT CODE ENTRY AT '51000' CLOSES FILE 51010 REM 51020 CLOSE 1 51030 REM 51040 REM ENTRY AT '51050' DOES NOT CLOSE THE CHANNEL 51050 PRINT:PRINT:PRINT"***** FEJL *****":PRINT:PRINT 51055 XC=XC+1:IFXC<2GOTO51060 51056 PRINT"*** KONTROLER AT DISKETTERNE ER PLACERET RIGTIGT ***" 51060 PRINT ERR$ 51065 REM PICKUP DISC ADDRESS WHERE ERROR OCCURED 51070 EA=0: FOR I=4 TO 1 STEP -1: EA=EA*256+PEEK(9889+I): NEXT I 51080 DV(3)=PEEK(9832): IF DV(3)>127 THEN DV(3)=DV(3)-128+4 51090 PRINT"P] STATION "+CHR$(DV(3)+65)+" I DISK ADRESSE";EA 51095 PRINT:INPUT"TAST RETURN, HVIS FORS[TTELSE ";QS$:PRINT 51100 REM COMMON EXIT PATH 51110 DEV CHR$(DV(2)+65): REM SELECT ORGINAL DEVICE 51120 POKE 2972,58: POKE 2976,44: REM DISALLOW , & : IN DATA FIELD 51130 REM R1* REMOVE BASIC IMMEDIATE MODE ENABLE 51140 FLAG 12: REM DISABLE SPACE SUPPRESSION 51150 REM R1* REMOVED ENABLE OF PROGRAM ABORT ON DISC ERROR 51160 POKE 14457,PC: REM ENABLE LINE PRINTER PAGEING 51170 RUN "DBMSYS","PASS"