DataMuseum.dk

top - download

    Length: 8004 (0x1f44)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
    Names: »FORSK85.B«

└─⟦fe8d363bb⟧ Bits:30004640 EASY-Skat 1985 (MIKADOS)
    └─⟦this⟧ »FORSK85.B« 

SPC/1 COMAL-80

0100 ON ESC GOTO DUMMY
0110 DIM HKL$ OF 38,BKL$ OF 38,BJ$ OF 4
0120 LET FSLUT := 0 ; HKL$ := "" ; BKL$ := "" ; ZH := 0 ; ZB := 0
0130 INTEGER F5,X,Y,PR,F8,FE,G,T0,T1,T2,T3,T4,RESTRATE,NYRATE
0140 DIM LI$ OF 80,QT$ OF 80,FIL$ OF 15,S$ OF 80,J$ OF 4,PIL$ OF 80,HJ$ OF 4
0150 // ---------------------- skatvar -----------------------------
0160 LET F5 := 1985 ; U1 := .9 ; P0 := 3.5 ; PA0 := 2 ; P2 := 182600
0170 // ------------------------------------------------------------
0180 LET T2 := 0 ; F8 := 0 ; T4 := 0 ; G := 0
0190 LET LI$ := "" ; PIL$ := ""
0200 FOR X := 1 TO 9 DO
0210 LET LI$ := LI$ + "-"
0220 LET PIL$ := PIL$ + "."
0230 NEXT X
0240 OPEN "dde:fvar",R
0250 GET "dde:fvar" : PR,C4,HD6,C9,B0,T1,TKH,F6,F1
0260 GET "dde:fvar" : F9,P1,P7,P8,P9,T0,B2,B1,B9
0270 GET "dde:fvar" : T2,C6,BD6,C0,B3,E6,F2,T3,TKB
0280 GET "dde:fvar" : F0,F7,SKG,AKT,D6,GSLUT
0290 GET "DDE:FVAR" : HFORMUE,BFORMUE,HATP,BATP,G,FSLUT
0300 GET "dde:fvar" : HKL$,BKL$
0310 CLOSE "dde:fvar"
0320 OPEN "DDE:FORSKVAR",R
0330 GET "DDE:FORSKVAR" : ZH,HJ$,HAIH,HASQ,HBSKF,F1
0340 GET "DDE:FORSKVAR" : ZB,BJ$,BAIH,BASQ,BBSKF,F2
0350 CLOSE "DDE:FORSKVAR"
0360 IF >< 1 AND FSLUT >< 1 THEN
0370 LET HBSKF := 0 ; BBSKF := 0
0380 PRINT "Skriv hovedpersonens indregnede restskat i " ; F5 - 2 ; "(evt. 0) " ;
0390 INPUT F1
0400 PRINT LI$
0410 IF 2 >< 0 THEN
0420 IF >< 1 AND FSLUT >< 1 THEN
0430 PRINT "Skriv den gifte kvindes indregnede restskat i " ; F5 - 2 ; "(evt. 0) " ;
0440 INPUT F2
0450 PRINT LI$
0460 ENDIF
0470 ENDIF
0480 ENDIF
0490 LET C7 := INT(C4 / 100) * 100
0500 LET D6 := HD6 ; D0 := C9 ; AI := B0 ; B6 := B9 ; IR := F1 ; TP := T1 ; TK := TKH ; D6 := D6 - F9 - F6
0510 EXEC REGN12
0520 IF = 1 AND FSLUT = 1 THEN
0530 LET Z := ZH ; J$ := HJ$ ; AIH := HAIH ; ASQ := HASQ ; BSKF := HBSKF
0540 ELSE
0550 CLEAR
0560 LET FIL$ := "dde:skatdath"
0570 OPEN FIL$,R
0580 EXEC LÆSFIL
0590 LET ZH := Z
0600 ENDIF
0610 IF > 0 THEN
0620 EXEC INDASKAT
0630 LET HJ$ := J$ ; HAIH := AIH ; HASQ := ASQ ; HBSKF := BSKF
0640 ENDIF
0650 IF I = 0 THEN
0660 EXEC REGN13
0670 ELSE
0680 IF 6 < 100 THEN
0690 EXEC REGN14
0700 ELSE
0710 IF T2 = 1 AND T0 = 2 AND B2 > 0 THEN LET D0 := AR ; C7 := INT(B1 / 100) * 100
0720 EXEC REGN15
0730 EXEC REGN16
0740 IF INT(FR) > 0 THEN EXEC REGN11
0750 ENDIF
0760 EXEC REGN17
0770 ENDIF
0780 LET QT$ := "FORSKUDSOPGØRELSE FOR " + HKL$ + ":"
0790 EXEC ÆNDFORS
0800 IF 2 >< 0 THEN
0810 LET C7 := INT(C6 / 100) * 100
0820 LET D6 := BD6 ; D0 := C0 ; AI := B3 ; B6 := E6 ; IR := F2 ; TP := T3 ; TK := TKB ; D6 := D6 - F0 - F7
0830 EXEC REGN12
0840 IF = 1 AND FSLUT = 1 THEN
0850 LET Z := ZB ; J$ := BJ$ ; AIH := BAIH ; ASQ := BASQ ; BSKF := BBSKF
0860 ELSE
0870 CLEAR
0880 LET FIL$ := "dde:skatdatb"
0890 OPEN FIL$,R
0900 EXEC LÆSFIL
0910 LET ZB := Z
0920 ENDIF
0930 IF > 0 THEN
0940 EXEC INDASKAT
0950 LET BJ$ := J$ ; BAIH := AIH ; BASQ := ASQ ; BBSKF := BSKF
0960 ENDIF
0970 IF I = 0 THEN
0980 EXEC REGN13
0990 ELSE
1000 IF 6 < 100 THEN
1010 EXEC REGN14
1020 ELSE
1030 IF T2 = 1 AND T0 = 1 AND B2 > 0 THEN LET D0 := AR ; C7 := INT(B1 / 100) * 100
1040 EXEC REGN15
1050 EXEC REGN16
1060 IF INT(FR) > 0 THEN EXEC REGN11
1070 ENDIF
1080 EXEC REGN17
1090 ENDIF
1100 LET QT$ := "FORSKUDSOPGØRELSE FOR " + BKL$ + ":"
1110 EXEC ÆNDFORS
1120 ENDIF
1130 LET SYS := 1
1140 OPEN "DDE:FORSKVAR",W
1150 PUT "DDE:FORSKVAR" : ZH,HJ$,HAIH,HASQ,HBSKF,F1
1160 PUT "DDE:FORSKVAR" : ZB,BJ$,BAIH,BASQ,BBSKF,F2
1170 CLOSE "DDE:FORSKVAR"
1180 OPEN "dde:skatsys",W
1190 PUT "dde:skatsys" : SYS
1200 CLOSE "dde:skatsys"
1210 PRINT "*** VENT *** HOVEDPROGRAMMET INDLÆSES ***"
1220 CHAIN "dde:skat85"
1230 PROC LSKRIV2
1240 LET PRB := QB
1250 PRINT QT$ ; TAB(35) ;
1260 PRINT USING "#########.## KR." : PRB
1270 ENDPROC LSKRIV2
1280 PROC LSKRIV1
1290 LET PRB := QB
1300 PRINT QT$ ; TAB(35) ;
1310 PRINT USING "######### KR." : PRB
1320 ENDPROC LSKRIV1
1330 PROC LSKRIV4
1340 LET PRB := QB
1350 PRINT QT$ ; TAB(35) ;
1360 PRINT USING "######### PCT." : PRB
1370 ENDPROC LSKRIV4
1380 PROC SVAR
1390 REPEAT
1400 INPUT S$
1410 IF S$ = "J" THEN LET S$ := "j"
1420 IF S$ = "N" THEN LET S$ := "n"
1430 IF $ = "Q" OR S$ = "q" THEN
1440 PRINT "Programmet kan kun afsluttes fra hovedprogrammet." ; CHR$ (7)
1450 ENDIF
1460 UNTIL S$ = "j" OR S$ = "n"
1470 PRINT LI$
1480 ENDPROC SVAR
1490 PROC LSKRIV
1500 PRINT
1510 ENDPROC LSKRIV
1520 PROC LSKRIV3
1530 PRINT QT$
1540 ENDPROC LSKRIV3
1550 PROC REGN12
1560 LET Z := 0 ; AIH := 0 ; ASQ := 0 ; PCT := 0 ; BSK := 0 ; MAX := 0 ; FR := 0 ; BSKF := 0 ; NYRATE := 1
1570 LET RESTRATE := 10
1580 ENDPROC REGN12
1590 PROC INDASKAT
1600 IF >< 1 AND FSLUT >< 1 THEN
1610 IF I >< 0 THEN
1620 INPUT "Skriv A-indkomst (løn) fra 1. januar til ændringsdato: " : AIH
1630 PRINT LI$
1640 INPUT "Skriv betalt A-skat fra 1. januar til ændringsdato: " : ASQ
1650 PRINT LI$
1660 ENDIF
1670 PRINT "Skriv forfalden B-skat til og med måned " ;
1680 PRINT ( ╱cc╱ (J$(3 : 1)) - 48) * 10 + ╱cc╱ (J$(4 : 1)) - 48 ;
1690 INPUT "(evt. 0):" : BSKF
1700 PRINT LI$
1710 ENDIF
1720 IF ╱cc╱ (J$(3 : 1)) - 48) * 10 + ╱cc╱ (J$(4 : 1)) - 48 =< 5 THEN
1730 LET NYRATE := ( ╱cc╱ (J$(3 : 1)) - 48) * 10 + ╱cc╱ (J$(4 : 1)) - 47
1740 ELSE
1750 LET NYRATE := ( ╱cc╱ (J$(3 : 1)) - 48) * 10 + ╱cc╱ (J$(4 : 1)) - 48
1760 ENDIF
1770 LET RESTRATE := 11 - NYRATE
1780 LET D6 := D6 - ASQ - BSKF ; AI := AI - AIH
1790 ENDPROC INDASKAT
1800 PROC REGN15
1810 IF 7 > 0 THEN
1820 LET PCT := (D0 * 100) / (INT(C7 / 100) * 100)
1830 ELSE
1840 LET PCT := (16 * U1) + P0 + PA0 + P7 + P8 + (P9 * (TK = 1))
1850 ENDIF
1860 LET PCT := INT(PCT * 10) / 10
1870 ENDPROC REGN15
1880 PROC REGN17
1890 IF C7 =< P1 THEN LET PCT := PCT + 1 ; PCT := INT(PCT)
1900 IF C7 > P1 THEN LET PCT := PCT + 1.5 ; PCT := INT(PCT)
1910 ENDPROC REGN17
1920 PROC REGN16
1930 LET FR := AI - (D6 * 100 / PCT)
1940 IF R >= 0 THEN
1950 IF R >< 0 AND INT(B6) >< 0 THEN
1960 LET FR := FR - (((IR + B6) * 100) / PCT)
1970 IF R < 0 THEN
1980 LET BSK := FR * PCT / 100 ; BSK := ABS(INT(BSK)) ; FR := 0
1990 ENDIF
2000 ENDIF
2010 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
2020 ELSE
2030 LET BSK := FR * PCT / 100 ; BSK := ABS(INT(BSK)) ; FR := 0
2040 IF R >< 0 AND INT(B6) >< 0 THEN
2050 LET BSK := BSK + IR + INT(B6)
2060 ENDIF
2070 ENDIF
2080 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
2090 ENDPROC REGN16
2100 PROC REGN11
2110 LET FR1 := FR * 365 / (365 - Z) / 12
2120 LET FR2 := FR * 365 / (365 - Z) / 26
2130 LET FR3 := FR * 365 / (365 - Z) / 52
2140 LET FR4 := FR / (365 - Z)
2150 ENDPROC REGN11
2160 PROC REGN13
2170 LET BSK := INT(D6 + IR + B6)
2180 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
2190 ENDPROC REGN13
2200 PROC AFRUND
2210 LET BSKRATE := INT(BSK / RESTRATE) ; BSK := BSKRATE * RESTRATE
2220 ENDPROC AFRUND
2230 PROC REGN14
2240 IF C7 =< P1 THEN LET PCT := (16 * U1) + P0 + PA0 + P7 + P8 + (P9 * (TK = 1))
2250 IF C7 > P1 THEN LET PCT := (32 * U1) + P0 + PA0 + P7 + P8 + (P9 * (TK = 1))
2260 IF C7 > P2 THEN LET PCT := (44 * U1) + P0 + PA0 + P7 + P8 + (P9 * (TK = 1))
2270 LET PCT := INT(PCT * 100) / 100
2280 IF P = 0 AND IR =< 100 THEN
2290 LET MAX := AI - (D6 * 100 / PCT) ; MAX := INT(MAX)
2300 IF INT(B6) = 0 AND IR = 0 THEN EXIT
2310 LET BSK := IR + INT(B6)
2320 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
2330 ELSE
2340 LET FR := AI - (IR * 100 / PCT)
2350 IF FR < 0 THEN LET BSK := (FR * PCT / 100) ; BSK := ABS(INT(BSK)) ; FR := 0
2360 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
2370 IF INT(FR) > 0 THEN EXEC REGN11
2380 ENDIF
2390 ENDPROC REGN14
2400 PROC ÆNDFORS
2410 FOR Y := 1 TO R + 1 DO
2420 IF Y = 2 THEN OUTPUT "P"
2430 EXEC LSKRIV3
2440 PRINT
2450 IF CT > 0 THEN
2460 LET QT$ := "TRÆKPROCENT " + PIL$(1 : 20) ; QB := PCT
2470 EXEC LSKRIV4
2480 ENDIF
2490 IF R > 0 THEN
2500 LET QT$ := "FRADRAG PR. MÅNED " + PIL$(1 : 14) ; QB := FR1
2510 EXEC LSKRIV1
2520 LET QT$ := "FRADRAG PR. 14-DAG " + PIL$(1 : 13) ; QB := FR2
2530 EXEC LSKRIV1
2540 LET QT$ := "FRADRAG PR. UGE " + PIL$(1 : 16) ; QB := FR3
2550 EXEC LSKRIV1
2560 LET QT$ := "FRADRAG PR. DAG " + PIL$(1 : 16) ; QB := FR4
2570 EXEC LSKRIV1
2580 ENDIF
2590 IF AX > 0 THEN
2600 LET QT$ := "MAKSIMAL A-INDKOMST" + PIL$(1 : 13) ; QB := MAX
2610 EXEC LSKRIV1
2620 ENDIF
2630 IF SK > 0 AND RESTRATE > 0 THEN
2640 LET QT$ := "B-SKAT FOR RESTEN AF ÅRET" + PIL$(1 : 6) ; QB := BSK
2650 EXEC LSKRIV1
2660 PRINT "B-SKATTEN FORDELES OVER " ; RESTRATE ; "RATE(R). FØRSTE RATE ER " ;
2670 PRINT "NR. " ; NYRATE ; "."
2680 LET QT$ := "RATEBELØBET UDGØR " + PIL$(1 : 14) ; QB := BSK / RESTRATE
2690 EXEC LSKRIV1
2700 ENDIF
2710 IF SK > 0 AND RESTRATE =< 0 THEN
2720 LET QT$ := "B-SKAT KAN IKKE ÆNDRES EFTER DEN 31/10. DER KAN EVT. INDBETALES"
2730 LET QT$ := QT$ + " FRIVILLIGT"
2740 EXEC LSKRIV3
2750 LET QT$ := "EFTER KILDESKATTELOVENS PGF. 59. SAMMENLIGN B-SKAT MED SKATTEBE"
2760 LET QT$ := QT$ + "REGNINGEN."
2770 EXEC LSKRIV3
2780 ENDIF
2790 IF SK < 0 THEN
2800 LET QT$ := "DER ER BETALT FOR MEGET I FORSKUDSSKAT. SKATTEVÆSENET KAN EVT."
2810 LET QT$ := QT$ + " ANMODES OM"
2820 EXEC LSKRIV3
2830 LET QT$ := "TILBAGEBETALING INDEN DEN 30/12. SAMMENLIGN B-SKAT MED SKATTE"
2840 LET QT$ := QT$ + "BEREGNINGEN."
2850 EXEC LSKRIV3
2860 ENDIF
2870 PRINT
2880 PRINT
2890 IF SKF > 0 THEN
2900 LET QT$ := "ALLEREDE FORFALDEN B-SKAT UDGØR " ; QB := BSKF
2910 EXEC LSKRIV1
2920 LET QT$ := "DEN FORFALDNE B-SKAT FORUDSÆTTES BETALT."
2930 EXEC LSKRIV3
2940 ENDIF
2950 IF R > 0 THEN
2960 PRINT "INDREGNET RESTSKAT FRA " ; F5 - 2 ; ":    " ;
2970 LET QT$ := "" ; QB := IR
2980 EXEC LSKRIV1
2990 ENDIF
3000 IF IH > 0 THEN
3010 LET QT$ := "A-INDKOMST TIL ÆNDRINGSDATO:     " ; QB := AIH
3020 EXEC LSKRIV1
3030 ENDIF
3040 IF SQ > 0 THEN
3050 LET QT$ := "A-SKAT TIL ÆNDRINGSDATO:         " ; QB := ASQ
3060 EXEC LSKRIV1
3070 ENDIF
3080 IF > 0 THEN
3090 LET QT$ := "ÆNDRINGSDATO: " + PIL$(1 : 18) + "       " ; QT$ := QT$ + J$
3100 EXEC LSKRIV3
3110 ENDIF
3120 IF Y = 1 THEN EXEC RETURN
3130 NEXT Y
3140 OUTPUT "t"
3150 ENDPROC ÆNDFORS
3160 PROC LÆSFIL
3170 LET STATUS := 0
3180 REPEAT
3190 GET FIL$ : S$
3200 PRINT S$
3210 UNTIL ╱cd╱ (FIL$) = 19
3220 CLOSE FIL$
3230 REPEAT
3240 INPUT "Skriv skattekortets beregningsdato (gyldighedsdato): " : J$
3250 CLEAR
3260 IF ╱cb╱ (J$) >< 4 THEN PRINT CHR$ (7)
3270 UNTIL ╱cb╱ (J$) = 4
3280 IF $ >< "0101" THEN
3290 LET Z := 0
3300 LET MÅNED := ( ╱cc╱ (J$(3)) - 48) * 10 + ╱cc╱ (J$(4)) - 48
3310 LET DAG := ( ╱cc╱ (J$(1)) - 48) * 10 + ╱cc╱ (J$(2)) - 48
3320 FOR X := 2 TO ÅNED DO
3330 LET Z := Z + 31
3340 IF X = 5 OR X = 7 OR X = 10 OR X = 12 THEN LET Z := Z - 1
3350 IF X = 3 THEN LET Z := Z - 3
3360 NEXT X
3370 LET Z := Z + DAG - 1
3380 ENDIF
3390 ENDPROC LÆSFIL
3400 PROC RETURN
3410 PRINT
3420 PRINT TAB(65) ;
3430 LET S$ := "-"
3440 EDIT "TRYK -RETURN" : S$
3450 ENDPROC RETURN