DataMuseum.dk

top - metrics - download

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

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

SPC/1 COMAL-80

00100 ON ESC GOTO DUMMY
00110 DIM HKL $ OF 38 , BKL $ OF 38 , BJ $ OF 4
00120 LET FSLUT := 0 ; HKL $ := "" ; BKL $ := "" ; ZH := 0 ; ZB := 0
00130 INTEGER F5 , X , Y , PR , F8 , FE , G , T0 , T1 , T2 , T3 , T4 , RESTRATE , NYRATE
00140 DIM LI $ OF 80 , QT $ OF 80 , FIL $ OF 15 , S $ OF 80 , J $ OF 4 , PIL $ OF 80 , HJ $ OF 4
00150 // ----------------------…skatvar…-----------------------------
00160 LET F5 := 1985 ; U1 := .9 ; P0 := 3.5 ; PA0 := 2 ; P2 := 182600
00170 // ------------------------------------------------------------
00180 LET T2 := 0 ; F8 := 0 ; T4 := 0 ; G := 0
00190 LET LI $ := "" ; PIL $ := ""
00200 FOR X := 1 TO 9 DO
00210 LET LI $ := LI $ + "-"
00220 LET PIL $ := PIL $ + "."
00230 NEXT X
00240 OPEN "dde:fvar" , R
00250 GET "dde:fvar" : PR , C4 , HD6 , C9 , B0 , T1 , TKH , F6 , F1
00260 GET "dde:fvar" : F9 , P1 , P7 , P8 , P9 , T0 , B2 , B1 , B9
00270 GET "dde:fvar" : T2 , C6 , BD6 , C0 , B3 , E6 , F2 , T3 , TKB
00280 GET "dde:fvar" : F0 , F7 , SKG , AKT , D6 , GSLUT
00290 GET "DDE:FVAR" : HFORMUE , BFORMUE , HATP , BATP , G , FSLUT
00300 GET "dde:fvar" : HKL $ , BKL $
00310 CLOSE "dde:fvar"
00320 OPEN "DDE:FORSKVAR" , R
00330 GET "DDE:FORSKVAR" : ZH , HJ $ , HAIH , HASQ , HBSKF , F1
00340 GET "DDE:FORSKVAR" : ZB , BJ $ , BAIH , BASQ , BBSKF , F2
00350 CLOSE "DDE:FORSKVAR"
00360 IF >< 1 AND FSLUT >< 1 THEN
00370 LET HBSKF := 0 ; BBSKF := 0
00380 PRINT "Skriv…hovedpersonens…indregnede…restskat…i…" ; F5 - 2 ; "(evt.…0)…" ;
00390 INPUT F1
00400 PRINT LI $
00410 IF 2 >< 0 THEN
00420 IF >< 1 AND FSLUT >< 1 THEN
00430 PRINT "Skriv…den…gifte…kvindes…indregnede…restskat…i…" ; F5 - 2 ; "(evt.…0)…" ;
00440 INPUT F2
00450 PRINT LI $
00460 ENDIF
00470 ENDIF
00480 ENDIF
00490 LET C7 := INT ( C4 / 100 ) * 100
00500 LET D6 := HD6 ; D0 := C9 ; AI := B0 ; B6 := B9 ; IR := F1 ; TP := T1 ; TK := TKH ; D6 := D6 - F9 - F6
00510 EXEC REGN12
00520 IF = 1 AND FSLUT = 1 THEN
00530 LET Z := ZH ; J $ := HJ $ ; AIH := HAIH ; ASQ := HASQ ; BSKF := HBSKF
00540 ELSE
00550 CLEAR
00560 LET FIL $ := "dde:skatdath"
00570 OPEN FIL $ , R
00580 EXEC L[SFIL
00590 LET ZH := Z
00600 ENDIF
00610 IF > 0 THEN
00620 EXEC INDASKAT
00630 LET HJ $ := J $ ; HAIH := AIH ; HASQ := ASQ ; HBSKF := BSKF
00640 ENDIF
00650 IF I = 0 THEN
00660 EXEC REGN13
00670 ELSE
00680 IF 6 < 100 THEN
00690 EXEC REGN14
00700 ELSE
00710 IF T2 = 1 AND T0 = 2 AND B2 > 0 THEN LET D0 := AR ; C7 := INT ( B1 / 100 ) * 100
00720 EXEC REGN15
00730 EXEC REGN16
00740 IF INT ( FR ) > 0 THEN EXEC REGN11
00750 ENDIF
00760 EXEC REGN17
00770 ENDIF
00780 LET QT $ := "FORSKUDSOPG\RELSE…FOR…" + HKL $ + ":"
00790 EXEC [NDFORS
00800 IF 2 >< 0 THEN
00810 LET C7 := INT ( C6 / 100 ) * 100
00820 LET D6 := BD6 ; D0 := C0 ; AI := B3 ; B6 := E6 ; IR := F2 ; TP := T3 ; TK := TKB ; D6 := D6 - F0 - F7
00830 EXEC REGN12
00840 IF = 1 AND FSLUT = 1 THEN
00850 LET Z := ZB ; J $ := BJ $ ; AIH := BAIH ; ASQ := BASQ ; BSKF := BBSKF
00860 ELSE
00870 CLEAR
00880 LET FIL $ := "dde:skatdatb"
00890 OPEN FIL $ , R
00900 EXEC L[SFIL
00910 LET ZB := Z
00920 ENDIF
00930 IF > 0 THEN
00940 EXEC INDASKAT
00950 LET BJ $ := J $ ; BAIH := AIH ; BASQ := ASQ ; BBSKF := BSKF
00960 ENDIF
00970 IF I = 0 THEN
00980 EXEC REGN13
00990 ELSE
01000 IF 6 < 100 THEN
01010 EXEC REGN14
01020 ELSE
01030 IF T2 = 1 AND T0 = 1 AND B2 > 0 THEN LET D0 := AR ; C7 := INT ( B1 / 100 ) * 100
01040 EXEC REGN15
01050 EXEC REGN16
01060 IF INT ( FR ) > 0 THEN EXEC REGN11
01070 ENDIF
01080 EXEC REGN17
01090 ENDIF
01100 LET QT $ := "FORSKUDSOPG\RELSE…FOR…" + BKL $ + ":"
01110 EXEC [NDFORS
01120 ENDIF
01130 LET SYS := 1
01140 OPEN "DDE:FORSKVAR" , W
01150 PUT "DDE:FORSKVAR" : ZH , HJ $ , HAIH , HASQ , HBSKF , F1
01160 PUT "DDE:FORSKVAR" : ZB , BJ $ , BAIH , BASQ , BBSKF , F2
01170 CLOSE "DDE:FORSKVAR"
01180 OPEN "dde:skatsys" , W
01190 PUT "dde:skatsys" : SYS
01200 CLOSE "dde:skatsys"
01210 PRINT "***…VENT…***…HOVEDPROGRAMMET…INDL[SES…***"
01220 CHAIN "dde:skat85"
01230 PROC LSKRIV2
01240 LET PRB := QB
01250 PRINT QT $ ; TAB ( 35 ) ;
01260 PRINT USING "#########.##…KR." : PRB
01270 ENDPROC LSKRIV2
01280 PROC LSKRIV1
01290 LET PRB := QB
01300 PRINT QT $ ; TAB ( 35 ) ;
01310 PRINT USING "#########…KR." : PRB
01320 ENDPROC LSKRIV1
01330 PROC LSKRIV4
01340 LET PRB := QB
01350 PRINT QT $ ; TAB ( 35 ) ;
01360 PRINT USING "#########…PCT." : PRB
01370 ENDPROC LSKRIV4
01380 PROC SVAR
01390 REPEAT
01400 INPUT S $
01410 IF S $ = "J" THEN LET S $ := "j"
01420 IF S $ = "N" THEN LET S $ := "n"
01430 IF $ = "Q" OR S $ = "q" THEN
01440 PRINT "Programmet…kan…kun…afsluttes…fra…hovedprogrammet." ; CHR$ ( 7 )
01450 ENDIF
01460 UNTIL S $ = "j" OR S $ = "n"
01470 PRINT LI $
01480 ENDPROC SVAR
01490 PROC LSKRIV
01500 PRINT
01510 ENDPROC LSKRIV
01520 PROC LSKRIV3
01530 PRINT QT $
01540 ENDPROC LSKRIV3
01550 PROC REGN12
01560 LET Z := 0 ; AIH := 0 ; ASQ := 0 ; PCT := 0 ; BSK := 0 ; MAX := 0 ; FR := 0 ; BSKF := 0 ; NYRATE := 1
01570 LET RESTRATE := 10
01580 ENDPROC REGN12
01590 PROC INDASKAT
01600 IF >< 1 AND FSLUT >< 1 THEN
01610 IF I >< 0 THEN
01620 INPUT "Skriv…A-indkomst…(l|n)…fra…1.…januar…til…{ndringsdato:…" : AIH
01630 PRINT LI $
01640 INPUT "Skriv…betalt…A-skat…fra…1.…januar…til…{ndringsdato:…" : ASQ
01650 PRINT LI $
01660 ENDIF
01670 PRINT "Skriv…forfalden…B-skat…til…og…med…m}ned…" ;
01680 PRINT ( ╱cc╱ ( J $ ( 3 : 1 ) ) - 48 ) * 10 + ╱cc╱ ( J $ ( 4 : 1 ) ) - 48 ;
01690 INPUT "(evt.…0):" : BSKF
01700 PRINT LI $
01710 ENDIF
01720 IF ╱cc╱ ( J $ ( 3 : 1 ) ) - 48 ) * 10 + ╱cc╱ ( J $ ( 4 : 1 ) ) - 48 =< 5 THEN
01730 LET NYRATE := ( ╱cc╱ ( J $ ( 3 : 1 ) ) - 48 ) * 10 + ╱cc╱ ( J $ ( 4 : 1 ) ) - 47
01740 ELSE
01750 LET NYRATE := ( ╱cc╱ ( J $ ( 3 : 1 ) ) - 48 ) * 10 + ╱cc╱ ( J $ ( 4 : 1 ) ) - 48
01760 ENDIF
01770 LET RESTRATE := 11 - NYRATE
01780 LET D6 := D6 - ASQ - BSKF ; AI := AI - AIH
01790 ENDPROC INDASKAT
01800 PROC REGN15
01810 IF 7 > 0 THEN
01820 LET PCT := ( D0 * 100 ) / ( INT ( C7 / 100 ) * 100 )
01830 ELSE
01840 LET PCT := ( 16 * U1 ) + P0 + PA0 + P7 + P8 + ( P9 * ( TK = 1 ) )
01850 ENDIF
01860 LET PCT := INT ( PCT * 10 ) / 10
01870 ENDPROC REGN15
01880 PROC REGN17
01890 IF C7 =< P1 THEN LET PCT := PCT + 1 ; PCT := INT ( PCT )
01900 IF C7 > P1 THEN LET PCT := PCT + 1.5 ; PCT := INT ( PCT )
01910 ENDPROC REGN17
01920 PROC REGN16
01930 LET FR := AI - ( D6 * 100 / PCT )
01940 IF R >= 0 THEN
01950 IF R >< 0 AND INT ( B6 ) >< 0 THEN
01960 LET FR := FR - ( ( ( IR + B6 ) * 100 ) / PCT )
01970 IF R < 0 THEN
01980 LET BSK := FR * PCT / 100 ; BSK := ABS ( INT ( BSK ) ) ; FR := 0
01990 ENDIF
02000 ENDIF
02010 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
02020 ELSE
02030 LET BSK := FR * PCT / 100 ; BSK := ABS ( INT ( BSK ) ) ; FR := 0
02040 IF R >< 0 AND INT ( B6 ) >< 0 THEN
02050 LET BSK := BSK + IR + INT ( B6 )
02060 ENDIF
02070 ENDIF
02080 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
02090 ENDPROC REGN16
02100 PROC REGN11
02110 LET FR1 := FR * 365 / ( 365 - Z ) / 12
02120 LET FR2 := FR * 365 / ( 365 - Z ) / 26
02130 LET FR3 := FR * 365 / ( 365 - Z ) / 52
02140 LET FR4 := FR / ( 365 - Z )
02150 ENDPROC REGN11
02160 PROC REGN13
02170 LET BSK := INT ( D6 + IR + B6 )
02180 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
02190 ENDPROC REGN13
02200 PROC AFRUND
02210 LET BSKRATE := INT ( BSK / RESTRATE ) ; BSK := BSKRATE * RESTRATE
02220 ENDPROC AFRUND
02230 PROC REGN14
02240 IF C7 =< P1 THEN LET PCT := ( 16 * U1 ) + P0 + PA0 + P7 + P8 + ( P9 * ( TK = 1 ) )
02250 IF C7 > P1 THEN LET PCT := ( 32 * U1 ) + P0 + PA0 + P7 + P8 + ( P9 * ( TK = 1 ) )
02260 IF C7 > P2 THEN LET PCT := ( 44 * U1 ) + P0 + PA0 + P7 + P8 + ( P9 * ( TK = 1 ) )
02270 LET PCT := INT ( PCT * 100 ) / 100
02280 IF P = 0 AND IR =< 100 THEN
02290 LET MAX := AI - ( D6 * 100 / PCT ) ; MAX := INT ( MAX )
02300 IF INT ( B6 ) = 0 AND IR = 0 THEN EXIT
02310 LET BSK := IR + INT ( B6 )
02320 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
02330 ELSE
02340 LET FR := AI - ( IR * 100 / PCT )
02350 IF FR < 0 THEN LET BSK := ( FR * PCT / 100 ) ; BSK := ABS ( INT ( BSK ) ) ; FR := 0
02360 IF RESTRATE > 0 AND BSK > 0 THEN EXEC AFRUND
02370 IF INT ( FR ) > 0 THEN EXEC REGN11
02380 ENDIF
02390 ENDPROC REGN14
02400 PROC [NDFORS
02410 FOR Y := 1 TO R + 1 DO
02420 IF Y = 2 THEN OUTPUT "P"
02430 EXEC LSKRIV3
02440 PRINT
02450 IF CT > 0 THEN
02460 LET QT $ := "TR[KPROCENT…" + PIL $ ( 1 : 20 ) ; QB := PCT
02470 EXEC LSKRIV4
02480 ENDIF
02490 IF R > 0 THEN
02500 LET QT $ := "FRADRAG…PR.…M]NED…" + PIL $ ( 1 : 14 ) ; QB := FR1
02510 EXEC LSKRIV1
02520 LET QT $ := "FRADRAG…PR.…14-DAG…" + PIL $ ( 1 : 13 ) ; QB := FR2
02530 EXEC LSKRIV1
02540 LET QT $ := "FRADRAG…PR.…UGE…" + PIL $ ( 1 : 16 ) ; QB := FR3
02550 EXEC LSKRIV1
02560 LET QT $ := "FRADRAG…PR.…DAG…" + PIL $ ( 1 : 16 ) ; QB := FR4
02570 EXEC LSKRIV1
02580 ENDIF
02590 IF AX > 0 THEN
02600 LET QT $ := "MAKSIMAL…A-INDKOMST" + PIL $ ( 1 : 13 ) ; QB := MAX
02610 EXEC LSKRIV1
02620 ENDIF
02630 IF SK > 0 AND RESTRATE > 0 THEN
02640 LET QT $ := "B-SKAT…FOR…RESTEN…AF…]RET" + PIL $ ( 1 : 6 ) ; QB := BSK
02650 EXEC LSKRIV1
02660 PRINT "B-SKATTEN…FORDELES…OVER…" ; RESTRATE ; "RATE(R).…F\RSTE…RATE…ER…" ;
02670 PRINT "NR.…" ; NYRATE ; "."
02680 LET QT $ := "RATEBEL\BET…UDG\R…" + PIL $ ( 1 : 14 ) ; QB := BSK / RESTRATE
02690 EXEC LSKRIV1
02700 ENDIF
02710 IF SK > 0 AND RESTRATE =< 0 THEN
02720 LET QT $ := "B-SKAT…KAN…IKKE…[NDRES…EFTER…DEN…31/10.…DER…KAN…EVT.…INDBETALES"
02730 LET QT $ := QT $ + "…FRIVILLIGT"
02740 EXEC LSKRIV3
02750 LET QT $ := "EFTER…KILDESKATTELOVENS…PGF.…59.…SAMMENLIGN…B-SKAT…MED…SKATTEBE"
02760 LET QT $ := QT $ + "REGNINGEN."
02770 EXEC LSKRIV3
02780 ENDIF
02790 IF SK < 0 THEN
02800 LET QT $ := "DER…ER…BETALT…FOR…MEGET…I…FORSKUDSSKAT.…SKATTEV[SENET…KAN…EVT."
02810 LET QT $ := QT $ + "…ANMODES…OM"
02820 EXEC LSKRIV3
02830 LET QT $ := "TILBAGEBETALING…INDEN…DEN…30/12.…SAMMENLIGN…B-SKAT…MED…SKATTE"
02840 LET QT $ := QT $ + "BEREGNINGEN."
02850 EXEC LSKRIV3
02860 ENDIF
02870 PRINT
02880 PRINT
02890 IF SKF > 0 THEN
02900 LET QT $ := "ALLEREDE…FORFALDEN…B-SKAT…UDG\R…" ; QB := BSKF
02910 EXEC LSKRIV1
02920 LET QT $ := "DEN…FORFALDNE…B-SKAT…FORUDS[TTES…BETALT."
02930 EXEC LSKRIV3
02940 ENDIF
02950 IF R > 0 THEN
02960 PRINT "INDREGNET…RESTSKAT…FRA…" ; F5 - 2 ; ":…………" ;
02970 LET QT $ := "" ; QB := IR
02980 EXEC LSKRIV1
02990 ENDIF
03000 IF IH > 0 THEN
03010 LET QT $ := "A-INDKOMST…TIL…[NDRINGSDATO:……………" ; QB := AIH
03020 EXEC LSKRIV1
03030 ENDIF
03040 IF SQ > 0 THEN
03050 LET QT $ := "A-SKAT…TIL…[NDRINGSDATO:………………………" ; QB := ASQ
03060 EXEC LSKRIV1
03070 ENDIF
03080 IF > 0 THEN
03090 LET QT $ := "[NDRINGSDATO:…" + PIL $ ( 1 : 18 ) + "…………………" ; QT $ := QT $ + J $
03100 EXEC LSKRIV3
03110 ENDIF
03120 IF Y = 1 THEN EXEC RETURN
03130 NEXT Y
03140 OUTPUT "t"
03150 ENDPROC [NDFORS
03160 PROC L[SFIL
03170 LET STATUS := 0
03180 REPEAT
03190 GET FIL $ : S $
03200 PRINT S $
03210 UNTIL ╱cd╱ ( FIL $ ) = 19
03220 CLOSE FIL $
03230 REPEAT
03240 INPUT "Skriv…skattekortets…beregningsdato…(gyldighedsdato):…" : J $
03250 CLEAR
03260 IF ╱cb╱ ( J $ ) >< 4 THEN PRINT CHR$ ( 7 )
03270 UNTIL ╱cb╱ ( J $ ) = 4
03280 IF $ >< "0101" THEN
03290 LET Z := 0
03300 LET M]NED := ( ╱cc╱ ( J $ ( 3 ) ) - 48 ) * 10 + ╱cc╱ ( J $ ( 4 ) ) - 48
03310 LET DAG := ( ╱cc╱ ( J $ ( 1 ) ) - 48 ) * 10 + ╱cc╱ ( J $ ( 2 ) ) - 48
03320 FOR X := 2 TO ]NED DO
03330 LET Z := Z + 31
03340 IF X = 5 OR X = 7 OR X = 10 OR X = 12 THEN LET Z := Z - 1
03350 IF X = 3 THEN LET Z := Z - 3
03360 NEXT X
03370 LET Z := Z + DAG - 1
03380 ENDIF
03390 ENDPROC L[SFIL
03400 PROC RETURN
03410 PRINT
03420 PRINT TAB ( 65 ) ;
03430 LET S $ := "-"
03440 EDIT "TRYK…-RETURN" : S $
03450 ENDPROC RETURN
38382 ╱00╱ ╱00╱