|
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: 8760 (0x2238)
Types: SPC/1-COMAL-BIN
Notes: Mikados_B
Names: »MAFSLUT.B«
└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
└─⟦this⟧ »MAFSLUT.B«
└─⟦ff7f7aeee⟧ Bits:30009007 NBT 15/3-84
└─⟦this⟧ »MAFSLUT.B«
0100 REM MAFSLUT 0110 DIM BLANK$(25),TKO$(E),BEO$(12),TEO$(25),OP1$(12),OP2$(12),RES$(14) 0120 DIM DEBNAVN$(25),DSALDO1$(12),DSALDO2$(12),DSALDO3$(12),DSALDO4$(12) 0130 DIM DEBKGR$(G),DEBBY$(20),ÅRKØB$(12),MDNKØB$(12),SALDO$(12),FNAVN$(25) 0140 DIM FMKODE$(E),FMDEBET$(12),FMKREDIT$(12),FUKODE$(E),FÅDEBET$(12) 0150 DIM FÅKREDIT$(12),TAL4$(12),K1$(17),K2$(17),K3$(17),K4$(17),K5$(17) 0160 DIM K6$(17),K7$(17),K8$(17),K9$(17),K10$(17),N$(6),A$(G),DEBLK$(G) 0170 DIM KREBY$(20),KRELK$(E),KREGR$(E),KSALDO1$(12),KSALDO2$(12),T1(W),T2(W) 0180 DIM T3(W),T4(W),K11$(17),K12$(17),K13$(17),K14$(17),SVAR$(E) 0185 DIM K15$(17),K16$(17),K17$(17),K18$(17) 0190 PROC FEJL(NR1,NR2,NR3) 0200 IF STATUS(NR3$)<>B THEN 0205 CURSOR 5,15 0210 PRINT NR1,NR2,NR3$,STATUS(NR3$) 0220 STOP 0230 ENDIF 0240 ENDPROC 0250 PROC FSYSUD 0260 OPEN K1$,W 0270 EXEC FEJL(6,E,K1$) 0280 PUT K1$,13:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W) 0290 EXEC FEJL(6,G,K1$) 0300 PUT K1$,17:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W) 0310 EXEC FEJL(6,V,K1$) 0311 PUT K1$,21:T3(E),T3(G),T3(V),T3(4),T3(5),T3(6),T3(7),T3(8),T3(W) 0312 EXEC FEJL(20,20,K1$) 0320 CLOSE K1$ 0330 EXEC FEJL(6,4,K1$) 0340 ENDPROC 0350 PROC FGET2(K15,I3,N3,D3,BI3,TK3,BE3,TE3,ENT3) 0360 GET K15$,I3:N3,D3,BI3,TK3$,BE3$,ENT3 0370 EXEC FEJL(W,E,K15$) 0380 IF ORD(TK3$)-48>W AND ORD(TK3$)-48<20 THEN 0390 I3=I3+E 0400 GET K15$,I3:N3,TE3$ 0410 EXEC FEJL(W,G,K15$) 0420 ELSE 0430 TE3$=BLANK$ 0440 ENDIF 0450 ENDPROC 0460 PROC FPUT2(K16,I4,N4,D4,BI4,TK4,BE4,TE4,ENT4) 0470 PUT K16$,I4:N4,D4,BI4,TK4$,BE4$,ENT4 0480 EXEC FEJL(10,E,K16$) 0490 IF ORD(TK4$)-48>W AND ORD(TK4$)-48<20 THEN 0500 I4=I4+E 0510 PUT K16$,I4:N4,TE4$ 0520 EXEC FEJL(10,G,K16$) 0530 ENDIF 0540 ENDPROC 0550 PROC HOVIND(V1,MPOSTANTAL1,R) 0560 OPEN V1$,R 0570 EXEC FEJL(13,E,V1$) 0580 FOR I=E TO MPOSTANTAL1 DIV 160 0590 J=(I-E)*4+E;J1=J+E;J2=J+G;J3=J+V 0600 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) 0610 EXEC FEJL(13,G,V1$) 0620 NEXT I 0630 CLOSE V1$ 0640 EXEC FEJL(13,V,V1$) 0650 ENDPROC 0660 PROC UNDIND(V2,U1,Z) 0670 OPEN V2$,R 0680 EXEC FEJL(14,E,V2$) 0690 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) 0700 EXEC FEJL(14,G,V2$) 0710 CLOSE V2$ 0720 EXEC FEJL(14,V,V2$) 0730 ENDPROC ;UNDIND 0740 PROC TABINIT(K31,K32,MPOSTANTAL3,HTAB2,UTAB2) 0750 OPEN K31$,R 0760 EXEC FEJL(15,E,K31$) 0770 OPEN K32$,W 0780 EXEC FEJL(15,G,K32$) 0790 H=E 0800 FOR I=E TO MPOSTANTAL3 DIV 40 0810 GET K31$,H:KONR 0820 EXEC FEJL(15,V,K31$) 0830 HTAB2(I,E)=KONR 0840 FOR J=E TO 4 0850 GET K31$,H:KONR 0860 EXEC FEJL(15,4,K31$) 0870 UTAB2(J,E)=KONR 0880 H=H+W 0890 GET K31$,H:KONR 0900 EXEC FEJL(15,5,K31$) 0910 UTAB2(J,G)=KONR 0920 H=H+E 0930 NEXT J 0940 HTAB2(I,G)=KONR 0950 K=I+MPOSTANTAL3 DIV 160 0960 EXEC UNDUD(K32$,K,UTAB2) 0970 NEXT I 0980 EXEC HOVUD(K32$,MPOSTANTAL3,HTAB2) 0990 CLOSE K31$ 1000 EXEC FEJL(15,6,K31$) 1010 CLOSE K32$ 1020 EXEC FEJL(15,7,K32$) 1030 ENDPROC ;TABINIT 1040 PROC UNDUD(V3,U2,T) 1050 PUT V3$,U2:T(E,E),T(E,G),T(G,E),T(G,G),T(V,E),T(V,G),T(4,E),T(4,G) 1060 EXEC FEJL(16,E,V3$) 1070 ENDPROC ;UNDUD 1080 PROC HOVUD(V4,MPOSTANTAL4,S) 1090 FOR I=E TO MPOSTANTAL4 DIV 160 1100 J=(I-E)*4+E;J1=J+E;J2=J+G;J3=J+V 1110 PUT V4$,I:S(J,E),S(J,G),S(J1,E),S(J1,G),S(J2,E),S(J2,G),S(J3,E),S(J3,G) 1120 EXEC FEJL(17,G,V4$) 1130 NEXT I 1140 ENDPROC 1150 PROC CALC(ART,AB,AC,ES) 1160 OP1$=AB$;OP2$=AC$;RES$=ES$;SI=B;FLAG=B 1170 CALL "P641210:REGN" 1180 ES$=RES$ 1190 IF FLAG<>B THEN STOP 1200 ENDPROC 1210 PROC PINIT(K61,MPOSTANTAL8,Q) 1220 OPEN K61$,W 1230 EXEC FEJL(E,E,K61$) 1240 FOR I=E TO MPOSTANTAL8 1250 PUT K61$,I:Q,B,B,"0","0+",1000000 1260 EXEC FEJL(E,G,K61$) 1270 NEXT I 1280 CLOSE K61$ 1290 EXEC FEJL(E,V,K61$) 1300 ENDPROC 1310 PROC KINIT(K62,K63,K64,TAB1,KM,F,MANTAL) 1320 F=B;TKO$=CHR(26+48) 1330 OPEN K63$,W 1340 EXEC FEJL(G,E,K63$) 1350 OPEN K64$,W 1360 EXEC FEJL(G,22,K64$) 1370 FOR J=E TO MANTAL DIV 4 1380 K=J+MANTAL DIV 32 1390 EXEC UNDIND(K62$,K,TAB1) 1400 FOR I=E TO 4 1410 IF TAB1(I,E)=1000000 THEN EXIT 1420 X=TAB1(I,G) 1430 CASE KM OF 1440 GET K63$,X:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$ 1450 EXEC FEJL(G,G,K63$) 1460 IF DEBNR<>TAB1(I,E) THEN STOP 1470 GET K63$,X+E:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$ 1480 EXEC FEJL(G,V,K63$) 1490 GET K63$,X+V:DEBBY$,ÅRKØB$,MDNKØB$ 1500 EXEC FEJL(G,4,K63$) 1510 EXEC CALC(B,DSALDO3$,DSALDO4$,SALDO$) 1520 DSALDO4$=SALDO$ 1530 EXEC CALC(B,SALDO$,DSALDO2$,SALDO$) 1540 DSALDO3$=DSALDO2$ 1550 EXEC CALC(B,SALDO$,DSALDO1$,SALDO$) 1560 DSALDO2$=DSALDO1$ 1570 DSALDO1$="0+" 1580 MDNKØB$="0+" 1590 PUT K63$,X:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$ 1600 EXEC FEJL(G,5,K63$) 1610 PUT K63$,X+E:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$ 1620 EXEC FEJL(G,6,K63$) 1630 PUT K63$,X+V:DEBBY$,ÅRKØB$,MDNKØB$ 1640 EXEC FEJL(G,7,K63$) 1650 WHEN E 1660 GET K63$,X+E:FMKODE$,FMDEBET$,FMKREDIT$ 1670 EXEC FEJL(G,14,K63$) 1680 GET K63$,X+G:FUKODE$,FÅDEBET$,FÅKREDIT$ 1690 EXEC FEJL(G,15,K63$) 1700 EXEC CALC(B,FÅDEBET$,FÅKREDIT$,SALDO$) 1710 FMDEBET$="0+" 1720 FMKREDIT$="0+" 1730 PUT K63$,X+E:FMKODE$,FMDEBET$,FMKREDIT$ 1740 EXEC FEJL(G,17,K63$) 1750 PUT K63$,X+G:FUKODE$,FÅDEBET$,FÅKREDIT$ 1760 EXEC FEJL(G,18,K63$) 1770 WHEN G 1780 GET K63$,X+E:KREBY$,KRELK$,KREGR$,KREPOSTNR,KSALDO1$,KSALDO2$ 1790 EXEC FEJL(G,20,K63$) 1800 EXEC CALC(B,KSALDO1$,KSALDO2$,SALDO$) 1810 KSALDO2$=SALDO$;KSALDO1$="0+" 1820 PUT K63$,X+E:KREBY$,KRELK$,KREGR$,KREPOSTNR,KSALDO1$,KSALDO2$ 1830 EXEC FEJL(G,21,K63$) 1831 WHEN V 1832 GET K63$,X:DEBNR,FMDEBET$,FMKREDIT$ 1833 EXEC FEJL(99,19,K63$) 1834 PUT K63$,X:DEBNR,"0+",FMKREDIT$ 1835 EXEC FEJL(99,20,K63$) 1836 FOR X1=X+G TO X+G+MUNKANT 1837 GET K63$,X1:DEBNR,FMDEBET$,FMKREDIT$ 1838 EXEC FEJL(99,21,K63$) 1839 PUT K63$,X1:DEBNR,"0+",FMKREDIT$ 1840 EXEC FEJL(99,22,K63$) 1841 NEXT X1 1842 SALDO$="0+" 1849 ENDCASE 1850 EXEC CALC(4,TAL4$,SALDO$,TAL4$) 1860 IF KM<>E THEN FUKODE$="0" 1870 IF SI<>B AND ORD(FUKODE$)-48<E THEN 1880 F=F+E 1890 PUT K64$,F:TAB1(I,E),DATO,-E,TKO$,SALDO$,1000000 1900 EXEC FEJL(G,21,K64$) 1910 ENDIF 1920 NEXT I 1930 IF TAB1(I-E*(I=5),E)=1000000 THEN EXIT 1940 NEXT J 1950 CLOSE K63$ 1960 EXEC FEJL(G,22,K63$) 1970 CLOSE K64$ 1980 EXEC FEJL(G,23,K64$) 1990 ENDPROC 2000 K1$="P641220:SYSTEM1" 2010 OPEN K1$,R 2020 EXEC FEJL(W,E,K1$) 2030 GET K1$,E:MFANTAL,MDANTAL,MKANTAL 2040 EXEC FEJL(W,G,K1$) 2050 GET K1$,V:MDMID,MKMID,MFPOST,MDPOST 2060 EXEC FEJL(W,V,K1$) 2070 GET K1$,4:MKPOST 2080 EXEC FEJL(W,4,K1$) 2082 GET K1$,W:KRTAL,VTAL,MEANTAL,MUNKANT 2084 EXEC FEJL(99,E,K1$) 2090 GET K1$,10:N$ 2100 EXEC FEJL(W,5,K1$) 2110 GET K1$,11:K8$ 2120 EXEC FEJL(10,E,K1$) 2130 GET K1$,12:K4$ 2140 EXEC FEJL(10,G,K1$) 2150 GET K1$,13:K12$ 2160 EXEC FEJL(10,V,K1$) 2170 GET K1$,15:K9$ 2180 EXEC FEJL(10,4,K1$) 2190 GET K1$,16:K5$ 2200 EXEC FEJL(10,5,K1$) 2210 GET K1$,17:K13$ 2220 EXEC FEJL(10,6,K1$) 2230 GET K1$,25:K7$ 2240 EXEC FEJL(10,7,K1$) 2250 GET K1$,26:K3$ 2260 EXEC FEJL(10,8,K1$) 2270 GET K1$,27:K11$ 2280 EXEC FEJL(10,W,K1$) 2290 GET K1$,32:K10$ 2300 EXEC FEJL(10,10,K1$) 2310 GET K1$,33:K6$ 2320 EXEC FEJL(10,11,K1$) 2330 GET K1$,34:K14$ 2340 EXEC FEJL(10,12,K1$) 2350 GET K1$,36:K2$ 2360 EXEC FEJL(10,13,K1$) 2361 GET K1$,37:K15$ 2362 EXEC FEJL(99,G,K1$) 2363 GET K1$,38:K16$ 2364 EXEC FEJL(99,V,K1$) 2365 GET K1$,41:K17$ 2366 EXEC FEJL(99,4,K1$) 2367 GET K1$,42:K18$ 2368 EXEC FEJL(99,5,K1$) 2369 GET K1$,43:METOT,MEMID,MEPOST 2370 EXEC FEJL(99,6,K1$) 2375 CLOSE K1$ 2380 EXEC FEJL(W,6,K1$) 2390 K1$=N$+K2$ 2400 OPEN K1$,R 2410 EXEC FEJL(W,7,K1$) 2420 GET K1$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),DATO 2430 EXEC FEJL(W,8,K1$) 2440 GET K1$,13:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W) 2450 EXEC FEJL(W,W,K1$) 2460 GET K1$,17:T2(E),T2(G),T2(V),T2(4),T2(5),T2(6),T2(7),T2(8),T2(W) 2470 EXEC FEJL(W,10,K1$) 2472 GET K1$,21:T3(E),T3(G),T3(V),T3(4),T3(5),T3(6),T3(7),T3(8),T3(W) 2474 EXEC FEJL(99,25,K1$) 2480 CLOSE K1$ 2490 EXEC FEJL(W,11,K1$) 2500 DIM HDTAB(MDPOST DIV 40,G),HFTAB(MFPOST DIV 40,G),UDTAB(4,G),UFTAB(4,G) 2510 DIM DTAB(4,G),FTAB(4,G),KTAB(4,G),HKRTAB(MKPOST DIV 40,G),UKRTAB(4,G) 2515 DIM HETAB(MEPOST DIV 40,G),UETAB(4,G),ETAB(4,G) 2520 TAL4$="0+" 2530 OUTPUT T 2540 K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$;K6$=N$+K6$;K7$=N$+K7$;K8$=N$+K8$ 2550 K9$=N$+K9$;K10$=N$+K10$;K11$=N$+K11$;K12$=N$+K12$;K13$=N$+K13$ 2560 K14$=N$+K14$;K15$=N$+K15$;K16$=N$+K16$;K17$=N$+K17$;K18$=N$+K18$ 2570 EXEC PINIT(K3$,MDPOST,100000) 2580 EXEC KINIT(K4$,K5$,K3$,DTAB,0,T1(6),MDANTAL) 2590 EXEC TABINIT(K3$,K6$,MDPOST,HDTAB,UDTAB) 2600 EXEC FSYSUD 2610 EXEC PINIT(K7$,MFPOST,100000) 2620 EXEC KINIT(K8$,K9$,K7$,FTAB,1,T1(5),MFANTAL) 2630 EXEC TABINIT(K7$,K10$,MFPOST,HFTAB,UFTAB) 2640 EXEC FSYSUD 2650 EXEC PINIT(K11$,MKPOST,100000) 2660 EXEC KINIT(K12$,K13$,K11$,KTAB,2,T1(7),MKANTAL) 2670 EXEC TABINIT(K11$,K14$,MKPOST,HKRTAB,UKRTAB) 2672 EXEC FSYSUD 2673 EXEC PINIT(K17$,MEPOST,1000000) 2674 EXEC KINIT(K16$,K15$,K17$,ETAB,3,T3(5),MEANTAL) 2675 EXEC TABINIT(K17$,K18$,MEPOST,HETAB,UETAB) 2680 T2(G)=V 2690 EXEC FSYSUD 2700 CLEAR 2750 CHAIN "P641210:ÅKOPI"