DataMuseum.dk

top - download

    Length: 20224 (0x4f00)
    Types: TextFile
    Notes: Mikados_K
    Names: »REGVEDL.K«

└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
    └─⟦this⟧ »REGVEDL.K« 
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
    └─⟦this⟧ »REGVEDL.K« 

Mikados K File

0100 REM REGVEDL 
0110Z=9;LIN=51;O=0;W=1;Æ=2;Ø=3;Å=9 
0120DIM K1$(F),K2$(F),A$(W),STREG$(71),KNR$(D),DEBNV$(25),ANV$(25) 
0130DIM N$(D),MOMS$(12),BET$(W),FORS$(W),PORTO$(W),TFELT$(20),EANV$(25) 
0140DIM BK$(77),TAH$(12),VTAB2(C),K10$(F),K11$(F),TITEL$(25),PRIS$(12) 
0150DIM RES$(15),LK$(Ø),KG$(Ø),KTN$(D),BLB2$(12),K8$(F),DSALDO1$(12) 
0160DIM PNR$(D),TY$(W),OP1$(12),OP2$(12),TA$(12),TB$(14),DAT$(E),ATLF$(Z) 
0170DIM UD3$(14),UD4$(14),K3$(F),K4$(F),K5$(F),K6$(F),T1(Z),DEBKGR$(W) 
0180DIM VAR2$(25),VAR3$(13),DBK$(W),K7$(F),UBLB2$(14),K12$(F),STJERNE$(78) 
0190DIM DSL2$(12),DSL3$(12),DSL4$(12),SELEKT$(12),GADE$(25),BY$(20) 
0200DIM TLF$(Z),KØB$(12),MDNK$(12),TN(E),TITEL1$(E,F),T2(10),TAL4$(14) 
0210DIM BELØB$(12),ISBN$(12),BNV$(15,25),FRANR(15),TILNR(15) 
0220PROC CA(ART,B1,B2,ES) 
0230OP1$=B1$;OP2$=B2$;RES$=ES$;SI=O;FLAG=O 
0240CALL "P641210:REGN" 
0250ES$=RES$ 
0260IF FLAG THEN STOP  
0270ENDPROC  
0280PROC FE(NR1,NR2,NR3) 
0290IF STATUS(NR3$)<>O THEN  
0300PRINT STATUS(NR3$),NR1,NR2,NR3$ 
0310STOP  
0320ENDIF  
0330ENDPROC  
0340PROC INDTAB1(T,MANTAL,K15) 
0350J=MANTAL DIV 32 
0360OPEN K15$,R 
0370EXEC FE(999,W,K15$) 
0380FOR I=W TO J 
0390H=(I-W)*E+W 
0400GET K15$,I:T(H),T(H+W),T(H+Æ),T(H+Ø),T(H+B),T(H+C),T(H+D),T(H+7) 
0410EXEC FE(W,W,K15$) 
0420NEXT I 
0430CLOSE K15$ 
0440EXEC FE(W,Æ,K15$) 
0450ENDPROC  
0460PROC INDTAB(U,MANTAL,K15) 
0470J=MANTAL DIV 32+W 
0480OPEN K15$,R 
0490EXEC FE(999,W,K15$) 
0500FOR I=J TO MANTAL DIV B+J-W 
0510H=(I-J)*B+W;J1=H+W;J2=H+Æ;J3=H+Ø 
0520GET K15$,I:U(H,W),U(H,Æ),U(J1,W),U(J1,Æ),U(J2,W),U(J2,Æ),U(J3,W),U(J3,Æ) 
0530EXEC FE(Æ,W,K15$) 
0540NEXT I 
0550CLOSE K15$ 
0560EXEC FE(Æ,Æ,K15$) 
0570ENDPROC  
0580PROC FIND1(J5,Q,J6,J7,J8,J9) 
0590E3=J6 DIV E;J8=E3;I8=W;D9=J6 DIV B;D5=J6 DIV 32 
0600REPEAT  
0610IF J7=J5(J8) OR E3=W THEN EXIT  
0620E3=(E3+W) DIV Æ;J8=J8+E3*(W-Æ*(J7<J5(J8))) 
0630IF J8<W THEN J8=W 
0640IF J8>D9 THEN J8=D9 
0650UNTIL E3=O 
0660IF J5(J8)>J7 THEN J8=J8-W*(J8>W) 
0670J8=D5+J8 
0680OPEN J9$,R 
0690EXEC FE(999,W,J9$) 
0700GET J9$,J8:Q(W,W),Q(W,Æ),Q(Æ,W),Q(Æ,Æ),Q(Ø,W),Q(Ø,Æ),Q(B,W),Q(B,Æ) 
0710EXEC FE(W,W,J9$) 
0720CLOSE J9$ 
0730EXEC FE(W,Æ,J9$) 
0740FOR J8=W TO B 
0750IF J7=Q(J8,W) THEN EXIT  
0760NEXT J8 
0770IF J8<>C THEN I8=O 
0780ENDPROC  
0790PROC FIND(TAB1,MANT1,NØGL1,PIL3) 
0800PIL1=MANT1 DIV Æ;PIL3=PIL1;CEKS=W 
0810REPEAT  
0820IF NØGL1=TAB1(PIL3,W) OR PIL1=W THEN EXIT  
0830PIL1=(PIL1+W) DIV Æ;PIL3=PIL3+PIL1*(W-Æ*(NØGL1<TAB1(PIL3,W))) 
0840IF PIL3<W THEN PIL3=W 
0850IF PIL3>MANT1 THEN PIL3=MANT1 
0860UNTIL PIL1=O 
0870IF NØGL1=TAB1(PIL3,W) THEN CEKS=O 
0880ENDPROC  
0890PROC HENTMPOST 
0900S=MTAB(MPIL3,Æ) 
0910OPEN K3$,R 
0920EXEC FE(999,W,K3$) 
0930GET K3$,S:MNR,AFHNR,BET$,FORS$,PORTO$,TFELT$ 
0940EXEC FE(E,Æ,K3$) 
0950CLOSE K3$ 
0960EXEC FE(E,Ø,K3$) 
0970ENDPROC  
0980PROC HENTA 
0990S=ATAB1(APIL3,Æ) 
1000OPEN K5$,R 
1010EXEC FE(999,W,K5$) 
1020GET K5$,S:DEBNR,DEBNV$,EANV$,TLF$ 
1030EXEC FE(Z,31,K5$) 
1040IF DEBNR<>ATAB1(APIL3,W) THEN STOP  
1050GET K5$,S+W:GADE$,DPOSTNR,BY$,LK$,SELEKT$ 
1060EXEC FE(88,D,K5$) 
1070CLOSE K5$ 
1080EXEC FE(88,7,K5$) 
1090ENDPROC  
1100PROC HENTD 
1110S=DTAB1(DPIL3,Æ) 
1120OPEN K12$,R 
1130EXEC FE(999,W,K12$) 
1140GET K12$,S:DEBNR,DEBNV$,DSALDO1$,DEBKGR$ 
1150EXEC FE(Z,32,K12$) 
1160IF DEBNR<>DTAB1(DPIL3,W) THEN STOP  
1170GET K12$,S+W:DSL2$,DSL3$,DSL4$,DPOSTNR,LK$ 
1180EXEC FE(88,Æ,K12$) 
1190GET K12$,S+Æ:GADE$,TLF$,KPOST,HKUNDE 
1200EXEC FE(88,Ø,K12$) 
1210GET K12$,S+Ø:BY$,KØB$,MDNK$ 
1220EXEC FE(88,B,K12$) 
1230CLOSE K12$ 
1240EXEC FE(88,C,K12$) 
1250ENDPROC  
1260PROC HENTRPOST(POST) 
1270GET K10$,POST:MNR,TNR,AFHNR,STATUS 
1280EXEC FE(40,Z,K10$) 
1290ENDPROC  
1300PROC GETPOST 
1310WHILE MNR=O AND ( NOT SLUTFILE) DO  
1320POST1=POST1+W 
1330IF POST1>SPOST THEN  
1340SLUTFILE=W 
1350ELSE  
1360GET K10$,POST1:MNR,TNR,AFHNR,STATUS 
1370EXEC FE(88,7,K10$) 
1380ENDIF  
1390ENDWHILE  
1400ENDPROC  
1410PROC GEMRPOST(GPOST) 
1420GPOST=GPOST+W 
1430PUT K10$,GPOST:MNR,TNR,AFHNR,STATUS 
1440EXEC FE(Z,33,K10$) 
1450ENDPROC  
1460PROC SLETR(P8) 
1470PUT K10$,P8:O,O,O,O 
1480EXEC FE(Z,56,K10$) 
1490ENDPROC  
1500PROC HENTT(TNR1) 
1510S=TNR1 
1520OPEN K11$,R 
1530EXEC FE(999,W,K11$) 
1540GET K11$,S:TNUM,TITEL$,PRIS$,VKONT,ISBN$,VÆGT 
1550EXEC FE(Æ,44,K11$) 
1560CLOSE K11$ 
1570EXEC FE(Æ,45,K11$) 
1580IF TNUM=O THEN  
1590REPEAT  
1600CURSOR Ø,23 
1610INPUT "Titelnummer eksisterer ikke, tast RETURN ",A$ 
1620EXEC NRT(A$) 
1630UNTIL P=-W 
1640ENDIF  
1650ENDPROC  
1660PROC SØG(NØGLE,ANPOST1,I1) 
1670FOR I1=W TO ANPOST1 
1680EXEC HENTRPOST(I1) 
1690IF MNR=>NØGLE THEN EXIT  
1700NEXT I1 
1710ENDPROC  
1720PROC SØG2(NØGL5,ANPOST5,POST5,X1) 
1730FOR X1=ANPOST5+W TO POST5 
1740EXEC HENTRPOST(X1) 
1750IF NØGL5=MNR THEN EXIT  
1760NEXT X1 
1770IF X1=POST5+W THEN  
1780REPEAT  
1790CURSOR Ø,23 
1800INPUT "Medlem ikke registreret, tast RETURN",A$ 
1810EXEC NRT(A$) 
1820UNTIL P=-W 
1830ENDIF  
1840ENDPROC  
1850PROC DSIDST(XX,TKONT) 
1860FOR II=XX+W TO SPOST 
1870EXEC HENTRPOST(II) 
1880IF TKONT<>MNR THEN EXIT  
1890NEXT II 
1900IF SPOST<II THEN TEK1=W 
1910ENDPROC  
1920PROC TUD(BLB1,UBLB1,TEGN,STØR) 
1930BLB2$=BLB1$;UBLB2$=UBLB1$ 
1940EXEC CA(C,BLB2$,TAH$,UBLB2$) 
1950UBLB1$=UBLB2$ 
1960IF TEGN=O THEN UBLB1$=UBLB1$(W:13) 
1970IF TEGN=W AND UBLB1$(LEN(UBLB1$))="+" THEN UBLB1$(LEN(UBLB1$))=" " 
1980IF STØR=W THEN UBLB1$=UBLB1$(B:LEN(UBLB1$)-Ø) 
1990ENDPROC  
2000PROC NRT(NUM1) 
2010P=O;TEST2=O;KTAL=O;L=LEN(NUM1$) 
2020CASE L OF  
2030FOR I=W TO L 
2040P1=INT(ORD(NUM1$(I))-48) 
2050IF P1=>O AND P1<=Z THEN  
2060P=P*10+P1 
2070ELSE  
2080TEST2=W 
2090ENDIF  
2100NEXT I 
2110KTAL=P DIV 10000 
2120WHEN O 
2130P=-W 
2140WHEN W 
2150CASE NUM1$ OF  
2160P=INT(ORD(NUM1$)-48) 
2170WHEN "J","j" 
2180P=-7 
2190WHEN "N","n" 
2200P=-E 
2210ENDCASE  
2220ENDCASE  
2230ENDPROC  
2240PROC ARBEJDE(I1) 
2250EXEC HPOST 
2260FOR J=W TO I1 
2270EXEC HENTT(TN(J)) 
2280TITEL1$(J)=TITEL$(W:18) 
2290NEXT J 
2300EXEC SKRIV 
2310ENDPROC  
2320PROC HPOST 
2330KTAL=KONTO DIV 10000 
2340IF KTAL=DEBGR THEN  
2350EXEC FIND1(DTAB,DTAB1,MDANTAL,KONTO,DPIL3,K7$) 
2360IF I8=O THEN  
2370EXEC HENTD 
2380ELSE  
2390MNR=KONTO;DEBNV$="Deb. eksisterer ikke." 
2400ENDIF  
2410ELSE  
2420EXEC FIND1(ATAB,ATAB1,MAANTAL,KONTO,APIL3,K8$) 
2430IF I8=O THEN  
2440EXEC HENTA 
2450ELSE  
2460MNR=KONTO;DEBNV$="Afh. eksisterer ikke." 
2470ENDIF  
2480ENDIF  
2490ENDPROC  
2500PROC UDSKRIV 
2510CLEAR  
2520CURSOR 21,W 
2530PRINT "Registrering" 
2540EXEC OVERSKRIFT 
2550CURSOR Æ,Ø 
2560PRINT "Medlemsnummer       :";MNR 
2570ENDPROC  
2580PROC INDTAST 
2590CURSOR Æ,C 
2600PRINT USING "Kundenr/Afhenternr :#######":AFHNR 
2610IF TEKST=-7 THEN  
2620EXEC HPOST 
2630CURSOR 33,C 
2640PRINT DEBNV$ 
2650ENDIF  
2660IF TYPE<>Æ THEN  
2670REPEAT  
2680EXEC TTAST 
2690IF TNR<>O AND TYPE=Ø THEN EXEC GEMRPOST(SPOST) 
2700IF TNR<>O AND TYPE=W THEN EXEC GEMRPOST(ANPOST) 
2710POS=POS+W 
2720UNTIL TNR=O 
2730ELSE  
2740EXEC TTAST 
2750ENDIF  
2760ENDPROC  
2770PROC TTAST 
2780IF TYPE=W OR TYPE=Ø THEN  
2790REPEAT  
2800CURSOR Æ,7+POS 
2810PRINT BK$(W:70) 
2820CURSOR Æ,7 
2830PRINT "Titelnummer    :" 
2840REPEAT  
2850CURSOR Ø,23 
2860PRINT BK$(W:70) 
2870REPEAT  
2880CURSOR Ø,23 
2890PRINT "Titelnummer    :      (0:Færdig)" 
2900CURSOR 20,23 
2910INPUT TNR 
2920UNTIL TNR=>O AND TNR<=MTANTAL 
2930IF TNR=O THEN EXIT  
2940EXEC HENTT(TNR) 
2950UNTIL TNR=O OR (TNUM=TNR) 
2960IF TNR=O THEN EXIT  
2970CURSOR Æ,7+POS 
2980PRINT USING "Titelnummer    :####":TNR 
2990CURSOR 33,7+POS 
3000PRINT TITEL$ 
3010REPEAT  
3020CURSOR Ø,23 
3030A$="J" 
3040EDIT "Er titelnummer rigtig, (J/N) ",A$ 
3050EXEC NRT(A$) 
3060UNTIL P=-7 OR P=-E 
3070UNTIL P=-7 OR TNR=O 
3080ELSE  
3090CURSOR Æ,7+POS 
3100PRINT USING "Titelnummer    :####":TNR 
3110EXEC HENTT(TNR) 
3120CURSOR 33,7+POS 
3130PRINT TITEL$ 
3140ENDIF  
3150ENDPROC  
3160PROC HOVED 
3170SIDE=SIDE+W 
3180IF LIE=47 AND SIDE>W THEN  
3190FOR XI=W TO B 
3200PRINT " " 
3210NEXT XI 
3220ENDIF  
3230PRINT " " 
3240PRINT CHR(14);"KONTROLLISTE";CHR(15);TAB(43);"SIDE";SIDE 
3250PRINT " " 
3260PRINT "Med.nr    Navn" 
3270PRINT "Kundenr   Adresse" 
3280PRINT "Saldo     Postnr By" 
3290PRINT " " 
3300LIE=7 
3310ENDPROC  
3320PROC AHOVED 
3330SIDE=SIDE+W 
3340IF LIE=49 THEN  
3350PRINT " " 
3360PRINT " " 
3370ENDIF  
3380PRINT " " 
3390PRINT CHR(14);"AFKRYDSNINGSLISTE";CHR(15); 
3400IF BKLUB>0 THEN PRINT BNV$(BKLUB); 
3410PRINT TAB(55);"SIDE ";SIDE 
3420PRINT " " 
3430PRINT "  Med.nr    Navn" 
3440PRINT "  Kundenr   Adresse" 
3450PRINT "  Saldo     Postnr By" 
3460PRINT STJERNE$ 
3470LIE=7 
3480ENDPROC  
3490PROC SKRIV 
3500IF LIE=O OR LIE=47 THEN EXEC HOVED 
3510TAL=W 
3520PRINT USING "#######":KONT; 
3530PRINT TAB(11);DEBNV$;TAB(35); 
3540PRINT USING "####:":TN(TAL); 
3550PRINT TITEL1$(TAL);TAB(57); 
3560PRINT USING "####:":TN(W+TAL); 
3570PRINT TITEL1$(W+TAL) 
3580TAL=TAL+Æ 
3590PRINT USING "#######":DEBNR; 
3600PRINT TAB(11);GADE$;TAB(35); 
3610PRINT USING "####:":TN(TAL); 
3620PRINT TITEL1$(TAL);TAB(57); 
3630PRINT USING "####:":TN(W+TAL); 
3640PRINT TITEL1$(W+TAL) 
3650TAL=TAL+Æ 
3660IF KTAL=DEBGR THEN  
3670EXEC CA(O,DSL3$,DSL4$,BELØB$) 
3680EXEC CA(B,BELØB$,TAH$,TAH$) 
3690IF SI=Æ THEN  
3700EXEC TUD(BELØB$,TAL4$,W,W) 
3710PRINT TAB(W);TAL4$; 
3720ENDIF  
3730ENDIF  
3740PRINT TAB(10); 
3750PRINT USING "###### ":DPOSTNR;TAB(F); 
3760PRINT BY$;TAB(35); 
3770PRINT USING "####:":TN(TAL); 
3780PRINT TITEL1$(TAL);TAB(57); 
3790PRINT USING "####:":TN(W+TAL); 
3800PRINT TITEL1$(W+TAL) 
3810IF I3>D THEN  
3820TAL=TAL+Æ 
3830PRINT TAB(35); 
3840PRINT USING "####":TN(TAL); 
3850PRINT TITEL1$(TAL);TAB(57); 
3860PRINT USING "####":TN(W+TAL); 
3870PRINT TITEL1$(W+TAL) 
3880ELSE  
3890PRINT " " 
3900ENDIF  
3910PRINT " " 
3920LIE=LIE+C 
3930ENDPROC  
3940PROC ASKRIV 
3950PRINT "*";TAB(78);"*" 
3960PRINT USING "* #######":MNR; 
3970PRINT TAB(13);DEBNV$;TAB(35);" *      *      *      *      *"; 
3980PRINT "      *      *" 
3990IF I8=O THEN  
4000PRINT USING "* #######":DEBNR; 
4010PRINT TAB(13);GADE$;TAB(35);" *      *      *      *      *"; 
4020PRINT "      *      *" 
4030PRINT "*"; 
4040IF KTAL=DEBGR THEN  
4050EXEC CA(O,DSL3$,DSL4$,BELØB$) 
4060EXEC CA(B,BELØB$,TAH$,TAH$) 
4070IF SI=Æ THEN  
4080EXEC TUD(BELØB$,TAL4$,W,W) 
4090PRINT TAB(Ø);TAL4$; 
4100ENDIF  
4110ENDIF  
4120PRINT TAB(13); 
4130PRINT USING "######":DPOSTNR; 
4140PRINT TAB(20);BY$;TAB(35);" *      *      *      *      *      *      *" 
4150PRINT "*";TAB(78);"*" 
4160ELSE  
4170PRINT "*";TAB(78);"*" 
4180PRINT "*";TAB(78);"*" 
4190PRINT "*";TAB(78);"*" 
4200ENDIF  
4210PRINT STJERNE$ 
4220LIE=LIE+D 
4230ENDPROC  
4240PROC OVERSKRIFT 
4250CURSOR 45,W 
4260CASE TYPE OF  
4270WHEN W 
4280PRINT "Registrering" 
4290WHEN Ø 
4300PRINT "Tilføjelse" 
4310WHEN Æ 
4320PRINT "Sletning" 
4330ENDCASE  
4340ENDPROC  
4350PROC NULSTIL 
4360FOR I=W TO E 
4370TN(I)=O;TITEL1$(I)=BK$(W:18) 
4380NEXT I 
4390ENDPROC  
4400K6$="P641220:SYSTEM1" 
4410OPEN K6$,R 
4420EXEC FE(87,W,K6$) 
4430GET K6$,W:FANTAL,MDANTAL 
4440EXEC FE(Z,50,K6$) 
4450GET K6$,E:VSNR,DIVNR,DEFNR,DEBGR 
4460EXEC FE(Z,53,K6$) 
4470GET K6$,12:K7$ 
4480EXEC FE(Z,75,K6$) 
4490GET K6$,16:K12$ 
4500EXEC FE(Z,76,K6$) 
4510CLOSE K6$ 
4520EXEC FE(Z,51,K6$) 
4530K1$="P641220:SYSTEM3" 
4540OPEN K1$,R 
4550EXEC FE(Z,W,K1$) 
4560GET K1$,W:MLANTAL,MAANTAL,MTANTAL 
4570EXEC FE(Z,Æ,K1$) 
4580GET K1$,D:N$ 
4590EXEC FE(Z,Ø,K1$) 
4600GET K1$,7:K2$ 
4610EXEC FE(Z,B,K1$) 
4620GET K1$,E:K8$ 
4630EXEC FE(Z,77,K1$) 
4640GET K1$,Z:K3$ 
4650EXEC FE(Z,C,K1$) 
4660GET K1$,10:K5$ 
4670EXEC FE(Z,78,K1$) 
4680GET K1$,11:K11$ 
4690EXEC FE(79,Z,K1$) 
4700GET K1$,18:K10$ 
4710EXEC FE(Z,80,K1$) 
4720GET K1$,19:K4$ 
4730EXEC FE(Z,D,K1$) 
4740CLOSE K1$ 
4750EXEC FE(Z,7,K1$) 
4760K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$;K7$=N$+K7$;K8$=N$+K8$ 
4770K12$=N$+K12$;K10$=N$+K10$;K11$=N$+K11$ 
4780DIM MTAB(MLANTAL,Æ),DTAB(MDANTAL DIV B),ATAB(MAANTAL DIV B) 
4790DIM DTAB1(B,Æ),ATAB1(B,Æ) 
4800OPEN K4$,R 
4810EXEC FE(Z,E,K4$) 
4820GET K4$,C:MOMS$,T1(W),T1(Æ),T1(Ø),T1(B),T1(C),T1(D),T1(7),T1(E),T1(Z) 
4830EXEC FE(Z,Z,K4$) 
4840GET K4$,D:T2(W),T2(Æ),T2(Ø),T2(B),T2(C),T2(D),T2(7),T2(E),T2(Å),T2(10) 
4850EXEC FE(77,7,K4$) 
4860FOR II=1 TO 15 
4870GET K4$,18+II:BNV$(II),FRANR(II),TILNR(II) 
4880EXEC FE(88,II,K4$) 
4890NEXT II 
4900CLOSE K4$ 
4910EXEC FE(Z,10,K4$) 
4920OPEN K10$,W 
4930EXEC FE(Z,83,K10$) 
4940EXEC INDTAB1(DTAB,MDANTAL,K7$) 
4950EXEC INDTAB1(ATAB,MAANTAL,K8$) 
4960EXEC INDTAB(MTAB,MLANTAL,K2$) 
4970BK$="                                      ";BK$=BK$+BK$+" " 
4980TAH$="0+";MEDL=T1(7);ANPOST=T1(E);STATUS=O;TNR=W;SPOST=T1(Z);YX=O;TEK1=O 
4990STJERNE$="****************************************" 
5000STJERNE$=STJERNE$+STJERNE$ 
5010STREG$="-----------------------------------";STREG$=STREG$+STREG$ 
5020REG=T2(W) 
5030REPEAT  
5040OUTPUT T 
5050CLEAR  
5060CURSOR 21,W 
5070PRINT "Registrering" 
5080CURSOR 22,Ø 
5090PRINT "0:Færdig" 
5100CURSOR 22,C 
5110PRINT "1:Registrering" 
5120CURSOR 22,7 
5130PRINT "2:Sletning" 
5140CURSOR 22,Z 
5150PRINT "3:Tilføjelse" 
5160CURSOR 22,11 
5170PRINT "4:Kontrolliste" 
5180CURSOR 22,13 
5190PRINT "5:Afkrydsningsliste" 
5200REPEAT  
5210CURSOR 24,15 
5220PRINT "Vælg type     (0-5)" 
5230CURSOR 34,15 
5240INPUT TY$ 
5250EXEC NRT(TY$) 
5260UNTIL P>-W AND P<D 
5270TYPE=P;LIE=O;SIDE=O;TEST5=O 
5280IF TYPE=O THEN EXIT  
5290REPEAT  
5300CURSOR 24,F 
5310PRINT "Indtast bogklubnr.      (0:15)" 
5320CURSOR 43,F 
5330INPUT TY$ 
5340EXEC NRT(TY$) 
5350UNTIL P>-1 AND P<16 
5360IF BKLUB>0 THEN  
5370EXEC FIND(MTAB,MLANTAL,FRANR(BKLUB),MPIL3) 
5380IF MTAB(MPIL3,W)<BKLUB THEN MPIL3=MPIL3+W 
5390FRA=MPIL3 
5400EXEC FIND(MTAB,MLANTAL,TILNR(BKLUB),MPIL3) 
5410IF MTAB(MPIL3,W)>BKLUB THEN MPIL3=MPIL3-W 
5420TIL=MPIL3 
5430ELSE  
5440IF TYPE<>B THEN  
5450REPEAT  
5460IF TYPE=W AND REG=W THEN EXIT  
5470REPEAT  
5480CURSOR 22,19 
5490PRINT "Fra medlemsnummer:       (0:Alle)" 
5500CURSOR 41,19 
5510INPUT " ",KNR$ 
5520EXEC NRT(KNR$) 
5530UNTIL P=O OR (KTAL<>DEBGR AND TEST2=O) 
5540KONT=P 
5550IF P=O AND (TYPE=W OR TYPE=C) THEN  
5560FRA=W;TIL=MEDL 
5570ELSE  
5580KONT=P 
5590EXEC FIND(MTAB,MLANTAL,P,MPIL3) 
5600IF MTAB(MPIL3,W)<KONT THEN MPIL3=MPIL3+W 
5610FRA=MPIL3 
5620ENDIF  
5630UNTIL FRA<=MEDL 
5640IF NOT (TYPE=W AND REG=W) THEN  
5650IF TYPE=W OR TYPE=C THEN  
5660IF P>O THEN  
5670REPEAT  
5680CURSOR 22,21 
5690INPUT "Til medlemsnummer: ",KNR$ 
5700EXEC NRT(KNR$) 
5710UNTIL (P=>KONT AND TEST2=O AND KTAL<>DEBGR) 
5720EXEC FIND(MTAB,MLANTAL,P,MPIL3) 
5730IF MTAB(MPIL3,W)>P THEN MPIL3=MPIL3-W 
5740TIL=MPIL3 
5750ENDIF  
5760ELSE  
5770TIL=FRA;TEKST=-7 
5780ENDIF  
5790ENDIF  
5800ENDIF  
5810ENDIF  
5820IF TYPE<>C THEN  
5830REPEAT  
5840CURSOR 22,23 
5850INPUT "Ønskes der udskrevet tekst, (J/N) ",A$ 
5860EXEC NRT(A$) 
5870UNTIL P=-7 OR P=-E 
5880TEKST=P 
5890ENDIF  
5900IF NOT (TYPE=W AND REG=W) THEN  
5910CASE TYPE OF  
5920WHEN W,B 
5930TEST5=O 
5940IF TYPE=W THEN  
5950FOR MPIL3=FRA TO TIL 
5960IF MTAB(MPIL3,W)<1000000 THEN  
5970CLEAR  
5980EXEC HENTMPOST 
5990EXEC UDSKRIV 
6000KONTO=AFHNR;POS=O 
6010EXEC INDTAST 
6020ENDIF  
6030NEXT MPIL3 
6040SPOST=ANPOST;REG=W 
6050REPEAT  
6060CLEAR  
6070CURSOR 20,15 
6080INPUT "Ønskes udskrevet kontrolliste, (J/N) ",A$ 
6090EXEC NRT(A$) 
6100UNTIL P=-7 OR P=-E 
6110IF P=-7 THEN TEST5=W 
6120ENDIF  
6130IF TYPE=B OR TEST5=W THEN  
6140CLEAR  
6150REPEAT  
6160CURSOR 21,15 
6170INPUT "Monter papir og tast RETURN",A$ 
6180EXEC NRT(A$) 
6190UNTIL P=-W 
6200OUTPUT P 
6210MNR=O;SLUTFILE=O;KONT=O;POST1=O 
6220EXEC GETPOST 
6230WHILE NOT SLUTFILE DO  
6240EXEC NULSTIL 
6250KONT=MNR;I3=O;KONTO=AFHNR 
6260WHILE KONT=MNR DO  
6270I3=I3+W;TN(I3)=TNR;MNR=O 
6280EXEC GETPOST 
6290ENDWHILE  
6300EXEC ARBEJDE(I3) 
6310ENDWHILE  
6320ENDIF  
6330WHEN Æ 
6340EXEC SØG(KONT,ANPOST,YX) 
6350IF KONT<MNR OR YX=ANPOST+W THEN EXEC SØG2(KONT,ANPOST,SPOST,YX) 
6360IF YX=SPOST+W THEN EXIT  
6370REPEAT  
6380EXEC HENTRPOST(YX) 
6390IF KONT<>MNR THEN EXIT  
6400KONTO=AFHNR;POS=O 
6410EXEC UDSKRIV 
6420EXEC INDTAST 
6430REPEAT  
6440CURSOR Ø,23 
6450INPUT "Ønskes denne post slettet, (J/N) ",A$ 
6460EXEC NRT(A$) 
6470UNTIL P=-7 OR P=-E 
6480IF P=-7 THEN EXEC SLETR(YX) 
6490YX=YX+W 
6500UNTIL KONT<>MNR 
6510WHEN Ø 
6520REPEAT  
6530CURSOR 22,21 
6540INPUT "Rigtig medlemsnummer, (J/N)   ",A$ 
6550EXEC NRT(A$) 
6560UNTIL P=-7 OR P=-E 
6570IF P=-7 THEN  
6580EXEC SØG(KONT,ANPOST,YX) 
6590IF KONT<MNR OR YX=ANPOST+W THEN EXEC SØG2(KONT,ANPOST,SPOST,YX) 
6600EXEC DSIDST(YX,KONT) 
6610IF TEK1<>W THEN  
6620REPEAT  
6630EXEC HENTRPOST(YX) 
6640IF KONT<>MNR THEN EXIT  
6650EXEC GEMRPOST(SPOST) 
6660EXEC SLETR(YX) 
6670YX=YX+W 
6680UNTIL KONT<>MNR 
6690EXEC HENTRPOST(SPOST) 
6700ELSE  
6710EXEC HENTMPOST 
6720ENDIF  
6730KONTO=AFHNR;POS=O 
6740EXEC UDSKRIV 
6750EXEC INDTAST 
6760ENDIF  
6770WHEN C 
6780CLEAR  
6790REPEAT  
6800CURSOR 21,15 
6810INPUT "Monter papir og tast RETURN",A$ 
6820EXEC NRT(A$) 
6830UNTIL P=-W 
6840OUTPUT P 
6850FOR MPIL3=FRA TO TIL 
6860IF MTAB(MPIL3,W)<1000000 THEN  
6870EXEC HENTMPOST 
6880KONTO=AFHNR 
6890EXEC HPOST 
6900IF LIE=O OR LIE=49 THEN EXEC AHOVED 
6910EXEC ASKRIV 
6920ENDIF  
6930NEXT MPIL3 
6940ENDCASE  
6950IF TYPE=B OR TYPE=C OR TEST5=W THEN  
6960FOR KL=LIE TO LIN-W 
6970PRINT " " 
6980NEXT KL 
6990ENDIF  
7000ENDIF  
7010UNTIL TYPE=O 
7020CLOSE K10$ 
7030EXEC FE(Z,21,K10$) 
7040OPEN K4$,W 
7050EXEC FE(Z,22,K4$) 
7060T1(7)=MEDL;T1(E)=ANPOST;T1(Z)=SPOST;T2(W)=REG 
7070PUT K4$,C:MOMS$,T1(W),T1(Æ),T1(Ø),T1(B),T1(C),T1(D),T1(7),T1(E),T1(Z) 
7080EXEC FE(Z,24,K4$) 
7090PUT K4$,D:T2(W),T2(Æ),T2(Ø),T2(B),T2(C),T2(D),T2(7),T2(E),T2(Å),T2(10) 
7100EXEC FE(67,W,K4$) 
7110CLOSE K4$ 
7120EXEC FE(Z,25,K4$) 
7130CHAIN "P641210:STARTS"