|
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 - metrics - download
Length: 7584 (0x1da0)
Types: SPC/1-COMAL-BCD
Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_01, UNKNOWN_TOKEN_02, UNKNOWN_TOKEN_03, UNKNOWN_TOKEN_04, UNKNOWN_TOKEN_05, UNKNOWN_TOKEN_06, UNKNOWN_TOKEN_08, UNKNOWN_TOKEN_11, UNKNOWN_TOKEN_12, UNKNOWN_TOKEN_14, UNKNOWN_TOKEN_18, UNKNOWN_TOKEN_19, UNKNOWN_TOKEN_80, UNKNOWN_TOKEN_d0, UNKNOWN_TOKEN_f4
Names: »DEBVEDL«
└─⟦ec8c1e0b0⟧ Bits:30007442 8" floppy ( MIKPROG vol. 1-3, MIKREL vol. 1-3, PCSE 4.7.80 vol 1-3, GL.SYS )
└─⟦this⟧ »DEBVEDL«
8701 ╱00╱ DIM K1 $ ( 17 ) , K2 $ ( 17 ) , DEBNAVN $ ( 25 ) , DSALDO1 $ ( 12 ) , DEBKGR $ ( 1 ╱80╱ ╱01╱ ) , UD2 $ ( 14 ) , A $ ( 1 ) 0110 DIM DSALDO2 $ ( 12 ) , DSALDO3 $ ( 12 ) , DSALDMMO4 $ ( 12 ) , DEBLK $ ( 1 ) , DEBGADE $ ( 25 ) , N $ ( 6 ) 0120 DIM T2 ( 9 ) , BLANMMK $ ( 77 ) , TAL4 $ ( 14 ) , TAH $ ( 12 ) , DEBTLF $ ( 9 ) , DEBBY $ ( 20 ) , VTABMM2 ( 5 ) 0130 DIM RES $ ( 14 ) , ]RK\B $ ( 12 ) , MDNK\B $ ( 12 ) , DSALDI $ ( 12MM ) , LK $ ( 3 ) , KG $ ( 3 ) , KTN $ ( 6 ) 0140 DIM PNR $ ( 6 ) , TY $ ( 1 ) , OP1 $ ( 12 TAN ╱04╱ ) , OP2 $ ( 12 ) , TA $ ( 12 ) , TB $ ( 14 ) , T]RK\B $ ( 12 ) , DAT $ ( 8 ) 4d89 ╱01╱ P DIM DEBGADE1 $ ( 25 ) , DEBTLF1 $ ( 9 ) , BLB2 $ ( 12 ) , UBLB2 $ ( 14 ) , UD1 $ ( 1MM4 ) , STREG $ ( 71 ) 0160 DIM UD3 $ ( 14 ) , UD4 $ ( 14 ) , K3 $ ( 17 ) , K4 $ ( 17 DEF ╱05╱ ) , K5 $ ( 17 ) , K6 $ ( 17 ) , T1 ( 9 ) , LAND $ ( 9 , 12 ) 0170 PROC CALC ( ARMMT , B1 , B2 , ES ) 0180 OP1 $ = B1 $ ; OP2 $ = B2 $ ; RES $ = ES $ ; SI = 0 ; FLAG = 0 0190 CALL "P641MM210:REGN" 0200 ES $ = RES $ 0210 IF FLAG THEN STOP 0220 ENDPROC 0230 PROC FEJL ( NR1 , NR2 , NR3 ) 0240 IF STATUS ( NR3 $ ) >< MM0 THEN 0250 PRINT STATUS ( NR3 $ ) , NR1 , NR2 , NR3 $ 0260 STOP 0270 ENDIF 0280 ENDPROC 0290 PROC INDTAB ( T , MANTAL , K10 ) MM 0300 J = MANTAL DIV 32 + 1 0310 FOR I = J TO MANTAL DIV 4 + J - 1 0320 H = ( I - J ) * 4 ╱80╱ ╱03╱ + 1 ; J2 = H + 1 ; J3 = H + 2 ; J4 = H + 3 0330 GET K10 $ , I : T ( H , 1 ) , T ( H , 2 ╱80╱ ╱02╱ ) , T ( J2 , 1 ) , T ( J2 , 2 ) , T ( J3 , 1 ) , T ( J3 , 2 ) , T ( J4 , 1 ) , T ( J4 , 2 ╱80╱ ╱02╱ ) 0340 EXEC FEJL ( 1 , 1 , K10 $ ) 0350 NEXT I 0360 ENDPROC 0370 PROC UDTAB ( U , MANTAL1 , K9 ) 034d M ╱80╱ J = MANTAL1 DIV 32 + 1 0390 FOR I = 1 TO J - 1 0400 H = ( I - 1 ) * 32 + 1 ╱80╱ ╱01╱ ; J1 = H + 4 ; J2 = H + 8 ; J3 = H + 12 ; J4 = H + 16 ; J5 = H + 20 ; J6 = H + 24 TAN ╱05╱ ; J7 = H + 28 0410 PUT K9 $ , I : U ( H , 1 ) , U ( J1 , 1 ) , U ( J2 , 1 ) , U ( J3 , 1 ) MM , U ( J4 , 1 ) , U ( J5 , 1 ) , U ( J6 , 1 ) , U ( J7 , 1 ) 0420 EXEC FEJL ( 2 , 1 , MMK9 $ ) 0430 NEXT I 0440 FOR I = J TO MANTAL1 DIV 4 + J - 1 0450 H = ( I - J ) * 4 + 1 ; J1 = H + 1MM ; J2 = H + 2 ; J3 = H + 3 0460 PUT K9 $ , I : U ( H , 1 ) , U ( H , 2 ) , U ( J1 , 1 ) MM , U ( J1 , 2 ) , U ( J2 , 1 ) , U ( J2 , 2 ) , U ( J3 , 1 ) , U ( J3 , 2 ) 0470 EXEC FEJL ( 2MM , 2 , K9 $ ) 0480 NEXT I 0490 ENDPROC 0500 PROC FINDPOST ( TAB1 , MANT1 , N\GL1 , PIL3 ) 0510 PIL1 = MMMANT1 DIV 2 ; PIL3 = PIL1 ; CEKS = 1 0520 REPEAT 0530 IF N\GL1 = TAB1 ( PIL3 , 1 ) THEN 0540 CEMMKS = 0 0550 ELSE 0560 IF PIL1 = 1 THEN PIL1 = 0 0570 PIL1 = INT ( ( PIL1 + 1 ) / 2 ) MM 0580 IF N\GL1 > TAB1 ( PIL3 , 1 ) THEN 0590 PIL3 = PIL3 + PIL1 0600 ELSE 0610 PIL3 = PIL3 - PIL1 4d4d ╱06╱ … ENDIF 0630 IF PIL3 < 1 THEN PIL3 = 1 0640 IF PIL3 > MANT1 THEN PIL3 = MANT1 0650 ENDIF 0660 UNTIL CEKS = 0MM OR PIL1 = 0 0670 ENDPROC 0680 PROC SLETDPOST ( N\GLE3 ) 0690 EXEC FINDPOST ( DTAB , MDANTAL , N\GMMLE3 , DPIL3 ) 0700 IF CEKS = 1 THEN STOP 0710 DEBNR = 0 0720 DEBNAVN $ = BLANK $ ( 1 : 25 SGN ╱05╱ ) 0730 DSALDO1 $ = BLANK $ ( 1 : 12 ) 0740 DSALDO2 $ = BLANK $ ( 1 : 12 ) MM 0750 DSALDO3 $ = BLANK $ ( 1 : 12 ) 0760 DSALDO4 $ = BLANK $ ( 1 : 12 ) 0770 MM]RK\B $ = BLANK $ ( 1 : 12 ) 0780 MDNK\B $ = BLANK $ ( 1 : 12 ) 0790 DEBKGR $ = MM"0" 0800 DEBPOSTNR = 0 0810 DEBLK $ = "0" 0820 DEBGADE $ = BLANK $ ( 1 : 25 ) 4d91 ╱08╱ 0DEBTLF $ = BLANK $ ( 1 : 9 ) 0840 HPOST = 0 0850 HKUNDE = 0 0860 DEBBYMM $ = BLANK $ ( 1 : 20 ) 0870 EXEC GEMDPOST 0880 EXEC SLETPOST ( DTAB , ADEB , N\GLE3 , DPIL3 ) 7492 ╱08╱ RESTORE ENDPROC 0900 PROC INDS[T ( TAB2 , ANTAL2 , N\GL2 , PIL4 ) 0910 IF CEKS = 1 THEN 0920 POSTNR = TAB2 ( AMMNTAL2 + 1 , 2 ) 0930 IF N\GL2 > TAB2 ( PIL4 , 1 ) AND TAB2 ( PIL4 , 1 ) >< 1000000 ╱f4╱ ╱14╱ THEN PIL4 = PIL4 + 1 0940 FOR J = ANTAL2 + 1 TO PIL4 + 1 STEP - 1 0950 TAB2 ( J , 1 ╱80╱ ╱01╱ ) = TAB2 ( J - 1 , 1 ) 0960 TAB2 ( J , 2 ) = TAB2 ( J - 1 , 2 ) 0970 NEXT J 094d M ╱80╱ TAB2 ( PIL4 , 1 ) = N\GL2 0990 TAB2 ( PIL4 , 2 ) = POSTNR 1000 ANTAL2 = ANTAL2 + 1M ╱01╱ 1010 ENDIF 1020 ENDPROC 1030 PROC SLETPOST ( TAB3 , ANTAL3 , N\GL3 , PIL5 ) 1040 IF CEKS = 0 THEN 1050 POSMMTNR = TAB3 ( PIL5 , 2 ) 1060 FOR I = PIL5 TO ANTAL3 1070 TAB3 ( I , 1 ) = TAB3 ( I + 1 , 1 ╱80╱ ╱01╱ ) 1080 TAB3 ( I , 2 ) = TAB3 ( I + 1 , 2 ) 1090 NEXT I 1100 TAB3 ( ANTAL3 , 1 ) = MM1000000 1110 TAB3 ( ANTAL3 , 2 ) = POSTNR 1120 ANTAL3 = ANTAL3 - 1 1130 ENDIF 4d4d ╱11╱ @ ENDPROC 1150 PROC HENTDPOST 1160 S = DTAB ( DPIL3 , 2 ) 1170 GET K3 $ , S : DEBNR , DEBNAVN $ , DSALDO1MM $ , DEBKGR $ 1180 EXEC FEJL ( 8 , 2 , K3 $ ) 1190 IF DEBNR >< DTAB ( DPIL3 , 1 ) THEN STOP 1200 GET KMM3 $ , S + 1 : DSALDO2 $ , DSALDO3 $ , DSALDO4 $ , DEBPOSTNR , DEBLK $ 1210 EXEC FEJL ( 8 , 3 TAN ╱02╱ , K3 $ ) 1220 GET K3 $ , S + 2 : DEBGADE $ , DEBTLF $ , HPOST , HKUNDE 1230 EXEC FEJL ( 8 , 4 ╱80╱ ╱03╱ , K3 $ ) 1240 GET K3 $ , S + 3 : DEBBY $ , ]RK\B $ , MDNK\B $ 1250 EXEC FEJL ( 8 , 5 , K3 $ ) aa96 ╱12╱ ` ENDPROC 1270 PROC GEMDPOST 1280 S = DTAB ( DPIL3 , 2 ) 1290 PUT K3 $ , S : DEBNR , DEBNAVN $ , DSALDOMM1 $ , DEBKGR $ 1300 EXEC FEJL ( 9 , 3 , K3 $ ) 1310 PUT K3 $ , S + 1 : DSALDO2 $ , DSALDO3 $ , DMMSALDO4 $ , DEBPOSTNR , DEBLK $ 1320 EXEC FEJL ( 9 , 4 , K3 $ ) 1330 PUT K3 $ , S + 2 : DEBGAMMDE $ , DEBTLF $ , HPOST , HKUNDE 1340 EXEC FEJL ( 9 , 4 , K3 $ ) 1350 PUT K3 $ , S + 3 : DEBBYMM $ , ]RK\B $ , MDNK\B $ 1360 EXEC FEJL ( 9 , 5 , K3 $ ) 1370 ENDPROC 1380 PROC DINDTAST ( DSTYR , C[ND , MMDEBNR2 ) 1390 IF C[ND >< 1 THEN 1400 CLEAR 1410 CURSOR 21 , 1 1420 PRINT "Kundeoplysninger" 4d98 ╱14╱ 0 EXEC OVERSKRIFT 1440 CURSOR 2 , 3 1450 PRINT "1:Kundenr………:" ; DEBNR2 1460 ENDIF 1470 REPEAT 144d M ╱80╱ CASE DSTYR OF 1490 STOP 1500 WHEN 2 1510 IF C[ND >< 1 THEN 1520 CURSOR 2 , 4 1530 PRINT "2:NavMMn………………:" 1540 DSTYR = 3 1550 ENDIF 1560 IF C[ND >< 2 THEN 1570 CURSOR 3 , 23 1580 PRINT "MMNavn" ; BLANK $ ( 1 : 33 ) ; "(max…25…tegn)" ; BLANK $ ( 1 : 26 ) 1590 CURSOR 13 ╱d0╱ ╱04╱ , 23 1600 INPUT DEBNAVN $ 1610 ENDIF 1620 CURSOR 16 , 4 1630 PRINT BLANK $ ( 1 : 25M ╱05╱ ) 1640 CURSOR 16 , 4 1650 PRINT DEBNAVN $ 1660 WHEN 3 1670 IF C[ND >< 1 THEN 1680 CURSOR 2 ╱80╱ ╱02╱ , 5 1690 PRINT "3:Gade………………:" 1700 DSTYR = 4 1710 ENDIF 1720 IF C[ND >< 2 THEN 1730 CURSOR MM3 , 23 1740 PRINT "Gade" ; BLANK $ ( 1 : 33 ) ; "(max…25…tegn)" ; BLANK $ ( 1 ╱80╱ ╱01╱ : 26 ) 1750 CURSOR 13 , 23 1760 INPUT DEBGADE $ 1770 ENDIF 1780 CURSOR 16 , 5 1790 MM PRINT BLANK $ ( 1 : 25 ) 1800 CURSOR 16 , 5 1810 PRINT DEBGADE $ 1820 WHEN 4 1830 IF CMM[ND >< 1 THEN 1840 CURSOR 2 , 6 1850 PRINT "4:Postnr…………:" 1860 DSTYR = 5 1870 ENDIF 4d4d ╱18╱ ╱80╱ IF C[ND >< 2 THEN 1890 REPEAT 1900 CURSOR 3 , 23 1910 PRINT "Postnr" ; BLANK $ ( 1 : 12MM ) ; "(max…6…tegn)" ; BLANK $ ( 1 : 45 ) 1920 CURSOR 13 , 23 1930 INPUT PNR $ 1940 EXEC NMMRTEST ( PNR $ ) 1950 UNTIL ( ( L > 3 AND L < 7 ) OR ( P = - 1 AND C[ND = 1 ) ) AND TEST2 = 0 4d9c ╱19╱ ` IF P >< - 1 THEN DEBPOSTNR = P 1970 ENDIF 1980 CURSOR 16 , 6 1990 PRINT BLANK $ ( 1 : 6MM ) 2000 CURSOR 16 , 6 2010 PRINT DEBPOSTNR 2020 WHEN 5 2030 IF C[ND >< 1 THEN 2040 CURSOR 2 ╱80╱ ╱02╱ , 7 2050 PRINT "5:By……………………:" 2060 DSTYR = 6 2070 ENDIF 2080 IF C[ND >< 2 THEN 2090 CURSOR MM3 , 23 2100 PRINT "By" ; BLANK $ ( 1 : 30 ) ; "(max…20…tegn)" ; BLANK $ ( 1MM : 31 ) 2110 CURSOR 13 , 23 2120 INPUT DEBBY $ 2130 ENDIF 2140 CURSOR 16 , 7 2150 PRINT BLAMMNK $ ( 1 : 20 ) 2160 CURSOR 16 , 7 2170 PRINT DEBBY $ 2180 WHEN 6 2190 IF C[ND >< 1 ╱80╱ ╱01╱ THEN 2200 CURSOR 2 , 8 2210 PRINT "6:Landekode…:……………Land:" 2220 DSTYR = 7 2230 MM ENDIF 2240 IF C[ND >< 2 THEN 2250 REPEAT 2260 CURSOR 3 , 23 2270 PRINT "Landekode" ; BLANK $ ( 1 : MM9 ) ; "0:for…Danmark,max…2…cifre)" ; BLANK $ ( 1 : 30 ) 2280 CURSOR 13 , 23 STEP ╱05╱ 2290 INPUT LK $ 2300 EXEC NRTEST ( LK $ ) 2310 UNTIL ( P > - 1 AND P < 10 AND TEST2 = 0 ) OR ( P = - 1 ╱80╱ ╱01╱ AND C[ND = 1 ) 2320 ENDIF 2330 CURSOR 16 , 8 2340 PRINT BLANK $ ( 1 : 3 ) 2350 CURSOR 27MM , 8 2360 PRINT BLANK $ ( 1 : 15 ) 2370 CURSOR 16 , 8 2380 IF P < 10 AND CMM[ND >< 2 THEN 2390 DEBLK $ = CHR ( P + 48 ) 2400 ENDIF 2410 P = ORD ( DEBLK $ ) - 48 2420 PRINT USING "###"MM : P 2430 CURSOR 27 , 8 2440 IF P = 0 THEN 2450 PRINT "Danmark" 2460 ELSE 2470 PRINT LAND $ ( P ) 2480 MM ENDIF 2490 WHEN 7 2500 IF C[ND >< 1 THEN 2510 CURSOR 2 , 9 2520 PRINT "7:Telefon………:" 2530 MMDSTYR = 8 2540 ENDIF 2550 IF C[ND >< 2 THEN 2560 CURSOR 3 , 23 2570 PRINT "Telefon" ; BLANKMM $ ( 1 : 14 ) ; "(max…9…tegn)" ; BLANK $ ( 1 : 44 ) 2580 CURSOR 13 , 23 d2a1 % RESTORE INPUT DEBTLF $ 2600 ENDIF 2610 CURSOR 16 , 9 2620 PRINT BLANK $ ( 1 : 9 ) 2630 CURSOR 16M ╱05╱ , 9 2640 PRINT DEBTLF $ 2650 WHEN 8 2660 IF C[ND >< 1 THEN 2670 CURSOR 2 , 10 2680 MM PRINT "8:Kundegr………:" 2690 DSTYR = 9 2700 ELSE 2710 IF TYPE = 2 THEN 2720 EXEC KS\G ( DEBNR2 , ORD ( MMDEBKGR $ ) - 48 ) 2730 EXEC KINDSLET ( 0 ) 2740 ENDIF 2750 ENDIF 2760 IF C[ND >< 2 THEN 2770 REPEAT 4da3 ' ╱80╱ CURSOR 3 , 23 2790 PRINT "Kundegr……………………(max…2…cifre)" ; BLANK $ ( 1 : 49 ) MM 2800 CURSOR 13 , 23 2810 INPUT KG $ 2820 EXEC NRTEST ( KG $ ) 2830 UNTIL ( P > 0 AND TEST2 = 0 AND PMM =< MKGR ) OR ( P = - 1 AND C[ND = 1 ) 2840 ENDIF 2850 CURSOR 16 , 10 2860 IF P > 0 AND C[ND >< Mccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc