DataMuseum.dk

top - download

    Length: 18157 (0x46ed)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »KASRAP.B«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »KASRAP.B« 
└─⟦ff7f7aeee⟧ Bits:30009007 NBT	15/3-84
    └─⟦this⟧ »KASRAP.B« 

SPC/1 COMAL-BIN

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