⟦fdc1b386e⟧

Text

0100 DIM BLANK$(25),TKO$(1),BEO$(12),TEO$(25),OP1$(12),OP2$(12),RES$(14)
0110 DIM DEBNAVN$(25),DSALDO1$(12),DSALDO2$(12),DSALDO3$(12),DSALDO4$(12)
0120 DIM DEBKGR$(2),DEBBY$(20),ÅRKØB$(12),MDNKØB$(12),SALDO$(12),FNAVN$(25)
0130 DIM FMKODE$(1),FMDEBET$(12),FMKREDIT$(12),FUKODE$(1),FÅDEBET$(12)
0140 DIM FÅKREDIT$(12),TAL4$(12),K1$(17),K2$(17),K3$(17),K4$(17),K5$(17)
0150 DIM K6$(17),K7$(17),K8$(17),K9$(17),K10$(17),N$(6),A$(2),DEBLK$(2)
0160 DIM KREBY$(20),KRELK$(1),KREGR$(1),KSALDO1$(12),KSALDO2$(12),T1(9),T2(9)
0170 DIM T3(9),T4(9)
0180 PROC FEJL(NR1,NR2,NR3)
0190 IF STATUS(NR3$)<>0 THEN 
0200 PRINT NR1,NR2,NR3$,STATUS(NR3$)
0210 STOP 
0220 ENDIF 
0230 ENDPROC 
0240 PROC FSYSUD(K12,T8,T9)
0250 OPEN K12$,W
0260 EXEC FEJL(6,1,K12$)
0270 PUT K12$,13:T8(1),T8(2),T8(3),T8(4),T8(5),T8(6),T8(7),T8(8),T8(9)
0280 EXEC FEJL(6,2,K12$)
0290 PUT K12$,17:T9(1),T9(2),T9(3),T9(4),T9(5),T9(6),T9(7),T9(8),T9(9)
0300 EXEC FEJL(6,3,K12$)
0310 CLOSE K12$
0320 EXEC FEJL(6,4,K12$)
0330 ENDPROC 
0340 PROC FGET2(K15,I3,N3,D3,BI3,TK3,BE3,TE3)
0350 GET K15$,I3:N3,D3,BI3,TK3$,BE3$
0360 EXEC FEJL(9,1,K15$)
0370 IF ORD(TK3$)-48>9 AND ORD(TK3$)-48<20 THEN 
0380 I3=I3+1
0390 GET K15$,I3:N3,TE3$
0400 EXEC FEJL(9,2,K15$)
0410 ELSE 
0420 TE3$=BLANK$
0430 ENDIF 
0440 ENDPROC 
0450 PROC FPUT2(K16,I4,N4,D4,BI4,TK4,BE4,TE4)
0460 PUT K16$,I4:N4,D4,BI4,TK4$,BE4$
0470 EXEC FEJL(10,1,K16$)
0480 IF ORD(TK4$)-48>9 AND ORD(TK4$)-48<20 THEN 
0490 I4=I4+1
0500 PUT K16$,I4:N4,TE4$
0510 EXEC FEJL(10,2,K16$)
0520 ENDIF 
0530 ENDPROC 
0540 PROC FKOPI(K19,K20,DPO4,DPO5)
0550 OPEN K19$,R
0560 EXEC FEJL(12,1,K19$)
0570 OPEN K20$,W
0580 EXEC FEJL(12,2,K20$)
0590 FOR I=1 TO DPO4
0600 J=I
0610 EXEC FGET2(K19$,I,NO,DO,BIO,TKO$,BEO$,TEO$)
0620 EXEC FPUT2(K20$,J,NO,DO,BIO,TKO$,BEO$,TEO$)
0630 NEXT I
0640 CLOSE K19$
0650 CLOSE K20$
0660 EXEC FEJL(12,3,K20$)
0670 DPO5=DPO4
0680 ENDPROC 
0690 PROC HOVIND(V1,MPOSTANTAL1,R)
0700 OPEN V1$,R
0710 EXEC FEJL(13,1,V1$)
0720 FOR I=1 TO MPOSTANTAL1 DIV 160
0730 J=(I-1)*4+1;J1=J+1;J2=J+2;J3=J+3
0740 GET V1$,I:R(J,1),R(J,2),R(J1,1),R(J1,2),R(J2,1),R(J2,2),R(J3,1),R(J3,2)
0750 EXEC FEJL(13,2,V1$)
0760 NEXT I
0770 CLOSE V1$
0780 EXEC FEJL(13,3,V1$)
0790 ENDPROC 
0800 PROC UNDIND(V2,U1,Z)
0810 OPEN V2$,R
0820 EXEC FEJL(14,1,V2$)
0830 GET V2$,U1:Z(1,1),Z(1,2),Z(2,1),Z(2,2),Z(3,1),Z(3,2),Z(4,1),Z(4,2)
0840 EXEC FEJL(14,2,V2$)
0850 CLOSE V2$
0860 EXEC FEJL(14,3,V2$)
0870 ENDPROC ;UNDIND
0880 PROC TABINIT(K31,K32,MPOSTANTAL3,HTAB2,UTAB2)
0890 OPEN K31$,R
0900 EXEC FEJL(15,1,K31$)
0910 OPEN K32$,W
0920 EXEC FEJL(15,2,K32$)
0930 H=1
0940 FOR I=1 TO MPOSTANTAL3 DIV 40
0950 GET K31$,H:KONR
0960 EXEC FEJL(15,3,K31$)
0970 HTAB2(I,1)=KONR
0980 FOR J=1 TO 4
0990 GET K31$,H:KONR
1000 EXEC FEJL(15,4,K31$)
1010 UTAB2(J,1)=KONR
1020 H=H+9
1030 GET K31$,H:KONR
1040 EXEC FEJL(15,5,K31$)
1050 UTAB2(J,2)=KONR
1060 H=H+1
1070 NEXT J
1080 HTAB2(I,2)=KONR
1090 K=I+MPOSTANTAL3 DIV 160
1100 EXEC UNDUD(K32$,K,UTAB2)
1110 NEXT I
1120 EXEC HOVUD(K32$,MPOSTANTAL3,HTAB2)
1130 CLOSE K31$
1140 EXEC FEJL(15,6,K31$)
1150 CLOSE K32$
1160 EXEC FEJL(15,7,K32$)
1170 ENDPROC ;TABINIT
1180 PROC UNDUD(V3,U2,T)
1190 PUT V3$,U2:T(1,1),T(1,2),T(2,1),T(2,2),T(3,1),T(3,2),T(4,1),T(4,2)
1200 EXEC FEJL(16,1,V3$)
1210 ENDPROC ;UNDUD
1220 PROC HOVUD(V4,MPOSTANTAL4,S)
1230 FOR I=1 TO MPOSTANTAL4 DIV 160
1240 J=(I-1)*4+1;J1=J+1;J2=J+2;J3=J+3
1250 PUT V4$,I:S(J,1),S(J,2),S(J1,1),S(J1,2),S(J2,1),S(J2,2),S(J3,1),S(J3,2)
1260 EXEC FEJL(17,2,V4$)
1270 NEXT I
1280 ENDPROC 
1290 PROC CALC(ART,AB,AC,ES)
1300 OP1$=AB$;OP2$=AC$;RES$=ES$;SI=0;FLAG=0
1310 CALL "P641210:REGN"
1320 ES$=RES$
1330 IF FLAG<>0 THEN STOP 
1340 ENDPROC 
1350 PROC PINIT(K61,MPOSTANTAL8)
1360 OPEN K61$,W
1370 EXEC FEJL(1,1,K61$)
1380 FOR I=1 TO MPOSTANTAL8
1390 PUT K61$,I:100000
1400 EXEC FEJL(1,2,K61$)
1410 NEXT I
1420 CLOSE K61$
1430 EXEC FEJL(1,3,K61$)
1440 ENDPROC 
1450 PROC KINIT(K62,K63,K64,TAB1,KM,F,MANTAL)
1460 F=0;TKO$=CHR(26+48)
1470 OPEN K63$,W
1480 EXEC FEJL(2,1,K63$)
1490 OPEN K64$,W
1500 EXEC FEJL(2,22,K64$)
1510 FOR J=1 TO MANTAL DIV 4
1520 K=J+MANTAL DIV 32
1530 EXEC UNDIND(K62$,K,TAB1)
1540 FOR I=1 TO 4
1550 IF TAB1(I,1)=1000000 THEN EXIT 
1560 X=TAB1(I,2)
1570 CASE KM OF 
1580 GET K63$,X:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
1590 EXEC FEJL(2,2,K63$)
1600 IF DEBNR<>TAB1(I,1) THEN STOP 
1610 GET K63$,X+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$
1620 EXEC FEJL(2,3,K63$)
1630 GET K63$,X+3:DEBBY$,ÅRKØB$,MDNKØB$
1640 EXEC FEJL(2,4,K63$)
1650 EXEC CALC(0,DSALDO3$,DSALDO4$,SALDO$)
1660 DSALDO4$=SALDO$
1670 EXEC CALC(0,SALDO$,DSALDO2$,SALDO$)
1680 DSALDO3$=DSALDO2$
1690 EXEC CALC(0,SALDO$,DSALDO1$,SALDO$)
1700 DSALDO2$=DSALDO1$
1710 DSALDO1$="0+"
1720 MDNKØB$="0+"
1730 PUT K63$,X:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
1740 EXEC FEJL(2,5,K63$)
1750 PUT K63$,X+1:DSALDO2$,DSALDO3$,DSALDO4$,DEBPOSTNR,DEBLK$
1760 EXEC FEJL(2,6,K63$)
1770 PUT K63$,X+3:DEBBY$,ÅRKØB$,MDNKØB$
1780 EXEC FEJL(2,7,K63$)
1790 WHEN 1
1800 GET K63$,X+1:FMKODE$,FMDEBET$,FMKREDIT$
1810 EXEC FEJL(2,14,K63$)
1820 GET K63$,X+2:FUKODE$,FÅDEBET$,FÅKREDIT$
1830 EXEC FEJL(2,15,K63$)
1840 EXEC CALC(0,FÅDEBET$,FÅKREDIT$,SALDO$)
1850 FMDEBET$="0+"
1860 FMKREDIT$="0+"
1870 PUT K63$,X+1:FMKODE$,FMDEBET$,FMKREDIT$
1880 EXEC FEJL(2,17,K63$)
1890 PUT K63$,X+2:FUKODE$,FÅDEBET$,FÅKREDIT$
1900 EXEC FEJL(2,18,K63$)
1910 WHEN 2
1920 GET K63$,X+1:KREBY$,KRELK$,KREGR$,KREPOSTNR,KSALDO1$,KSALDO2$
1930 EXEC FEJL(2,20,K63$)
1940 EXEC CALC(0,KSALDO1$,KSALDO2$,SALDO$)
1950 KSALDO2$=SALDO$;KSALDO1$="0+"
1960 PUT K63$,X+1:KREBY$,KRELK$,KREGR$,KREPOSTNR,KSALDO1$,KSALDO2$
1970 EXEC FEJL(2,21,K63$)
1980 ENDCASE 
1990 EXEC CALC(4,TAL4$,SALDO$,TAL4$)
2000 IF KM<>1 THEN FUKODE$="0"
2010 IF SI<>0 AND ORD(FUKODE$)-48<1 THEN 
2020 F=F+1
2030 PUT K64$,F:TAB1(I,1),DATO,-1,TKO$,SALDO$
2040 EXEC FEJL(2,21,K64$)
2050 ENDIF 
2060 NEXT I
2070 IF TAB1(I-1*(I=5),1)=1000000 THEN EXIT 
2080 NEXT J
2090 CLOSE K63$
2100 EXEC FEJL(2,22,K63$)
2110 CLOSE K64$
2120 EXEC FEJL(2,23,K64$)
2130 ENDPROC 
2140 K1$="P641220:SYSTEM1"
2150 OPEN K1$,R
2160 EXEC FEJL(9,1,K1$)
2170 GET K1$,1:MFANTAL,MDANTAL,MKANTAL
2180 EXEC FEJL(9,2,K1$)
2190 GET K1$,3:MDMID,MKMID,MFPOST,MDPOST
2200 EXEC FEJL(9,3,K1$)
2210 GET K1$,4:MKPOST
2220 EXEC FEJL(9,4,K1$)
2230 GET K1$,10:N$
2240 EXEC FEJL(9,5,K1$)
2250 CLOSE K1$
2260 EXEC FEJL(9,6,K1$)
2270 K1$=N$+"20:SYSTEM2"
2280 OPEN K1$,R
2290 EXEC FEJL(9,7,K1$)
2300 GET K1$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),DATO
2310 EXEC FEJL(9,8,K1$)
2320 GET K1$,13:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
2330 EXEC FEJL(9,9,K1$)
2340 GET K1$,17:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
2350 EXEC FEJL(9,10,K1$)
2360 CLOSE K1$
2370 EXEC FEJL(9,11,K1$)
2380 DIM HDTAB(MDPOST DIV 40,2),HFTAB(MFPOST DIV 40,2),UDTAB(4,2),UFTAB(4,2)
2390 DIM DTAB(4,2),FTAB(4,2),KTAB(4,2),HKRTAB(MKPOST DIV 40,2),UKRTAB(4,2)
2400 TAL4$="0+"
2410 IF T2(2)=0 THEN 
2420 T2(2)=1
2430 EXEC FSYSUD(K1$,T1,T2)
2440 CHAIN "P641210:KSP1"
2450 ELSE 
2460 OUTPUT T
2470 CLEAR 
2480 K2$=N$+"22:SYSTEM22"
2490 REPEAT 
2500 OPEN K2$,R
2510 IF STATUS(K2$)=0 THEN EXIT 
2520 CURSOR 25,13
2530 INPUT "Isæt plade nr. 22 og tast RETURN",A$
2540 UNTIL STATUS(K2$)=0
2550 GET K2$,13:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
2560 EXEC FEJL(9,12,K2$)
2570 GET K2$,17:T4(1),T4(2),T4(3),T4(4),T4(5),T4(6),T4(7),T4(8),T4(9)
2580 EXEC FEJL(9,13,K2$)
2590 CLOSE K2$
2600 EXEC FEJL(9,14,K2$)
2610 K3$=N$+"20:DPOST"
2620 K4$=N$+"22:DPOST2"
2630 K5$=N$+"22:HDTAB2"
2640 K7$=N$+"20:DEBTAB"
2650 K8$=N$+"20:DEBPOST"
2660 K9$=N$+"20:HDTAB"
2670 EXEC PINIT(K4$,MDPOST)
2680 EXEC FKOPI(K3$,K4$,T1(6),T3(6))
2690 EXEC TABINIT(K4$,K5$,MDPOST,HDTAB,UDTAB)
2700 EXEC FSYSUD(K2$,T3,T4)
2710 EXEC PINIT(K3$,MDPOST)
2720 EXEC KINIT(K7$,K8$,K3$,DTAB,0,T1(6),MDANTAL)
2730 EXEC TABINIT(K3$,K9$,MDPOST,HDTAB,UDTAB)
2740 EXEC FSYSUD(K1$,T1,T2)
2750 K3$=N$+"20:FPOST"
2760 K4$=N$+"22:FPOST2"
2770 K5$=N$+"22:HFTAB2"
2780 K7$=N$+"20:FINTAB"
2790 K8$=N$+"20:FINPOST"
2800 K9$=N$+"20:HFTAB"
2810 EXEC PINIT(K4$,MFPOST)
2820 EXEC FKOPI(K3$,K4$,T1(5),T3(5))
2830 EXEC TABINIT(K4$,K5$,MFPOST,HFTAB,UFTAB)
2840 EXEC FSYSUD(K2$,T3,T4)
2850 EXEC PINIT(K3$,MFPOST)
2860 EXEC KINIT(K7$,K8$,K3$,FTAB,1,T1(5),MFANTAL)
2870 EXEC TABINIT(K3$,K9$,MFPOST,HFTAB,UFTAB)
2880 EXEC FSYSUD(K1$,T1,T2)
2890 K3$=N$+"20:KRPOST"
2900 K4$=N$+"22:KRPOST2"
2910 K5$=N$+"22:HKRTAB2"
2920 K7$=N$+"20:KRETAB"
2930 K8$=N$+"20:KREPOST"
2940 K9$=N$+"20:HKRTAB"
2950 EXEC PINIT(K4$,MKPOST)
2960 EXEC FKOPI(K3$,K4$,T1(7),T3(7))
2970 EXEC TABINIT(K4$,K5$,MKPOST,HKRTAB,UKRTAB)
2980 EXEC FSYSUD(K2$,T3,T4)
2990 EXEC PINIT(K3$,MKPOST)
3000 EXEC KINIT(K7$,K8$,K3$,KTAB,2,T1(7),MKANTAL)
3010 EXEC TABINIT(K3$,K9$,MKPOST,HKRTAB,UKRTAB)
3020 T2(2)=0
3030 EXEC FSYSUD(K1$,T1,T2)
3040 CLEAR 
3050 REPEAT 
3060 CURSOR 30,13
3070 INPUT "Isæt plade nr. 10 , tast RETURN",A$
3080 UNTIL ORD(A$)=255
3090 CHAIN "P641210:OPSTART"
3100 ENDIF 
3110 END
DataMuseum.dk

MIKADOS

⟦fdc1b386e⟧

Derivation

Text
