DataMuseum.dk

top - download

    Length: 21077 (0x5255)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cd
    Names: »SKAT85.B«

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

SPC/1 COMAL-80

0010 INTEGER X,PR,Y,F8,FE,G,T0,T1,T2,T3,T4,O,W
0015 CLEAR
0020 LET STATUS,G1,B7,B8,U2,F0,F7,T,TKB,TKH,B3,C0,BD6,C6,F0,F7,OV,HS := 0
0025 LET AKT,SKG,D6,HFORMUE,BFORMUE,B6,HC3,BC3,HATP,BATP,GSLUT,FSLUT,F1,F2 := 0
0030 LET T0,T1,T2,T3,T4,O := 0
0035 DIM A1$(29) OF 29,A(29),H(23),K(23),LI$ OF 80,QT$ OF 80,S$ OF 80
0040 DIM FIL$ OF 15,PIL$ OF 45,SP$ OF 40,REV$ OF 80,ADR$ OF 80,HKL$ OF 38
0045 DIM BKL$ OF 38,NU$ OF 9
0050 LET LI$ := "" ; PIL$ := "" ; SP$ := "" ; NU$ := "#########" ; W := 100 ; GEMAFR := O
0055 LET REV$ := "Revisor Kaja Jensen"
0060 LET ADR$ := "Lysholmvej 14, 2650 Hvidovre, (01)784852"
0065 FOR X := 1 TO 8 DO
0070 LET LI$ := LI$ + "-" ; PIL$ := PIL$ + "." ; SP$ := SP$ + " "
0075 NEXT X
0080 LET F8,T4,G := O ; T2 := 2
0085 LET FIL$ := "dde:skatsys"
0090 OPEN FIL$,R
0095 GET FIL$ : SYS
0100 CLOSE FIL$
0105 IF YS = 1 THEN
0110 OPEN FIL$,W
0115 LET SYS := O
0120 PUT FIL$ : SYS
0125 CLOSE FIL$
0130 LET FIL$ := "dde:hskvar"
0135 OPEN FIL$,R
0140 FOR X := 1 TO 9 DO
0145 GET FIL$ : A(X)
0150 IF X < 24 THEN GET FIL$ : H(X),K(X)
0155 NEXT X
0160 GET FIL$ : F8,T1,T2,T4
0165 CLOSE FIL$
0170 LET FIL$ := "dde:fvar"
0175 OPEN FIL$,R
0180 GET FIL$ : PR,C4,HD6,C9,B0,T1,TKH,F6,F1
0185 GET FIL$ : F9,P1,P7,P8,P9,T0,B2,B1,B9
0190 GET FIL$ : T2,C6,BD6,C0,B3,E6,F2,T3,TKB
0195 GET FIL$ : F0,F7,SKG,AKT,D6,GSLUT
0200 GET FIL$ : HFORMUE,BFORMUE,HATP,BATP,G,FSLUT
0205 GET FIL$ : HKL$,BKL$
0210 CLOSE FIL$
0215 EXEC FORTSÆT
0220 ELSE
0225 PRINT TAB(29) ; ">>> EASY - SKAT <<<"
0230 LET FIL$ := "DDE:skatvejl"
0235 OPEN FIL$,R
0240 EXEC LFIL
0245 EXEC RETURN
0250 ENDIF
0255 LET X := O
0260 OPEN "dde:skatart",R
0265 REPEAT
0270 LET X := X + 1
0275 GET "dde:skatart" : A1$(X)
0280 UNTIL ╱cd╱ ("dde:skatart") = 19 OR ╱cd╱ ("dde:skatart") > O OR X = 29
0285 CLOSE
0290 LET E1 := 28 ; F3 := 64000 ; F4 := 70999 ; F5 := 1985 ; P1 := 111300 ; P2 := 182600
0295 LET P3 := 22700 ; P4 := 20300 ; P5 := 43900 ; P6 := 24000 ; P0 := 3.5 ; PA0 := 2
0300 LET U1 := .9 ; U2 := 1229200 ; M1 := 112700
0305 REPEAT
0310 REPEAT
0315 LABEL START :
0320 LET E8,E9,E6,C5,B9,AR,BD1,BD2,BDA2,BD3,BD4,BD5,BD6,E4,E7,E5,D8,E2 := O
0325 IF T4 = 1 THEN LET T2 := 1
0330 IF F8 >< 1 THEN EXEC NULSTIL2
0335 IF F8 = 1 THEN EXEC SÆTATILH
0340 REPEAT
0345 REPEAT
0350 LET FE := O ; QT$ := " HOVEPERSONEN " ; A(24) := HFORMUE
0355 EXEC INDKOMST
0360 LET HFORMUE := B6 ; A(24) := O
0365 EXEC FEJLMED
0370 EXEC FEJL
0375 UNTIL FE >< 1
0380 LET F6 := A(12) ; F9 := A(11) * (30 / W)
0385 EXEC SÆTHTILA
0390 EXEC REGN1
0395 IF >< 1 THEN
0400 PRINT "Er hovedpersonen tilkendt enke-, folke- eller invalidepension,"
0405 PRINT "dvs. har ret til personfradrag som pensionist" ;
0410 EXEC SVAR
0415 LET T1 := O
0420 IF $ = "j" THEN
0425 LET T1 := 2
0430 PRINT "Er hovedpersonen fyldt 67 år ved indkomstårets begyndelse" ;
0435 EXEC SVAR
0440 IF S$ = "j" THEN LET T1 := 1
0445 ENDIF
0450 ENDIF
0455 IF 1 = 1 THEN
0460 IF G = 1 THEN LET ATP := HATP
0465 EXEC INDATP
0470 LET HC3 := C3 + C5 ; HATP := ATP
0475 ENDIF
0480 LET B0 := A(1) ; B1 := C1 ; B2 := C2 ; C4 := C7 ; PR := O ; C3 := O
0485 IF T1 = 1 THEN LET C3 := HC3
0490 EXEC SKATIND
0495 PRINT
0500 PRINT "Ønskes rettelser til ovenstående" ;
0505 EXEC SVAR
0510 CLEAR
0515 UNTIL S$ = "n"
0520 IF >< 1 THEN
0525 PRINT "Skal der foretages beregning af en ægtefælle (gift kvinde)" ;
0530 EXEC SVAR
0535 EXEC NULSTIL2
0540 LET T2 := O
0545 IF $ = "j" THEN
0550 PRINT "Har ægtefællerne været gift hele kalenderåret" ;
0555 EXEC SVAR
0560 LET T2 := 2 ; T4 := O
0565 IF S$ = "j" THEN LET T2 := 1 ; T4 := 1
0570 IF F8 = 1 THEN EXEC SÆTATILK
0575 ENDIF
0580 ELSE
0585 IF 2 >< O THEN
0590 EXEC NULSTIL2
0595 IF F8 = 1 THEN EXEC SÆTATILK
0600 ENDIF
0605 ENDIF
0610 IF 2 >< O THEN
0615 REPEAT
0620 REPEAT
0625 LET FE := O ; QT$ := " DEN GIFTE KVINDE " ; A(24) := BFORMUE
0630 EXEC INDKOMST
0635 LET BFORMUE := B6 ; A(24) := O
0640 EXEC FEJLMED
0645 EXEC FEJL
0650 UNTIL FE >< 1
0655 LET F7 := A(12) ; F0 := A(11) * (30 / W)
0660 EXEC SÆTKTILA
0665 EXEC REGN1
0670 EXEC TTEST
0675 EXEC FEJL
0680 IF E = 1 THEN
0685 LET FE := O ; F8 := 1
0690 GOTO START
0695 ENDIF
0700 IF >< 1 THEN
0705 PRINT "Er den gifte kvinde tilkendt enke-, folke- eller invalidepension"
0710 PRINT "dvs. har ret til personfradrag som pensionist" ;
0715 EXEC SVAR
0720 LET T3 := O
0725 IF $ = "j" THEN
0730 LET T3 := 2
0735 PRINT "Er den gifte kvinde fyldt 67 år ved indkomstårets begyndelse" ;
0740 EXEC SVAR
0745 IF S$ = "j" THEN LET T3 := 1
0750 ENDIF
0755 ENDIF
0760 IF 3 = 1 THEN
0765 IF G = 1 THEN LET ATP := BATP
0770 EXEC INDATP
0775 LET BC3 := C3 + C5 ; BATP := ATP
0780 ENDIF
0785 LET B3 := A(1) ; B4 := C1 ; B5 := C2 ; C6 := C7 ; PR := O
0790 IF C6 < O THEN LET C6 := O
0795 LET C3 := O
0800 IF T3 = 1 THEN LET C3 := BC3
0805 EXEC SKATIND
0810 PRINT
0815 PRINT "Ønskes rettelser til ovenstående" ;
0820 EXEC SVAR
0825 CLEAR
0830 UNTIL S$ = "n"
0835 ENDIF
0840 IF C4 < O THEN LET C4 := O
0845 IF T2 = O THEN EXEC FORMUE
0850 IF T2 >< O THEN EXEC ÆFORMUE
0855 IF >< 1 THEN
0860 INPUT "Skriv kommuneskatteprocent: " : P7
0865 PRINT LI$
0870 INPUT "Skriv den amtskommunale skatteprocent: " : P8
0875 PRINT LI$
0880 INPUT "Skriv kirkeskatteprocenten: " : P9
0885 PRINT LI$
0890 PRINT "Ønskes klientens navn anvendt i opgørelsen i stedet for HOVED" ;
0895 PRINT "PERSONEN og GIFT"
0900 PRINT "KVINDE" ;
0905 EXEC SVAR
0910 LET HKL$ := "HOVEDPERSONEN" ; BKL$ := "DEN GIFTE KVINDE"
0915 IF $ = "j" THEN
0920 INPUT "Skriv hovedpersonens navn    " : HKL$
0925 IF T2 >< O THEN INPUT "Skriv den gifte kvindes navn " : BKL$
0930 PRINT LI$
0935 ENDIF
0940 ENDIF
0945 IF T2 = 1 THEN EXEC REGN3
0950 IF 2 >< 1 THEN
0955 EXEC REGN4
0960 IF T2 = 2 THEN EXEC REGN5
0965 ELSE
0970 EXEC REGN6
0975 ENDIF
0980 EXEC REGN7
0985 IF T2 = O AND B7 > U2 + 99 THEN EXEC REGN8
0990 IF T4 = 1 AND B7 + B8 > U2 + 99 THEN EXEC REGN9
0995 IF 2 = 2 AND T4 = O AND B7 > U2 + 99 THEN
1000 EXEC REGN8
1005 LET HB9 := B9 ; HB7 := B7
1010 ENDIF
1015 IF 2 = 2 AND T4 = O AND B8 > U2 + 99 THEN
1020 LET B7 := B8
1025 EXEC REGN8
1030 LET E6 := B9 ; B9 := HB9 ; B7 := HB7
1035 ENDIF
1040 PRINT "Ønskes der print af beregningerne" ;
1045 EXEC SVAR
1050 LET PR := O
1055 IF S$ = "j" THEN LET PR := 1
1060 FOR Y := 1 TO R + 1 DO
1065 IF Y = 2 THEN OUTPUT "P"
1070 EXEC SIDESKIFT
1075 EXEC SÆTATILH
1080 LET QT$ := "INDKOMSTOPGØRELSE FOR " + HKL$ + ":"
1085 LET C3 := O
1090 IF T1 = 1 THEN LET C3 := HC3
1095 LET C1 := B1 ; C2 := B2 ; B6 := HFORMUE
1100 EXEC SKATIND
1105 EXEC SKIFT
1110 EXEC REGN10
1115 EXEC SKAT
1120 EXEC INDSKAT
1125 LET FS := B9
1130 EXEC FSKAT
1135 EXEC SIDESKIFT
1140 IF 2 >< O THEN
1145 EXEC SÆTATILK
1150 LET QT$ := "INDKOMSTOPGØRELSE FOR " + BKL$ + ":"
1155 LET C3 := O
1160 IF T3 = 1 THEN LET C3 := BC3
1165 LET C1 := B4 ; C2 := B5 ; B6 := BFORMUE
1170 EXEC SKATIND
1175 EXEC SKIFT
1180 EXEC REGN22
1185 EXEC SKAT
1190 EXEC INDSKAT
1195 LET FS := E6
1200 EXEC FSKAT
1205 EXEC SIDESKIFT
1210 ENDIF
1215 EXEC SKATPRO
1220 EXEC SKIFT
1225 NEXT Y
1230 OUTPUT "T"
1235 PRINT LI$
1240 PRINT "Ønskes beregning af forskudsregistrering, d.v.s skattekort " ;
1245 PRINT "m.v." ;
1250 EXEC SVAR
1255 IF $ = "j" THEN
1260 PRINT "*** VENT **** FORSKUDSREGISTREINGS PROGRAMMET INDLÆSES ***"
1265 EXEC PROGRAMSKIFT
1270 CHAIN "dde:forsk85"
1275 ENDIF
1280 PRINT "Ønskes årsopgørelse udskrevet" ;
1285 EXEC SVAR
1290 IF $ = "j" THEN
1295 PRINT "*** VENT **** ÅRSOPGØRELSES PROGRAMMET INDLÆSES ***"
1300 EXEC PROGRAMSKIFT
1305 CHAIN "DDE:ÅRSOP85"
1310 ENDIF
1315 EXEC FORTSÆT
1320 UNTIL F8 >< 1
1325 LET T2 := 2 ; T4 := O ; GSLUT,HFORMUE,BFORMUE := O
1330 UNTIL 1 >< 1
1335 PROC PROGRAMSKIFT
1340 LET FIL$ := "dde:fvar"
1345 OPEN FIL$,W
1350 PUT FIL$ : PR,C4,HD6,C9,B0,T1,TKH,F6,F1
1355 PUT FIL$ : F9,P1,P7,P8,P9,T0,B2,B1,B9
1360 PUT FIL$ : T2,C6,BD6,C0,B3,E6,F2,T3,TKB
1365 PUT FIL$ : F0,F7,SKG,AKT,D6,GSLUT
1370 PUT FIL$ : HFORMUE,BFORMUE,HATP,BATP,G,FSLUT
1375 PUT FIL$ : HKL$,BKL$
1380 CLOSE FIL$
1385 LET FIL$ := "dde:hskvar"
1390 OPEN FIL$,W
1395 FOR X := 1 TO 9 DO
1400 PUT FIL$ : A(X)
1405 IF X < 24 THEN PUT FIL$ : H(X),K(X)
1410 NEXT X
1415 PUT FIL$ : F8,T1,T2,T4
1420 CLOSE FIL$
1425 ENDPROC PROGRAMSKIFT
1430 PROC FORTSÆT
1435 CLEAR
1440 PRINT "*** BEREGNINGEN ER GENNEMFØRT *** Ønskes de indtastede"
1445 PRINT "indkomster/fradrag bevaret til en ny beregning" ;
1450 EXEC SVAR
1455 LET G,F8 := O ; FSLUT := O
1460 IF $ = "j" THEN
1465 LET F8 := 1 ; FSLUT := 1
1470 PRINT "Ønskes alle andre forudsætninger for beregningerne bevaret" ;
1475 EXEC SVAR
1480 IF S$ = "j" THEN LET G := 1
1485 ENDIF
1490 ENDPROC FORTSÆT
1495 PROC REGN20
1500 LET HD1 := D1 ; HD2 := D2 ; HDA2 := DA2 ; HD3 := D3 ; HD4 := D4 ; HD5 := D5 ; HD6 := D6
1505 ENDPROC REGN20
1510 PROC REGN10
1515 LET D1 := HD1 ; D2 := HD2 ; DA2 := HDA2 ; D3 := HD3 ; D4 := HD4 ; D5 := HD5 ; D6 := HD6
1520 ENDPROC REGN10
1525 PROC REGN21
1530 LET BD1 := D1 ; BD2 := D2 ; BDA2 := DA2 ; BD3 := D3 ; BD4 := D4 ; BD5 := D5 ; BD6 := D6
1535 ENDPROC REGN21
1540 PROC REGN22
1545 LET D1 := BD1 ; D2 := BD2 ; DA2 := BDA2 ; D3 := BD3 ; D4 := BD4 ; D5 := BD5 ; D6 := BD6
1550 ENDPROC REGN22
1555 PROC LFIL
1560 REPEAT
1565 GET FIL$ : S$
1570 IF ╱cd╱ (FIL$) = O THEN PRINT S$
1575 UNTIL ╱cd╱ (FIL$) = 19
1580 CLOSE FIL$
1585 ENDPROC LFIL
1590 PROC SKÆRM
1595 LET A1$(24) := "24. FORMUE " + PIL$(1 : 18)
1600 FOR X := 1 TO 2 DO
1605 PRINT A1$(X) ;
1610 IF A(X) >< O THEN PRINT USING NU$ : A(X) ;
1615 PRINT TAB(42) ; A1$(X + 12) ;
1620 IF A(X + 12) >< O THEN PRINT USING NU$ : A(X + 12) ;
1625 PRINT
1630 NEXT X
1635 ENDPROC SKÆRM
1640 PROC INDKOMST
1645 CLEAR
1650 PRINT TAB(29) ; ">>> EASY - SKAT <<<"
1655 PRINT TAB(20) ; "*** INDDATERING TIL " ; QT$ ; " ***"
1660 PRINT "Nr. Indkomst" ; TAB(33) ; "Beløb" ; TAB(42) ; "Nr. Fradrag" ; TAB(74) ;
1665 PRINT "Beløb"
1670 PRINT
1675 EXEC SKÆRM
1680 REPEAT
1685 REPEAT
1690 LET B6 := A(24)
1695 CURSOR 1,20
1700 INPUT "Skriv nummer på indkomst/fradrag (1 til 24, 0 for slut) ----> " : N
1705 IF N > 24 THEN PRINT "*** Nummeret skal være fra 1 til 24 ***" ; CHR$ (7)
1710 UNTIL N < 25
1715 IF = 2 OR N = 8 OR N = 18 OR N = 19 THEN
1720 EXEC WIN
1725 ELSE
1730 IF >< O THEN
1735 PRINT "Skriv beløbets størelse " + LI$(1 : 36) + ">" ;
1740 INPUT " " : A(N)
1745 IF = 11 THEN
1750 LET A(12) := INT(A(11) * 25 / W)
1755 CURSOR 30,16
1760 PRINT USING NU$ : A(12)
1765 ENDIF
1770 ENDIF
1775 ENDIF
1780 CURSOR 1,17
1785 FOR X := 1 TO 2 DO
1790 PRINT SP$ ;
1795 NEXT X
1800 IF >< O THEN
1805 IF N > 12 THEN CURSOR 71,N - 8
1810 IF N =< 12 THEN CURSOR 30,N + 4
1815 IF (N) >< O THEN
1820 PRINT USING NU$ : A(N)
1825 ELSE
1830 PRINT SP$(1 : 9)
1835 ENDIF
1840 ENDIF
1845 UNTIL N = O
1850 CLEAR
1855 ENDPROC INDKOMST
1860 PROC REGN1
1865 LET C1 := A(1) + A(2) + A(4) - A(5) - A(7) + A(6) + A(9) + A(10) - A(14) - A(18) + A(15) - A(16)
1870 LET C1 := C1 + A(17) - A(22) - A(23)
1875 LET C2 := A(3) + A(5) + A(7) - A(9) + A(12) + A(11) - A(15) - A(13) - A(17) - A(19) - A(20) - A(21)
1880 LET C2 := C2 + A(22) + A(8) ; C7 := C1 + C2
1885 ENDPROC REGN1
1890 PROC INDATP
1895 LET C3 := A(8) - A(9) - A(21) + A(22)
1900 IF C3 < O THEN LET C3 := O
1905 IF >< 1 THEN
1910 PRINT "Skriv størrelsen på modtaget ATP-beløb til brug for "
1915 INPUT "rentenedslag (evt, 0): " : ATP
1920 PRINT LI$
1925 ENDIF
1930 LET C3 := C3 + ATP ; C3 := C3 * 30 / W
1935 IF C3 > 3500 THEN LET C3 := 3500
1940 IF C7 > F3 + 99 THEN LET C3 := C3 - ((INT(C7 / W) * W) - F3) / 2
1945 IF C3 < O THEN LET C3 := O
1950 LET C3 := INT(C3 + .9) ; C5 := O
1955 IF C3 > A(8) - A(9) THEN LET C5 := C3 - A(8) + A(9)
1960 LET C3 := C3 - C5 ; C2 := C2 - C3 ; C1 := C1 - C5 ; C7 := C1 + C2
1965 ENDPROC INDATP
1970 PROC FEJLMED
1975 LET FE := O
1980 PRINT "FEJLMEDDELELSER:"
1985 IF A(9) > A(8) THEN EXEC FEJL1(1)
1990 IF A(5) > A(4) THEN EXEC FEJL1(2)
1995 IF A(7) > A(6) THEN EXEC FEJL1(3)
2000 IF A(15) > A(14) THEN EXEC FEJL1(4)
2005 IF A(17) > A(16) THEN EXEC FEJL1(5)
2010 IF A(23) > A(6) * 50 / W THEN EXEC FEJL1(6)
2015 IF (23) > M1 THEN
2020 LET FE := 1
2025 PRINT "Medarbejdende ægtefællefradrag er for stor. Må højst udgøre" ; M1 ;
2030 PRINT "."
2035 PRINT
2040 ENDIF
2045 IF A(12) > A(11) * 25 / W THEN EXEC FEJL1(7)
2050 IF A(22) > A(21) THEN EXEC FEJL1(8)
2055 IF A(9) > O OR A(22) > O) AND A(4) - A(5) = O AND A(6) - A(7) = O THEN
2060 IF A(14) - A(15) = O AND A(16) - A(17) = O THEN EXEC FEJL1(9)
2065 ENDIF
2070 ENDPROC FEJLMED
2075 PROC FEJL1(Æ)
2080 LET FIL$ := "dde:skfejl" ; FE := 1
2085 OPEN FIL$,R
2090 FOR Ø := 1 TO DO
2095 FOR Q := 1 TO DO
2100 GET FIL$ : S$
2105 IF ╱cb╱ (S$) > 2 AND Æ = Ø AND ╱cd╱ (FIL$) < 19 THEN PRINT S$
2110 NEXT Q
2115 NEXT Ø
2120 CLOSE FIL$
2125 ENDPROC FEJL1
2130 PROC FEJL
2135 IF E = O THEN
2140 PRINT "Ingen åbenbare fejl fundet."
2145 PRINT LI$
2150 ELSE
2155 PRINT "Skal der foretages rettelser" ;
2160 EXEC SVAR
2165 IF S$ = "n" THEN LET FE := O
2170 PRINT LI$
2175 ENDIF
2180 ENDPROC FEJL
2185 PROC TTEST
2190 PRINT "TOTALTEST:"
2195 IF (23) >< H(10) OR A(10) >< H(23) THEN
2200 LET FE := 1
2205 PRINT "Medarbejdende ægtefælleindkomst er ikke lig med medarbejdende "
2210 PRINT "ægtefællefradrag."
2215 PRINT
2220 ENDIF
2225 IF C4 > O AND C7 < O THEN LET FIL$ := "dde:skatfejb" ; FE := 1
2230 IF C4 < O AND C7 > O THEN LET FIL$ := "dde:skatfejh" ; FE := 1
2235 IF IL$(9 : 3) = "fej" AND FE = 1 THEN
2240 OPEN FIL$,R
2245 EXEC LFIL
2250 LET QT$ := "Det negative beløb udgør " ; QB := C7
2255 EXEC LSKRIV2
2260 PRINT
2265 ENDIF
2270 ENDPROC TTEST
2275 PROC NULSTIL2
2280 FOR X := 1 TO 3 DO
2285 LET A(X) := O
2290 NEXT X
2295 ENDPROC NULSTIL2
2300 PROC SÆTATILH
2305 FOR X := 1 TO 3 DO
2310 LET A(X) := H(X)
2315 NEXT X
2320 ENDPROC SÆTATILH
2325 PROC SÆTATILK
2330 FOR X := 1 TO 3 DO
2335 LET A(X) := K(X)
2340 NEXT X
2345 ENDPROC SÆTATILK
2350 PROC SÆTHTILA
2355 FOR X := 1 TO 3 DO
2360 LET H(X) := A(X)
2365 NEXT X
2370 ENDPROC SÆTHTILA
2375 PROC SÆTKTILA
2380 FOR X := 1 TO 3 DO
2385 LET K(X) := A(X)
2390 NEXT X
2395 ENDPROC SÆTKTILA
2400 PROC SKATIND
2405 LET S$ := NU$ + " KR."
2410 EXEC LSKRIV3
2415 PRINT
2420 LET C7,C7IK,C7FR := O
2425 FOR X := 1 TO 2 DO
2430 PRINT A1$(X,5 : 25) ;
2435 IF A(X) >< O THEN PRINT USING S$ : A(X) ;
2440 IF < 12 THEN
2445 PRINT TAB(41) ; A1$(X + 12,5 : 25) ;
2450 IF A(X + 12) >< O THEN PRINT USING S$ : A(X + 12) ;
2455 ELSE
2460 IF 3 > O THEN
2465 PRINT TAB(41) ; "RENTEINDTÆGTSNEDSLAG ...." ;
2470 PRINT USING S$ : C3 ;
2475 ENDIF
2480 ENDIF
2485 PRINT
2490 NEXT X
2495 FOR X := 1 TO 3 DO
2500 IF >< 5 AND X >< 7 AND X >< 9 AND X >< 15 AND X >< 17 AND X >< 22 THEN
2505 IF X =< 12 THEN LET C7IK := C7IK + A(X)
2510 IF X > 12 THEN LET C7FR := C7FR + A(X)
2515 ENDIF
2520 NEXT X
2525 LET QT$ := SP$(1 : 25) + LI$(1 : 12) + SP$(1 : 29) + LI$(1 : 12)
2530 EXEC LSKRIV3
2535 PRINT "INDKOMST IALT " ; PIL$(1 : 11) ;
2540 PRINT USING S$ : C7IK ;
2545 PRINT TAB(41) ; "FRADRAG IALT " ; PIL$(1 : 12) ;
2550 PRINT USING S$ : C7FR
2555 LET QT$ := SP$(1 : 25) + "============" + SP$(1 : 29) + "============"
2560 EXEC LSKRIV3
2565 PRINT
2570 PRINT "ARBEJDSINDKOMST " ; PIL$(1 : 9) ;
2575 PRINT USING S$ : C1 ;
2580 PRINT TAB(41) ; "FORMUEINDKOMST " ; PIL$(1 : 10) ;
2585 PRINT USING S$ : C2
2590 LET C7 := C1 + C2
2595 PRINT "SKATTEPLIGTIG INDKOMST " ; PIL$(1 : 42) ;
2600 PRINT USING S$ : C7
2605 PRINT "SKATTEPLIGTIG FORMUE " ; PIL$(1 : 44) ;
2610 PRINT USING S$ : B6
2615 ENDPROC SKATIND
2620 PROC FORMUE
2625 LET B7 := HFORMUE
2630 IF B7 < U2 + 99 THEN LET B7 := O
2635 ENDPROC FORMUE
2640 PROC ÆFORMUE
2645 LET B7 := HFORMUE ; B8 := BFORMUE
2650 IF T4 = 1 AND B7 + B8 < U2 + 99 THEN LET B7 := O ; B8 := O
2655 IF T4 = O AND B7 < U2 + 99 THEN LET B7 := O
2660 IF T4 = O AND B8 < U2 + 99 THEN LET B8 := O
2665 ENDPROC ÆFORMUE
2670 PROC REGN3
2675 IF B1 < O THEN LET B2 := B2 + B1 ; B1 := O
2680 IF B4 < O THEN LET B5 := B5 + B4 ; B4 := O
2685 IF 1 = B4 THEN
2690 IF B2 >= B5 THEN LET T0 := 1
2695 IF B2 < B5 THEN LET T0 := 2
2700 ELSE
2705 IF 1 > B4 THEN
2710 LET T0 := 1
2715 IF B5 < O AND ABS(B5) > C4 THEN EXEC REGN23
2720 ELSE
2725 LET T0 := 2
2730 IF B2 < O AND ABS(B2) > C6 THEN EXEC REGN24
2735 ENDIF
2740 ENDIF
2745 IF (T0 = 1 AND ABS(B5) =< 1000) OR (T0 = 2 AND ABS(B2) =< 1000) THEN LET T2 := 2
2750 ENDPROC REGN3
2755 PROC REGN23
2760 LET E4 := B5 + C4 ; B5 := B5 - E4 ; B4 := B4 + E4
2765 ENDPROC REGN23
2770 PROC REGN24
2775 LET E4 := B2 + C6 ; B2 := B2 - E4 ; B1 := B1 + E4
2780 ENDPROC REGN24
2785 PROC REGN25
2790 LET C7 := INT(C7 / W) * W
2795 IF 7 =< P1 OR C7 =< P2 THEN
2800 LET D1 := C7 * 16 / W * U1
2805 IF C7 > P1 THEN LET D1 := ((C7 - P1) * 32 / W * U1) + (P1 * 16 / W * U1)
2810 ELSE
2815 LET D1 := ((C7 - P2) * 44 / W * U1) + ((P2 - P1) * 32 / W * U1) + (P1 * 16 / W * U1)
2820 IF P7 + P8 > E1 THEN LET D1 := D1 - ((C7 - P2) * (P7 + P8 - E1) / W)
2825 ENDIF
2830 ENDPROC REGN25
2835 PROC REGN26
2840 LET D2 := C7 * P0 / W
2845 ENDPROC REGN26
2850 PROC REGN27
2855 LET DA2 := C7 * PA0 / W
2860 ENDPROC REGN27
2865 PROC REGN28
2870 LET D3 := C7 * P7 / W
2875 ENDPROC REGN28
2880 PROC REGN29
2885 LET D4 := C7 * P8 / W
2890 ENDPROC REGN29
2895 PROC REGN30
2900 LET D5 := C7 * P9 / W
2905 ENDPROC REGN30
2910 PROC REGN31
2915 LET D0 := D1 + D2 + DA2 + D3 + D4 + D5
2920 ENDPROC REGN31
2925 PROC REGN32
2930 LET D1 := D1 - (C8 * 16 / W * U1)
2935 ENDPROC REGN32
2940 PROC REGN33
2945 LET D2 := D2 - (C8 * P0 / W) ; D2AFR := D2 - INT(D2) ; D2 := INT(D2)
2950 ENDPROC REGN33
2955 PROC REGN34
2960 LET DA2 := DA2 - (C8 * PA0 / W) ; D2AFR := DA2 - INT(DA2) ; DA2 := INT(DA2)
2965 ENDPROC REGN34
2970 PROC REGN35
2975 LET D3 := D3 - (C8 * P7 / W)
2980 ENDPROC REGN35
2985 PROC REGN36
2990 LET D4 := D4 - (C8 * P8 / W)
2995 ENDPROC REGN36
3000 PROC REGN37
3005 LET D5 := D5 - (C8 * P9 / W)
3010 ENDPROC REGN37
3015 PROC REGN38
3020 LET D6 := D1 + D2 + DA2 + D3 + D4 + D5
3025 ENDPROC REGN38
3030 PROC REGN6
3035 LET C7 := (INT(C6 / W) * W) + B2
3040 IF T0 = 1 THEN LET C7 := (INT(C4 / W) * W) + B5
3045 LET D8 := C7
3050 EXEC REGN25
3055 LET E2 := D1 ; C7 := C6
3060 IF T0 = 1 THEN LET C7 := C4
3065 EXEC REGN25
3070 LET E2 := E2 - D1
3075 EXEC REGN51
3080 IF 0 = 1 THEN
3085 EXEC KIRKE
3090 ELSE
3095 EXEC GKIRKE
3100 ENDIF
3105 LET D5 := O
3110 IF (T0 = 1 AND TKH = 1) OR (T0 = 2 AND TKB = 1) THEN EXEC REGN30
3115 EXEC REGN31
3120 EXEC REGN39
3125 EXEC REGN50
3130 IF 0 = 1 THEN
3135 EXEC REGN20
3140 LET C9 := D0 ; D7 := D6 ; C7 := INT(B5 / W) * W
3145 ELSE
3150 EXEC REGN21
3155 LET C0 := D0 ; D9 := D6 ; C7 := INT(B2 / W) * W
3160 ENDIF
3165 EXEC REGN51
3170 IF 0 = 1 THEN
3175 EXEC GKIRKE
3180 ELSE
3185 EXEC KIRKE
3190 ENDIF
3195 LET D5 := O
3200 IF (T0 = 2 AND TKH = 1) OR (T0 = 1 AND TKB = 1) THEN EXEC REGN30
3205 LET C7 := B1
3210 IF T0 = 1 THEN LET C7 := B4
3215 EXEC REGN25
3220 LET AR := D1 ; D1 := D1 + E2 ; E8 := D2
3225 EXEC REGN26
3230 LET AR := AR + D2 ; D2 := D2 + E8 ; E8 := DA2
3235 EXEC REGN27
3240 LET AR := AR + DA2 ; DA2 := DA2 + E8 ; E8 := D3
3245 EXEC REGN28
3250 LET AR := AR + D3 ; D3 := D3 + E8 ; E8 := D4
3255 EXEC REGN29
3260 LET AR := AR + D4 ; D4 := D4 + E8
3265 IF 5 >< O THEN
3270 LET E8 := D5
3275 EXEC REGN30
3280 LET AR := AR + D5 ; D5 := D5 + E8
3285 ENDIF
3290 LET E8 := O
3295 EXEC REGN31
3300 EXEC REGN42
3305 EXEC REGN32
3310 EXEC REGN33
3315 LET GEMAFR := D2AFR
3320 EXEC REGN34
3325 LET GEMAFR := GEMAFR + D2AFR
3330 EXEC REGN40
3335 EXEC REGN35
3340 EXEC REGN36
3345 IF 5 > O THEN
3350 EXEC REGN37
3355 ELSE
3360 IF C8 > C7 THEN LET D5 := D5 - ((C8 - C7) * P9 / W)
3365 ENDIF
3370 EXEC REGN38
3375 IF 0 = 1 THEN
3380 EXEC REGN21
3385 LET C0 := D0 ; D9 := D6
3390 ELSE
3395 EXEC REGN20
3400 LET C9 := D0 ; D7 := D6
3405 ENDIF
3410 ENDPROC REGN6
3415 PROC KIRKE
3420 IF >< 1 THEN
3425 PRINT "Er hovedpersonen medlem af folkekirken" ;
3430 EXEC SVAR
3435 LET TKH := O
3440 IF S$ = "j" THEN LET TKH := 1
3445 ENDIF
3450 ENDPROC KIRKE
3455 PROC GKIRKE
3460 IF >< 1 THEN
3465 PRINT "Er den gifte kvinde medlem af folkekirken" ;
3470 EXEC SVAR
3475 LET TKB := O
3480 IF S$ = "j" THEN LET TKB := 1
3485 ENDIF
3490 ENDPROC GKIRKE
3495 PROC REGN39
3500 LET C8 := P3
3505 IF T0 = 1 AND T1 >< O THEN LET C8 := P6
3510 IF T0 = 2 AND T3 >< O THEN LET C8 := P6
3515 ENDPROC REGN39
3520 PROC REGN40
3525 IF C8 = P3 THEN LET C8 := P4
3530 ENDPROC REGN40
3535 PROC REGN42
3540 LET C8 := P3
3545 IF T0 = 1 AND T3 >< O THEN LET C8 := P6
3550 IF T0 = 2 AND T1 >< O THEN LET C8 := P6
3555 ENDPROC REGN42
3560 PROC REGN4
3565 LET C7 := C4
3570 EXEC REGN25
3575 EXEC REGN51
3580 EXEC KIRKE
3585 LET D5 := O
3590 IF TKH = 1 THEN EXEC REGN30
3595 EXEC REGN31
3600 IF T2 = O AND T1 >< O THEN LET C8 := P5
3605 IF T2 = 2 AND T1 >< O THEN LET C8 := P6
3610 IF T1 = O THEN LET C8 := P3
3615 EXEC REGN50
3620 EXEC REGN20
3625 LET C9 := D0 ; D7 := D6
3630 ENDPROC REGN4
3635 PROC REGN5
3640 LET C7 := C6
3645 EXEC REGN25
3650 EXEC REGN51
3655 EXEC GKIRKE
3660 LET D5 := O
3665 IF TKB = 1 THEN EXEC REGN30
3670 EXEC REGN31
3675 LET C8 := P6
3680 IF T3 = O THEN LET C8 := P3
3685 EXEC REGN50
3690 EXEC REGN21
3695 LET C0 := D0 ; D9 := D6
3700 ENDPROC REGN5
3705 PROC REGN7
3710 IF HD1 + HD2 + HDA2 < 0 AND HD3 + HD4 + HD5 > 0 THEN EXEC MSSIKS
3715 IF 2 = O THEN
3720 LET HD6 := HD1 + HD2 + HDA2 + HD3 + HD4 + HD5
3725 IF HD6 =< O THEN LET HD1 := O ; HD2 := O ; HDA2 := O ; HD3 := O ; HD4 := O ; HD5 := O ; HD6 := O
3730 ELSE
3735 IF HD1 + HD2 + HDA2 < 0 AND HD3 + HD4 + HD5 > 0 THEN EXEC MSSIKS1
3740 IF D1 < O THEN
3745 LET BD1 := BD1 + HD1 ; HD1 := O
3750 IF BD1 < O THEN LET BD1 := O
3755 ENDIF
3760 IF D2 < O THEN
3765 LET BD2 := BD2 + HD2 ; HD2 := O
3770 IF BD2 < O THEN LET BD2 := O
3775 ENDIF
3780 IF DA2 < O THEN
3785 LET BDA2 := BDA2 + HDA2 ; HDA2 := O
3790 IF BDA2 < O THEN LET BDA2 := O
3795 ENDIF
3800 IF D3 < O THEN
3805 LET BD3 := BD3 + HD3 ; HD3 := O
3810 IF BD3 < O THEN LET BD3 := O
3815 ENDIF
3820 IF D4 < O THEN
3825 LET BD4 := BD4 + HD4 ; HD4 := O
3830 IF BD4 < O THEN LET BD4 := O
3835 ENDIF
3840 IF D5 < O THEN
3845 LET BD5 := BD5 + HD5 ; HD5 := O
3850 IF BD5 < O THEN LET BD5 := O
3855 ENDIF
3860 IF D1 < O THEN
3865 LET HD1 := HD1 + BD1 ; BD1 := O
3870 IF HD1 < O THEN LET HD1 := O
3875 ENDIF
3880 IF D2 < O THEN
3885 LET HD2 := HD2 + BD2 ; BD2 := O
3890 IF HD2 < O THEN LET HD2 := O
3895 ENDIF
3900 IF DA2 < O THEN
3905 LET HDA2 := HDA2 + BDA2 ; BDA2 := O
3910 IF HDA2 < O THEN LET HDA2 := O
3915 ENDIF
3920 IF D3 < O THEN
3925 LET HD3 := HD3 + BD3 ; BD3 := O
3930 IF HD3 < O THEN LET HD3 := O
3935 ENDIF
3940 IF D4 < O THEN
3945 LET HD4 := HD4 + BD4 ; BD4 := O
3950 IF HD4 < O THEN LET HD4 := O
3955 ENDIF
3960 IF D5 < O THEN
3965 LET HD5 := HD5 + BD5 ; BD5 := O
3970 IF HD5 < O THEN LET HD5 := O
3975 ENDIF
3980 LET HD6 := HD1 + HD2 + HDA2 + HD3 + HD4 + HD5 ; BD6 := BD1 + BD2 + BDA2 + BD3 + BD4 + BD5
3985 ENDIF
3990 ENDPROC REGN7
3995 PROC MSSIKS
4000 LET F4 := ABS(HD1 + HD2 + HDA2)
4005 IF F4 > HD3 + HD4 + HD5 THEN LET F4 := HD3 + HD4 + HD5
4010 LET HD3 := HD3 - (F4 / (P7 + P8 + P9) * P7) ; HD4 := HD4 - (F4 / (P7 + P8 + P9) * P8)
4015 LET HD5 := HD5 - (F4 / (P7 + P8 + P9) * P9) ; D1 := HD1 ; D2 := HD2 ; DA2 := HDA2
4020 LET HD1 := HD1 + (F4 / (D1 + D2 + DA2) * D1) ; HD2 := HD2 + (F4 / (D1 + D2 + DA2) * D2)
4025 LET HDA2 := HDA2 + (F4 / (D1 + D2 + DA2) * DA2)
4030 ENDPROC MSSIKS
4035 PROC MSSIKS1
4040 LET F4 := ABS(BD1 + BD2 + BDA2)
4045 IF F4 > BD3 + BD4 + BD5 THEN LET F4 := BD3 + BD4 + BD5
4050 LET BD3 := BD3 - (F4 / (P7 + P8 + P9) * P7) ; BD4 := BD4 - (F4 / (P7 + P8 + P9) * P8)
4055 LET BD5 := BD5 - (F4 / (P7 + P8 + P9) * P9) ; D1 := BD1 ; D2 := BD2 ; DA2 := BDA2
4060 LET BD1 := BD1 + (F4 / (D1 + D2 + DA2) * D1) ; BD2 := BD2 + (F4 / (D1 + D2 + DA2) * D2)
4065 LET BDA2 := BDA2 + (F4 / (D1 + D2 + DA2) * DA2)
4070 ENDPROC MSSIKS1
4075 PROC REGN43
4080 IF T0 = 1 AND B4 < C8 THEN LET E9 := (((INT(B4 / W) * W) - C8) * ((16 * U1) + P0 + PA0) / W)
4085 IF T0 = 1 AND C4 < C8 THEN LET E8 := (((INT(C4 / W) * W) - C8) * ((16 * U1) + P0 + PA0) / W)
4090 IF T0 = 2 AND B1 < C8 THEN LET E8 := (((INT(B1 / W) * W) - C8) * ((16 * U1) + P0 + PA0) / W)
4095 IF T0 = 2 AND C6 < C8 THEN LET E9 := (((INT(C6 / W) * W) - C8) * ((16 * U1) + P0 + PA0) / W)
4100 ENDPROC REGN43
4105 PROC REGN44
4110 IF T0 = 1 AND B4 < C8 THEN LET E9 := E9 + ((((INT(B4 / W) * W) - C8) * (P7 + P8)) / W)
4115 IF T0 = 1 AND C4 < C8 THEN LET E8 := E8 + ((((INT(C4 / W) * W) - C8) * (P7 + P8)) / W)
4120 IF T0 = 2 AND B1 < C8 THEN LET E8 := E8 + ((((INT(B1 / W) * W) - C8) * (P7 + P8)) / W)
4125 IF T0 = 2 AND C6 < C8 THEN LET E9 := E9 + ((((INT(C6 / W) * W) - C8) * (P7 + P8)) / W)
4130 ENDPROC REGN44
4135 PROC REGN8
4140 LET B9 := O ; B7 := INT(B7 / W) * W ; B9 := (B7 - U2) * 22 / 1000
4145 IF 6 - D5 + B9 > C4 * 78 / W THEN
4150 LET E5 := (D6 - D5 + B9) - (C4 * 78 / W)
4155 IF 5 =< B9 * 60 / W THEN
4160 LET B9 := B9 - E5
4165 ELSE
4170 LET E5 := E5 - (B9 * 60 / W) ; B9 := B9 - (B9 * 60 / W)
4175 LET D1 := D1 - E5
4180 IF D1 < 0 THEN LET D1 := 0
4185 EXEC REGN38
4190 EXEC REGN7
4195 ENDIF
4200 ENDIF
4205 ENDPROC REGN8
4210 PROC REGN9
4215 IF B7 < O THEN LET B7 := O
4220 IF B8 < O THEN LET B8 := O
4225 LET B6 := B7 + B8 ; B6 := INT(B6 / W) * W ; E7 := (B6 - U2) * 22 / 1000
4230 IF B7 > O THEN LET B9 := E7 / B6 * B7
4235 IF B8 > O THEN LET E6 := E7 / B6 * B8
4240 IF 2 = 2 AND (T0 = 1 OR T0 = 2) THEN
4245 IF T0 = 1 THEN LET D8 := C4
4250 IF T0 = 2 THEN LET D8 := C6
4255 LET D0 := O
4260 ELSE
4265 IF 0 = 1 THEN
4270 LET C7 := B5
4275 ELSE
4280 LET C7 := B2
4285 ENDIF
4290 LET D0 := (INT(C7 / W) * W) * ((P0 + PA0 + P7 + P8) / W) ; D0 := D0 + E2
4295 ENDIF
4300 IF E8 < O THEN LET D0 := D0 + E8
4305 IF E9 < O THEN LET D0 := D0 + E9
4310 IF T0 = 1 AND E8 >= O THEN LET D0 := D0 + HD6 - HD5 + GEMAFR
4315 IF C0 < 0 THEN LET D0 := D0 - C0
4320 IF T0 = 2 AND E9 >= O THEN LET D0 := D0 + BD6 - BD5 + GEMAFR
4325 IF C9 < 0 THEN LET D0 := D0 - C9
4330 LET D0 := D0 + E7
4335 IF D0 =< D8 * 78 / W THEN EXIT
4340 LET E5 := D0 - (D8 * 78 / W)
4345 IF 5 =< E7 * 60 / W THEN
4350 LET B9 := B9 - (E5 / B6 * B7) ; E6 := E6 - (E5 / B6 * B8)
4355 ELSE
4360 LET D0 := E7 * 60 / W ; E5 := E5 - D0 ; B9 := B9 - (D0 / B6 * B7) ; E6 := E6 - (D0 / B6 * B8)
4365 EXEC REGN10
4370 LET D1 := D1 - (E5 / B6 * B7)
4375 EXEC REGN38
4380 LET D7 := D6
4385 EXEC REGN20
4390 EXEC REGN22
4395 LET D1 := D1 - (E5 / B6 * B8)
4400 EXEC REGN38
4405 LET D9 := D6
4410 EXEC REGN21
4415 EXEC REGN7
4420 ENDIF
4425 ENDPROC REGN9
4430 PROC SKAT
4435 LET QT$ := "SKATTEBEREGNING:"
4440 EXEC LSKRIV3
4445 PRINT
4450 LET QT$ := "STATSSKAT " + PIL$(1 : 24) ; QB := D1
4455 EXEC LSKRIV2
4460 LET QT$ := "FOLKEPENSIONSBIDRAG " + PIL$(1 : 14) ; QB := D2
4465 EXEC LSKRIV2
4470 LET QT$ := "DAGPENGEFONDBIDRAG " + PIL$(1 : 15) ; QB := DA2
4475 EXEC LSKRIV2
4480 LET QT$ := "KOMMUNESKAT " + PIL$(1 : 22) ; QB := D3
4485 EXEC LSKRIV2
4490 LET QT$ := "AMTSKOMMUNAL INDKOMSTSKAT " + PIL$(1 : 8) ; QB := D4
4495 EXEC LSKRIV2
4500 IF 5 > O THEN
4505 LET QT$ := "KIRKESKAT " + PIL$(1 : 24) ; QB := D5
4510 EXEC LSKRIV2
4515 ENDIF
4520 ENDPROC SKAT
4525 PROC INDSKAT
4530 LET QT$ := SP$(1 : 34) + LI$(1 : 16)
4535 EXEC LSKRIV3
4540 LET QT$ := "INDKOMSTSKAT IALT " + PIL$(1 : 16) ; QB := D6
4545 EXEC LSKRIV2
4550 ENDPROC INDSKAT
4555 PROC FSKAT
4560 IF S > O THEN
4565 LET QT$ := "FORMUESKAT " + PIL$(1 : 23) ; QB := FS
4570 EXEC LSKRIV2
4575 LET QT$ := SP$(1 : 34) + LI$(1 : 16)
4580 EXEC LSKRIV3
4585 LET QT$ := "*** TOTALSKAT " + PIL$(1 : 20) ; QB := D6 + FS
4590 EXEC LSKRIV2
4595 ENDIF
4600 LET QT$ := SP$(1 : 34) + "================"
4605 EXEC LSKRIV3
4610 ENDPROC FSKAT
4615 PROC SKATPRO
4620 LET QT$ := "Kommuneskatteprocent       " ; QB := P7
4625 EXEC LSKRIV4
4630 LET QT$ := "Amtskommunal skatteprocent " ; QB := P8
4635 EXEC LSKRIV4
4640 LET QT$ := "Kirkeskatteprocent         " ; QB := P9
4645 EXEC LSKRIV4
4650 IF 1 >< O THEN
4655 LET QT$ := "Hovedpersonen er beregnet med personfradrag som pensionist."
4660 EXEC LSKRIV3
4665 ENDIF
4670 IF 3 >< O THEN
4675 LET QT$ := "Den gifte kvinde er beregnet med personfradrag som pensionist."
4680 EXEC LSKRIV3
4685 ENDIF
4690 IF 4 = 1 THEN
4695 LET QT$ := "Beregningerne er sket efter reglerne om ligedeling ægtefæller."
4700 EXEC LSKRIV3
4705 ENDIF
4710 ENDPROC SKATPRO
4715 PROC LSKRIV2
4720 PRINT USING QT$ + "#########.## KR." : QB
4725 ENDPROC LSKRIV2
4730 PROC LSKRIV1
4735 PRINT USING QT$ + "######### KR." : QB
4740 ENDPROC LSKRIV1
4745 PROC LSKRIV4
4750 PRINT USING QT$ + "#######.# PCT." : QB
4755 ENDPROC LSKRIV4
4760 PROC SVAR
4765 REPEAT
4770 INPUT "? (j/n) " : S$
4775 IF S$ = "N" THEN LET S$ := "n"
4780 IF S$ = "J" THEN LET S$ := "j"
4785 IF S$ = "q" OR S$ = "Q" THEN END
4790 UNTIL S$ = "j" OR S$ = "n"
4795 PRINT LI$
4800 ENDPROC SVAR
4805 PROC LSKRIV
4810 PRINT
4815 ENDPROC LSKRIV
4820 PROC LSKRIV3
4825 PRINT QT$
4830 ENDPROC LSKRIV3
4835 PROC REGN50
4840 EXEC REGN32
4845 EXEC REGN33
4850 EXEC REGN34
4855 IF C8 = P3 THEN LET C8 := P4
4860 EXEC REGN35
4865 EXEC REGN36
4870 IF 5 > O THEN
4875 EXEC REGN37
4880 ELSE
4885 IF C8 > C7 THEN LET D5 := D5 - ((C8 - C7) * P9 / W)
4890 ENDIF
4895 EXEC REGN38
4900 ENDPROC REGN50
4905 PROC REGN51
4910 EXEC REGN26
4915 EXEC REGN27
4920 EXEC REGN28
4925 EXEC REGN29
4930 ENDPROC REGN51
4935 PROC RETURN
4940 LET S$ := "-"
4945 PRINT
4950 PRINT TAB(65) ;
4955 EDIT "TRYK -RETURN" : S$
4960 ENDPROC RETURN
4965 PROC SKIFT
4970 IF = 1 THEN
4975 EXEC RETURN
4980 CLEAR
4985 ELSE
4990 FOR X := 1 TO DO
4995 PRINT
5000 NEXT X
5005 ENDIF
5010 ENDPROC SKIFT
5015 PROC SIDESKIFT
5020 IF = 2 THEN
5025 PRINT CHR$ (12)
5030 PRINT REV$
5035 PRINT ADR$
5040 ENDIF
5045 EXEC SKIFT
5050 ENDPROC SIDESKIFT
5055 PROC WIN
5060 CURSOR 1,20
5065 PRINT SP$ + SP$
5070 LET X := 3 ; P := O ; A(N) := O ; FIL$ := "DDE:INDKOM"
5075 OPEN FIL$,R
5080 IF N = 18 THEN LET X := 6 ; P := 6
5085 IF N = 8 THEN LET P := 3
5090 IF N = 19 THEN LET P := 12
5095 CURSOR 1,23 - X
5100 FOR Y := 1 TO + X DO
5105 GET FIL$ : S$
5110 IF > P THEN
5115 PRINT S$
5120 ENDIF
5125 NEXT Y
5130 FOR Y := 1 TO DO
5135 CURSOR 65,22 - X + Y
5140 INPUT B
5145 LET A(N) := A(N) + B
5150 NEXT Y
5155 CLOSE FIL$
5160 ENDPROC WIN