⟦11a78469c⟧

Text

0100 DIM OP1$(12),OP2$(12),RES$(14),A1$(12),A2$(77),A3$(25),A4$(17)
0110 DIM A5$(17),A6$(17),A7$(25),A8$(12),A9$(1),B0$(25)
0120 DIM B1$(12),B2$(12),B3$(12),B4$(25),B5$(25)
0130 DIM B6$(17),B7$(77),B8$(14),B9$(12),C0$(9),C1$(20),C2$(17)
0140 DIM C3$(12),C4$(12),C5$(1),A$(2),C6$(12),C7$(1),C8$(1)
0150 DIM C9$(17),D0$(17),D1$(17),D2$(17),D3$(17),D4$(26),D5$(7),D6$(8)
0160 DIM D7$(12),D8$(12),D9$(12),E0$(12),E1$(12)
0170 DIM E2$(17),E3$(25),E4$(25),E5$(18,10),E6$(1),E7$(6),E8(9)
0180 DIM E9$(17),F0(9),F1$(1),F2$(1),F3$(12),F4$(12),F5$(6,12)
0190 DIM F6$(12),F7$(12),F8$(25),F9$(6,12),G0$(1),G1(9)
0200 DIM G2(18),G3(18),G4(18),G5(18),G6$(18,12),G7(18),G8$(18,25)
0210 PROC CALC(G9,H0,H1,H2)
0220 OP1$=H0$;OP2$=H1$;RES$=H2$;SI=0;FLAG=0;ART=G9-6*(G9>5)
0230 CALL "P641210:REGN"
0240 H2$=RES$
0250 IF G9<>6 THEN 
0260 IF FLAG THEN STOP 
0270 ENDIF 
0280 ENDPROC 
0290 PROC INDTASTNING(H3)
0300 REPEAT 
0310 CASE H3 OF 
0320 STOP 
0330 WHEN 1
0340 REPEAT 
0350 REPEAT 
0360 CURSOR 3,23
0370 PRINT "Bilag      (0:Færdig, RETURN:Automatisk, D:Ny dato, A:Annuller)"
0380 CURSOR 8,23
0390 INPUT D5$
0400 EXEC NRTEST(D5$)
0410 UNTIL P=>-3 AND H4=0
0420 IF P<>0 AND H5=19 AND P<>-2 AND P<>-3 THEN 
0430 CLEAR 
0440 EXEC UDHOVED
0450 H5=1
0460 EXEC UDLINIE(H6,H7,E4$,F4$,H8)
0470 EXEC KYSGEM
0480 H5=H5+1
0490 ENDIF 
0500 H9=-1
0510 REPEAT 
0520 H9=-1
0530 CASE P OF 
0540 CURSOR 1,H5+3
0550 PRINT USING "###":H5
0560 H7=P
0570 P=-4
0580 I0=H7
0590 CURSOR 4,H5+3
0600 PRINT USING "#######":H7
0610 H3=2
0620 WHEN 0
0630 H3=6
0640 IF I1=2 THEN H3=-1
0650 P=-4
0660 WHEN -1
0670 I0=I0+1
0680 P=I0
0690 H9=0
0700 WHEN -2
0710 EXEC NYDATO
0720 EXEC UDHOVED
0730 WHEN -3
0740 IF I2>I3 THEN 
0750 I0=I0-1
0760 H5=H5-1
0770 EXEC KLET(5)
0780 EXEC ÆND(1,F4$,H8)
0790 I2=I3;I4=I3-1
0800 ENDIF 
0810 ENDCASE 
0820 UNTIL H9=-1
0830 UNTIL P=-4
0840 WHEN 2
0850 REPEAT 
0860 REPEAT 
0870 CURSOR 3,23
0880 PRINT "Tekst"+B7$(1:27)+"(max 25 tegn)"+B7$(1:32)
0890 CURSOR 9,23
0900 INPUT D4$
0910 I5=LEN(D4$)
0920 UNTIL I5<=25
0930 IF I5<3 THEN 
0940 EXEC NRTEST(D4$)
0950 ELSE 
0960 P=20;H4=0
0970 ENDIF 
0980 UNTIL P=>0 AND P<21 AND H4=0 AND P<>10
0990 IF P<>0 THEN 
1000 I6=P MOD 10
1010 IF I6=0 THEN 
1020 P=10
1030 E3$=D4$
1040 E4$=E3$
1050 ELSE 
1060 E4$=E5$(I6)+B7$(1:15)
1070 IF P>10 THEN 
1080 REPEAT 
1090 CURSOR 3,23
1100 PRINT "Tekst";B7$(1:16);"(max 14 tegn)"+B7$(1:43)
1110 CURSOR 9,23
1120 INPUT D4$
1130 UNTIL LEN(D4$)<15
1140 E4$(12,25)=D4$
1150 E3$=E4$
1160 ENDIF 
1170 ENDIF 
1180 CURSOR 12,H5+3
1190 PRINT E4$
1200 ELSE 
1210 E4$=B7$(1:25)
1220 ENDIF 
1230 H3=3
1240 I7=P
1250 WHEN 3
1260 REPEAT 
1270 REPEAT 
1280 CURSOR 3,23
1290 PRINT "Konto         (5 cifre)";B7$(1:53)
1300 CURSOR 9,23
1310 INPUT D5$
1320 EXEC NRTEST(D5$)
1330 UNTIL H4=0 AND (I8<>0 AND I5=5)
1340 H6=P
1350 EXEC KTNAVN(I8,H6)
1360 CURSOR 15,23
1370 PRINT "(Navn:";B7$(1:27);"Er konto rigtig     (J/N)       "
1380 CURSOR 22,23
1390 PRINT B4$
1400 REPEAT 
1410 CURSOR 64,23
1420 INPUT A$
1430 EXEC NRTEST(A$)
1440 UNTIL P=-7 OR P=-8
1450 UNTIL P=-7 AND ((I9=0 AND I1=1) OR I1<>1)
1460 IF I9=1 THEN 
1470 EXEC KLET(5)
1480 H3=1;I0=I0-1
1490 ELSE 
1500 CURSOR 38,H5+3
1510 H3=4
1520 IF I1=1 THEN H3=-1
1530 PRINT USING "######":H6
1540 ENDIF 
1550 WHEN 4
1560 REPEAT 
1570 REPEAT 
1580 REPEAT 
1590 REPEAT 
1600 CURSOR 3,23
1610 PRINT "Beløb";B7$(1:14);"(Kredit indtastes med efterstillet minus)";
1620 PRINT B7$(1:16)
1630 CURSOR 8,23
1640 INPUT F3$
1650 UNTIL LEN(F3$)>0
1660 EXEC FORTEGN
1670 EXEC CALC(6,F3$,B9$,B8$)
1680 UNTIL FLAG=0
1690 EXEC CALC(4,F3$,B9$,B9$)
1700 UNTIL SI<>0 AND FLAG=0
1710 I8=H6 DIV 10000
1720 J0=0
1730 D5$=F3$(LEN(F3$))
1740 IF (I8=J1 AND D5$="+") OR (I8=J2 AND D5$="-") THEN 
1750 EXEC TESTSALDO(F3$)
1760 ENDIF 
1770 UNTIL J0=0
1780 F4$=F3$
1790 EXEC KLET(3)
1800 IF D5$="+" THEN 
1810 CURSOR 46,H5+3
1820 J3=1
1830 ELSE 
1840 CURSOR 61,H5+3
1850 J3=0
1860 ENDIF 
1870 EXEC TUD(F4$,B8$,0,0)
1880 PRINT B8$
1890 H3=5
1900 IF I1=1 THEN H3=-1
1910 WHEN 5
1920 REPEAT 
1930 CURSOR 3,23
1940 PRINT "Kode   (0:Annullering, 1:Kasse, 2:Giro, 3:Bank)"+B7$(1:27)
1950 CURSOR 7,23
1960 INPUT D5$
1970 EXEC NRTEST(D5$)
1980 UNTIL (P>0 AND P<4) OR (P=0 AND I1<>1)
1990 H8=P;H3=1
2000 IF H8=0 THEN 
2010 EXEC KLET(5)
2020 I0=I0-1
2030 ELSE 
2040 CURSOR 77,H5+3
2050 PRINT USING "##":H8
2060 IF I1<>1 THEN 
2070 EXEC ÆND(0,F4$,H8)
2080 H5=H5+1
2090 EXEC GENNYPOST
2100 ENDIF 
2110 ENDIF 
2120 IF I1=1 THEN H3=-1
2130 WHEN 6
2140 REPEAT 
2150 CURSOR 3,23
2160 PRINT "Ønskes afstemning J/N "+B7$(1:54)
2170 CURSOR 22,23
2180 INPUT A$
2190 EXEC NRTEST(A$)
2200 UNTIL P=-7 OR P=-8
2210 EXEC KYSGEM
2220 IF P=-7 THEN 
2230 J4=0
2240 FOR I=1 TO 6
2250 REPEAT 
2260 REPEAT 
2270 CURSOR 3,23
2280 PRINT J5$(I);B7$(1:60)
2290 CURSOR 17,23
2300 INPUT F3$
2310 UNTIL LEN(F3$)>0
2320 EXEC FORTEGN
2330 EXEC CALC(6,F3$,B9$,B8$)
2340 UNTIL FLAG=0
2350 IF I MOD 2=1 THEN 
2360 F9$(I)=F3$
2370 ELSE 
2380 F9$(I)=F3$(1:LEN(F3$)-1)+"-"
2390 ENDIF 
2400 NEXT I
2410 ELSE 
2420 J4=1
2430 ENDIF 
2440 H3=-1
2450 ENDCASE 
2460 UNTIL H3=-1
2470 ENDPROC 
2480 PROC GENNYPOST
2490 I3=I2;F1$=CHR(I7+48);F2$=CHR(H8+48)
2500 PUT D2$,I2:H6,J6,H7,F1$,F4$,F2$
2510 EXEC FEJL(6,1,D2$)
2520 I2=I2+1
2530 IF I7>9 THEN 
2540 PUT D2$,I2:E3$
2550 EXEC FEJL(6,2,D2$)
2560 I2=I2+1
2570 ENDIF 
2580 I4=I2-1
2590 ENDPROC 
2600 PROC HENTKRPOST
2610 J7=J8(J9,2)
2620 GET D1$,J7:K0,F8$,A3$
2630 EXEC FEJL(5,1,D1$)
2640 GET D1$,J7+1:A5$,C7$,C8$,K1,F6$,F7$
2650 EXEC FEJL(5,2,D1$)
2660 ENDPROC 
2670 PROC HENTKASPOST
2680 EXEC UDHOVED
2690 IF K2=I2 THEN K2=1
2700 K3=K2;H5=1
2710 FOR I=1 TO 18
2720 GET D2$,K2:G2(I),G3(I),G4(I),F1$,G6$(I),F2$
2730 EXEC FEJL(2,1,D2$)
2740 K2=K2+1
2750 G5(I)=ORD(F1$)-48;G7(I)=ORD(F2$)-48
2760 IF G5(I)>9 AND G5(I)<20 THEN 
2770 IF I2=K2 THEN EXIT 
2780 GET D2$,K2:G8$(I)
2790 EXEC FEJL(2,2,D2$)
2800 K2=K2+1
2810 ELSE 
2820 IF G5(I)>0 THEN 
2830 G8$(I)=E5$(G5(I)-10*(G5(I)>20))
2840 ELSE 
2850 G8$(I)=B7$(1:25)
2860 ENDIF 
2870 ENDIF 
2880 IF G2(I)<>0 THEN EXEC UDLINIE(G2(I),G4(I),G8$(I),G6$(I),G7(I))
2890 H5=H5+1
2900 IF K2=I2 THEN EXIT 
2910 NEXT I
2920 ENDPROC 
2930 PROC GEMKASPOST
2940 FOR I=1 TO 18
2950 F1$=CHR(G5(I)+48);F2$=CHR(G7(I)+48)
2960 PUT D2$,K3:G2(I),G3(I),G4(I),F1$,G6$(I),F2$
2970 EXEC FEJL(3,1,D2$)
2980 K3=K3+1
2990 IF G5(I)>9 AND G5(I)<20 THEN 
3000 PUT D2$,K3:G8$(I)
3010 EXEC FEJL(3,2,D2$)
3020 K3=K3+1
3030 ENDIF 
3040 IF K3=K2 THEN EXIT 
3050 NEXT I
3060 ENDPROC 
3070 PROC ÆND(K4,K5,K6)
3080 J3=0;B8$=K5$
3090 IF B8$(LEN(B8$))="+" THEN J3=1
3100 J3=2*K6-J3
3110 EXEC CALC(K4,F5$(J3),B8$,F5$(J3))
3120 ENDPROC 
3130 PROC RETTE
3140 K3=1;K2=1
3150 IF I2=1 THEN EXIT 
3160 REPEAT 
3170 CLEAR 
3180 EXEC HENTKASPOST
3190 K7=H5;K8=0
3200 REPEAT 
3210 REPEAT 
3220 CURSOR 3,23
3230 PRINT "Ønskes ændringer    (1-18:Linienr, 0:Færdig, RETURN:Ny side, N:";
3240 PRINT "Ny post)     "
3250 CURSOR 20,23
3260 INPUT D5$
3270 EXEC NRTEST(D5$)
3280 UNTIL (P=-8 OR P>-2 AND P<K7) AND H4=0
3290 K9=P
3300 IF K9<1 THEN EXIT 
3310 K8=1
3320 REPEAT 
3330 REPEAT 
3340 CURSOR 3,23
3350 PRINT "Linie:";K9;" Vælg ændring    (0:Færdig, A:Annuller, 1:Konto, ";
3360 PRINT "2:Beløb, 3:Kode)"
3370 CURSOR 25,23
3380 INPUT D5$
3390 EXEC NRTEST(D5$)
3400 UNTIL (P=-3 OR P>-1 AND P<4) AND H4=0
3410 L0=P
3420 IF L0=0 THEN EXIT 
3430 H5=K9
3440 IF G2(K9)=0 THEN 
3450 CURSOR 3,H5+3
3460 PRINT "Postering er annulleret"
3470 ELSE 
3480 IF L0<>1 THEN EXEC ÆND(1,G6$(K9),G7(K9))
3490 IF L0=-3 THEN 
3500 EXEC KLET(5)
3510 G2(K9)=0
3520 ELSE 
3530 L0=L0+2;L1=L0;I1=1;H6=G2(K9);F4$=G6$(K9);H8=G7(K9)
3540 EXEC INDTASTNING(L0)
3550 G2(K9)=H6;G6$(K9)=F4$;G7(K9)=H8
3560 IF L1<>3 THEN EXEC ÆND(0,F4$,H8)
3570 ENDIF 
3580 ENDIF 
3590 UNTIL L0=-3 OR L0=0
3600 UNTIL K9<1
3610 IF K8=1 THEN 
3620 EXEC GEMKASPOST
3630 EXEC KYSGEM
3640 ENDIF 
3650 UNTIL K9=0 OR K9=-8
3660 IF K9=-8 THEN 
3670 CLEAR 
3680 EXEC UDHOVED
3690 H5=1;I1=2
3700 EXEC INDTASTNING(1)
3710 ENDIF 
3720 ENDPROC 
3730 PROC KYSGEM
3740 E8(4)=L2;E8(8)=I0;F0(2)=I4;G1(1)=L3
3750 OPEN E2$,W
3760 EXEC FEJL(3,1,E2$)
3770 PUT E2$,2:E8(1),E8(2),E8(3),E8(4),E8(5),E8(6),E8(7),E8(8),E8(9)
3780 EXEC FEJL(3,2,E2$)
3790 PUT E2$,12:F0(1),F0(2),F0(3),F0(4),F0(5),F0(6),F0(7),F0(8),F0(9)
3800 EXEC FEJL(3,3,E2$)
3810 PUT E2$,13:G1(1),G1(2),G1(3),G1(4),G1(5),G1(6),G1(7),G1(8),G1(9)
3820 EXEC FEJL(3,4,E2$)
3830 PUT E2$,15:F5$(1),F5$(2),F5$(3)
3840 EXEC FEJL(3,5,E2$)
3850 PUT E2$,16:F5$(4),F5$(5),F5$(6)
3860 EXEC FEJL(3,6,E2$)
3870 CLOSE E2$
3880 EXEC FEJL(3,7,E2$)
3890 ENDPROC 
3900 PROC HENTKASPOST1
3910 GET D2$,I:H6,L4,H7,F1$,F4$,F2$
3920 EXEC FEJL(4,1,D2$)
3930 I7=ORD(F1$)-48;H8=ORD(F2$)-48
3940 IF I7>9 AND I7<20 THEN 
3950 I=I+1
3960 GET D2$,I:E3$
3970 EXEC FEJL(4,2,D2$)
3980 ENDIF 
3990 ENDPROC 
4000 PROC FINDPOST1(L5,Q,L6,L7,L8,L9)
4010 M0=L6 DIV 8;L8=M0;I9=1;M1=L6 DIV 4;M2=L6 DIV 32
4020 REPEAT 
4030 IF L7=L5(L8) OR M0=1 THEN EXIT 
4040 M0=(M0+1) DIV 2
4050 L8=L8+M0*(1-2*(L7<L5(L8)))
4060 IF L8<1 THEN L8=1
4070 IF L8>M1 THEN L8=M1
4080 UNTIL M0=0
4090 IF L5(L8)>L7 THEN L8=L8-1*(L8>1)
4100 L8=M2+L8
4110 GET L9$,L8:Q(1,1),Q(1,2),Q(2,1),Q(2,2),Q(3,1),Q(3,2),Q(4,1),Q(4,2)
4120 EXEC FEJL(1,1,L9$)
4130 FOR L8=1 TO 4
4140 IF L7=Q(L8,1) THEN EXIT 
4150 NEXT L8
4160 IF L8<>5 THEN I9=0
4170 ENDPROC 
4180 PROC INDTAB1(Z,M3,M4)
4190 M0=M3 DIV 32
4200 FOR I=1 TO M0
4210 H=(I-1)*8+1
4220 GET M4$,I:Z(H),Z(H+1),Z(H+2),Z(H+3),Z(H+4),Z(H+5),Z(H+6),Z(H+7)
4230 EXEC FEJL(5,1,M4$)
4240 NEXT I
4250 ENDPROC 
4260 PROC KTNAVN(M5,M6)
4270 I9=1
4280 CASE M5 OF 
4290 EXEC FINDPOST1(M7,M8,M9,M6,N0,A6$)
4300 IF I9=0 THEN 
4310 EXEC HENTPOST
4320 B4$=B0$
4330 ENDIF 
4340 WHEN J1
4350 IF NOT (M5*10000<=M6 AND M5*10000+N1=>M6) THEN 
4360 EXEC FINDPOST1(N2,N3,N4,M6,N5,A4$)
4370 IF I9=0 THEN 
4380 EXEC HENTDPOST
4390 B4$=A7$
4400 ENDIF 
4410 ENDIF 
4420 WHEN J2
4430 IF NOT (M5*1000<=M6 AND M5*1000+N6=>M6) THEN 
4440 EXEC FINDPOST1(N7,J8,N8,M6,J9,B6$)
4450 IF I9=0 THEN 
4460 EXEC HENTKRPOST
4470 B4$=F8$
4480 ENDIF 
4490 ENDIF 
4500 ENDCASE 
4510 IF I9=1 THEN 
4520 B4$="Konto eksisterer ikke    "
4530 ENDIF 
4540 ENDPROC 
4550 PROC TESTSALDO(N9)
4560 EXEC KTNAVN(I8,H6)
4570 IF I9=0 THEN 
4580 J0=0
4590 C6$=N9$
4600 IF I8=J1 THEN 
4610 EXEC CALC(4,B3$,B9$,B9$)
4620 IF SI<>0 THEN 
4630 EXEC CALC(0,B3$,C6$,C6$)
4640 ELSE 
4650 EXEC CALC(4,B2$,B9$,B9$)
4660 IF SI<>0 THEN 
4670 EXEC CALC(0,B2$,C6$,C6$)
4680 ELSE 
4690 EXEC CALC(4,B1$,B9$,B9$)
4700 IF SI<>0 THEN 
4710 EXEC CALC(0,B1$,C6$,C6$)
4720 ELSE 
4730 EXEC CALC(4,A8$,B9$,B9$)
4740 IF SI<>0 THEN 
4750 EXEC CALC(0,A8$,C6$,C6$)
4760 ELSE 
4770 J0=1
4780 C6$="0+"
4790 ENDIF 
4800 ENDIF 
4810 ENDIF 
4820 ENDIF 
4830 IF C6$(LEN(C6$))="-" THEN J0=1
4840 ELSE 
4850 EXEC CALC(4,F7$,B9$,B9$)
4860 IF SI<>0 THEN 
4870 EXEC CALC(0,F7$,C6$,C6$)
4880 ELSE 
4890 EXEC CALC(4,F6$,B9$,B9$)
4900 IF SI<>0 THEN 
4910 EXEC CALC(0,F6$,C6$,C6$)
4920 ELSE 
4930 C6$="0+"
4940 ENDIF 
4950 ENDIF 
4960 IF C6$(LEN(C6$))="+" THEN J0=1
4970 ENDIF 
4980 IF J0=1 THEN 
4990 REPEAT 
5000 CURSOR 22,23
5010 PRINT "  Er beløbet rigtigt ?    (J/N)";B7$(1:20)
5020 CURSOR 45,23
5030 INPUT " ",A$
5040 EXEC NRTEST(A$)
5050 UNTIL P=-7 OR P=-8
5060 IF P=-7 THEN J0=0
5070 ENDIF 
5080 ELSE 
5090 STOP 
5100 ENDIF 
5110 ENDPROC 
5120 PROC KLET(O0)
5130 CASE O0 OF 
5140 STOP 
5150 WHEN 1
5160 CURSOR 4,H5+3
5170 PRINT B7$(1:32)
5180 WHEN 2
5190 CURSOR 38,H5+3
5200 PRINT "      "
5210 WHEN 3
5220 CURSOR 46,H5+3
5230 PRINT B7$(1:28)
5240 WHEN 4
5250 CURSOR 77,H5+3
5260 PRINT B7$(1)
5270 WHEN 5
5280 CURSOR 4,H5+3
5290 PRINT B7$
5300 ENDCASE 
5310 ENDPROC 
5320 PROC FORTEGN
5330 I5=LEN(F3$)
5340 IF I5=0 THEN F3$="0+"
5350 IF F3$(I5)<>"+" AND F3$(I5)<>"-" THEN 
5360 F3$=F3$+"+"
5370 ENDIF 
5380 ENDPROC 
5390 PROC UDHOVED
5400 CURSOR 35,1
5410 PRINT "Kasserapport";TAB(30);"Dato:"
5420 CURSOR 72,1
5430 PRINT J6
5440 CURSOR 2,3
5450 PRINT "Nr  Bilag Tekst";TAB(38);"Konto       Debet         Kredit";
5460 PRINT "    Kode"
5470 ENDPROC 
5480 PROC NYDATO
5490 REPEAT 
5500 CURSOR 3,23
5510 PRINT "Ny dato        (ååmmdd)"+B7$(1:54)
5520 CURSOR 11,23
5530 INPUT D5$
5540 EXEC NRTEST(D5$)
5550 UNTIL I8=>80 AND (P MOD 10000) DIV 100<13 AND P MOD 100<32
5560 J6=P
5570 ENDPROC 
5580 PROC UDLINIE(O1,O2,O3,O4,O5)
5590 B8$=O4$
5600 CURSOR 1,H5+3
5610 PRINT USING "###":H5
5620 IF O2<>-1 THEN 
5630 CURSOR 4,H5+3
5640 PRINT USING "#######":O2
5650 ENDIF 
5660 CURSOR 12,H5+3
5670 PRINT O3$
5680 CURSOR 38,H5+3
5690 PRINT O1
5700 IF B8$(LEN(B8$))="+" THEN 
5710 CURSOR 46,H5+3
5720 ELSE 
5730 CURSOR 61,H5+3
5740 ENDIF 
5750 EXEC TUD(B8$,B8$,0,0)
5760 PRINT B8$
5770 CURSOR 77,H5+3
5780 PRINT O5
5790 ENDPROC 
5800 PROC FEJL(O6,O7,O8)
5810 IF STATUS(O8$)<>0 THEN 
5820 PRINT STATUS(O8$),O6,O7,O8$
5830 STOP 
5840 ENDIF 
5850 ENDPROC 
5860 PROC HENTDPOST
5870 J7=N3(N5,2)
5880 GET D0$,J7:O9,A7$,A8$,A9$
5890 EXEC FEJL(8,2,D0$)
5900 IF O9<>N3(N5,1) THEN STOP 
5910 GET D0$,J7+1:B1$,B2$,B3$,P0,C5$
5920 EXEC FEJL(8,3,D0$)
5930 GET D0$,J7+2:B5$,C0$,P1,P2
5940 EXEC FEJL(8,4,D0$)
5950 GET D0$,J7+3:C1$,C3$,C4$
5960 EXEC FEJL(8,5,D0$)
5970 ENDPROC 
5980 PROC TUD(P3,P4,P5,P6)
5990 C6$=P3$;B8$=P4$
6000 EXEC CALC(5,C6$,B9$,B8$)
6010 P4$=B8$
6020 IF P5=0 THEN 
6030 P4$=P4$(1:13)
6040 ELSE 
6050 IF P5=1 AND P4$(LEN(P4$))="+" THEN 
6060 P4$(LEN(P4$))=" "
6070 ENDIF 
6080 ENDIF 
6090 IF P6=1 THEN 
6100 P4$=P4$(4:LEN(P4$)-3)
6110 ENDIF 
6120 ENDPROC 
6130 PROC NRTEST(P7)
6140 P=0;H4=0;I8=0;I5=LEN(P7$)
6150 CASE I5 OF 
6160 FOR I=1 TO I5
6170 P8=INT(ORD(P7$(I))-48)
6180 IF P8=>0 AND P8<10 THEN 
6190 P=P*10+P8
6200 ELSE 
6210 H4=1
6220 ENDIF 
6230 NEXT I
6240 I8=P DIV 10000;KTAL9=P DIV 1000
6250 IF KTAL9=J2 THEN I8=KTAL9
6260 WHEN 0
6270 P=-1
6280 WHEN 1
6290 CASE P7$ OF 
6300 P=INT(ORD(P7$)-48)
6310 WHEN "d","D"
6320 P=-2
6330 WHEN "a","A"
6340 P=-3
6350 WHEN "j","J"
6360 P=-7
6370 WHEN "n","N"
6380 P=-8
6390 ENDCASE 
6400 ENDCASE 
6410 ENDPROC 
6420 PROC HENTPOST
6430 J7=M8(N0,2)
6440 GET C9$,J7:P9,B0$
6450 EXEC FEJL(3,2,C9$)
6460 IF P9<>M8(N0,1) THEN STOP 
6470 GET C9$,J7+1:G0$,D7$,D8$
6480 EXEC FEJL(3,3,C9$)
6490 GET C9$,J7+2:E6$,D9$,E0$
6500 EXEC FEJL(3,4,C9$)
6510 ENDPROC 
6520 PROC BFSTEMNING
6530 REPEAT 
6540 CLEAR 
6550 CURSOR 21,1
6560 PRINT "Kasserapport afstemning"
6570 CURSOR 66,1
6580 PRINT "Dato :";J6
6590 CURSOR 21,3
6600 PRINT "Differencer   Indtastede saldi"
6610 FOR I=1 TO 6
6620 EXEC CALC(1,F5$(I),F9$(I),F3$)
6630 CURSOR 1,I+4
6640 PRINT I;J5$(I)
6650 CURSOR 19,I+4
6660 EXEC TUD(F3$,B8$,1,0)
6670 PRINT B8$
6680 CURSOR 36,I+4
6690 EXEC TUD(F9$(I),B8$,1,0)
6700 PRINT B8$
6710 NEXT I
6720 CURSOR 4,12
6730 PRINT "Kontroller dine saldi !"
6740 REPEAT 
6750 CURSOR 4,14
6760 PRINT "Hvilken er forkert     (0:ingen,1-6)"
6770 CURSOR 25,14
6780 INPUT D5$
6790 EXEC NRTEST(D5$)
6800 UNTIL -1<P AND P<7 AND H4=0
6810 IF P<>0 THEN 
6820 REPEAT 
6830 REPEAT 
6840 CURSOR 1,16
6850 PRINT P;J5$(P);"              (tast ændret saldo)"
6860 CURSOR 19,16
6870 INPUT F3$
6880 UNTIL LEN(F3$)>0
6890 EXEC FORTEGN
6900 EXEC CALC(6,F3$,B9$,B8$)
6910 UNTIL FLAG=0
6920 IF P MOD 2=0 THEN 
6930 F9$(P)=F3$(1:LEN(F3$)-1)+"-"
6940 ELSE 
6950 F9$(P)=F3$
6960 ENDIF 
6970 Q0=0
6980 ELSE 
6990 FOR I=1 TO 6
7000 EXEC CALC(1,F5$(I),F9$(I),F3$)
7010 EXEC CALC(4,F3$,B9$,B9$)
7020 IF SI<>0 THEN EXIT 
7030 NEXT I
7040 IF SI<>0 THEN 
7050 EXEC RETTE
7060 Q0=0
7070 ELSE 
7080 REPEAT 
7090 CURSOR 4,16
7100 PRINT "Ønskes ændringer     (J/N)"
7110 CURSOR 22,16
7120 INPUT A$
7130 EXEC NRTEST(A$)
7140 UNTIL (P=-7 OR P=-8) AND H4=0
7150 IF P=-7 THEN 
7160 EXEC RETTE
7170 Q0=0
7180 ELSE 
7190 Q0=-1
7200 ENDIF 
7210 ENDIF 
7220 ENDIF 
7230 UNTIL Q0=-1
7240 ENDPROC 
7250 PROC HOVEDUD(Q1,Q2)
7260 EXEC DATOUD(Q1,D6$)
7270 OUTPUT P
7280 IF R3=36 THEN PRINT CHR(10);CHR(10);CHR(10);CHR(10);CHR(10);CHR(10)
7290 PRINT TAB(9);CHR(14);"Kasserapport";CHR(15);TAB(44);"Dato:";D6$;
7300 PRINT TAB(61);
7310 PRINT USING "Side:####":Q2
7320 PRINT CHR(10)
7330 PRINT TAB(3);"Bilag";TAB(10);"Tekst";TAB(39);"Konto";
7340 PRINT TAB(52);"Debet";TAB(67);"Kredit";TAB(75);"Kode"
7350 PRINT TAB(3);A2$
7360 ENDPROC 
7370 PROC LINIEUD(Q3,Q4,Q5,Q6,Q7,Q8)
7380 IF Q3<>-1 THEN 
7390 PRINT USING "#######":Q3;
7400 ENDIF 
7410 IF Q4<10 AND Q4>0 THEN 
7420 E3$=E5$(Q4)+B7$(1:15)
7430 ENDIF 
7440 IF Q4<>0 THEN 
7450 PRINT TAB(10);E3$;
7460 ENDIF 
7470 PRINT TAB(38);
7480 PRINT USING "######":Q5;
7490 PRINT TAB(47+14*(Q6=0));
7500 EXEC TUD(Q7$,B8$,0,0)
7510 PRINT B8$;TAB(76);
7520 PRINT USING "##":Q8
7530 ENDPROC 
7540 PROC DATOUD(Q9,R0)
7550 R1=Q9
7560 R0$="        "
7570 FOR J=8 TO 1 STEP -1
7580 IF J MOD 3=0 THEN 
7590 R0$(J)="."
7600 ELSE 
7610 R0$(J)=CHR(R1 MOD 10+48)
7620 R1=R1 DIV 10
7630 ENDIF 
7640 NEXT J
7650 ENDPROC 
7660 PROC UDSKRIV(R2,R3)
7670 IF R3=36 OR R3=0 THEN 
7680 R2=R2+1
7690 EXEC HOVEDUD(R4,R2)
7700 R3=0
7710 ENDIF 
7720 R5=0
7730 R3=R3+1
7740 IF F4$(LEN(F4$))="+" THEN R5=1
7750 EXEC LINIEUD(H7,I7,H6,R5,F4$,H8)
7760 ENDPROC 
7770 PROC MODFORTEGN(R6,R7)
7780 I5=LEN(R7$)
7790 IF R7$(I5)="+" THEN 
7800 R6$=R7$(1:I5-1)+"-"
7810 ELSE 
7820 R6$=R7$(1:I5-1)+"+"
7830 ENDIF 
7840 ENDPROC 
7850 PROC GEMBHPOST
7860 J7=L3;D5$="1"
7870 J7=J7+1
7880 F1$=CHR(I7+48)
7890 PUT D3$,J7:H6,L4,H7,F1$,F3$,D5$
7900 EXEC FEJL(7,2,D3$)
7910 IF I7=>10 AND I7<20 THEN 
7920 J7=J7+1
7930 PUT D3$,J7:H6,E3$
7940 EXEC FEJL(7,3,D3$)
7950 ENDIF 
7960 L3=J7
7970 ENDPROC 
7980 PROC BUND
7990 FOR I=R8 TO 36
8000 PRINT CHR(10);
8010 NEXT I
8020 PRINT " "
8030 PRINT TAB(3);A2$
8040 EXEC TUD(A1$,B8$,0,0)
8050 PRINT TAB(10);CHR(14);"Difference";CHR(15);
8060 PRINT TAB(39+14*(B8$(LEN(B8$))="-"));B8$
8070 PRINT TAB(3);A2$
8080 PRINT CHR(10)
8090 ENDPROC 
8100 PROC UDBIL
8110 CLEAR 
8120 REPEAT 
8130 CURSOR 8,13
8140 INPUT "Monter papir til udskrift af kasserapport og tast RETURN",A$
8150 UNTIL ORD(A$)=255
8160 ENDPROC 
8170 C2$="P641220:SYSTEM1"
8180 OPEN C2$,R
8190 EXEC FEJL(9,1,C2$)
8200 GET C2$,1:M9,N4,N8
8210 EXEC FEJL(9,2,C2$)
8220 GET C2$,2:R9,S0,S1
8230 EXEC FEJL(9,3,C2$)
8240 GET C2$,4:S2,S3,S4,N1
8250 EXEC FEJL(9,4,C2$)
8260 GET C2$,5:N6
8270 EXEC FEJL(9,5,C2$)
8280 GET C2$,6:S5,S6,S7
8290 EXEC FEJL(9,6,C2$)
8300 GET C2$,8:S8,S9,T0,J1
8310 EXEC FEJL(9,7,C2$)
8320 GET C2$,9:J2
8330 EXEC FEJL(9,8,C2$)
8340 GET C2$,10:E7$
8350 EXEC FEJL(9,9,C2$)
8360 GET C2$,11:A6$
8370 EXEC FEJL(9,10,C2$)
8380 GET C2$,12:A4$
8390 EXEC FEJL(9,11,C2$)
8400 GET C2$,13:B6$
8410 EXEC FEJL(9,12,C2$)
8420 GET C2$,15:C9$
8430 EXEC FEJL(9,13,C2$)
8440 GET C2$,16:D0$
8450 EXEC FEJL(9,14,C2$)
8460 GET C2$,17:D1$
8470 EXEC FEJL(9,15,C2$)
8480 GET C2$,19:D2$
8490 EXEC FEJL(9,16,C2$)
8500 GET C2$,21:D3$
8510 EXEC FEJL(9,17,C2$)
8520 GET C2$,36:E2$
8530 EXEC FEJL(9,18,C2$)
8540 CLOSE C2$
8550 EXEC FEJL(9,19,C2$)
8560 DIM M7(M9 DIV 4),N2(N4 DIV 4),N7(N8 DIV 4)
8570 DIM M8(4,2),N3(4,2),J8(4,2),J5$(6,14)
8580 E2$=E7$+E2$
8590 OPEN E2$,R
8600 EXEC FEJL(9,20,E2$)
8610 GET E2$,2:E8(1),E8(2),E8(3),E8(4),E8(5),E8(6),E8(7),E8(8),E8(9)
8620 EXEC FEJL(9,21,E2$)
8630 FOR I=1 TO 6
8640 J=(I-1)*3+1
8650 GET E2$,I+5:E5$(J),E5$(J+1),E5$(J+2)
8660 EXEC FEJL(9,22,E2$)
8670 NEXT I
8680 GET E2$,12:F0(1),F0(2),F0(3),F0(4),F0(5),F0(6),F0(7),F0(8),F0(9)
8690 EXEC FEJL(9,23,E2$)
8700 GET E2$,13:G1(1),G1(2),G1(3),G1(4),G1(5),G1(6),G1(7),G1(8),G1(9)
8710 EXEC FEJL(9,24,E2$)
8720 GET E2$,15:F5$(1),F5$(2),F5$(3)
8730 EXEC FEJL(9,25,E2$)
8740 GET E2$,16:F5$(4),F5$(5),F5$(6)
8750 EXEC FEJL(9,26,E2$)
8760 CLOSE E2$
8770 EXEC FEJL(9,27,E2$)
8780 A6$=E7$+A6$;A4$=E7$+A4$;B6$=E7$+B6$;C9$=E7$+C9$;D0$=E7$+D0$;D1$=E7$+D1$
8790 D2$=E7$+D2$;D3$=E7$+D3$
8800 OPEN A6$,R
8810 EXEC FEJL(9,28,A6$)
8820 OPEN A4$,R
8830 EXEC FEJL(9,29,A4$)
8840 OPEN B6$,R
8850 EXEC FEJL(9,30,B6$)
8860 OPEN C9$,R
8870 EXEC FEJL(9,31,C9$)
8880 OPEN D0$,R
8890 EXEC FEJL(9,32,D0$)
8900 OPEN D1$,R
8910 EXEC FEJL(9,33,D1$)
8920 OPEN D2$,W
8930 EXEC FEJL(9,34,D2$)
8940 EXEC INDTAB1(M7,M9,A6$)
8950 EXEC INDTAB1(N2,N4,A4$)
8960 EXEC INDTAB1(N7,N8,B6$)
8970 J5$(1)="Kasse debet   ";J5$(2)="Kasse kredit  ";J5$(3)="Giro  debet   "
8980 J5$(4)="Giro  kredit  ";J5$(5)="Bank  debet   ";J5$(6)="Bank  kredit  "
8990 B7$="                                        ";B7$=B7$+B7$
9000 B9$="0+";A1$="0+";A2$="--------------------------------------"
9010 I1=0;A2$=A2$+A2$+" "
9020 L2=E8(4);R4=E8(7);I0=E8(8);I4=F0(2);L3=G1(1)
9030 H5=1;J6=R4;R8=0;L4=0;B8$="0+";I3=I4+1
9040 I2=I3;K3=1;K2=1
9050 CLEAR 
9060 EXEC UDHOVED
9070 EXEC INDTASTNING(1)
9080 IF J4=0 THEN 
9090 EXEC BFSTEMNING
9100 EXEC UDBIL
9110 OPEN D3$,W
9120 EXEC FEJL(9,37,D3$)
9130 FOR I=1 TO I4
9140 EXEC HENTKASPOST1
9150 IF H6<>0 THEN 
9160 EXEC MODFORTEGN(F3$,F4$)
9170 EXEC GEMBHPOST
9180 EXEC CALC(0,F3$,A1$,A1$)
9190 EXEC UDSKRIV(L2,R8)
9200 ENDIF 
9210 NEXT I
9220 I7=24;H7=L2;H8=0
9230 EXEC CALC(0,F5$(1),F5$(2),F3$)
9240 EXEC CALC(0,F3$,A1$,A1$)
9250 H6=S5
9260 EXEC GEMBHPOST
9270 I7=10;H7=-1;F4$=F3$;E3$="Samlet kassepostering"
9280 EXEC UDSKRIV(L2,R8)
9290 EXEC CALC(0,F5$(3),F5$(4),F3$)
9300 EXEC CALC(0,F3$,A1$,A1$)
9310 I7=24;H7=L2;H6=S6
9320 EXEC GEMBHPOST
9330 F4$=F3$;I7=10;H7=-1;E3$="Samlet giropostering"
9340 EXEC UDSKRIV(L2,R8)
9350 EXEC CALC(0,F5$(5),F5$(6),F3$)
9360 EXEC CALC(0,F3$,A1$,A1$)
9370 I7=24;H7=L2;H6=S7
9380 EXEC GEMBHPOST
9390 E3$="Samlet bankpostering";F4$=F3$;I7=10;H7=-1
9400 EXEC UDSKRIV(L2,R8)
9410 EXEC CALC(4,A1$,B9$,B9$)
9420 IF SI<>0 THEN 
9430 I7=10;H7=L2;H6=T0;E3$="Difference kasserapport"
9440 EXEC MODFORTEGN(F3$,A1$)
9450 EXEC GEMBHPOST
9460 EXEC CALC(0,F3$,A1$,A1$)
9470 F4$=F3$;H7=-1
9480 EXEC UDSKRIV(L2,R8)
9490 ENDIF 
9500 EXEC BUND
9510 CLOSE D3$
9520 EXEC FEJL(9,38,D3$)
9530 I4=0
9540 FOR I=1 TO 6
9550 F5$(I)="0+"
9560 NEXT I
9570 ELSE 
9580 REPEAT 
9590 CURSOR 3,23
9600 PRINT "Ønskes kontroludskrift J/N ";B7$(1:45)
9610 CURSOR 26,23
9620 INPUT A$
9630 UNTIL (A$="J" OR A$="N" OR A$="j" OR A$="n") AND LEN(A$)=1
9640 IF A$="J" OR A$="j" THEN 
9650 T1=L2
9660 EXEC UDBIL
9670 FOR I=1 TO I4
9680 EXEC HENTKASPOST1
9690 EXEC UDSKRIV(T1,R8)
9700 EXEC CALC(1,A1$,F4$,A1$)
9710 NEXT I
9720 I7=10;H7=-1;H8=0;H6=0
9730 FOR I=1 TO 6
9740 E3$=J5$(I);F4$=F5$(I)
9750 EXEC UDSKRIV(T1,R8)
9760 EXEC CALC(0,A1$,F4$,A1$)
9770 NEXT I
9780 EXEC BUND
9790 ENDIF 
9800 ENDIF 
9810 EXEC KYSGEM
9820 CLOSE D2$
9830 EXEC FEJL(9,39,D2$)
9840 CLOSE 
9850 OUTPUT T
9860 CHAIN "P641210:OPSTART"
DataMuseum.dk

MIKADOS

⟦11a78469c⟧

Derivation

Text
