1 REM Ins{nd av Erik Wetterberg <5948> 1987-01-21 Diskett
2 !
10 ! LIST MEDLSKRV.BAS
11 ! -------------- MEDLSKRV ---------------
20 ! hantering av medlemregister
21 ! INFO i MEDLEM.INF
22 ! ----------------------------------------
23 ! Rev 19870314.1848 B Sandgren <2776>:
24 ! CHAIN "NUL:" borttaget p} rad 2140
25 ! Skrivaren initieras p} rad 440 !! Kolla att det passar
26 ! Rev 19870627 Kristoffer Eriksson <5357>:
27 ! Rad 1970, 1980 {ndrade f|r tangentkoder p} alla ABC80x.
28 ! Rad 1855,1860 undviker BLK p} ABC800 som saknar den
29 ! Rad 2010 Del {ndrad till CTRL-D som i MEDLEM
30 ! Rad 34 f|r r{tt inladdning i BAS-form. (30 flyttad till 35)
32 ! ----------------------------------------
34 INTEGER : EXTEND
35 COMMON Klubb$=4
40 DIM Medlpost$=136 : Medlpost$=CHR$(255,255,255)+SPACE$(133)
50 DIM Persnr1$=0,Persnr2$=0,Mnamn$=0,Coadr$=0,Adr$=0,Postnr$=0,Padr$=0,Tele$=0
60 Adr=VARPTR(Medlpost$)
70 POKE VAROOT(Persnr1$),6,0,Adr+5,SWAP%(Adr+5),6,0
80 POKE VAROOT(Persnr2$),4,0,Adr+11,SWAP%(Adr+11),4,0
90 POKE VAROOT(Mnamn$),30,0,Adr+15,SWAP%(Adr+15),30,0
100 POKE VAROOT(Coadr$),30,0,Adr+45,SWAP%(Adr+45),30,0
110 POKE VAROOT(Adr$),30,0,Adr+75,SWAP%(Adr+75),30,0
120 POKE VAROOT(Postnr$),5,0,Adr+105,SWAP%(Adr+105),5,0
130 POKE VAROOT(Padr$),16,0,Adr+110,SWAP%(Adr+110),16,0
140 POKE VAROOT(Tele$),10,0,Adr+126,SWAP%(Adr+126),10,0
150 DIM Mkodpost$=17,Mkod$=0,Datkod$=0
160 Adr=VARPTR(Mkodpost$)
170 POKE VAROOT(Mkod$),6,0,Adr+5,SWAP%(Adr+5),6,0
180 POKE VAROOT(Datkod$),6,0,Adr+11,SWAP%(Adr+11),6,0
190 DIM Koder$=160
200 True=(1=1)
210 PRINT CHR$(12)
220 Z=FNInittang
230 PRINT CUR(2,0) "MEDLEMREGISTER F\R " Klubb$;
240 IF NOT FNInitfile(Klubb$) THEN Z=FNErr("Inget s}dant register !!") : STOP
250 PRINT CUR(4,0) "ANGE KOD: ";
260 PRINT CUR(6,0) "ANGE FORMAT :";
270 PRINT CUR(8,0) "SKRIVARE:";
280 PRINT CUR(10,0) "RADER:";
290 PRINT CUR(12,0) "RUBRIK:";
300 PRINT CUR(14,0) "MARGINAL:";
310 Selkod$=SPACE$(7) : Format$="L" : Skriv$="J"
320 Rubr$=Klubb$+SPACE$(46)+LEFT$(TIME$,10) : Vmarg=6
330 WHILE Kom$<>Esc$
340 Fltnr=1
350 WHILE Fltnr<=6
360 Selkod$=FNTxtflt$(1,Selkod$,4,13)
370 WHILE NOT FNKodfinns(Selkod$)
380 Z=FNErr("Ingen s}dan kod i registret !!")
390 Selkod$=FNTxtflt$(0,Selkod$,4,13)
400 WEND
410 Format$=FNValflt$(2,Format$,"ETL",6,13)
420 IF Format$="E" THEN Radant=2 ELSE Radant=65
430 Skriv$=FNValflt$(3,Skriv$,"JN",8,13)
440 IF Skrivare THEN PREPARE "PR:VSA40A72.55A" AS FILE 9
450 IF Format$="E" THEN Radant=FNTalflt(4,Radant,10,13,1,10)
460 IF Format$<>"E" THEN Radant=FNTalflt(4,Radant,10,13,5,68)
470 Rubr$=FNTxtflt$(5,Rubr$,12,13)
480 Vmarg=FNTalflt(6,Vmarg,14,13,0,20)
490 WEND
500 Rad=0 : Sid=1
510 IF Skriv$="J" THEN PREPARE "PR:VSA40A72.55A" AS FILE 9
520 Eof=NOT True
530 Z=FNMsg("Tryck vad som helst f|r pause")
540 Z=FNFirst(Selkod$)
550 WHILE NOT Eof
560 IF NOT FNPause THEN GOTO 630
570 IF Format$="T" THEN Koder$=FNKodstr$(CVT$%(MID$(Medlpost$,4,2)))
580 PRINT CUR(16,0) SPACE$(320) CUR(16,0);
590 Z=FNSkriv(Format$,0)
600 IF Skriv$="J" THEN Z=FNSkriv(Format$,9)
610 Z=FNNext(Selkod$)
620 WEND
630 Z=FNMsg("Tryck Esc f|r }ter, Return f|r ny utskrift")
640 GET Kom$
650 WEND
660 CLOSE
670 CHAIN "MEDLEM"
680 ! ------------------------------
690 DEF FNInitfile(In$) LOCAL Fil$=12
700 ON ERROR GOTO 770
710 Fil$=FNNoblank$(In$+"medl.ism")
720 ISAM OPEN Fil$ AS FILE 1
730 Fil$=FNNoblank$(In$+"mkod.ism")
740 ISAM OPEN Fil$ AS FILE 2
750 RETURN True
760 RETURN NOT True
770 RESUME 760
780 FNEND
790 ! --------------
800 DEF FNKodfinns(In$) LOCAL T$=6
810 IF In$=SPACE$(LEN(In$)) THEN RETURN True
820 IF LEFT$(In$,1)="-" THEN T$=RIGHT$(In$,2) ELSE T$=LEFT$(In$,6)
830 ON ERROR GOTO 860
840 ISAM READ #2,Mkodpost$ INDEX "MKOD" KEY T$
850 RETURN True
860 RESUME 870
870 RETURN NOT True
880 FNEND
890 ! ----------------------------
900 DEF FNKodkoll(Nr$,In$) LOCAL T$=6,T
910 IF LEFT$(In$,1)="-" THEN T$=RIGHT$(In$,2) : T=NOT True ELSE T$=LEFT$(In$,6) : T=True
920 ON ERROR GOTO 950
930 ISAM READ #2,Mkodpost$ INDEX "MNRKOD" KEY Nr$+T$
940 RETURN T
950 RESUME 960
960 RETURN NOT T
970 FNEND
980 ! --------------------
990 DEF FNFirst(In$)
1000 ON ERROR GOTO 1070
1010 ISAM READ #1,Medlpost$ FIRST
1020 IF In$=SPACE$(LEN(In$)) THEN RETURN 0
1030 WHILE NOT FNKodkoll(MID$(Medlpost$,4,2),In$)
1040 ISAM READ #1,Medlpost$ NEXT
1050 WEND
1060 RETURN 0
1070 PRINT "FNFirst errcode: " ERRCODE : STOP
1080 FNEND
1090 ! ----------------------------
1100 DEF FNNext(In$)
1110 ON ERROR GOTO 1180
1120 ISAM READ #1,Medlpost$ NEXT
1130 IF In$=SPACE$(LEN(In$)) THEN RETURN 0
1140 WHILE NOT FNKodkoll(MID$(Medlpost$,4,2),In$)
1150 ISAM READ #1,Medlpost$ NEXT
1160 WEND
1170 RETURN 0
1180 IF ERRCODE=34 THEN Eof=True : RESUME 1170
1190 PRINT "FNNext error: " ERRCODE : STOP
1200 FNEND
1210 ! ----------------------------
1220 DEF FNSkriv(Inform$,Inskr)
1230 IF Inform$="E" THEN RETURN FNEtik(Inskr)
1240 IF Rad=0 AND Inskr<>0 THEN PRINT #Inskr,SPACE$(Vmarg)+Rubr$+" SIDA:" Sid : PRINT #Inskr,""
1250 PRINT #Inskr,SPACE$(Vmarg)+Mnamn$;
1260 IF Coadr$=SPACE$(30) THEN PRINT #Inskr,Adr$ Tele$ ELSE PRINT #Inskr,Coadr$ Tele$
1270 PRINT #Inskr,SPACE$(Vmarg)+Persnr1$;
1280 IF Persnr2$<>SPACE$(4) THEN PRINT #Inskr,"-"+Persnr2$+SPACE$(19); ELSE PRINT #Inskr,SPACE$(24);
1290 IF Coadr$<>SPACE$(30) THEN PRINT #Inskr,Adr$ : PRINT #Inskr,SPACE$(30+Vmarg);
1300 PRINT #Inskr,LEFT$(Postnr$,3) " " RIGHT$(Postnr$,4) " " Padr$
1310 IF Inform$="T" THEN PRINT #Inskr,SPACE$(Vmarg)+Koder$
1320 PRINT #Inskr,""
1330 IF Inskr=0 THEN RETURN 0
1340 IF Inform$="T" THEN Rad=Rad+4 ELSE Rad=Rad+3
1350 IF Rad+3