⟦f0f4c1a6d⟧

Text

0100 DIM KONTONAVN$(25),DEBNAVN$(25),N$(6),FNAVN$(25),FUKODE$(1),T1(9),T2(9)
0110 DIM KRENAVN$(25),T3(9),K6$(17),K7$(17),K8$(17),K9$(17),K10$(17)
0120 DIM K1$(17),SALDO$(12),DAT$(8),TKO$(1),BELØB1$(12),MUL$(1),TEKST$(25)
0130 DIM K4$(17),TFIL$(9,10),UBELØB$(14),BELØB2$(12),KA(36),DA(36),TKA(36)
0140 DIM TA$(36,25),A$(2),TAL4$(12),OP1$(12),OP2$(12),STREG$(70),K5$(17)
0150 DIM RES$(14),BIL$(8),RET$(3),BTEKST$(26),ATEKST$(26),KTN$(6),BLB$(12)
0160 DIM K2$(17),BLB2$(12),BLB3$(12),BLK$(76),CA(36),CEA$(36,12),K3$(17)
0170 PROC CALC(AR3,AB,AC,ES)
0180 OP1$=AB$;OP2$=AC$;RES$=ES$;SI=0;FLAG=0;ART=AR3-6*(AR3>5)
0190 CALL "P641210:REGN"
0200 ES$=RES$
0210 IF AR3<>6 THEN 
0220 IF FLAG<>0 THEN STOP 
0230 ENDIF 
0240 ENDPROC 
0250 PROC KTNAVN(KOTAL,KKONTO)
0260 CEKS=1
0270 CASE KOTAL OF 
0280 EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,KKONTO,FPIL3,K2$)
0290 IF CEKS=0 THEN 
0300 EXEC HENTPOST
0310 IF INT(ORD(FUKODE$)-48)=0 THEN 
0320 KONTONAVN$=FNAVN$
0330 ELSE 
0340 CEKS=1
0350 ENDIF 
0360 ENDIF 
0370 WHEN DTAL
0380 IF DTAL*10000+MKGR<KKONTO THEN 
0390 EXEC FINDPOST1(DTAB1,DTAB,MDANTAL,KKONTO,DPIL3,K3$)
0400 IF CEKS=0 THEN 
0410 EXEC HENTDPOST
0420 KONTONAVN$=DEBNAVN$
0430 ENDIF 
0440 ELSE 
0450 CEKS=1
0460 ENDIF 
0470 WHEN KRTAL
0480 IF KRTAL*1000+MKRGR<KKONTO THEN 
0490 EXEC FINDPOST1(KTAB1,KTAB,MKANTAL,KKONTO,KPIL3,K4$)
0500 IF CEKS=0 THEN 
0510 EXEC HENTKRPOST
0520 KONTONAVN$=KRENAVN$
0530 ENDIF 
0540 ENDIF 
0550 ENDCASE 
0560 IF CEKS=1 THEN 
0570 KONTONAVN$="Konto eksisterer ikke    "
0580 ENDIF 
0590 ENDPROC 
0600 PROC HENTDPOST
0610 S=DTAB(DPIL3,2)
0620 GET K6$,S:DEBNR,DEBNAVN$
0630 EXEC FEJL(8,2,K6$)
0640 IF DEBNR<>DTAB(DPIL3,1) THEN STOP 
0650 ENDPROC 
0660 PROC HENTKRPOST
0670 S=KTAB(KPIL3,2)
0680 GET K7$,S:KRENR,KRENAVN$
0690 EXEC FEJL(1,1,K7$)
0700 IF KRENR<>KTAB(KPIL3,1) THEN STOP 
0710 ENDPROC 
0720 PROC HENTPOST
0730 S=FTAB(FPIL3,2)
0740 GET K5$,S:FNR,FNAVN$
0750 EXEC FEJL(3,2,K5$)
0760 IF FNR<>FTAB(FPIL3,1) THEN STOP 
0770 GET K5$,S+2:FUKODE$
0780 EXEC FEJL(3,4,K5$)
0790 ENDPROC 
0800 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
0810 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=1;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
0820 REPEAT 
0830 IF NØGL5=TAB4(PIL6) OR PIL1=1 THEN EXIT 
0840 PIL1=(PIL1+1) DIV 2
0850 PIL6=PIL6+PIL1*(1-2*(NØGL5<TAB4(PIL6)))
0860 IF PIL6<1 THEN PIL6=1
0870 IF PIL6>MANT3 THEN PIL6=MANT3
0880 UNTIL PIL1=0
0890 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-1*(PIL6>1)
0900 PIL6=MANT4+PIL6
0910 GET L8$,PIL6:Q(1,1),Q(1,2),Q(2,1),Q(2,2),Q(3,1),Q(3,2),Q(4,1),Q(4,2)
0920 EXEC FEJL(1,1,L8$)
0930 FOR PIL6=1 TO 4
0940 IF NØGL5=Q(PIL6,1) THEN EXIT 
0950 NEXT PIL6
0960 IF PIL6<5 THEN CEKS=0
0970 ENDPROC 
0980 PROC INDTAB1(Z,MANT5,L7)
0990 PIL1=MANT5 DIV 32
1000 FOR I=1 TO PIL1
1010 H=(I-1)*8+1
1020 GET L7$,I:Z(H),Z(H+1),Z(H+2),Z(H+3),Z(H+4),Z(H+5),Z(H+6),Z(H+7)
1030 EXEC FEJL(2,1,L7$)
1040 NEXT I
1050 ENDPROC 
1060 PROC DATOUD(DA1,DA2)
1070 DA3=DA1
1080 DA2$="        "
1090 FOR J=8 TO 1 STEP -1
1100 IF J MOD 3=0 THEN 
1110 DA2$(J)="."
1120 ELSE 
1130 DA2$(J)=CHR(DA3 MOD 10+48)
1140 DA3=DA3 DIV 10
1150 ENDIF 
1160 NEXT J
1170 ENDPROC 
1180 PROC PGETUD(SIDE)
1190 IF CPIL>1 THEN 
1200 I=1;SIDE=1;SALDO$="0+"
1210 CLEAR 
1220 REPEAT 
1230 CURSOR 8,13
1240 INPUT "Monter papir til udskrift af posteringsark og tast RETURN",A$
1250 UNTIL ORD(A$)=255
1260 REPEAT 
1270 EXEC DATOUD(DATO,DAT$)
1280 OUTPUT P
1290 PRINT " "
1300 PRINT TAB(9);CHR(14);"Posteringsark";CHR(15);TAB(44);"Dato:";DAT$;
1310 PRINT TAB(61);
1320 PRINT USING "Side:####":SIDE
1330 SIDE=SIDE+1
1340 PRINT CHR(10)
1350 PRINT TAB(3);"Bilag    Tekst";TAB(42);"Debet         Beløb       Kredit"
1360 PRINT TAB(3);STREG$
1370 LINIE=1
1380 REPEAT 
1390 GET K8$,I:KONTO1,DDATO,BILAG,TKO$,BLB2$,MUL$
1400 EXEC FEJL(3,2,K8$)
1410 TEKSTKODE=ORD(TKO$)-48
1420 MULTI=ORD(MUL$)-48
1430 I=I+1
1440 IF TEKSTKODE>9 THEN 
1450 GET K8$,I:KONTO1,TEKST$
1460 EXEC FEJL(3,3,K8$)
1470 I=I+1
1480 ELSE 
1490 TEKST$=BLK$(1:25)
1500 IF TEKSTKODE<>0 THEN TEKST$(1:10)=TFIL$(TEKSTKODE)
1510 ENDIF 
1520 IF MULTI=0 THEN 
1530 EXEC CALC(1,SALDO$,BLB2$,SALDO$)
1540 GET K8$,I:KONTO2
1550 EXEC FEJL(3,4,K8$)
1560 I=I+1
1570 IF TEKSTKODE>9 THEN I=I+1
1580 ELSE 
1590 IF BLB2$(LEN(BLB2$))="-" THEN 
1600 KONTO2=KONTO1
1610 KONTO1=100000
1620 ELSE 
1630 KONTO2=100000
1640 ENDIF 
1650 ENDIF 
1660 EXEC CALC(0,SALDO$,BLB2$,SALDO$)
1670 PRINT USING "#######    ":BILAG;
1680 PRINT TEKST$;TAB(39);
1690 PRINT USING "  ######    ":KONTO1;
1700 EXEC TUD(BLB2$,UBELØB$,0,0)
1710 PRINT UBELØB$;
1720 PRINT USING "   ######":KONTO2
1730 LINIE=LINIE+1
1740 UNTIL LINIE=37 OR I=CPIL
1750 IF LINIE=37 AND I<>CPIL THEN 
1760 PRINT CHR(10);CHR(10);CHR(10);CHR(10);CHR(10)
1770 ELSE 
1780 FOR LINIE=LINIE TO 36
1790 PRINT CHR(10);
1800 NEXT LINIE
1810 PRINT " "
1820 PRINT TAB(3);STREG$
1830 EXEC TUD(SALDO$,UBELØB$,1,0)
1840 PRINT TAB(27);CHR(14);"Difference";CHR(15);TAB(43);UBELØB$
1850 PRINT TAB(3);STREG$
1860 PRINT CHR(10)
1870 OUTPUT T
1880 ENDIF 
1890 UNTIL I=CPIL
1900 ENDIF 
1910 ENDPROC 
1920 PROC PPUT
1930 MUL$=CHR(MULTI+48)
1940 IF MULTI=0 THEN 
1950 BPIL=CPIL
1960 TKO$=CHR(TEKSTKODE+48)
1970 PUT K8$,CPIL:KONTO1,BDATO,BILAG,TKO$,BLB2$,MUL$
1980 EXEC FEJL(2,2,K8$)
1990 CPIL=CPIL+1
2000 IF TEKSTKODE>9 THEN 
2010 PUT K8$,CPIL:KONTO1,TEKST$
2020 EXEC FEJL(2,3,K8$)
2030 CPIL=CPIL+1
2040 ENDIF 
2050 PUT K8$,CPIL:KONTO2,BDATO,BILAG,TKO$,BLB3$,MUL$
2060 EXEC FEJL(2,4,K8$)
2070 CPIL=CPIL+1
2080 IF TEKSTKODE>9 THEN 
2090 PUT K8$,CPIL:KONTO2,TEKST$
2100 EXEC FEJL(2,5,K8$)
2110 CPIL=CPIL+1
2120 ENDIF 
2130 ELSE 
2140 FOR I=1 TO APIL
2150 IF KA(I)<>0 THEN 
2160 TKO$=CHR(TKA(I)+48)
2170 PUT K8$,CPIL:KA(I),DA(I),CA(I),TKO$,CEA$(I),MUL$
2180 EXEC FEJL(2,6,K8$)
2190 CPIL=CPIL+1
2200 IF TKA(I)>9 THEN 
2210 PUT K8$,CPIL:KA(I),TA$(I)
2220 EXEC FEJL(2,7,K8$)
2230 CPIL=CPIL+1
2240 ENDIF 
2250 ENDIF 
2260 NEXT I
2270 BPIL=CPIL;APIL=0;DPIL=0
2280 EXEC SYSGEM
2290 ENDIF 
2300 ENDPROC 
2310 PROC SYSGEM
2320 T1(5)=PSIDENR;T1(8)=BBILAG;T2(1)=PPOST;T3(1)=BHPOSTNR
2330 OPEN K10$,W
2340 EXEC FEJL(7,1,K10$)
2350 PUT K10$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
2360 EXEC FEJL(7,2,K10$)
2370 PUT K10$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
2380 EXEC FEJL(7,3,K10$)
2390 PUT K10$,13:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
2400 EXEC FEJL(7,4,K10$)
2410 CLOSE K10$
2420 EXEC FEJL(7,5,K10$)
2430 ENDPROC 
2440 PROC KONTOOK
2450 EXEC KTNAVN(KTAL,P)
2460 CURSOR 25,23
2470 PRINT KONTONAVN$;BLK$(1:30-LEN(KONTONAVN$))
2480 REPEAT 
2490 CURSOR 55,23
2500 PRINT "Rigtig konto (J/N)  "
2510 CURSOR 75,23
2520 INPUT A$
2530 EXEC NRTEST(A$)
2540 UNTIL P=-7 OR P=-8
2550 ENDPROC 
2560 PROC KONTOUD(KONT)
2570 IF CEKS=1 THEN 
2580 CURSOR 2,LINIENR+3
2590 PRINT BLK$
2600 IF MULTI=0 THEN BBILAG=BBILAG-1
2610 CNR=1
2620 ELSE 
2630 CURSOR 42+28*(CNR=5),LINIENR+3
2640 PRINT USING "   ######   ":KONT
2650 LINIENR=LINIENR+1*(CNR=5)
2660 CNR=4-3*(CNR=5)
2670 ENDIF 
2680 ENDPROC 
2690 PROC TUD(BLB1,UBLB,TEGN,STØR)
2700 EXEC CALC(5,BLB1$,TAL4$,UBLB$)
2710 IF TEGN=0 THEN 
2720 UBLB$=UBLB$(1:13)
2730 ELSE 
2740 IF TEGN=1 AND UBLB$(LEN(UBLB$))="+" THEN 
2750 UBLB$(LEN(UBLB$))=" "
2760 ENDIF 
2770 ENDIF 
2780 IF STØR=1 THEN 
2790 UBLB$=UBLB$(3:LEN(UBLB$)-3)
2800 ENDIF 
2810 ENDPROC 
2820 PROC FEJL(NR1,NR2,NR3)
2830 IF STATUS(NR3$)<>0 THEN 
2840 PRINT STATUS(NR3$),NR1,NR2,NR3$
2850 STOP 
2860 ENDIF 
2870 ENDPROC 
2880 PROC PSLET(ART1)
2890 IF MULTI=0 THEN 
2900 IF BPIL=CPIL THEN 
2910 REPEAT 
2920 CURSOR 3,23
2930 PRINT "Posteringen kan ikke annuleres, tast RETURN"+BLK$(1:34)
2940 CURSOR 48,23
2950 INPUT A$
2960 EXEC NRTEST(A$)
2970 UNTIL P=-1
2980 ELSE 
2990 LINIENR=LINIENR-1
3000 BBILAG=BBILAG-1
3010 CURSOR 3,LINIENR+3
3020 PRINT BLK$
3030 FOR I=BPIL TO CPIL-1
3040 PUT K8$,I:0
3050 EXEC FEJL(1,2,K8$)
3060 NEXT I
3070 CPIL=BPIL
3080 ENDIF 
3090 ELSE 
3100 IF APIL>0 THEN 
3110 IF ART1=1 THEN 
3120 CURSOR 3,(P-1) MOD 18+4
3130 ELSE 
3140 P=APIL
3150 LINIENR=LINIENR-1
3160 CURSOR 3,LINIENR+3
3170 ENDIF 
3180 IF TKA(P)>9 THEN DPIL=DPIL-1
3190 PRINT BLK$
3200 KA(P)=0
3210 DA(P)=0
3220 CA(P)=0
3230 TKA(P)=0
3240 TA$(P)=BLK$(1:25)
3250 EXEC CALC(1,SALDO$,CEA$(P),SALDO$)
3260 CEA$(P)=BLK$(1:14)
3270 IF ART1=0 THEN 
3280 APIL=APIL-1;DPIL=DPIL-1
3290 ENDIF 
3300 ENDIF 
3310 ENDIF 
3320 ENDPROC 
3330 PROC NRTEST(NUM1)
3340 P=0;TEST2=0;KTAL=0
3350 L=LEN(NUM1$)
3360 CASE L OF 
3370 FOR I=1 TO L
3380 P1=INT(ORD(NUM1$(I))-48)
3390 IF P1=>0 AND P1<=9 THEN 
3400 P=P*10+P1
3410 ELSE 
3420 TEST2=1
3430 ENDIF 
3440 NEXT I
3450 KTAL=P DIV 10000;KTAL9=P DIV 1000
3460 IF KRTAL=KTAL9 THEN KTAL=KTAL9
3470 WHEN 0
3480 P=-1
3490 WHEN 1
3500 CASE NUM1$ OF 
3510 P=INT(ORD(NUM1$)-48)
3520 WHEN "d","D"
3530 P=-2
3540 WHEN "A","a"
3550 P=-3
3560 WHEN "M","m"
3570 P=-4
3580 WHEN "J","j"
3590 P=-7
3600 WHEN "N","n"
3610 P=-8
3620 ENDCASE 
3630 ENDCASE 
3640 ENDPROC 
3650 PROC FORTEGN
3660 L=LEN(BLB$)
3670 IF L=0 THEN 
3680 BLB$="0+";L=2
3690 ENDIF 
3700 IF BLB$(L)<>"+" AND BLB$(L)<>"-" THEN 
3710 BLB$=BLB$+"+"
3720 ELSE 
3730 BLB$(L)="+"
3740 ENDIF 
3750 ENDPROC 
3760 PROC UDHOVED
3770 CURSOR 2,1
3780 EXEC DATOUD(BDATO,DAT$)
3790 PRINT TAB(20);"Posteringsark";BLK$(1:25);"Dato:";DAT$
3800 CURSOR 3,3
3810 PRINT "Nr   Bilag    Tekst";BLK$(1:24);"Debet         Beløb        K";
3820 PRINT "redit"
3830 ENDPROC 
3840 PROC UDLINIE
3850 CURSOR 1,4
3860 PRINT USING "### #######     ":LINIENR,BILAG;
3870 IF TEKSTKODE<>0 THEN PRINT ATEKST$
3880 CURSOR 42,4
3890 PRINT USING "     ######  ":KONTO1;
3900 EXEC TUD(BLB2$,UBELØB$,0,0)
3910 PRINT UBELØB$;
3920 PRINT USING "   ######":KONTO2
3930 ENDPROC 
3940 PROC NYDATO
3950 REPEAT 
3960 CURSOR 3,23
3970 PRINT "Ny dato           (ÅÅMMDD)"+BLK$(1:51)
3980 CURSOR 11,23
3990 INPUT DAT$
4000 EXEC NRTEST(DAT$)
4010 UNTIL KTAL>79 AND (P DIV 100) MOD 100<13 AND P MOD 100<32
4020 BDATO=P
4030 ENDPROC 
4040 K1$="P641220:SYSTEM1"
4050 REPEAT 
4060 OPEN K1$,R
4070 IF STATUS(K1$)<>0 THEN 
4080 CLEAR 
4090 CURSOR 25,13
4100 INPUT "Isæt plade nr. 20 ,tast RETURN",A$
4110 EXEC NRTEST(A$)
4120 P=0
4130 ELSE 
4140 P=-1
4150 ENDIF 
4160 UNTIL P=-1
4170 GET K1$,1:MFANTAL,MDANTAL,MKANTAL
4180 EXEC FEJL(9,1,K1$)
4190 GET K1$,2:MKASPOST,MPPOST,MBHPOST
4200 EXEC FEJL(9,2,K1$)
4210 GET K1$,4:MKPOST,MFAK,MVGR,MKGR
4220 EXEC FEJL(9,3,K1$)
4230 GET K1$,5:MKRGR
4240 EXEC FEJL(9,4,K1$)
4250 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
4260 EXEC FEJL(9,5,K1$)
4270 GET K1$,9:KRTAL
4280 EXEC FEJL(9,6,K1$)
4290 GET K1$,10:N$
4300 EXEC FEJL(9,7,K1$)
4310 GET K1$,11:K2$
4320 EXEC FEJL(9,8,K1$)
4330 GET K1$,12:K3$
4340 EXEC FEJL(9,9,K1$)
4350 GET K1$,13:K4$
4360 EXEC FEJL(9,10,K1$)
4370 GET K1$,15:K5$
4380 EXEC FEJL(9,11,K1$)
4390 GET K1$,16:K6$
4400 EXEC FEJL(9,12,K1$)
4410 GET K1$,17:K7$
4420 EXEC FEJL(9,13,K1$)
4430 GET K1$,20:K8$
4440 EXEC FEJL(9,14,K1$)
4450 GET K1$,21:K9$
4460 EXEC FEJL(9,15,K1$)
4470 GET K1$,36:K10$
4480 EXEC FEJL(9,16,K1$)
4490 CLOSE K1$
4500 EXEC FEJL(9,17,K1$)
4510 DIM FTAB1(MFANTAL DIV 4),DTAB1(MDANTAL DIV 4),KTAB1(MKANTAL DIV 4)
4520 DIM FTAB(4,2),DTAB(4,2),KTAB(4,2)
4530 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$;K6$=N$+K6$;K7$=N$+K7$
4540 K8$=N$+K8$;K9$=N$+K9$;K10$=N$+K10$
4550 OPEN K10$,R
4560 EXEC FEJL(9,18,K10$)
4570 GET K10$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
4580 EXEC FEJL(9,19,K10$)
4590 FOR I=1 TO 3
4600 H=(I-1)*3+1
4610 GET K10$,I+5:TFIL$(H),TFIL$(H+1),TFIL$(H+2)
4620 EXEC FEJL(9,20,K10$)
4630 NEXT I
4640 GET K10$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
4650 EXEC FEJL(9,21,K10$)
4660 GET K10$,13:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
4670 EXEC FEJL(9,22,K10$)
4680 CLOSE K10$
4690 EXEC FEJL(9,23,K10$)
4700 OPEN K2$,R
4710 EXEC FEJL(9,24,K2$)
4720 OPEN K3$,R
4730 EXEC FEJL(9,25,K3$)
4740 OPEN K4$,R
4750 EXEC FEJL(9,26,K4$)
4760 OPEN K5$,R
4770 EXEC FEJL(9,27,K5$)
4780 OPEN K6$,R
4790 EXEC FEJL(9,28,K6$)
4800 OPEN K7$,R
4810 EXEC FEJL(9,29,K7$)
4820 OPEN K8$,W
4830 EXEC FEJL(9,30,K8$)
4840 PSIDENR=T1(5);DATO=T1(7);BBILAG=T1(8);PPOST=T2(1);BHPOSTNR=T3(1)
4850 EXEC INDTAB1(FTAB1,MFANTAL,K2$)
4860 EXEC INDTAB1(DTAB1,MDANTAL,K3$)
4870 EXEC INDTAB1(KTAB1,MKANTAL,K4$)
4880 BLK$="                                                              "
4890 BLK$=BLK$+"              "
4900 TAL4$="0+";BDATO=DATO;CPIL=PPOST+1;BPIL=CPIL;APIL=0;LINIENR=1;MULTI=0
4910 CNR=1;SALDO$="0+";STREG$="-----------------------------------"
4920 STREG$=STREG$+STREG$;DPIL=0
4930 CLEAR 
4940 EXEC UDHOVED
4950 REPEAT 
4960 CASE CNR OF 
4970 STOP 
4980 WHEN 1
4990 REPEAT 
5000 REPEAT 
5010 CURSOR 3,23
5020 PRINT "Bilag        (0:færdig,RETURN:automatisk,A:annuller,D:ny dato,";
5030 PRINT "M:afslut multi)"
5040 CURSOR 8,23
5050 INPUT BIL$
5060 EXEC NRTEST(BIL$)
5070 UNTIL P=>-4 AND TEST2=0 AND L<=6
5080 FPIL=CPIL+DPIL
5090 IF (FPIL>MPPOST-3 OR APIL=35 OR FPIL+T3(1)-3>MBHPOST) AND P<>-3 THEN P=0
5100 IF P<>0 AND P>-2 AND LINIENR=19 THEN 
5110 CLEAR 
5120 EXEC UDHOVED
5130 LINIENR=1
5140 EXEC SYSGEM
5150 EXEC UDLINIE
5160 LINIENR=LINIENR+1
5170 ENDIF 
5180 REPEAT 
5190 CBILAG=-1
5200 CASE P OF 
5210 BILAG=P
5220 BBILAG=P
5230 CURSOR 1,LINIENR+3
5240 PRINT USING "### #######":LINIENR,BILAG
5250 P=-9
5260 CNR=2
5270 WHEN 0
5280 IF MULTI=0 THEN 
5290 IF CPIL>MPPOST-3 OR FPIL+T3(1)-3>MBHPOST THEN 
5300 REPEAT 
5310 CURSOR 3,23
5320 PRINT "Ikke plads til flere posteringer , tast RETURN";BLK$(1:30)
5330 CURSOR 50,23
5340 INPUT A$
5350 EXEC NRTEST(A$)
5360 UNTIL P=-1
5370 ENDIF 
5380 P=-9
5390 CNR=6
5400 ELSE 
5410 IF FPIL>MPPOST-3 OR APIL=35 OR FPIL+T3(1)-3>MBHPOST THEN 
5420 EXEC CALC(4,TAL4$,SALDO$,TAL4$)
5430 IF SI<>0 THEN 
5440 EXEC TUD(SALDO$,UBELØB$,1,0)
5450 REPEAT 
5460 CURSOR 3,23
5470 PRINT "Ikke plads til flere posteringer,";UBELØB$;" på differencekonto";
5480 PRINT ",RETURN"
5490 CURSOR 76,23
5500 INPUT A$
5510 EXEC NRTEST(A$)
5520 UNTIL P=-1
5530 APIL=APIL+1;DPIL=DPIL+2
5540 IF SALDO$(LEN(SALDO$))="+" THEN 
5550 CEA$(APIL)=SALDO$(1:LEN(SALDO$)-1)+"-"
5560 ELSE 
5570 CEA$(APIL)=SALDO$(1:LEN(SALDO$)-1)+"+"
5580 ENDIF 
5590 EXEC CALC(0,SALDO$,CEA$(APIL),SALDO$)
5600 KA(APIL)=DIFNR;TKA(APIL)=10;DA(APIL)=BDATO;CA(APIL)=BILAG
5610 TA$(APIL)="Difference multipostering"
5620 ENDIF 
5630 CBILAG=0
5640 P=-4
5650 ELSE 
5660 REPEAT 
5670 CURSOR 3,23
5680 PRINT "Multipostering ikke afsluttet , tast RETURN"+BLK$(1:34)
5690 CURSOR 46,23
5700 INPUT A$
5710 EXEC NRTEST(A$)
5720 UNTIL P=-1
5730 ENDIF 
5740 ENDIF 
5750 WHEN -1
5760 IF MULTI=0 THEN BBILAG=BBILAG+1
5770 P=BBILAG
5780 CBILAG=0
5790 WHEN -2
5800 EXEC NYDATO
5810 EXEC UDHOVED
5820 WHEN -3
5830 EXEC PSLET(0)
5840 WHEN -4
5850 IF MULTI=0 THEN EXIT 
5860 EXEC CALC(4,TAL4$,SALDO$,TAL4$)
5870 IF SI<>0 THEN 
5880 REPEAT 
5890 EXEC TUD(SALDO$,UBELØB$,1,0)
5900 REPEAT 
5910 CURSOR 3,23
5920 PRINT "Multipostering kan ikke afsluttes , difference :";UBELØB$;" tas";
5930 PRINT "t RETURN  "
5940 CURSOR 79,23
5950 INPUT A$
5960 EXEC NRTEST(A$)
5970 UNTIL P=-1
5980 CLEAR 
5990 X=1
6000 REPEAT 
6010 EXEC UDHOVED
6020 REPEAT 
6030 IF CA(X)<>0 AND LEN(CEA$(X))>0 THEN 
6040 EXEC CALC(5,CEA$(X),TAL4$,UBELØB$)
6050 CURSOR 1,(X-1) MOD 18+4
6060 PRINT USING "### #######     ":X,CA(X);
6070 IF TKA(X)>9 THEN 
6080 PRINT TA$(X);
6090 ELSE 
6100 IF TKA(X)<>0 THEN PRINT TFIL$(TKA(X));
6110 ENDIF 
6120 LOG=0
6130 CURSOR 42,(X-1) MOD 18+4
6140 IF CEA$(X,LEN(CEA$(X)))="-" THEN LOG=1
6150 PRINT USING "   ######    ":KA(X)+100000*(LOG=1);
6160 PRINT UBELØB$(1:13);
6170 PRINT USING "     ######":KA(X)+100000*(LOG=0)
6180 ENDIF 
6190 X=X+1
6200 UNTIL X=APIL+1 OR X MOD 19=0
6210 REPEAT 
6220 REPEAT 
6230 CURSOR 3,23
6240 PRINT "Type      (1-36:Annulering,0:færdig,N:ny post,RETURN:ny sid";
6250 PRINT "e)"+BLK$(1:10)
6260 CURSOR 8,23
6270 INPUT RET$
6280 EXEC NRTEST(RET$)
6290 UNTIL (P<37 AND P>-2) OR P=-8
6300 CASE P OF 
6310 IF P<=APIL AND P<X THEN 
6320 EXEC PSLET(1)
6330 ENDIF 
6340 WHEN 0
6350 EXEC CALC(4,TAL4$,SALDO$,TAL4$)
6360 IF SI<>0 THEN 
6370 P=-2
6380 ELSE 
6390 EXEC PPUT
6400 MULTI=0
6410 ENDIF 
6420 WHEN -1
6430 IF APIL>18 THEN 
6440 CLEAR 
6450 ELSE 
6460 P=1
6470 ENDIF 
6480 WHEN -8
6490 P=0
6500 LINIENR=(X-1) MOD 18+1
6510 ENDCASE 
6520 UNTIL P<1 AND P>-3
6530 UNTIL P=0 OR P=-2
6540 UNTIL P=0
6550 ELSE 
6560 EXEC PPUT
6570 MULTI=0
6580 ENDIF 
6590 ENDCASE 
6600 UNTIL CBILAG=-1
6610 UNTIL P=-9
6620 WHEN 2
6630 REPEAT 
6640 REPEAT 
6650 CURSOR 3,23
6660 PRINT "Tekst                              (max 25 tegn,0-19:tekstkode)";
6670 PRINT BLK$(1:14)
6680 CURSOR 10,23
6690 INPUT BTEKST$
6700 UNTIL LEN(BTEKST$)<26
6710 IF LEN(BTEKST$)<3 THEN 
6720 EXEC NRTEST(BTEKST$)
6730 ELSE 
6740 P=20;TEST2=0
6750 ENDIF 
6760 UNTIL P=>0 AND P<21 AND TEST2=0 AND P<>10
6770 IF P<>0 THEN 
6780 ATK=P MOD 10
6790 IF P=20 THEN 
6800 P=10
6810 TEKST$=BTEKST$
6820 ATEKST$=TEKST$
6830 ELSE 
6840 ATEKST$=TFIL$(ATK)+BLK$(1:15)
6850 IF P>10 THEN 
6860 REPEAT 
6870 CURSOR 3,23
6880 PRINT "Tekst                 (max 14 tegn)"+BLK$(1:42)
6890 CURSOR 10,23
6900 INPUT BTEKST$
6910 UNTIL LEN(BTEKST$)<15
6920 ATEKST$(12,25)=BTEKST$
6930 TEKST$=ATEKST$
6940 ENDIF 
6950 ENDIF 
6960 CURSOR 17,LINIENR+3
6970 PRINT ATEKST$
6980 ENDIF 
6990 CNR=3
7000 TEKSTKODE=P
7010 WHEN 3
7020 REPEAT 
7030 REPEAT 
7040 CURSOR 3,23
7050 PRINT "Debet-konto           (RETURN:overspringes)"+BLK$(1:34)
7060 CURSOR 16,23
7070 INPUT KTN$
7080 EXEC NRTEST(KTN$)
7090 UNTIL (((KTAL<10 AND KTAL>0) OR KTAL=KRTAL) AND TEST2=0) OR P=-1
7100 IF P=-1 THEN 
7110 KONTO1=100000
7120 MULTI=1
7130 OVS=1
7140 CEKS=0
7150 ELSE 
7160 OVS=0
7170 KONTO1=P
7180 EXEC KONTOOK
7190 ENDIF 
7200 UNTIL P=-1 OR P=-7
7210 EXEC KONTOUD(KONTO1)
7220 WHEN 4
7230 REPEAT 
7240 REPEAT 
7250 CURSOR 3,23
7260 PRINT "Beløb"+BLK$(1:70)
7270 CURSOR 10,23
7280 INPUT BLB$
7290 EXEC FORTEGN
7300 EXEC CALC(6,BLB$,TAL4$,UBELØB$)
7310 UNTIL FLAG=0
7320 EXEC CALC(4,BLB$,TAL4$,TAL4$)
7330 UNTIL SI<>0
7340 BLB2$=BLB$
7350 BLB3$=BLB$(1:LEN(BLB$)-1)+"-"
7360 EXEC TUD(BLB$,UBELØB$,0,0)
7370 CURSOR 55,LINIENR+3
7380 PRINT UBELØB$
7390 CNR=5
7400 WHEN 5
7410 REPEAT 
7420 REPEAT 
7430 CURSOR 3,23
7440 PRINT "Kredit-konto           (RETURN:overspringes,A:annuller)";
7450 PRINT "                     "
7460 CURSOR 17,23
7470 INPUT KTN$
7480 EXEC NRTEST(KTN$)
7490 UNTIL (((KTAL<10 AND KTAL>0) OR KTAL=KRTAL) AND TEST2=0) OR P=-1 OR P=-3
7500 IF P=-1 THEN 
7510 IF OVS=0 THEN 
7520 P=0
7530 KONTO2=100000
7540 MULTI=1
7550 EXEC CALC(0,SALDO$,BLB2$,SALDO$)
7560 APIL=APIL+1;DPIL=DPIL+1
7570 KA(APIL)=KONTO1
7580 DA(APIL)=BDATO
7590 CA(APIL)=BILAG
7600 TKA(APIL)=TEKSTKODE
7610 CEA$(APIL)=BLB2$
7620 IF TEKSTKODE>9 THEN 
7630 TA$(APIL)=TEKST$;DPIL=DPIL+1
7640 ELSE 
7650 TA$(APIL)=BLK$(1:25)
7660 ENDIF 
7670 CEKS=0
7680 EXEC KONTOUD(KONTO2)
7690 ENDIF 
7700 ELSE 
7710 IF P=-3 THEN 
7720 CEKS=1
7730 EXEC KONTOUD(P)
7740 ELSE 
7750 MO=MULTI+OVS
7760 CASE MO OF 
7770 STOP 
7780 WHEN 0
7790 KONTO2=P
7800 EXEC KONTOOK
7810 IF P=-7 THEN 
7820 EXEC KONTOUD(KONTO2)
7830 IF CEKS=0 THEN 
7840 EXEC PPUT
7850 ENDIF 
7860 ENDIF 
7870 WHEN 1
7880 REPEAT 
7890 CURSOR 3,23
7900 PRINT "Multipostering ikke afsluttet , tast RETURN"+BLK$(1:34)
7910 CURSOR 46,23
7920 INPUT A$
7930 EXEC NRTEST(A$)
7940 UNTIL P=-1
7950 WHEN 2
7960 KONTO2=P
7970 EXEC KONTOOK
7980 IF P=-7 THEN 
7990 EXEC KONTOUD(KONTO2)
8000 IF CEKS=0 THEN 
8010 EXEC CALC(0,SALDO$,BLB3$,SALDO$)
8020 APIL=APIL+1;DPIL=DPIL+1
8030 KA(APIL)=KONTO2
8040 DA(APIL)=BDATO
8050 CA(APIL)=BILAG
8060 TKA(APIL)=TEKSTKODE
8070 CEA$(APIL)=BLB3$
8080 IF TEKSTKODE>9 THEN 
8090 TA$(APIL)=TEKST$;DPIL=DPIL+1
8100 ELSE 
8110 TA$(APIL)=BLK$(1:25)
8120 ENDIF 
8130 ENDIF 
8140 ENDIF 
8150 ENDCASE 
8160 ENDIF 
8170 ENDIF 
8180 UNTIL P=0 OR P=-3 OR P=-7
8190 WHEN 6
8200 REPEAT 
8210 CURSOR 3,23
8220 PRINT "Ønskes afslutning (J/N)"+BLK$(1:54)
8230 CURSOR 27,23
8240 INPUT A$
8250 EXEC NRTEST(A$)
8260 UNTIL P=-7 OR P=-8
8270 IF P=-7 THEN 
8280 MUL$="2"
8290 OPEN K9$,W
8300 EXEC FEJL(9,32,K9$)
8310 FOR I=1 TO CPIL-1
8320 GET K8$,I:KONTO1,DDATO,BILAG,TKO$,BLB2$
8330 EXEC FEJL(9,33,K8$)
8340 BHPOSTNR=BHPOSTNR+1
8350 PUT K9$,BHPOSTNR:KONTO1,DDATO,BILAG,TKO$,BLB2$,MUL$
8360 EXEC FEJL(9,34,K9$)
8370 IF ORD(TKO$)-48>9 THEN 
8380 I=I+1
8390 BHPOSTNR=BHPOSTNR+1
8400 GET K8$,I:KONTO1,TEKST$
8410 EXEC FEJL(9,35,K8$)
8420 PUT K9$,BHPOSTNR:KONTO1,TEKST$
8430 EXEC FEJL(9,36,K9$)
8440 ENDIF 
8450 NEXT I
8460 CLOSE K9$
8470 EXEC FEJL(9,38,K9$)
8480 EXEC PGETUD(PSIDENR)
8490 PPOST=0
8500 ELSE 
8510 REPEAT 
8520 CURSOR 3,23
8530 PRINT "Ønskes kontroludskrift (J/N)"+BLK$(1:49)
8540 CURSOR 31,23
8550 INPUT A$
8560 EXEC NRTEST(A$)
8570 UNTIL P=-7 OR P=-8
8580 IF P=-7 THEN 
8590 EXEC PGETUD(1)
8600 ENDIF 
8610 PPOST=CPIL-1
8620 ENDIF 
8630 CNR=-1
8640 ENDCASE 
8650 UNTIL CNR=-1
8660 CLOSE K8$
8670 EXEC FEJL(9,40,K8$)
8680 CLOSE 
8690 EXEC SYSGEM
8700 OUTPUT T
8710 CHAIN "P641210:OPSTART"
8720 END
DataMuseum.dk

MIKADOS

⟦f0f4c1a6d⟧

Derivation

Text
