|
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: 22752 (0x58e0)
Types: TextFile
Notes: Mikados_K
Names: »KASARAP.K«
└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
└─⟦this⟧ »KASARAP.K«
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$(1),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$(9) 0130 DIM C1$(20),C2$(17),C3$(12),C4$(12),C5$(1),A$(2),C6$(12),C7$(1),C8$(1) 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$(1),E7$(6),E8(9),E9$(17),F0(9),F1$(1),F2$(1),F3$(12) 0170 DIM F4$(12),F5$(6,12),F6$(12),F7$(12),F8$(25),F9$(6,12),G0$(1),G1(9) 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=0;FLAG=0;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 1 0310 REPEAT 0320 REPEAT 0330 CURSOR 3,23 0340 PRINT "Bilag (0:Færdig, RETURN:Automatisk, D:Ny dato, A:Annuller)"; 0350 PRINT B7$(1:12) 0360 CURSOR 8,23 0370 INPUT D5$ 0380 EXEC NR(D5$) 0390 UNTIL P=>-3 AND H4=0 0400 IF P<>0 AND H5=19 AND P<>-2 AND P<>-3 THEN 0410 CLEAR 0420 EXEC UH 0430 H5=1 0440 EXEC UL(H6,H7,I6,E4$,F4$,H8,H16) 0450 EXEC SY 0460 H5=H5+1 0470 ENDIF 0480 REPEAT 0490 H9=-1 0500 IF I2+3>R9 OR I2+F0(1)+G1(1)+9>S1 THEN 0510 REPEAT 0520 CURSOR 3,23 0530 PRINT "Ikke plads til flere posteringer , tast RETURN "+B7$(1:30) 0540 CURSOR 50,23 0550 INPUT A$ 0560 EXEC NR(A$) 0570 UNTIL P=-1 0580 P=0 0590 ENDIF 0600 CASE P OF 0610 CURSOR 1,H5+3 0620 PRINT USING "###":H5 0630 H7=P;P=-4;I0=H7;H3=2 0640 CURSOR 4,H5+3 0650 PRINT USING "#######":H7 0660 WHEN 0 0670 H3=7;P=-4 0680 IF I1=2 THEN H3=-1 0690 WHEN -1 0700 I0=I0+1;P=I0;H9=0 0710 WHEN -2 0720 REPEAT 0730 CURSOR 3,23 0740 PRINT "Ny dato (ååmmdd)";B7$(1: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 -3 0820 IF I2>I3 THEN 0830 I0=I0-1;H5=H5-1 0840 EXEC SL(5) 0850 EXEC ÆN(1,F4$,H8) 0860 I2=I3;I4=I3-1 0870 ENDIF 0880 ENDCASE 0890 UNTIL H9=-1 0900 UNTIL P=-4 0910 WHEN 2 0920 REPEAT 0930 REPEAT 0940 CURSOR 3,23 0950 PRINT "Tekst"+B7$(1:27)+"(max 25 tegn)"+B7$(1:32) 0960 CURSOR 9,23 0970 INPUT D4$ 0980 I5=LEN(D4$) 0990 UNTIL I5<=25 1000 IF I5<3 THEN 1010 EXEC NR(D4$) 1020 ELSE 1030 P=20;H4=0 1040 ENDIF 1050 UNTIL P=>0 AND P<21 AND H4=0 AND P<>10 1060 E4$=B7$ 1070 IF P<>0 THEN 1080 I6=P MOD 10 1090 IF I6=0 THEN 1100 P=10;E3$=D4$;E4$=E3$ 1110 ELSE 1120 E4$=E5$(I6)+B7$(1:15) 1130 IF P>10 THEN 1140 REPEAT 1150 CURSOR 3,23 1160 PRINT "Tekst";B7$(1:16);"(max 14 tegn)"+B7$(1:43) 1170 CURSOR 9,23 1180 INPUT D4$ 1190 UNTIL LEN(D4$)<15 1200 E4$(12,25)=D4$;E3$=E4$ 1210 ENDIF 1220 ENDIF 1230 CURSOR 12,H5+3 1240 PRINT E4$ 1250 ENDIF 1260 H3=3;I7=P 1270 WHEN 3 1280 REPEAT 1290 REPEAT 1300 CURSOR 3,23 1310 PRINT "Konto (5 cifre)";B7$(1:54) 1320 CURSOR 9,23 1330 INPUT D5$ 1340 EXEC NR(D5$) 1350 UNTIL H4=0 AND (I8<>0 AND I5=5) 1360 H6=P 1370 EXEC KN(I8,H6) 1380 CURSOR 15,23 1390 PRINT "(Navn:";B7$(1: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=0 AND I1=1) OR I1<>1) 1480 IF I9=1 THEN 1490 EXEC SL(5) 1500 H3=1;I0=I0-1 1510 ELSE 1520 CURSOR 37,H5+3 1530 H3=4 1540 IF I1=1 THEN H3=-1 1550 PRINT USING "######":H6 1560 ENDIF 1570 WHEN 4 1580 REPEAT 1590 REPEAT 1600 CURSOR 3,23 1610 PRINT "Entreprisekonto (5 cifre)";B7$(1:44) 1620 CURSOR 19,23 1630 INPUT D5$ 1640 EXEC NR(D5$) 1650 UNTIL H4=0 AND (I8<>0 AND I5=5) OR P=-1 1660 H16=1000000;I9=0 1670 IF P=-1 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=0 THEN 1710 FOR X=1 TO J13+J14 1720 I9=0 1730 IF (H16 MOD 100)=N12(X) AND N13$(X)="0" THEN EXIT 1740 I9=1 1750 NEXT X 1760 IF I9=0 THEN 1770 GET E12$,M8(J19,2)+1: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 1,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=0 AND I1=1) OR I1<>1) 1920 IF I9=1 THEN 1930 EXEC SL(5) 1940 H3=1;I0=I0-1 1950 ELSE 1960 CURSOR 44,H5+3 1970 H3=5 1980 IF I1=1 THEN H3=-1 1990 PRINT USING "######":H16 2000 ENDIF 2010 WHEN 5 2020 REPEAT 2030 REPEAT 2040 REPEAT 2050 CURSOR 3,23 2060 PRINT "Beløb";B7$(1:14);"(Kredit indtastes med efterstillet minus)"; 2070 PRINT B7$(1:17) 2080 CURSOR 8,23 2090 INPUT F3$ 2100 UNTIL LEN(F3$)>0 2110 EXEC FO 2120 EXEC CA(6,F3$,B9$,B8$) 2130 UNTIL FLAG=0 2140 EXEC CA(4,F3$,B9$,B9$) 2150 UNTIL SI<>0 AND FLAG=0 2160 F4$=F3$;SI=0 2170 EXEC SL(3) 2180 IF F3$(LEN(F3$))="+" THEN SI=1 2190 CURSOR 52+(SI=0)*11,H5+3 2200 EXEC TU(F4$,B8$,0,0) 2210 PRINT B8$ 2220 H3=6 2230 IF I1=1 THEN H3=-1 2240 WHEN 6 2250 REPEAT 2260 CURSOR 3,23 2270 PRINT "Kode (0:Annullering, 1:Kasse, 2:Bank, 3:Giro)"+B7$(1:30) 2280 CURSOR 7,23 2290 INPUT D5$ 2300 EXEC NR(D5$) 2310 UNTIL (P>0 AND P<4) OR (P=0 AND I1<>1) 2320 H8=P;H3=1 2330 IF H8=0 THEN 2340 EXEC SL(5) 2350 I0=I0-1 2360 ELSE 2370 CURSOR 77,H5+3 2380 PRINT USING "##":H8 2390 IF I1<>1 THEN 2400 EXEC ÆN(0,F4$,H8) 2410 H5=H5+1;I3=I2 2420 EXEC GP(D2$,I2,H6,J6,H7,I7,E3$,F4$,H8,H16) 2430 I2=I2+1;I4=I2-1 2440 ENDIF 2450 ENDIF 2460 IF I1=1 THEN H3=-1 2470 WHEN 7 2480 P=-7 2490 IF I2+F0(1)+G1(1)+9<S1 THEN 2500 REPEAT 2510 CURSOR 3,23 2520 PRINT "Ønskes afstemning J/N "+B7$(1: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=1 2600 IF P=-7 THEN 2610 J4=0 2620 FOR I=1 TO 6 2630 REPEAT 2640 REPEAT 2650 CURSOR 3,23 2660 PRINT J5$(I);B7$(1:60) 2670 CURSOR 17,23 2680 INPUT F3$ 2690 UNTIL LEN(F3$)>0 2700 EXEC FO 2710 EXEC CA(6,F3$,B9$,B8$) 2720 UNTIL FLAG=0 2730 F9$(I)=F3$ 2740 IF I MOD 2=0 THEN F9$(I)=F3$(1:LEN(F3$)-1)+"-" 2750 NEXT I 2760 ENDIF 2770 H3=-1 2780 ENDCASE 2790 UNTIL H3=-1 2800 ENDPROC 2810 PROC HK 2820 J7=M8(J9,2) 2830 GET D1$,J7:K0,F8$,A3$ 2840 EXEC FE(5,1,D1$) 2850 GET D1$,J7+1:A5$,C7$,C8$,K1,F6$,F7$ 2860 EXEC FE(5,2,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,1,FL$) 2920 IF TK>9 AND TK<20 THEN 2930 PN=PN+1 2940 PUT FL$,PN:KT,TKS$ 2950 EXEC FE(10,2,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,1,FL$) 3010 TK=ORD(F1$)-48;KO=ORD(D5$)-48 3020 IF TK>9 AND TK<20 THEN 3030 PN=PN+1 3040 GET FL$,PN:KT,TKS$ 3050 EXEC FE(11,2,FL$) 3060 ELSE 3070 TKS$=B7$ 3080 IF TK>0 THEN TKS$=E5$(TK-10*(TK>20)) 3090 ENDIF 3100 ENDPROC 3110 PROC ÆN(K4,K5,K6) 3120 J3=0;B8$=K5$ 3130 IF B8$(LEN(B8$))="+" THEN J3=1 3140 J3=2*K6-J3 3150 EXEC CA(K4,F5$(J3),B8$,F5$(J3)) 3160 ENDPROC 3170 PROC RE 3180 K3=1;K2=1 3190 IF I2=1 THEN EXIT 3200 REPEAT 3210 CLEAR 3220 EXEC UH 3230 IF K2=I2 THEN K2=1 3240 K3=K2;H5=1 3250 FOR I=1 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+1 3280 IF G2(I)<>0 THEN EXEC UL(G2(I),G4(I),G5(I),G8$(I),G6$(I),G7(I),G12(I)) 3290 H5=H5+1 3300 IF K2=I2 THEN EXIT 3310 NEXT I 3320 K7=H5;K8=0 3330 REPEAT 3340 REPEAT 3350 CURSOR 3,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>-2 AND P<K7) AND H4=0 3420 K9=P 3430 IF K9<1 THEN EXIT 3440 K8=1 3450 REPEAT 3460 REPEAT 3470 CURSOR 3,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=-3 OR P>-1 AND P<5) AND H4=0 3540 L0=P 3550 IF L0=0 THEN EXIT 3560 H5=K9 3570 IF G2(K9)=0 THEN 3580 CURSOR 3,H5+3 3590 PRINT "Postering er annulleret" 3600 ELSE 3610 IF L0<>1 THEN EXEC ÆN(1,G6$(K9),G7(K9)) 3620 IF L0=-3 THEN 3630 EXEC SL(5) 3640 G2(K9)=0 3650 ELSE 3660 L0=L0+2;L1=L0;I1=1;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<>3 THEN EXEC ÆN(0,F4$,H8) 3700 ENDIF 3710 ENDIF 3720 UNTIL L0=-3 OR L0=0 3730 UNTIL K9<1 3740 IF K8=1 THEN 3750 FOR I=1 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+1 3780 IF K3=K2 THEN EXIT 3790 NEXT I 3800 EXEC SY 3810 ENDIF 3820 UNTIL K9=0 OR K9=-8 3830 IF K9=-8 THEN 3840 CLEAR 3850 EXEC UH 3860 H5=1;I1=2 3870 EXEC IN(1) 3880 ENDIF 3890 ENDPROC 3900 PROC SY 3910 E8(4)=L2;E8(8)=I0;F0(2)=I4;G1(1)=L3 3920 OPEN E2$,W 3930 EXEC FE(3,1,E2$) 3940 PUT E2$,2:E8(1),E8(2),E8(3),E8(4),E8(5),E8(6),E8(7),E8(8),E8(9) 3950 EXEC FE(3,2,E2$) 3960 PUT E2$,12:F0(1),F0(2),F0(3),F0(4),F0(5),F0(6),F0(7),F0(8),F0(9) 3970 EXEC FE(3,3,E2$) 3980 PUT E2$,13:G1(1),G1(2),G1(3),G1(4),G1(5),G1(6),G1(7),G1(8),G1(9) 3990 EXEC FE(3,4,E2$) 4000 PUT E2$,15:F5$(1),F5$(2),F5$(3) 4010 EXEC FE(3,5,E2$) 4020 PUT E2$,16:F5$(4),F5$(5),F5$(6) 4030 EXEC FE(3,6,E2$) 4040 CLOSE E2$ 4050 EXEC FE(3,7,E2$) 4060 ENDPROC 4070 PROC FI(L5,Q,L6,L7,L8,L9) 4080 M0=L6 DIV 16;L8=M0;I9=1;M1=L6 DIV 8;M2=L6 DIV 32 4090 REPEAT 4100 IF L7=L5(L8) OR M0=1 THEN EXIT 4110 M0=(M0+1) DIV 2;L8=L8+M0*(1-2*(L7<L5(L8))) 4120 IF L8<1 THEN L8=1 4130 IF L8>M1 THEN L8=M1 4140 UNTIL M0=0 4150 IF L5(L8)>L7 THEN L8=L8-1*(L8>1) 4160 L8=M2+L8*2-1 4170 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) 4180 EXEC FE(1,1,L9$) 4190 GET L9$,L8+1:Q(5,1),Q(5,2),Q(6,1),Q(6,2),Q(7,1),Q(7,2),Q(8,1),Q(8,2) 4200 EXEC FE(1,2,L9$) 4210 FOR L8=1 TO 8 4220 IF L7=Q(L8,1) THEN EXIT 4230 NEXT L8 4240 IF L8<>9 THEN I9=0 4250 ENDPROC 4260 PROC IT(Z,M3,M4) 4270 M0=M3 DIV 32 4280 FOR I=1 TO M0 4290 H=(I-1)*4+1 4300 GET M4$,I:Z(H),Z(H+1),Z(H+1),Z(H+2),Z(H+2),Z(H+3),Z(H+3) 4310 EXEC FE(5,1,M4$) 4320 NEXT I 4330 ENDPROC 4340 PROC KN(M5,M6) 4350 I9=1 4360 CASE M5 OF 4370 EXEC FI(M7,M8,M9,M6,N0,A6$) 4380 IF I9=0 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=0 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=0 THEN 4540 EXEC HK 4550 B4$=F8$ 4560 ENDIF 4570 ENDIF 4580 ENDCASE 4590 IF I9=1 THEN 4600 B4$="Konto eksisterer ikke " 4610 ENDIF 4620 ENDPROC 4630 PROC SL(O0) 4640 CASE O0 OF 4650 STOP 4660 WHEN 3 4670 CURSOR 50,H5+3 4680 PRINT B7$(1:28) 4690 WHEN 5 4700 CURSOR 4,H5+3 4710 PRINT B7$ 4720 ENDCASE 4730 ENDPROC 4740 PROC FO 4750 I5=LEN(F3$) 4760 IF I5=0 THEN F3$="0+" 4770 IF F3$(I5)<>"+" AND F3$(I5)<>"-" THEN F3$=F3$+"+" 4780 ENDPROC 4790 PROC UH 4800 CURSOR 35,1 4810 PRINT "Kasserapport";TAB(30);"Dato:" 4820 CURSOR 72,1 4830 PRINT J6 4840 CURSOR 1,3 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 1,H5+3 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$)<>0 THEN 4960 PRINT STATUS(O8$),O6,O7,O8$ 4970 STOP 4980 ENDIF 4990 ENDPROC 5000 PROC HD 5010 J7=M8(N5,2) 5020 GET D0$,J7:O9,A7$,A8$,A9$ 5030 EXEC FE(8,2,D0$) 5040 IF O9<>M8(N5,1) THEN STOP 5050 GET D0$,J7+1:B1$,B2$,B3$,P0,C5$ 5060 EXEC FE(8,3,D0$) 5070 GET D0$,J7+2:B5$,C0$,P1,P2 5080 EXEC FE(8,4,D0$) 5090 GET D0$,J7+3: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=0 THEN P4$=P4$(1:13) 5170 IF P5=1 AND P4$(LEN(P4$))="+" THEN P4$(LEN(P4$))=" " 5180 IF P6=1 THEN P4$=P4$(4:LEN(P4$)-3) 5190 ENDPROC 5200 PROC NR(P7) 5210 P=0;H4=0;I8=0;I5=LEN(P7$) 5220 CASE I5 OF 5230 FOR I=1 TO I5 5240 P8=INT(ORD(P7$(I))-48) 5250 IF P8=>0 AND P8<10 THEN 5260 P=P*10+P8 5270 ELSE 5280 H4=1 5290 ENDIF 5300 NEXT I 5310 I8=P DIV 10000;KTAL9=P DIV 1000 5320 IF KTAL9=J2 THEN I8=KTAL9 5330 WHEN 0 5340 P=-1 5350 WHEN 1 5360 CASE P7$ OF 5370 P=INT(ORD(P7$)-48) 5380 WHEN "d","D" 5390 P=-2 5400 WHEN "a","A" 5410 P=-3 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,2) 5510 GET C9$,J7:P9,B0$ 5520 EXEC FE(3,2,C9$) 5530 IF P9<>M8(N0,1) THEN STOP 5540 GET C9$,J7+1:G0$,D7$,D8$ 5550 EXEC FE(3,3,C9$) 5560 GET C9$,J7+2:E6$,D9$,E0$ 5570 EXEC FE(3,4,C9$) 5580 ENDPROC 5590 PROC BF 5600 REPEAT 5610 CLEAR 5620 CURSOR 21,1 5630 PRINT "Kasserapport afstemning" 5640 CURSOR 66,1 5650 PRINT "Dato :";J6 5660 CURSOR 21,3 5670 PRINT "Differencer Indtastede saldi" 5680 FOR I=1 TO 6 5690 EXEC CA(1,F5$(I),F9$(I),F3$) 5700 CURSOR 1,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 -1<P AND P<7 AND H4=0 5880 IF P<>0 THEN 5890 REPEAT 5900 REPEAT 5910 CURSOR 1,16 5920 PRINT P;J5$(P);" (tast ændret saldo)" 5930 CURSOR 19,16 5940 INPUT F3$ 5950 UNTIL LEN(F3$)>0 5960 EXEC FO 5970 EXEC CA(6,F3$,B9$,B8$) 5980 UNTIL FLAG=0 5990 F9$(P)=F3$ 6000 IF P MOD 2=0 THEN F9$(P)=F3$(1:LEN(F3$)-1)+"-" 6010 Q0=0 6020 ELSE 6030 FOR I=1 TO 6 6040 EXEC CA(1,F5$(I),F9$(I),F3$) 6050 EXEC CA(4,F3$,B9$,B9$) 6060 IF SI<>0 THEN EXIT 6070 NEXT I 6080 P=-7;Q0=-1 6090 IF SI=0 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=0 6170 ENDIF 6180 IF P=-7 THEN 6190 EXEC RE 6200 Q0=0 6210 ENDIF 6220 ENDIF 6230 UNTIL Q0=-1 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(9);CHR(14);"Kasserapport";CHR(15);TAB(44);"Dato:";D6$; 6310 PRINT TAB(61); 6320 PRINT USING "Side:####":Q2 6330 PRINT " " 6340 PRINT TAB(3);"Bilag";TAB(12);"Tekst";TAB(38);"Konto";TAB(45);"Entre."; 6350 PRINT TAB(57);"Debet";TAB(68);"Kredit";TAB(75);"Kode" 6360 PRINT TAB(3);A2$ 6370 ENDPROC 6380 PROC LU(Q3,Q4,Q5,Q6,Q7,Q8,Q15) 6390 R5=0 6400 IF Q7$(LEN(Q7$))="+" THEN R5=1 6410 IF Q3<>-1 THEN PRINT USING "#######":Q3; 6420 IF Q4<10 AND Q4>0 THEN Q6$=E5$(Q4)+B7$(1:15) 6430 IF Q4<>0 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=0));B8$;TAB(77); 6480 PRINT USING "##":Q8 6490 ENDPROC 6500 PROC DU(Q9,R0) 6510 R1=Q9 6520 R0$=" " 6530 FOR J=8 TO 1 STEP -1 6540 R0$(J)="." 6550 IF J MOD 3<>0 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=0 THEN 6600 R2=R2+1 6610 EXEC HU(R4,R2) 6620 R3=0 6630 ENDIF 6640 R3=R3+1 6650 EXEC LU(H7,I7,H6,E3$,F4$,H8,H16) 6660 ENDPROC 6670 PROC MO(R6,R7) 6680 I5=LEN(R7$) 6690 R6$=R7$(1:I5-1)+"+" 6700 IF R7$(I5)="+" THEN R6$=R7$(1:I5-1)+"-" 6710 ENDIF 6720 ENDPROC 6730 PROC GB 6740 J7=L3;J7=J7+1 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(3);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(3);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(9,1,C2$) 7010 GET C2$,1:M9,N4,N8 7020 EXEC FE(9,2,C2$) 7030 GET C2$,2:R9,S0,S1 7040 EXEC FE(9,3,C2$) 7050 GET C2$,4:S2,S3,S4,N1 7060 EXEC FE(9,4,C2$) 7070 GET C2$,5:N6 7080 EXEC FE(9,5,C2$) 7090 GET C2$,6:S5,S6,S7 7100 EXEC FE(9,6,C2$) 7110 GET C2$,8:S8,S9,T0,J1 7120 EXEC FE(9,7,C2$) 7130 GET C2$,9:J2,J11,J12,J13 7140 EXEC FE(9,8,C2$) 7150 GET C2$,10:E7$ 7160 EXEC FE(9,9,C2$) 7170 GET C2$,11:A6$ 7180 EXEC FE(9,10,C2$) 7190 GET C2$,12:A4$ 7200 EXEC FE(9,11,C2$) 7210 GET C2$,13:B6$ 7220 EXEC FE(9,12,C2$) 7230 GET C2$,15:C9$ 7240 EXEC FE(9,13,C2$) 7250 GET C2$,16:D0$ 7260 EXEC FE(9,14,C2$) 7270 GET C2$,17:D1$ 7280 EXEC FE(9,15,C2$) 7290 GET C2$,19:D2$ 7300 EXEC FE(9,16,C2$) 7310 GET C2$,21:D3$ 7320 EXEC FE(9,17,C2$) 7330 GET C2$,36:E2$ 7340 EXEC FE(9,18,C2$) 7350 GET C2$,37:E12$ 7360 EXEC FE(99,1,C2$) 7370 GET C2$,38:E13$ 7380 EXEC FE(99,2,C2$) 7390 GET C2$,39:E14$ 7400 EXEC FE(99,3,C2$) 7410 GET C2$,43:J14,J15,J16 7420 EXEC FE(99,4,C2$) 7430 CLOSE C2$ 7440 EXEC FE(9,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,2),J5$(6,14),N13$(J13+J14) 7470 E2$=E7$+E2$ 7480 OPEN E2$,R 7490 EXEC FE(9,20,E2$) 7500 GET E2$,2:E8(1),E8(2),E8(3),E8(4),E8(5),E8(6),E8(7),E8(8),E8(9) 7510 EXEC FE(9,21,E2$) 7520 FOR I=1 TO 6 7530 J=(I-1)*3+1 7540 GET E2$,I+5:E5$(J),E5$(J+1),E5$(J+2) 7550 EXEC FE(9,22,E2$) 7560 NEXT I 7570 GET E2$,12:F0(1),F0(2),F0(3),F0(4),F0(5),F0(6),F0(7),F0(8),F0(9) 7580 EXEC FE(9,23,E2$) 7590 GET E2$,13:G1(1),G1(2),G1(3),G1(4),G1(5),G1(6),G1(7),G1(8),G1(9) 7600 EXEC FE(9,24,E2$) 7610 GET E2$,15:F5$(1),F5$(2),F5$(3) 7620 EXEC FE(9,25,E2$) 7630 GET E2$,16:F5$(4),F5$(5),F5$(6) 7640 EXEC FE(9,26,E2$) 7650 GET E2$,20:DV$ 7660 EXEC FE(9,40,E2$) 7670 CLOSE E2$ 7680 EXEC FE(9,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(9,28,A6$) 7790 OPEN A4$,R 7800 EXEC FE(9,29,A4$) 7810 OPEN B6$,R 7820 EXEC FE(9,30,B6$) 7830 OPEN C9$,R 7840 EXEC FE(9,31,C9$) 7850 OPEN D0$,R 7860 EXEC FE(9,32,D0$) 7870 OPEN D1$,R 7880 EXEC FE(9,33,D1$) 7890 OPEN D2$,W 7900 EXEC FE(9,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=1 TO J13+J14 7960 GET E14$,X:N12(X),N13$(X) 7970 EXEC FE(99,8,E14$) 7980 NEXT X 7990 J5$(1)="Kasse debet ";J5$(2)="Kasse kredit ";J5$(3)="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=0;A2$=A2$+A2$;L2=E8(4);R4=E8(7);I0=E8(8);I4=F0(2);L3=G1(1) 8040 H5=1;J6=R4;R8=0;L4=0;B8$="0+";I3=I4+1;I2=I3;K3=1;K2=1 8050 CLEAR 8060 EXEC UH 8070 EXEC IN(1) 8080 IF J4=0 THEN 8090 EXEC BF 8100 EXEC UB 8110 OPEN D3$,W 8120 EXEC FE(9,37,D3$) 8130 FOR I=1 TO I4 8140 EXEC GG(D2$,I,H6,L4,H7,I7,E3$,F4$,H8,H16) 8150 IF H6<>0 THEN 8160 EXEC MO(F3$,F4$) 8170 EXEC GB 8180 EXEC CA(0,F3$,A1$,A1$) 8190 EXEC UD(L2,R8) 8200 ENDIF 8210 NEXT I 8220 EXEC CA(0,F5$(1),F5$(2),F3$) 8230 EXEC CA(0,F3$,A1$,A1$) 8240 H6=S5;I7=24;H7=L2;H8=0;H16=1000000 8250 EXEC GB 8260 I7=10;H7=-1;F4$=F3$;E3$="Samlet kassepostering" 8270 EXEC UD(L2,R8) 8280 EXEC CA(0,F5$(3),F5$(4),F3$) 8290 EXEC CA(0,F3$,A1$,A1$) 8300 I7=24;H7=L2;H6=S7 8310 EXEC GB 8320 F4$=F3$;I7=10;H7=-1;E3$="Samlet bankpostering" 8330 EXEC UD(L2,R8) 8340 EXEC CA(0,F5$(5),F5$(6),F3$) 8350 EXEC CA(0,F3$,A1$,A1$) 8360 I7=24;H7=L2;H6=S6 8370 EXEC GB 8380 E3$="Samlet giropostering";F4$=F3$;I7=10;H7=-1 8390 EXEC UD(L2,R8) 8400 EXEC CA(4,A1$,B9$,B9$) 8410 IF SI<>0 THEN 8420 I7=10;H7=L2;H6=T0;E3$="Difference kasserapport" 8430 EXEC MO(F3$,A1$) 8440 EXEC GB 8450 EXEC CA(0,F3$,A1$,A1$) 8460 F4$=F3$;H7=-1 8470 EXEC UD(L2,R8) 8480 ENDIF 8490 EXEC BU 8500 CLOSE D3$ 8510 EXEC FE(9,38,D3$) 8520 I4=0 8530 FOR I=1 TO 6 8540 F5$(I)="0+" 8550 NEXT I 8560 ELSE 8570 REPEAT 8580 CURSOR 3,23 8590 PRINT "Ønskes kontroludskrift J/N ";B7$(1: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=1 TO I4 8680 EXEC GG(D2$,I,H6,L4,H7,I7,E3$,F4$,H8,H16) 8690 EXEC UD(T1,R8) 8700 EXEC CA(1,A1$,F4$,A1$) 8710 NEXT I 8720 I7=10;H7=-1;H8=0;H6=0 8730 FOR I=1 TO 6 8740 E3$=J5$(I);F4$=F5$(I) 8750 EXEC UD(T1,R8) 8760 EXEC CA(0,A1$,F4$,A1$) 8770 NEXT I 8780 EXEC BU 8790 ENDIF 8800 ENDIF 8810 EXEC SY 8820 CLOSE D2$ 8830 EXEC FE(9,39,D2$) 8840 CLOSE 8850 OUTPUT T 8860 CHAIN "P641210:OPSTART"