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