⟦5d87a496b⟧

Text

0100 DIM K1$(17),K2$(17),DEBNAVN$(25),DSALDO1$(12),DEBKGR$(2),FNAVN$(25)
0110 DIM DSALDO2$(12),DSALDO3$(12),DSALDO4$(12),DEBLK$(2),DEBGADE$(25),A$(6)
0120 DIM BLANK$(77),TAL4$(14),TAH$(12),DEBTLF$(9),DEBBY$(20),K3$(17),K4$(17)
0130 DIM RES$(14),ÅRKØB$(12),MDNKØB$(12),OP2$(12),BELØB$(12),KTNR$(6),K5$(17)
0140 DIM FMDEBET$(12),FMKREDIT$(12),FÅDEBET$(12),FÅKREDIT$(12),FSALDO$(12)
0150 DIM OP1$(12),TK$(3),TEKST$(25),TFIL$(20,10),FUKODE$(1),N$(6),FMKODE$(1)
0160 DIM K6$(17),K7$(17),UBELØB$(14),SUM$(12),DAT$(8),SALDO$(12),DA5$(8)
0170 DIM EGNAVN$(25),EGGADE$(25),EGBY$(20),STREG$(77),TKODE$(1)
0180 DIM K8$(17),K9$(17),K10$(17),K11$(17),K12$(17),K13$(17),K14$(17)
0190 DIM T1(9),T2(9),T3(9),KRENAVN$(25),KREGADE$(25),KREBY$(20),KRELK$(1)
0200 DIM KSALDO1$(12),KSALDO2$(12),LTX$(11,52),LAND$(9,12),KREGR$(1)
0210 DIM UBEL1$(14),UBEL2$(14),UBEL3$(14),UBEL4$(14)
0220 PROC CALC(AR3,B1,B2,ES)
0230 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0;ART=AR3-6*(AR3>5)
0240 CALL "P641210:REGN"
0250 ES$=RES$
0260 IF AR3<6 THEN 
0270 IF FLAG THEN STOP 
0280 ENDIF 
0290 ENDPROC 
0300 PROC TUD(BLB,UBLB,TEGN,STØR)
0310 EXEC CALC(5,BLB$,TAH$,UBLB$)
0320 IF TEGN=0 THEN 
0330 UBLB$=UBLB$(1:13)
0340 ELSE 
0350 IF TEGN=1 AND UBLB$(LEN(UBLB$))="+" THEN 
0360 UBLB$(LEN(UBLB$))=" "
0370 ENDIF 
0380 ENDIF 
0390 IF STØR=1 THEN 
0400 UBLB$=UBLB$(4:LEN(UBLB$)-3)
0410 ENDIF 
0420 ENDPROC 
0430 PROC FEJL(NR1,NR2,NR3)
0440 IF STATUS(NR3$)<>0 THEN 
0450 PRINT NR1,NR2,NR3$,STATUS(NR3$)
0460 STOP 
0470 ENDIF 
0480 ENDPROC 
0490 PROC SØG(MPOSTANTAL6,HTAB3,NØGLE3,UTAB3,K34)
0500 PPIL1=0
0510 PPIL2=MPOSTANTAL6 DIV 40+1
0520 REPEAT 
0530 PPIL3=(PPIL1+PPIL2) DIV 2
0540 IF HTAB3(PPIL3,1)=NØGLE3 THEN EXIT 
0550 IF HTAB3(PPIL3,1)>NØGLE3 THEN 
0560 PPIL2=PPIL3
0570 ELSE 
0580 PPIL1=PPIL3
0590 ENDIF 
0600 UNTIL PPIL2<=PPIL1+1
0610 IF PPIL3>1 THEN 
0620 REPEAT 
0630 PPIL3=PPIL3-1
0640 UNTIL HTAB3(PPIL3,1)<NØGLE3 OR PPIL3=1
0650 ENDIF 
0660 IF HTAB3(PPIL3,2)<NØGLE3 OR NØGLE3<HTAB3(PPIL3,1) THEN 
0670 IF HTAB3(PPIL3+1,1)>NØGLE3 THEN 
0680 T=0
0690 ELSE 
0700 T=PPIL3+1
0710 ENDIF 
0720 ELSE 
0730 T=PPIL3
0740 ENDIF 
0750 IF T>0 THEN 
0760 K=T+MPOSTANTAL6 DIV 160
0770 EXEC UNDIND(K34$,K,UTAB3)
0780 FOR I=4 TO 1 STEP -1
0790 IF UTAB3(I,1)<NØGLE3 THEN EXIT 
0800 NEXT I
0810 IF I=0 THEN I=1
0820 IF UTAB3(I,2)<NØGLE3 THEN 
0830 IF UTAB3(I+1,1)>NØGLE3 THEN 
0840 T=0
0850 ELSE 
0860 T=(T-1)*40+I*10+1
0870 ENDIF 
0880 ELSE 
0890 T=(T-1)*40+(I-1)*10+1
0900 ENDIF 
0910 ENDIF 
0920 ENDPROC 
0930 PROC POSTER(K35,NØGLE4,T5,MPOSTANTAL7,PKODE,SU3)
0940 LINIE=0
0950 OPEN K35$,R
0960 EXEC FEJL(1,1,K35$)
0970 FOR I=1 TO 10
0980 GET K35$,T5:KTNUM
0990 EXEC FEJL(1,2,K35$)
1000 IF KTNUM=NØGLE4 THEN EXIT 
1010 IF MAFSLUT=1 THEN EXIT 
1020 T5=T5+1
1030 NEXT I
1040 IF KTNUM=NØGLE4 THEN 
1050 FOR K=T5 TO MPOSTANTAL7
1060 GET K35$,K:KONTO,DDATO,BILAG,TKODE$,BELØB$
1070 EXEC FEJL(1,3,K35$)
1080 IF KONTO<>NØGLE4 THEN EXIT 
1090 TKS=ORD(TKODE$)-48
1100 IF TKS>9 AND TKS<20 THEN 
1110 K=K+1
1120 GET K35$,K:KONTO,TEKST$
1130 EXEC FEJL(1,4,K35$)
1140 TEKST$=TEKST$+BLANK$(1:25-LEN(TEKST$)+1)
1150 ELSE 
1160 IF TKS>0 THEN 
1170 TEKST$=TFIL$(TKS-10*(TKS>20))+BLANK$(1:25-LEN(TFIL$(TKS-10*(TKS>20))))
1180 ELSE 
1190 TEKST$=BLANK$
1200 ENDIF 
1210 ENDIF 
1220 EXEC UDSKRIV(PKODE,SU3$,LINIE)
1230 NEXT K
1240 IF MAFSLUT=1 THEN 
1250 T6=K;NØGLE4=KONTO
1260 ENDIF 
1270 ELSE 
1280 T6=T5;NØGLE4=KTNUM
1290 T5=0
1300 ENDIF 
1310 CLOSE K35$
1320 EXEC FEJL(1,5,K35$)
1330 ENDPROC 
1340 PROC LINIEUD(DA2,BI2,TE2,BE2,SU1)
1350 SK=SKRIV1
1360 EXEC CALC(0,SU1$,BE2$,SU1$)
1370 EXEC DATOUD(DA2,DA5$)
1380 PRINT TAB(3+8*(SK));DA5$;TAB(13+6*(SK));
1390 IF BI2<>-1 THEN 
1400 PRINT USING "#######":BI2;
1410 ENDIF 
1420 PRINT TAB(24+3*(SK));TE2$;
1430 EXEC TUD(BE2$,UBELØB$,0,0)
1440 IF SK THEN EXEC TUD(BE2$,UBELØB$,0,1)
1450 PRINT TAB(49+3*(SK)+(14-3*(SK))*(BE2$(LEN(BE2$))="-"));UBELØB$
1460 ENDPROC 
1470 PROC INDPUT1(XPOS1,YPOS1,LN4,LN5,LTK)
1480 REPEAT 
1490 CURSOR XPOS1,YPOS1
1500 PRINT LTK$;BLANK$(1:77-XPOS1-LEN(LTK$))
1510 CURSOR XPOS1+LEN(LTK$),YPOS1
1520 INPUT " ",A$
1530 EXEC NRTEST(A$)
1540 UNTIL P>LN4 AND P<LN5
1550 ENDPROC 
1560 PROC LINIER(FRA1,TIL1,TÆL1)
1570 FOR TÆL1=FRA1 TO TIL1
1580 PRINT " "
1590 NEXT TÆL1
1600 ENDPROC 
1610 PROC NAVN2(NAVN3,GADE1,POSTNR1,BY1,LANDK1)
1620 PRINT NAVN3$
1630 CURSOR 9,6
1640 PRINT GADE1$
1650 CURSOR 9,7
1660 PRINT USING "######":POSTNR1
1670 CURSOR 17,7
1680 PRINT BY1$
1690 CURSOR 9,8
1700 EXEC NRTEST(LANDK1$)
1710 IF P>0 AND P<10 THEN PRINT LAND$(P)
1720 ENDPROC 
1730 PROC NAVN1(NAVN,GADE,POSTNR,BY,LANDK)
1740 PRINT TAB(12);NAVN$;" "
1750 PRINT TAB(12);GADE$;" "
1760 PRINT TAB(12);POSTNR;TAB(19);BY$;" "
1770 P1=ORD(LANDK$)-48
1780 IF P1>0 AND P1<10 THEN PRINT TAB(12);LAND$(P1);" "
1790 EXEC LINIER(1,1*(P1<1 OR P1>9),I)
1800 ENDPROC 
1810 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
1820 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=1;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
1830 REPEAT 
1840 IF NØGL5=TAB4(PIL6) OR PIL1=1 THEN EXIT 
1850 PIL1=(PIL1+1) DIV 2;PIL6=PIL6+PIL1*(1-2*(NØGL5<TAB4(PIL6)))
1860 IF PIL6<1 THEN PIL6=1
1870 IF PIL6>MANT3 THEN PIL6=MANT3
1880 UNTIL PIL1=0
1890 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-1*(PIL6>1)
1900 PIL6=MANT4+PIL6
1910 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)
1920 EXEC FEJL(1,1,L8$)
1930 FOR PIL6=1 TO 4
1940 IF NØGL5=Q(PIL6,1) THEN EXIT 
1950 NEXT PIL6
1960 IF PIL6<>5 THEN CEKS=0
1970 ENDPROC 
1980 PROC INDTAB1(Z,MANT5,L7)
1990 PIL1=MANT5 DIV 32
2000 FOR I=1 TO PIL1
2010 H=(I-1)*8+1
2020 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)
2030 EXEC FEJL(2,1,L7$)
2040 NEXT I
2050 ENDPROC 
2060 PROC LUDSKRIV(KT1,DA4,KSNR)
2070 EXEC DATOUD(DA4,DA5$)
2080 KSNR=KSNR+1
2090 PRINT TAB(48);KT1;TAB(56);DA5$;TAB(69);
2100 PRINT USING "##":KSNR
2110 ENDPROC 
2120 PROC BUDSKRIV(MKØB,MK,SU2,DS1,DS2,DS3,DS4,LNR)
2130 IF MK<>2 THEN EXEC LINIER(LNR,24-6*(SKRIV1),LNR)
2140 IF SKRIV1=0 OR KTAL1<>DTAL THEN 
2150 IF MK<>2 THEN PRINT STREG$
2160 CASE MK OF 
2170 STOP 
2180 WHEN 1,2
2190 PRINT TAB(32);"Transport";
2200 WHEN 3,4
2210 PRINT TAB(57);CHR(14);"Ny saldo";CHR(15)
2220 PRINT STREG$
2230 WHEN 0
2240 PRINT TAB(11),CHR(14);"Månedens køb";TAB(36);"Ny saldo";CHR(15)
2250 PRINT STREG$
2260 ENDCASE 
2270 ENDIF 
2280 IF MK=0 THEN 
2290 EXEC TUD(MKØB$,UBELØB$,1,0)
2300 PRINT TAB(11);UBELØB$;
2310 ENDIF 
2320 EXEC TUD(SU2$,UBELØB$,0,0)
2330 IF SKRIV1 THEN EXEC TUD(SU2$,UBELØB$,0,1)
2340 PRINT TAB(49+3*(SKRIV1)+(14-3*(SKRIV1))*(SU2$(LEN(SU2$))="-"));UBELØB$
2350 IF SKRIV1=0 THEN 
2360 IF MK<>2 THEN PRINT STREG$
2370 ELSE 
2380 PRINT CHR(10)
2390 ENDIF 
2400 IF MK<1 OR MK>2 THEN 
2410 IF SKRIV1=0 THEN 
2420 CASE MK OF 
2430 PRINT TAB(15);CHR(14);"Månedens bev.";TAB(34);"Årets bev.";CHR(15)
2440 WHEN 0,4
2450 PRINT TAB(17);CHR(14);"0-30";
2460 IF MK=0 THEN PRINT TAB(25);"30-60";TAB(33);"60-90";
2470 PRINT TAB(41);"Ældre";CHR(15)
2480 ENDCASE 
2490 PRINT STREG$
2500 ENDIF 
2510 EXEC TUD(DS1$,UBEL1$,1,0)
2520 EXEC TUD(DS2$,UBEL2$,1,0)
2530 EXEC TUD(DS3$,UBEL3$,1,0)
2540 EXEC TUD(DS4$,UBEL4$,1,0)
2550 PRINT TAB(11);UBEL1$;
2560 IF MK<>4 THEN PRINT TAB(27);UBEL2$;TAB(44);UBEL3$;
2570 PRINT TAB(60);UBEL4$
2580 ENDIF 
2590 IF SKRIV1=0 AND MK<>1 AND MK<>2 THEN 
2600 PRINT STREG$
2610 PRINT CHR(10)
2620 ENDIF 
2630 IF MK=1 OR SKRIV1=1 THEN EXEC LINIER(LNR,29-5*(SKRIV1),LNR)
2640 ENDPROC 
2650 PROC STARTBIL
2660 REPEAT 
2670 OUTPUT T
2680 CLEAR 
2690 EXEC OVERSKRIFT(0)
2700 REPEAT 
2710 EXEC INDPUT1(4,3,-1,100000,LTX$(1))
2720 UNTIL P=0 OR (P>9999 AND P<100000)
2730 SUM$="0+";KONT=P;KTAL1=0
2740 IF KONT=0 THEN EXIT 
2750 IF KTAL=DTAL AND DTAL*10000+MKGR<KONT THEN KTAL1=DTAL
2760 IF KTAL=KRTAL AND KRTAL*1000+MKRGR<KONT THEN KTAL1=KRTAL
2770 CURSOR 9,5
2780 CASE KTAL1 OF 
2790 EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,KONT,FPIL3,K2$)
2800 IF CEKS=0 THEN 
2810 EXEC HENTPOST
2820 IF ORD(FUKODE$)-48=0 THEN 
2830 PRINT FNAVN$;" "
2840 ELSE 
2850 CEKS=1
2860 ENDIF 
2870 ENDIF 
2880 WHEN DTAL
2890 EXEC FINDPOST1(DTAB1,DTAB,MDANTAL,KONT,DPIL3,K3$)
2900 IF CEKS=0 THEN 
2910 EXEC HENTDPOST
2920 EXEC NAVN2(DEBNAVN$,DEBGADE$,DEBPOSTNR,DEBBY$,DEBLK$)
2930 ENDIF 
2940 WHEN KRTAL
2950 EXEC FINDPOST1(KTAB1,KTAB,MKANTAL,KONT,KPIL3,K4$)
2960 IF CEKS=0 THEN 
2970 EXEC HENTKPOST
2980 EXEC NAVN2(KRENAVN$,KREGADE$,KREPOSTNR,KREBY$,KRELK$)
2990 ENDIF 
3000 ENDCASE 
3010 IF CEKS=0 THEN EXEC INDPUT1(4,12,-9,-6,LTX$(2))
3020 IF CEKS=1 THEN EXEC INDPUT1(9,5,-2,0,LTX$(3))
3030 UNTIL P=-7 OR KONT=0
3040 ENDPROC 
3050 PROC HUDSKRIV
3060 PRINT CHR(10)
3070 CASE KTAL1 OF 
3080 PRINT TAB(12);CHR(14);FNAVN$;" ";CHR(15)
3090 EXEC LINIER(1,3,I)
3100 WHEN DTAL
3110 IF SKRIV1=1 THEN 
3120 PRINT CHR(10)
3130 EXEC NAVN1(EGNAVN$,EGGADE$,EGPOSTNR,EGBY$,A$)
3140 EXEC LINIER(1,4,I)
3150 ENDIF 
3160 EXEC NAVN1(DEBNAVN$,DEBGADE$,DEBPOSTNR,DEBBY$,DEBLK$)
3170 WHEN KRTAL
3180 EXEC NAVN1(KRENAVN$,KREGADE$,KREPOSTNR,KREBY$,KRELK$)
3190 ENDCASE 
3200 ENDPROC 
3210 PROC HSUDSKRIV
3220 IF SKRIV THEN 
3230 PRINT TAB(49);"Konto";TAB(56);"Dato";TAB(68);"Side"
3240 PRINT TAB(49);STREG$(1:29)
3250 EXEC LUDSKRIV(KONT,DATO,KSIDENR)
3260 PRINT STREG$
3270 ELSE 
3280 CLEAR 
3290 EXEC OVERSKRIFT(1)
3300 CURSOR 1,3
3310 ENDIF 
3320 PRINT TAB(3);"Dato";TAB(15);"Bilag    Tekst";TAB(52);"Debet";TAB(67);
3330 PRINT "Kredit"
3340 PRINT STREG$
3350 ENDPROC 
3360 PROC OVERSKRIFT(ART1)
3370 IF ART1=0 THEN 
3380 PRINT TAB(21);"Kontospørgeprogram";TAB(61);"Dato:";DAT$
3390 ELSE 
3400 CURSOR 1,1
3410 PRINT "Kontospørgeprogram   Nr:";
3420 PRINT USING "######  Navn :":KONT;
3430 CASE KTAL1 OF 
3440 PRINT FNAVN$;" ";
3450 WHEN DTAL
3460 PRINT DEBNAVN$;" ";
3470 WHEN KRTAL
3480 PRINT KRENAVN$;" ";
3490 ENDCASE 
3500 PRINT TAB(63);" Dato:";DAT$
3510 ENDIF 
3520 ENDPROC 
3530 PROC UDSKRIV(PKODE1,SU4,LNR1)
3540 EXEC LINIEUD(DDATO,BILAG,TEKST$,BELØB$,SU4$)
3550 LNR1=LNR1+1
3560 IF LNR1=18+5*(SKRIV) THEN 
3570 IF PKODE1=1 THEN 
3580 PRINT CHR(10);CHR(10)
3590 EXEC BUDSKRIV(TAL4$,1,SU4$,TAL4$,TAL4$,TAL4$,TAL4$,LNR1)
3600 EXEC HUDSKRIV
3610 EXEC HSUDSKRIV
3620 EXEC BUDSKRIV(TAL4$,2,SU4$,TAL4$,TAL4$,TAL4$,TAL4$,LNR1)
3630 LNR1=1
3640 ELSE 
3650 EXEC INDPUT1(4,23,-2,0,LTX$(4))
3660 CLEAR 
3670 EXEC HSUDSKRIV
3680 LNR1=0
3690 ENDIF 
3700 ENDIF 
3710 ENDPROC 
3720 PROC HENTPOST
3730 S=FTAB(FPIL3,2)
3740 GET K5$,S:FNR,FNAVN$
3750 EXEC FEJL(9,2,K5$)
3760 GET K5$,S+1:FMKODE$,FMDEBET$,FMKREDIT$
3770 EXEC FEJL(9,3,K5$)
3780 GET K5$,S+2:FUKODE$,FÅDEBET$,FÅKREDIT$
3790 EXEC FEJL(9,4,K5$)
3800 ENDPROC 
3810 PROC HENTDPOST
3820 S=DTAB(DPIL3,2)
3830 GET K6$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
3840 EXEC FEJL(8,2,K6$)
3850 GET K6$,S+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$
3860 EXEC FEJL(8,3,K6$)
3870 GET K6$,S+2:DEBGADE$,DEBTLF$,HPOST,HKUNDE
3880 EXEC FEJL(8,4,K6$)
3890 GET K6$,S+3:DEBBY$,ÅRKØB$,MDNKØB$
3900 EXEC FEJL(8,5,K6$)
3910 ENDPROC 
3920 PROC HENTKPOST
3930 S=KTAB(KPIL3,2)
3940 GET K7$,S:KRENR,KRENAVN$,KREGADE$
3950 EXEC FEJL(4,1,K7$)
3960 GET K7$,S+1:KREBY$,KRELK$,KREGR$,KREPOSTNR,KSALDO1$,KSALDO2$
3970 EXEC FEJL(4,2,K7$)
3980 ENDPROC 
3990 PROC NRTEST(KTN1)
4000 P=0;TEST2=0;KTAL=0;L=LEN(KTN1$)
4010 CASE L OF 
4020 FOR I=1 TO L
4030 P1=INT(ORD(KTN1$(I))-48)
4040 IF P1=>0 AND P1<=9 THEN 
4050 P=P*10+P1
4060 ELSE 
4070 TEST2=1
4080 ENDIF 
4090 NEXT I
4100 KTAL=P DIV 10000;KTAL9=P DIV 1000
4110 IF KTAL9=KRTAL THEN KTAL=KTAL9
4120 WHEN 0
4130 P=-1
4140 WHEN 1
4150 CASE KTN1$ OF 
4160 P=INT(ORD(KTN1$)-48)
4170 WHEN "j","J"
4180 P=-7
4190 WHEN "n","N"
4200 P=-8
4210 ENDCASE 
4220 ENDCASE 
4230 ENDPROC 
4240 PROC HOVIND(V1,MPOSTANTAL1,R)
4250 OPEN V1$,R
4260 EXEC FEJL(13,1,V1$)
4270 FOR I=1 TO MPOSTANTAL1 DIV 160
4280 J=(I-1)*4+1;J1=J+1;J2=J+2;J3=J+3
4290 GET V1$,I:R(J,1),R(J,2),R(J1,1),R(J1,2),R(J2,1),R(J2,2),R(J3,1),R(J3,2)
4300 EXEC FEJL(13,2,V1$)
4310 NEXT I
4320 CLOSE V1$
4330 EXEC FEJL(13,3,V1$)
4340 ENDPROC 
4350 PROC UNDIND(V2,U1,Z)
4360 OPEN V2$,R
4370 EXEC FEJL(14,1,V2$)
4380 GET V2$,U1:Z(1,1),Z(1,2),Z(2,1),Z(2,2),Z(3,1),Z(3,2),Z(4,1),Z(4,2)
4390 EXEC FEJL(14,2,V2$)
4400 CLOSE V2$
4410 EXEC FEJL(14,3,V2$)
4420 ENDPROC 
4430 PROC DATOUD(DA1,DA2)
4440 DA3=DA1
4450 DA2$="        "
4460 FOR J=8 TO 1 STEP -1
4470 IF J MOD 3=0 THEN 
4480 DA2$(J)="."
4490 ELSE 
4500 DA2$(J)=CHR(DA3 MOD 10+48)
4510 DA3=DA3 DIV 10
4520 ENDIF 
4530 NEXT J
4540 ENDPROC 
4550 PROC MKONTUD(K61,MPOSTANTAL8)
4560 OUTPUT P
4570 P=1;T=1
4580 EXEC POSTER(K61$,P,T,MPOSTANTAL8,SKRIV,SUM$)
4590 T=1
4600 IF P<100000 THEN 
4610 REPEAT 
4620 KSIDENR=0;SUM$="0+"
4630 CASE KTAL1 OF 
4640 EXEC FINDPOST1(FTAB1,FTAB,MFANTAL,P,FPIL3,K2$)
4650 IF CEKS=0 THEN EXEC HENTPOST
4660 WHEN DTAL
4670 EXEC FINDPOST1(DTAB1,DTAB,MDANTAL,P,DPIL3,K3$)
4680 IF CEKS=0 THEN EXEC HENTDPOST
4690 WHEN KRTAL
4700 EXEC FINDPOST1(KTAB1,KTAB,MKANTAL,P,KPIL3,K4$)
4710 IF CEKS=0 THEN EXEC HENTKPOST
4720 ENDCASE 
4730 IF CEKS<>0 THEN STOP 
4740 EXEC HUDSKRIV
4750 IF DTAL=KTAL1 AND SKRIV1=1 THEN 
4760 EXEC LUDSKRIV(P,DATO,KSIDENR)
4770 PRINT CHR(10)
4780 ELSE 
4790 KONT=P
4800 EXEC HSUDSKRIV
4810 ENDIF 
4820 EXEC POSTER(K61$,P,T,MPOSTANTAL8,SKRIV,SUM$)
4830 CASE KTAL1 OF 
4840 EXEC BUDSKRIV(TAL4$,3,SUM$,FMDEBET$,FMKREDIT$,FÅDEBET$,FÅKREDIT$,LINIE)
4850 WHEN DTAL
4860 EXEC BUDSKRIV(MDNKØB$,0,SUM$,DSALDO1$,DSALDO2$,DSALDO3$,DSALDO4$,LINIE)
4870 WHEN KRTAL
4880 EXEC BUDSKRIV(TAL4$,4,SUM$,KSALDO1$,TAL4$,TAL4$,KSALDO2$,LINIE)
4890 ENDCASE 
4900 T=T6
4910 UNTIL P=100000 OR T=MPOSTANTAL8
4920 ENDIF 
4930 P=0
4940 ENDPROC 
4950 K1$="P641220:SYSTEM1"
4960 REPEAT 
4970 OPEN K1$,R
4980 IF STATUS(K1$)=0 THEN EXIT 
4990 CLEAR 
5000 CURSOR 25,13
5010 INPUT "ISÆT PLADE NR.20,TAST RETURN",A$
5020 UNTIL STATUS(K1$)=0
5030 GET K1$,1:MFANTAL,MDANTAL,MKANTAL
5040 EXEC FEJL(9,1,K1$)
5050 GET K1$,3:DPOST,KPOST,MFPOST,MDPOST
5060 EXEC FEJL(9,2,K1$)
5070 GET K1$,4:MKPOST,MFAK,MVGR,MKGR
5080 EXEC FEJL(9,3,K1$)
5090 GET K1$,5:MKRGR
5100 EXEC FEJL(9,4,K1$)
5110 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
5120 EXEC FEJL(9,5,K1$)
5130 GET K1$,9:KRTAL
5140 EXEC FEJL(9,6,K1$)
5150 GET K1$,10:N$
5160 EXEC FEJL(9,7,K1$)
5170 GET K1$,11:K2$
5180 EXEC FEJL(9,8,K1$)
5190 GET K1$,12:K3$
5200 EXEC FEJL(9,9,K1$)
5210 GET K1$,13:K4$
5220 EXEC FEJL(9,10,K1$)
5230 GET K1$,15:K5$
5240 EXEC FEJL(9,11,K1$)
5250 GET K1$,16:K6$
5260 EXEC FEJL(9,12,K1$)
5270 GET K1$,17:K7$
5280 EXEC FEJL(9,13,K1$)
5290 GET K1$,25:K8$
5300 EXEC FEJL(9,14,K1$)
5310 GET K1$,26:K9$
5320 EXEC FEJL(9,15,K1$)
5330 GET K1$,27:K10$
5340 EXEC FEJL(9,16,K1$)
5350 GET K1$,32:K11$
5360 EXEC FEJL(9,17,K1$)
5370 GET K1$,33:K12$
5380 EXEC FEJL(9,18,K1$)
5390 GET K1$,34:K13$
5400 EXEC FEJL(9,19,K1$)
5410 GET K1$,36:K14$
5420 EXEC FEJL(9,20,K1$)
5430 CLOSE K1$
5440 EXEC FEJL(9,21,K1$)
5450 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$;K6$=N$+K6$;K7$=N$+K7$
5460 K8$=N$+K8$;K9$=N$+K9$;K10$=N$+K10$;K11$=N$+K11$;K12$=N$+K12$
5470 K13$=N$+K13$;K14$=N$+K14$
5480 OPEN K14$,R
5490 EXEC FEJL(9,22,K14$)
5500 GET K14$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
5510 EXEC FEJL(9,23,K14$)
5520 FOR I=1 TO 3
5530 H=(I-1)*3+1
5540 GET K14$,I+2:LAND$(H),LAND$(H+1),LAND$(H+2)
5550 EXEC FEJL(9,24,K14$)
5560 NEXT I
5570 FOR I=1 TO 6
5580 H=(I-1)*3+1
5590 GET K14$,I+5:TFIL$(H),TFIL$(H+1),TFIL$(H+2)
5600 EXEC FEJL(9,25,K14$)
5610 NEXT I
5620 GET K14$,13:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
5630 EXEC FEJL(9,26,K14$)
5640 GET K14$,17:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
5650 EXEC FEJL(9,27,K14$)
5660 CLOSE K14$
5670 EXEC FEJL(9,31,K14$)
5680 OPEN K2$,R
5690 EXEC FEJL(9,32,K2$)
5700 OPEN K3$,R
5710 EXEC FEJL(9,33,K3$)
5720 OPEN K4$,R
5730 EXEC FEJL(9,34,K4$)
5740 OPEN K5$,R
5750 EXEC FEJL(9,35,K5$)
5760 OPEN K6$,R
5770 EXEC FEJL(9,36,K6$)
5780 OPEN K7$,R
5790 EXEC FEJL(9,37,K7$)
5800 DIM DTAB1(MDANTAL DIV 4),FTAB1(MFANTAL DIV 4),KTAB1(MKANTAL DIV 4)
5810 DIM DTAB(4,2),FTAB(4,2),KTAB(4,2),HDTAB(MDPOST DIV 40,2)
5820 DIM HFTAB(MFPOST DIV 40,2)
5830 DIM HKRTAB(MKPOST DIV 40,2),UFTAB(4,2),UDTAB(4,2),UKRTAB(4,2)
5840 EXEC INDTAB1(FTAB1,MFANTAL,K2$)
5850 EXEC INDTAB1(DTAB1,MDANTAL,K3$)
5860 EXEC INDTAB1(KTAB1,MKANTAL,K4$)
5870 EXEC HOVIND(K11$,MFPOST,HFTAB)
5880 EXEC HOVIND(K12$,MDPOST,HDTAB)
5890 EXEC HOVIND(K13$,MKPOST,HKRTAB)
5900 LTX$(1)="Indtast kontonr. (0:færdig):"
5910 LTX$(2)="Rigtig konto (J/N)"
5920 LTX$(3)="Konto eksisterer ikke, tast RETURN"
5930 LTX$(4)="Tast RETURN når sideskift ønskes"
5940 LTX$(5)="Ønskes kontoudtog skrevet på formular (J/N):"
5950 LTX$(6)="Monter kontoudtogsformularer og tast RETURN"
5960 LTX$(7)="Ønskes yderligere testprint (J/N):"
5970 LTX$(8)="Monter papir til kontoudtog og tast RETURN"
5980 LTX$(9)="Ønskes udskrift på printer (J/N):"
5990 LTX$(10)="Ønskes flere udskrifter (J/N):"
6000 LTX$(11)="Monter papir til udskrift af finanskonti,tast RETURN"
6010 DATO=T1(7);MAFSLUT=T3(2)
6020 EXEC DATOUD(DATO,DAT$)
6030 EGNAVN$="Schilling Datasystemer";EGGADE$="Kuldyssen 13";EGPOSTNR=2630
6040 EGBY$="Tåstrup"
6050 STREG$="--------------------------------------";STREG$=STREG$+STREG$+"-"
6060 BLANK$="                         "
6070 IF MAFSLUT=1 THEN 
6080 REPEAT 
6090 CLEAR 
6100 CURSOR 1,1
6110 PRINT TAB(15);"Månedsafslutning Kontoudtog";TAB(63);" Dato:";DAT$
6120 EXEC INDPUT1(4,8,-9,-6,LTX$(5))
6130 KTAL1=DTAL
6140 IF P=-7 THEN 
6150 EXEC INDPUT1(4,10,-2,0,LTX$(6))
6160 SKRIV1=1
6170 REPEAT 
6180 DEBNAVN$="XXXXXXXXXXXXXXXXXXXXXXXXX";DEBGADE$=DEBNAVN$;DEBPOSTNR=9999
6190 OUTPUT P
6200 DEBBY$=DEBNAVN$(1:15);DEBLK$="0"
6210 EXEC HUDSKRIV
6220 EXEC LUDSKRIV(99999,999999,9)
6230 PRINT CHR(10)
6240 PRINT TAB(11);"XX.XX.XX XXXXXX XXXXXXXXXXXXXXXXXXXXXXXXX XXX.XXX,XX ";
6250 PRINT "XXX.XXX,XX"
6260 FOR I=1 TO 14
6270 PRINT CHR(10);
6280 NEXT I
6290 PRINT 
6300 PRINT TAB(11);"XX.XX.XX XXXXXX XXXXXXXXXXXXXXXXXXXXXXXXX XXX.XXX,XX ";
6310 PRINT "XXX.XXX,XX"
6320 PRINT CHR(10)
6330 PRINT TAB(11);"XX.XXX.XXX,XX";TAB(53);"XXX.XXX,XX XXX.XXX,XX"
6340 PRINT CHR(10)
6350 PRINT TAB(11);"XX.XXX.XXX,XX   XX.XXX.XXX,XX    XX.XXX.XXX,XX   ";
6360 PRINT "XX.XXX.XXX,XX"
6370 PRINT CHR(10);CHR(10);CHR(10);CHR(10);CHR(10)
6380 OUTPUT T
6390 EXEC INDPUT1(4,12,-9,-6,LTX$(7))
6400 UNTIL P=-8
6410 ELSE 
6420 EXEC INDPUT1(4,10,-2,0,LTX$(8))
6430 SKRIV1=0
6440 ENDIF 
6450 SKRIV=1;LINIE=0;T=1
6460 OUTPUT P
6470 EXEC MKONTUD(K9$,MDPOST)
6480 KTAL1=DTAL-1
6490 IF SKRIV1=1 THEN 
6500 SKRIV1=0
6510 OUTPUT T
6520 CLEAR 
6530 EXEC INDPUT1(20,13,-2,0,LTX$(11))
6540 ENDIF 
6550 EXEC MKONTUD(K8$,MFPOST)
6560 KTAL1=KRTAL
6570 EXEC MKONTUD(K10$,MKPOST)
6580 CLEAR 
6590 OUTPUT T
6600 EXEC INDPUT1(20,13,-9,-6,LTX$(10))
6610 UNTIL P=-8
6620 ELSE 
6630 EXEC STARTBIL
6640 REPEAT 
6650 IF KONT=0 THEN EXIT 
6660 EXEC INDPUT1(4,14,-9,-6,LTX$(9))
6670 KSIDENR=0;SKRIV1=0
6680 IF P=-7 THEN 
6690 SKRIV=1
6700 OUTPUT P
6710 EXEC HUDSKRIV
6720 EXEC HSUDSKRIV
6730 ELSE 
6740 SKRIV=0
6750 OUTPUT T
6760 EXEC HSUDSKRIV
6770 ENDIF 
6780 CASE KTAL1 OF 
6790 EXEC SØG(MFPOST,HFTAB,KONT,UFTAB,K11$)
6800 WHEN DTAL
6810 EXEC SØG(MDPOST,HDTAB,KONT,UDTAB,K12$)
6820 WHEN KRTAL
6830 EXEC SØG(MKPOST,HKRTAB,KONT,UKRTAB,K13$)
6840 ENDCASE 
6850 IF T>0 THEN 
6860 CASE KTAL1 OF 
6870 EXEC POSTER(K8$,KONT,T,MFPOST,SKRIV,SUM$)
6880 WHEN DTAL
6890 EXEC POSTER(K9$,KONT,T,MDPOST,SKRIV,SUM$)
6900 WHEN KRTAL
6910 EXEC POSTER(K10$,KONT,T,MKPOST,SKRIV,SUM$)
6920 ENDCASE 
6930 ELSE 
6940 LINIE=0
6950 ENDIF 
6960 IF T=0 THEN SUM$="0+"
6970 IF SKRIV=0 THEN 
6980 EXEC TUD(SUM$,UBELØB$,0,0)
6990 PRINT TAB(35);STREG$(1:43)
7000 PRINT TAB(35);"Ny saldo";TAB(49+14*(SUM$(LEN(SUM$))="-"));UBELØB$
7010 ELSE 
7020 CASE KTAL1 OF 
7030 EXEC BUDSKRIV(TAL4$,3,SUM$,FMDEBET$,FMKREDIT$,FÅDEBET$,FÅKREDIT$,LINIE)
7040 WHEN DTAL
7050 EXEC BUDSKRIV(MDNKØB$,0,SUM$,DSALDO1$,DSALDO2$,DSALDO3$,DSALDO4$,LINIE)
7060 WHEN KRTAL
7070 EXEC BUDSKRIV(TAL4$,4,SUM$,KSALDO1$,TAL4$,TAL4$,KSALDO2$,LINIE)
7080 ENDCASE 
7090 ENDIF 
7100 OUTPUT T
7110 EXEC INDPUT1(4,23,-9,-6,LTX$(10))
7120 IF P=-7 THEN 
7130 EXEC STARTBIL
7140 ELSE 
7150 KONT=0
7160 ENDIF 
7170 UNTIL KONT=0
7180 ENDIF 
7190 OUTPUT T
7200 CLEAR 
7210 IF MAFSLUT=0 THEN 
7220 CHAIN "P641210:OPSTART"
7230 ELSE 
7240 CHAIN "P641210:MAFSLUT"
7250 ENDIF
DataMuseum.dk

MIKADOS

⟦5d87a496b⟧

Derivation

Text
