|
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: 17254 (0x4366)
Types: SPC/1-COMAL-BIN
Notes: Mikados_B
Names: »PSTERING.B«
└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
└─⟦this⟧ »PSTERING.B«
└─⟦ff7f7aeee⟧ Bits:30009007 NBT 15/3-84
└─⟦this⟧ »PSTERING.B«
0100 DIM A1$(29),A2$(25),N$(6),A3$(25),A4$(E),A5(W),A6(W) 0110 DIM A7(W),A8$(17),A9$(17),B0$(17),B1$(17),B2$(17),B3$(10),B4$(17) 0120 DIM B5$(17),B6$(12),B7$(8),B8$(E),B9$(12),C0$(E),C1$(25) 0130 DIM C2$(17),C3$(W,10),C4$(14),C5$(12),C6(36),C7(36),C8(36) 0140 DIM C9$(36,25),A$(G),D0$(12),OP1$(12),OP2$(12),D1$(76),D2$(17) 0150 DIM RES$(15),D3$(8),D4$(V),D5$(26),D6$(26),D7$(6),D8$(12) 0160 DIM D9$(17),E0$(12),E1$(12),E2$(76),E3(36),E4$(36,12),E5$(17) 0170 DIM E6$(17),E7$(17),E8(36) 0180 PROC CA(E9,F0,F1,F2) 0190 OP1$=F0$;OP2$=F1$;RES$=F2$;SI=B;FLAG=B;ART=E9-6*(E9>5) 0200 CALL "P641210:REGN" 0210 F2$=RES$ 0220 IF E9<>6 THEN IF FLAG<>B THEN STOP 0230 ENDPROC 0240 PROC KTNV(F3,F4) 0250 F5=E 0260 CASE F3 OF 0270 EXEC FINDPOST1(F6,F7,F8,F4,F9,D9$) 0280 IF F5=B THEN 0290 EXEC HENTPOST 0300 A2$=A3$ 0310 IF INT(ORD(A4$)-48)<>B THEN F5=E 0320 ENDIF 0330 WHEN G0 0340 IF G0*10000+G1<F4 THEN 0350 EXEC FINDPOST1(G2,F7,G3,F4,F9,E5$) 0360 IF F5=B THEN EXEC HENTDPOST(F9,F4,F7,A8$,A2$) 0370 ENDIF 0380 WHEN G4 0390 IF G4*1000+G5<F4 THEN 0400 EXEC FINDPOST1(G6,F7,G7,F4,F9,C2$) 0410 IF F5=B THEN EXEC HENTDPOST(F9,F4,F7,A9$,A2$) 0420 ENDIF 0430 ENDCASE 0440 IF F5=E THEN A2$="Konto eksisterer ikke " 0450 ENDPROC 0460 PROC HENTDPOST(G8,G9,H0,H1,H2) 0470 S=H0(G8,G) 0480 GET H1$,S:G9,H2$ 0490 EXEC FE(8,G,H1$) 0500 IF G9<>H0(G8,E) THEN STOP 0510 ENDPROC 0520 PROC HENTPOST 0530 S=F7(F9,G) 0540 GET D2$,S:H3,A3$ 0550 EXEC FE(V,G,D2$) 0560 IF H3<>F7(F9,E) THEN STOP 0570 GET D2$,S+G:A4$ 0580 EXEC FE(V,4,D2$) 0590 ENDPROC 0600 PROC FINDPOST1(H4,Q,H5,H6,H7,H8) 0610 H9=H5 DIV 16;H7=H9;F5=E;I0=H5 DIV 8;I1=H5 DIV 32 0620 REPEAT 0630 IF H6=H4(H7) OR H9=E THEN EXIT 0640 H9=(H9+E) DIV G;H7=H7+H9*(E-G*(H6<H4(H7))) 0650 IF H7<E THEN H7=E 0660 IF H7>I0 THEN H7=I0 0670 UNTIL H9=B 0680 IF H4(H7)>H6 THEN H7=H7-E*(H7>E) 0690 H7=I1+H7*G-E 0700 GET H8$,H7:Q(E,E),Q(E,G),Q(G,E),Q(G,G),Q(V,E),Q(V,G),Q(4,E),Q(4,G) 0710 EXEC FE(E,E,H8$) 0711 GET H8$,H7+E:Q(5,E),Q(5,G),Q(6,E),Q(6,G),Q(7,E),Q(7,G),Q(8,E),Q(8,G) 0712 EXEC FE(99,E,H8$) 0720 FOR H7=E TO 8 0730 IF H6=Q(H7,E) THEN EXIT 0740 NEXT H7 0750 IF H7<W THEN F5=B 0760 ENDPROC 0770 PROC INDTAB1(Z,I2,I3) 0780 H9=I2 DIV 32 0790 FOR I=E TO H9 0800 H=(I-E)*4+E 0810 GET I3$,I:Z(H),Z(H+E),Z(H+E),Z(H+G),Z(H+G),Z(H+V),Z(H+V) 0820 EXEC FE(G,E,I3$) 0830 NEXT I 0840 ENDPROC 0850 PROC DATOUD(I4,I5) 0860 I6=I4;I5$=" " 0870 FOR J=8 TO E STEP -E 0880 IF J MOD V=B THEN 0890 I5$(J)="." 0900 ELSE 0910 I5$(J)=CHR(I6 MOD 10+48);I6=I6 DIV 10 0920 ENDIF 0930 NEXT J 0940 ENDPROC 0950 PROC PGETUD(I7) 0960 IF I8<G THEN EXIT 0970 I=E;B6$="0+" 0980 CLEAR 0990 REPEAT 1000 CURSOR 8,13 1010 INPUT "Monter papir til udskrift af posteringsark og tast RETURN",A$ 1020 UNTIL ORD(A$)=255 1025 OUTPUT P 1030 REPEAT 1040 EXEC DATOUD(I9,B7$) 1060 PRINT TAB(67);B3$;" " 1070 PRINT TAB(W);CHR(14);"Posteringsark";CHR(15);TAB(44);"Dato:";B7$; 1080 PRINT TAB(61); 1090 PRINT USING "Side:####":I7 1100 I7=I7+E 1110 PRINT " " 1111 PRINT TAB(43);"Debet";TAB(70);"Kredit" 1120 PRINT TAB(V);"Bilag Tekst";TAB(39);"Konto Entre Beløb Konto "; 1121 PRINT " Entre" 1130 PRINT TAB(V);D1$ 1140 J0=E 1150 REPEAT 1160 GET B0$,I:J1,J2,J3,B8$,E0$,C0$,J4 1170 EXEC FE(V,G,B0$) 1180 J5=ORD(B8$)-48;J6=ORD(C0$)-48;I=I+E 1190 IF J5>W THEN 1200 GET B0$,I:J1,C1$ 1210 EXEC FE(V,V,B0$) 1220 I=I+E 1230 ELSE 1240 C1$=E2$(E:25) 1250 IF J5>B THEN C1$(E:10)=C3$(J5) 1260 ENDIF 1270 IF J6=B THEN 1280 EXEC CA(E,B6$,E0$,B6$) 1290 GET B0$,I:J7,J2,J3,B8$,E1$,C0$,J8 1300 EXEC FE(V,4,B0$) 1310 I=I+E 1320 IF J5>W THEN I=I+E 1330 ELSE 1340 IF E0$(LEN(E0$))="-" THEN 1350 J7=J1;J1=100000;J8=J4;J4=1000000 1360 ELSE 1370 J7=100000;J8=1000000 1380 ENDIF 1390 ENDIF 1400 EXEC CA(B,B6$,E0$,B6$) 1410 PRINT USING "####### ":J3; 1420 PRINT C1$;TAB(38); 1430 PRINT USING "###### ###### ":J1,J4; 1440 EXEC TUD(E0$,C4$,B,B) 1450 PRINT C4$; 1460 PRINT USING " ###### ######":J7,J8 1470 J0=J0+E 1480 UNTIL J0=37 OR I=I8 1490 IF J0=37 AND I<>I8 THEN 1500 PRINT CHR(10);CHR(10);CHR(10);CHR(10);CHR(10) 1510 ELSE 1520 FOR J0=J0 TO 38 1530 PRINT " " 1540 NEXT J0 1550 PRINT TAB(V);D1$ 1560 EXEC TUD(B6$,C4$,E,B) 1570 PRINT TAB(27);CHR(14);"Difference";CHR(15);TAB(44);C4$ 1580 PRINT TAB(V);D1$ 1590 PRINT " " 1610 OUTPUT T 1620 ENDIF 1630 UNTIL I=I8 1640 ENDPROC 1650 PROC PPUT 1660 C0$=CHR(J6+48) 1670 IF J6=B THEN 1680 J9=I8;B8$=CHR(J5+48) 1690 PUT B0$,I8:J1,K0,J3,B8$,E0$,C0$,J4 1700 EXEC FE(G,G,B0$) 1710 I8=I8+E 1720 IF J5>W THEN 1730 PUT B0$,I8:J1,C1$ 1740 EXEC FE(G,V,B0$) 1750 I8=I8+E 1760 ENDIF 1770 PUT B0$,I8:J7,K0,J3,B8$,E1$,C0$,J8 1780 EXEC FE(G,4,B0$) 1790 I8=I8+E 1800 IF J5>W THEN 1810 PUT B0$,I8:J7,C1$ 1820 EXEC FE(G,5,B0$) 1830 I8=I8+E 1840 ENDIF 1850 ELSE 1860 FOR I=E TO K1 1870 IF C6(I)<>B THEN 1880 B8$=CHR(C8(I)+48) 1890 PUT B0$,I8:C6(I),C7(I),E3(I),B8$,E4$(I),C0$,E8(I) 1900 EXEC FE(G,6,B0$) 1910 I8=I8+E 1920 IF C8(I)>W THEN 1930 PUT B0$,I8:C6(I),C9$(I) 1940 EXEC FE(G,7,B0$) 1950 I8=I8+E 1960 ENDIF 1970 ENDIF 1980 NEXT I 1990 J9=I8;K1=B;K2=B;K3=I8-E 2000 EXEC SYSGEM 2010 ENDIF 2020 ENDPROC 2030 PROC SYSGEM 2040 A5(5)=K4;A5(8)=K5;A6(E)=K3;A7(E)=K6 2050 OPEN B2$,W 2060 EXEC FE(7,E,B2$) 2070 PUT B2$,G:A5(E),A5(G),A5(V),A5(4),A5(5),A5(6),A5(7),A5(8),A5(W) 2080 EXEC FE(7,G,B2$) 2090 PUT B2$,12:A6(E),A6(G),A6(V),A6(4),A6(5),A6(6),A6(7),A6(8),A6(W) 2100 EXEC FE(7,V,B2$) 2110 PUT B2$,13:A7(E),A7(G),A7(V),A7(4),A7(5),A7(6),A7(7),A7(8),A7(W) 2120 EXEC FE(7,4,B2$) 2130 CLOSE B2$ 2140 EXEC FE(7,5,B2$) 2150 ENDPROC 2160 PROC KNOK 2170 EXEC KTNV(K7,P) 2180 CURSOR 25,23 2190 PRINT A2$;E2$(E:30-LEN(A2$)) 2200 REPEAT 2210 CURSOR 55,23 2220 PRINT "Rigtig konto (J/N) " 2230 CURSOR 75,23 2240 INPUT A$ 2250 EXEC NRTEST(A$) 2260 UNTIL P=-7 OR P=-8 2270 ENDPROC 2280 PROC ENTKOOK(K8) 2290 A1$="Konto eksisterer ikke";A3$=E2$ 2300 EXEC FINDPOST1(K9,F7,L0,(K8 DIV 100),F9,E6$) 2310 IF F5=B THEN 2320 FOR L1=E TO L2+L3 2330 F5=B 2340 IF (K8 MOD 100)=L4(L1) AND L5$(L1)="0" THEN EXIT 2350 F5=E 2360 NEXT L1 2370 IF F5=B THEN 2380 GET B4$,F7(F9,G)+E:A1$ 2390 EXEC FE(99,10,B4$) 2400 GET E7$,L1:H3,A4$,A3$ 2410 EXEC FE(99,11,E7$) 2420 ENDIF 2430 ENDIF 2440 CURSOR E,23 2450 PRINT USING " ###### ":K8; 2460 PRINT A1$;" ";A3$;TAB(65);"Rigtig (J/N)" 2470 REPEAT 2480 CURSOR 71,23 2490 INPUT A$ 2500 EXEC NRTEST(A$) 2510 UNTIL P=-7 OR P=-8 2520 ENDPROC 2530 PROC KNUD(L6) 2540 IF F5=E THEN 2550 CURSOR G,L7+V 2560 PRINT E2$ 2570 IF J6=B THEN K5=K5-E 2580 L8=E 2590 ELSE 2600 CURSOR 38+7*(L8=4)+28*(L8=6)+35*(L8=7),L7+V 2610 PRINT USING "######":L6 2620 L7=L7+E*(L8=7);L8=4-V*(L8=7)+E*(L8=4)+V*(L8=6) 2630 ENDIF 2640 ENDPROC 2650 PROC TUD(L9,M0,M1,M2) 2660 EXEC CA(5,L9$,D0$,M0$) 2670 IF M1=B THEN M0$=M0$(E:13) 2680 IF M1=E AND M0$(LEN(M0$))="+" THEN M0$(LEN(M0$))=" " 2690 IF M2=E THEN M0$=M0$(V:LEN(M0$)-V) 2700 ENDPROC 2710 PROC FE(M3,M4,M5) 2720 IF STATUS(M5$)<>B THEN 2730 PRINT STATUS(M5$),M3,M4,M5$ 2740 STOP 2750 ENDIF 2760 ENDPROC 2770 PROC PSLET(M6) 2780 IF J6=B THEN 2790 IF J9=I8 THEN 2800 REPEAT 2810 CURSOR V,23 2820 PRINT "Posteringen kan ikke annuleres, tast RETURN"+E2$(E:34) 2830 CURSOR 48,23 2840 INPUT A$ 2850 EXEC NRTEST(A$) 2860 UNTIL P=-E 2870 ELSE 2880 L7=L7-E;K5=K5-E 2890 CURSOR V,L7+V 2900 PRINT E2$ 2910 FOR I=J9 TO I8-E 2920 PUT B0$,I:B 2930 EXEC FE(E,G,B0$) 2940 NEXT I 2950 I8=J9 2960 ENDIF 2970 ELSE 2980 IF K1>B THEN 2990 IF M6=E THEN 3000 CURSOR V,(P-E) MOD 18+4 3010 ELSE 3020 P=K1;L7=L7-E 3030 CURSOR V,L7+V 3040 ENDIF 3050 IF C8(P)>W THEN K2=K2-E 3060 PRINT E2$ 3070 EXEC CA(E,B6$,E4$(P),B6$) 3080 C6(P),E8(P),C7(P),E3(P),C8(P)=B;C9$(P)=E2$(E:25);E4$(P)="0+" 3090 IF M6=B THEN K1=K1-E;K2=K2-E 3100 ENDIF 3110 ENDIF 3120 ENDPROC 3130 PROC NRTEST(M7) 3140 P,M8,K7=B;M9=LEN(M7$) 3150 CASE M9 OF 3160 FOR I=E TO M9 3170 N0=INT(ORD(M7$(I))-48) 3180 IF N0=>B AND N0<=W THEN 3190 P=P*10+N0 3200 ELSE 3210 M8=E 3220 ENDIF 3230 NEXT I 3240 K7=P DIV 10000;N1=P DIV 1000 3250 IF G4=N1 THEN K7=N1 3260 WHEN B 3270 P=-E 3280 WHEN E 3290 CASE M7$ OF 3300 P=INT(ORD(M7$)-48) 3310 WHEN "d","D" 3320 P=-G 3330 WHEN "A","a" 3340 P=-V 3350 WHEN "M","m" 3360 P=-4 3370 WHEN "J","j" 3380 P=-7 3390 WHEN "N","n" 3400 P=-8 3410 ENDCASE 3420 ENDCASE 3430 ENDPROC 3440 PROC FORTEGN 3450 M9=LEN(D8$) 3460 IF M9=B THEN D8$="0+";M9=G 3470 IF D8$(M9)<>"+" AND D8$(M9)<>"-" THEN 3480 D8$=D8$+"+" 3490 ELSE 3500 D8$(M9)="+" 3510 ENDIF 3520 ENDPROC 3530 PROC UDHOVED 3540 CURSOR G,E 3550 EXEC DATOUD(K0,B7$) 3560 PRINT TAB(20);"Posteringsark";E2$(E:25);"Dato:";B7$ 3570 CURSOR G,V 3580 PRINT "Nr Bilag Tekst";E2$(E:21);"Debet Entre Beløb K"; 3590 PRINT "redit Entre" 3600 ENDPROC 3610 PROC UDLINIE 3620 CURSOR E,4 3630 PRINT USING "### ####### ":L7,J3; 3640 IF J5<>B THEN PRINT D6$ 3650 CURSOR 38,4 3660 PRINT USING "###### ###### ":J1,J4; 3670 EXEC TUD(E0$,C4$,B,B) 3680 PRINT C4$; 3690 PRINT USING " ###### ######":J7,J8 3700 ENDPROC 3710 PROC NYDATO 3720 REPEAT 3730 CURSOR V,23 3740 PRINT "Ny dato (ÅÅMMDD)"+E2$(E:51) 3750 CURSOR 11,23 3760 INPUT B7$ 3770 EXEC NRTEST(B7$) 3780 UNTIL K7>79 AND (P DIV 100) MOD 100<13 AND P MOD 100<32 3790 K0=P 3800 ENDPROC 3810 B5$="P641220:SYSTEM1" 3820 REPEAT 3830 P=-E 3840 OPEN B5$,R 3850 IF STATUS(B5$)<>B THEN 3860 CLEAR 3870 CURSOR 25,13 3880 INPUT "Isæt plade nr. 20 ,tast RETURN",A$ 3890 EXEC NRTEST(A$) 3900 P=B 3910 ENDIF 3920 UNTIL P=-E 3930 GET B5$,E:F8,G3,G7 3940 EXEC FE(W,E,B5$) 3950 GET B5$,G:N2,N3,N4 3960 EXEC FE(W,G,B5$) 3970 GET B5$,4:N5,N6,N7,G1 3980 EXEC FE(W,V,B5$) 3990 GET B5$,5:G5 4000 EXEC FE(W,4,B5$) 4010 GET B5$,8:N8,N9,O0,G0 4020 EXEC FE(W,5,B5$) 4030 GET B5$,W:G4,O1,L0,L3 4040 EXEC FE(W,6,B5$) 4050 GET B5$,10:N$ 4060 EXEC FE(W,7,B5$) 4070 GET B5$,11:D9$ 4080 EXEC FE(W,8,B5$) 4090 GET B5$,12:E5$ 4100 EXEC FE(W,W,B5$) 4110 GET B5$,13:C2$ 4120 EXEC FE(W,10,B5$) 4130 GET B5$,15:D2$ 4140 EXEC FE(W,11,B5$) 4150 GET B5$,16:A8$ 4160 EXEC FE(W,12,B5$) 4170 GET B5$,17:A9$ 4180 EXEC FE(W,13,B5$) 4190 GET B5$,20:B0$ 4200 EXEC FE(W,14,B5$) 4210 GET B5$,21:B1$ 4220 EXEC FE(W,15,B5$) 4230 GET B5$,36:B2$ 4240 EXEC FE(W,16,B5$) 4250 GET B5$,37:B4$ 4260 EXEC FE(99,E,B5$) 4270 GET B5$,38:E6$ 4280 EXEC FE(99,G,B5$) 4290 GET B5$,39:E7$ 4300 EXEC FE(99,V,B5$) 4310 GET B5$,43:L2 4320 EXEC FE(99,4,B5$) 4330 CLOSE B5$ 4340 EXEC FE(W,17,B5$) 4350 DIM F6(F8 DIV 8),G2(G3 DIV 8),G6(G7 DIV 8) 4360 DIM F7(8,G),K9(L0 DIV 8) 4370 DIM L4(L3+L2),L5$(L3+L2) 4380 D9$=N$+D9$;E5$=N$+E5$;C2$=N$+C2$;D2$=N$+D2$;A8$=N$+A8$;A9$=N$+A9$ 4390 B0$=N$+B0$;B1$=N$+B1$;B2$=N$+B2$;B4$=N$+B4$;E6$=N$+E6$ 4400 E7$=N$+E7$ 4410 OPEN B2$,R 4420 EXEC FE(W,18,B2$) 4430 GET B2$,G:A5(E),A5(G),A5(V),A5(4),A5(5),A5(6),A5(7),A5(8),A5(W) 4440 EXEC FE(W,19,B2$) 4450 FOR I=E TO V 4460 H=(I-E)*V+E 4470 GET B2$,I+5:C3$(H),C3$(H+E),C3$(H+G) 4480 EXEC FE(W,20,B2$) 4490 NEXT I 4500 GET B2$,12:A6(E),A6(G),A6(V),A6(4),A6(5),A6(6),A6(7),A6(8),A6(W) 4510 EXEC FE(W,21,B2$) 4520 GET B2$,13:A7(E),A7(G),A7(V),A7(4),A7(5),A7(6),A7(7),A7(8),A7(W) 4530 EXEC FE(W,22,B2$) 4540 GET B2$,20:B3$ 4550 EXEC FE(W,35,B2$) 4560 CLOSE B2$ 4570 EXEC FE(W,23,B2$) 4580 OPEN D9$,R 4590 EXEC FE(W,24,D9$) 4600 OPEN E5$,R 4610 EXEC FE(W,25,E5$) 4620 OPEN C2$,R 4630 EXEC FE(W,26,C2$) 4640 OPEN D2$,R 4650 EXEC FE(W,27,D2$) 4660 OPEN A8$,R 4670 EXEC FE(W,28,A8$) 4680 OPEN A9$,R 4690 EXEC FE(W,29,A9$) 4700 OPEN B0$,W 4710 EXEC FE(W,30,B0$) 4720 OPEN B4$,R 4730 EXEC FE(99,5,B4$) 4740 OPEN E6$,R 4750 EXEC FE(99,6,E6$) 4760 OPEN E7$,R 4770 EXEC FE(99,7,E7$) 4780 K4=A5(5);I9=A5(7);K5=A5(8);K3=A6(E);K6=A7(E) 4790 EXEC INDTAB1(F6,F8,D9$) 4800 EXEC INDTAB1(G2,G3,E5$) 4810 EXEC INDTAB1(G6,G7,C2$) 4820 EXEC INDTAB1(K9,L0,E6$) 4830 FOR O2=E TO L3+L2 4840 GET E7$,O2:L4(O2),L5$(O2) 4850 EXEC FE(99,8,E7$) 4860 NEXT O2 4870 E2$=" " 4880 E2$=E2$+" " 4890 D0$="0+";K0=I9;I8=K3+E;J9=I8;K1=B;L7=E;J6=B 4900 L8=E;B6$="0+";D1$="---------------------------------------" 4910 D1$=D1$+D1$;K2=B 4920 CLEAR 4930 EXEC UDHOVED 4940 REPEAT 4950 CASE L8 OF 4960 STOP 4970 WHEN E 4980 REPEAT 4990 REPEAT 5000 CURSOR V,23 5010 PRINT "Bilag (0:færdig,RETURN:automatisk,A:annuller,D:ny dato,"; 5020 PRINT "M:afslut multi)" 5030 CURSOR 8,23 5040 INPUT D3$ 5050 EXEC NRTEST(D3$) 5060 UNTIL P=>-4 AND M8=B AND M9<=6 5070 O3=I8+K2 5080 IF (O3>N3-V OR K1=35 OR O3+A7(E)+A6(G)>N4-V) THEN 5090 IF P<>-V THEN P=B 5100 ENDIF 5110 IF P<>B AND P>-G AND L7=19 THEN 5120 CLEAR 5130 EXEC UDHOVED 5140 L7=E 5150 EXEC SYSGEM 5160 EXEC UDLINIE 5170 L7=L7+E 5180 ENDIF 5190 REPEAT 5200 O4=-E 5210 CASE P OF 5220 J3,K5=P;P=-W;L8=G 5230 CURSOR E,L7+V 5240 PRINT USING "### #######":L7,J3 5250 WHEN B 5260 IF J6=B THEN 5270 IF I8>N3-V OR O3+A7(E)+A6(G)>N4-V THEN 5280 REPEAT 5290 CURSOR V,23 5300 PRINT "Ikke plads til flere posteringer , tast RETURN";E2$(E:30) 5310 CURSOR 50,23 5320 INPUT A$ 5330 EXEC NRTEST(A$) 5340 UNTIL P=-E 5350 ENDIF 5360 P=-W;L8=8 5370 ELSE 5380 IF O3>N3-V OR K1=35 OR O3+A7(E)+A6(G)>N4-V THEN 5390 EXEC CA(4,D0$,B6$,D0$) 5400 IF SI<>B THEN 5410 EXEC TUD(B6$,C4$,E,B) 5420 REPEAT 5430 CURSOR V,23 5440 PRINT "Ikke plads til flere posteringer,";C4$;" på differencekonto"; 5450 PRINT ",RETURN" 5460 CURSOR 76,23 5470 INPUT A$ 5480 EXEC NRTEST(A$) 5490 UNTIL P=-E 5500 K1=K1+E;K2=K2+G 5510 IF B6$(LEN(B6$))="+" THEN 5520 E4$(K1)=B6$(E:LEN(B6$)-E)+"-" 5530 ELSE 5540 E4$(K1)=B6$(E:LEN(B6$)-E)+"+" 5550 ENDIF 5560 EXEC CA(B,B6$,E4$(K1),B6$) 5570 C6(K1)=O0;C8(K1)=10;C7(K1)=K0;E3(K1)=J3 5580 C9$(K1)="Difference multipostering";E8(K1)=1000000 5590 ENDIF 5600 O4=B;P=-4 5610 ELSE 5620 REPEAT 5630 CURSOR V,23 5640 PRINT "Multipostering ikke afsluttet , tast RETURN"+E2$(E:34) 5650 CURSOR 46,23 5660 INPUT A$ 5670 EXEC NRTEST(A$) 5680 UNTIL P=-E 5690 ENDIF 5700 ENDIF 5710 WHEN -E 5720 IF J6=B THEN K5=K5+E 5730 P=K5;O4=B 5740 WHEN -G 5750 EXEC NYDATO 5760 EXEC UDHOVED 5770 WHEN -V 5780 EXEC PSLET(0) 5790 WHEN -4 5800 IF J6=B THEN EXIT 5810 EXEC CA(4,D0$,B6$,D0$) 5820 IF SI<>B THEN 5830 REPEAT 5840 EXEC TUD(B6$,C4$,E,B) 5850 REPEAT 5860 CURSOR V,23 5870 PRINT "Multipostering kan ikke afsluttes , difference :";C4$;" tas"; 5880 PRINT "t RETURN " 5890 CURSOR 79,23 5900 INPUT A$ 5910 EXEC NRTEST(A$) 5920 UNTIL P=-E 5930 CLEAR 5940 O2=E 5950 REPEAT 5960 EXEC UDHOVED 5970 REPEAT 5980 IF E3(O2)<>B AND LEN(E4$(O2))>B THEN 5990 EXEC CA(5,E4$(O2),D0$,C4$) 6000 CURSOR E,(O2-E) MOD 18+4 6010 PRINT USING "### ####### ":O2,E3(O2); 6020 IF C8(O2)>W THEN 6030 PRINT C9$(O2); 6040 ELSE 6050 IF C8(O2)<>B THEN PRINT C3$(C8(O2)); 6060 ENDIF 6070 LOG=B 6080 CURSOR 38,(O2-E) MOD 18+4 6090 IF E4$(O2,LEN(E4$(O2)))="-" THEN LOG=E 6100 PRINT USING "###### ######":C6(O2)+100000*(LOG=E),E8(O2)+100000*(LOG=E); 6110 PRINT C4$(E:13); 6120 PRINT USING " ###### ######":C6(O2)+100000*(LOG=B);E8(O2)+100000*(LOG=B) 6130 ENDIF 6140 O2=O2+E 6150 UNTIL O2=K1+E OR O2 MOD 19=B 6160 REPEAT 6170 REPEAT 6180 CURSOR V,23 6190 PRINT "Type (1-36:Annulering,0:færdig,N:ny post,RETURN:ny sid"; 6200 PRINT "e)"+E2$(E:10) 6210 CURSOR 8,23 6220 INPUT D4$ 6230 EXEC NRTEST(D4$) 6240 UNTIL (P<37 AND P>-G) OR P=-8 6250 CASE P OF 6260 IF P<=K1 AND P<O2 THEN EXEC PSLET(1) 6270 WHEN B 6280 EXEC CA(4,D0$,B6$,D0$) 6290 IF SI<>B THEN 6300 P=-G 6310 ELSE 6320 EXEC PPUT 6330 J6=B 6340 ENDIF 6350 WHEN -E 6360 IF K1>18 AND O2<K1 THEN 6370 CLEAR 6380 ELSE 6390 P=E 6400 ENDIF 6410 WHEN -8 6420 P=B 6430 L7=(O2-E) MOD 18+E 6440 ENDCASE 6450 UNTIL P<E AND P>-V 6460 UNTIL P=B OR P=-G 6470 UNTIL P=B 6480 ELSE 6490 EXEC PPUT 6500 J6=B 6510 ENDIF 6520 ENDCASE 6530 UNTIL O4=-E 6540 UNTIL P=-W 6550 WHEN G 6560 REPEAT 6570 REPEAT 6580 CURSOR V,23 6590 PRINT "Tekst (max 25 tegn,0-19:tekstkode)"; 6600 PRINT E2$(E:14) 6610 CURSOR 10,23 6620 INPUT D5$ 6630 UNTIL LEN(D5$)<26 6640 IF LEN(D5$)<V THEN 6650 EXEC NRTEST(D5$) 6660 ELSE 6670 P=20;M8=B 6680 ENDIF 6690 UNTIL P=>B AND P<21 AND M8=B AND P<>10 6700 IF P<>B THEN 6710 O5=P MOD 10 6720 IF P=20 THEN 6730 P=10;C1$=D5$;D6$=C1$ 6740 ELSE 6750 D6$=C3$(O5)+E2$(E:15) 6760 IF P>10 THEN 6770 REPEAT 6780 CURSOR V,23 6790 PRINT "Tekst (max 14 tegn)"+E2$(E:42) 6800 CURSOR 10,23 6810 INPUT D5$ 6820 UNTIL LEN(D5$)<15 6830 D6$(12,25)=D5$;C1$=D6$ 6840 ENDIF 6850 ENDIF 6860 CURSOR 13,L7+V 6870 PRINT D6$ 6880 ENDIF 6890 J5=P;L8=V 6900 WHEN V 6910 REPEAT 6920 REPEAT 6930 CURSOR V,23 6940 PRINT "Debet-konto (RETURN:overspringes)"+E2$(E:34) 6950 CURSOR 16,23 6960 INPUT D7$ 6970 EXEC NRTEST(D7$) 6980 UNTIL (((K7<10 AND K7>B) OR K7=G4) AND M8=B) OR P=-E 6990 IF P=-E THEN 7000 J1=100000;J6,O6=E;F5=B 7010 ELSE 7020 O6=B;J1=P 7030 EXEC KNOK 7040 ENDIF 7050 UNTIL P=-E OR P=-7 7060 EXEC KNUD(J1) 7070 WHEN 4 7080 J4=1000000;F5=B 7090 IF J1<>100000 THEN 7100 REPEAT 7110 REPEAT 7120 CURSOR V,23 7130 PRINT "Debet-entreprisekonto (RETURN:overspringes)";E2$(E:25) 7140 CURSOR 25,23 7150 INPUT D7$ 7160 EXEC NRTEST(D7$) 7170 UNTIL M9=5 AND M8=B OR P=-E 7180 J4=1000000;F5=B 7190 IF P=-E THEN EXIT 7200 J4=P 7210 EXEC ENTKOOK(J4) 7220 UNTIL P=-7 7230 ENDIF 7240 EXEC KNUD(J4) 7250 WHEN 5 7260 REPEAT 7270 REPEAT 7280 CURSOR V,23 7290 PRINT "Beløb"+E2$(E:71) 7300 CURSOR 10,23 7310 INPUT D8$ 7320 EXEC FORTEGN 7330 EXEC CA(6,D8$,D0$,C4$) 7340 UNTIL FLAG=B 7350 EXEC CA(4,D8$,D0$,D0$) 7360 UNTIL SI<>B 7370 E1$=D8$(E:LEN(D8$)-E)+"-";E0$=D8$;L8=6 7380 EXEC TUD(D8$,C4$,B,B) 7390 CURSOR 51,L7+V 7400 PRINT C4$ 7410 WHEN 6 7420 REPEAT 7430 REPEAT 7440 CURSOR V,23 7450 PRINT "Kredit-konto (RETURN:overspringes,A:annuller)"; 7460 PRINT " " 7470 CURSOR 17,23 7480 INPUT D7$ 7490 EXEC NRTEST(D7$) 7500 UNTIL (((K7<10 AND K7>B) OR K7=G4) AND M8=B) OR P=-E OR P=-V 7510 IF P=-E THEN 7520 IF O6=B THEN 7530 P,F5=B;J7=100000;J6=E;K1=K1+E;K2=K2+E;C6(K1)=J1 7540 C7(K1)=K0;E3(K1)=J3;C8(K1)=J5;E4$(K1)=E0$ 7550 EXEC CA(B,B6$,E0$,B6$) 7560 C9$(K1)=E2$(E:25);E8(K1)=J4 7570 IF J5>W THEN C9$(K1)=C1$;K2=K2+E 7580 EXEC KNUD(J7) 7590 ENDIF 7600 ELSE 7610 IF P=-V THEN 7620 F5=E 7630 EXEC KNUD(P) 7640 ELSE 7650 O7=J6+O6 7660 CASE O7 OF 7670 STOP 7680 WHEN B 7690 J7=P 7700 EXEC KNOK 7710 IF P=-7 THEN EXEC KNUD(J7) 7750 WHEN E 7760 REPEAT 7770 CURSOR V,23 7780 PRINT "Multipostering ikke afsluttet , tast RETURN"+E2$(E:34) 7790 CURSOR 46,23 7800 INPUT A$ 7810 EXEC NRTEST(A$) 7820 UNTIL P=-E 7830 WHEN G 7840 J7=P 7850 EXEC KNOK 7860 IF P=-7 THEN 7870 EXEC KNUD(J7) 7880 IF F5=B THEN 7890 EXEC CA(B,B6$,E1$,B6$) 7900 K1=K1+E;K2=K2+E;C6(K1)=J7;C7(K1)=K0;E3(K1)=J3 7910 C8(K1)=J5;E4$(K1)=E1$;C9$(K1)=E2$(E:25) 7920 E4$(K1)=E1$ 7930 IF J5>W THEN C9$(K1)=C1$;K2=K2+E 7940 ENDIF 7950 ENDIF 7960 ENDCASE 7970 ENDIF 7980 ENDIF 7990 UNTIL P=B OR P=-V OR P=-7 8000 WHEN 7 8010 J8=1000000;F5=B 8020 IF J7<>100000 THEN 8030 REPEAT 8040 REPEAT 8050 CURSOR V,23 8060 PRINT "Kredit-entreprisekonto (RETURN:overspringes)";E2$(E:24) 8070 CURSOR 26,23 8080 INPUT D7$ 8090 EXEC NRTEST(D7$) 8100 UNTIL M9=5 AND M8=B OR P=-E 8110 J8=1000000;F5=B 8120 IF P=-E THEN EXIT 8130 J8=P 8140 EXEC ENTKOOK(J8) 8150 UNTIL P=-7 8160 ENDIF 8170 EXEC KNUD(J8) 8180 IF J6+O6=G AND F5=B THEN E8(K1)=J8 8185 IF J6+O6=B THEN EXEC PPUT 8190 WHEN 8 8200 REPEAT 8210 CURSOR V,23 8220 PRINT "Ønskes afslutning (J/N)"+E2$(E: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 OPEN B1$,W 8290 EXEC FE(W,32,B1$) 8300 FOR I=E TO I8-E 8310 GET B0$,I:J1,J2,J3,B8$,E0$,C0$,J4 8320 EXEC FE(W,33,B0$) 8330 K6=K6+E;C0$="2" 8340 PUT B1$,K6:J1,J2,J3,B8$,E0$,C0$,J4 8350 EXEC FE(W,34,B1$) 8360 IF ORD(B8$)-48>W THEN 8370 I=I+E;K6=K6+E 8380 GET B0$,I:J1,C1$ 8390 EXEC FE(W,35,B0$) 8400 PUT B1$,K6:J1,C1$ 8410 EXEC FE(W,36,B1$) 8420 ENDIF 8430 NEXT I 8440 CLOSE B1$ 8450 EXEC FE(W,38,B1$) 8460 EXEC PGETUD(K4) 8470 K3=B 8480 ELSE 8490 REPEAT 8500 CURSOR V,23 8510 PRINT "Ønskes kontroludskrift (J/N)"+E2$(E:49) 8520 CURSOR 31,23 8530 INPUT A$ 8540 EXEC NRTEST(A$) 8550 UNTIL P=-7 OR P=-8 8560 IF P=-7 THEN EXEC PGETUD(1) 8570 K3=I8-E 8580 ENDIF 8590 L8=-E 8600 ENDCASE 8610 UNTIL L8=-E 8620 CLOSE B0$ 8630 EXEC FE(W,40,B0$) 8640 CLOSE 8650 EXEC SYSGEM 8660 OUTPUT T 8670 CHAIN "P641210:OPSTART"