DataMuseum.dk

top - download

    Length: 4603 (0x11fb)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_cd
    Names: »ÅRSOP85.B«

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

SPC/1 COMAL-80

0100 ON ESC GOTO DUMMY
0110 INTEGER X,N,PR,Y,F8,FE,G,T0,T1,T2,T3,T4
0120 LET STATUS := 0 ; G1 := 0 ; B7 := 0 ; B8 := 0 ; U2 := 0 ; F0 := 0 ; F7 := 0 ; T3 := 0 ; T := 0 ; T0 := 0
0130 LET TKB := 0 ; TKH := 0
0140 DIM A1$(29) OF 29,A(29),H(23),K(23),LI$ OF 80,QT$ OF 80,S$ OF 80
0150 DIM FIL$ OF 15,PIL$ OF 80,SP$ OF 80,HKL$ OF 38,BKL$ OF 38
0160 LET LI$ := "" ; PIL$ := "" ; SP$ := ""
0170 FOR X := 1 TO 8 DO
0180 LET LI$ := LI$ + "-" ; PIL$ := PIL$ + "." ; SP$ := SP$ + " "
0190 NEXT X
0200 LET F8 := 0 ; G := 0 ; T2 := 2 ; T4 := 0
0210 LET FIL$ := "dde:skatsys"
0220 OPEN FIL$,R
0230 GET FIL$ : SYS
0240 CLOSE FIL$
0250 OPEN FIL$,W
0260 LET SYS := 1
0270 PUT FIL$ : SYS
0280 CLOSE FIL$
0290 LET FIL$ := "dde:hskvar"
0300 OPEN FIL$,R
0310 FOR X := 1 TO 9 DO
0320 GET FIL$ : A(X)
0330 IF X < 24 THEN GET FIL$ : H(X),K(X)
0340 NEXT X
0350 GET FIL$ : F8,T1,T2,T4
0360 CLOSE FIL$
0370 LET FIL$ := "dde:fvar"
0380 OPEN FIL$,R
0390 GET FIL$ : PR,C4,HD6,C9,B0,T1,TKH,F6,F1
0400 GET FIL$ : F9,P1,P7,P8,P9,T0,B2,B1,B9
0410 GET FIL$ : T2,C6,BD6,C0,B3,E6,F2,T3,TKB
0420 GET FIL$ : F0,F7,SKG,AKT,D6,GSLUT
0430 GET FIL$ : HFORMUE,BFORMUE,HATP,BATP,G,FSLUT
0440 GET FIL$ : HKL$,BKL$
0450 CLOSE FIL$
0460 LET X := 0
0470 OPEN "dde:skatart",R
0480 REPEAT
0490 LET X := X + 1
0500 GET "dde:skatart" : A1$(X)
0510 UNTIL ╱cd╱ ("dde:skatart") = 19 OR ╱cd╱ ("dde:skatart") > 0 OR X = 29
0520 CLOSE
0530 LET E1 := 28 ; F3 := 64000 ; F4 := 70999 ; F5 := 1985 ; P1 := 111300 ; P2 := 182600
0540 LET P3 := 22700 ; P4 := 20300 ; P5 := 43900 ; P6 := 24000 ; P0 := 3.5 ; PA0 := 2
0550 LET U1 := .9 ; U2 := 1229200 ; M1 := 112700
0560 LET D6 := HD6 ; SKG := F6 ; AKT := F9
0570 FOR X := 24 TO 9 DO
0580 LET A(X) := 0
0590 NEXT X
0600 IF >< 1 AND GSLUT >< 1 THEN
0610 LET FIL$ := "dde:skatsluh"
0620 OPEN FIL$,R
0630 EXEC LÆSF
0640 EXEC GEMHOP
0650 ELSE
0660 EXEC HENTHOP
0670 ENDIF
0680 FOR Y := 1 TO R + 1 DO
0690 IF Y = 2 THEN OUTPUT "p"
0700 IF = 2 THEN
0710 EXEC TLI
0720 ELSE
0730 CLEAR
0740 ENDIF
0750 LET QT$ := "ÅRSOPGØRELSE FOR " + HKL$ + ":"
0760 EXEC LSKRIV3
0770 EXEC ÅRSOPG
0780 IF Y = 1 THEN EXEC RETURN
0790 IF Y = 2 THEN OUTPUT "t"
0800 NEXT Y
0810 IF 2 >< 0 THEN
0820 LET D6 := BD6 ; SKG := F7 ; AKT := F0
0830 FOR X := 24 TO 9 DO
0840 LET A(X) := 0
0850 NEXT X
0860 CLEAR
0870 IF >< 1 AND GSLUT >< 1 THEN
0880 LET FIL$ := "dde:skatslub"
0890 OPEN FIL$,R
0900 EXEC LÆSF
0910 EXEC GEMBIP
0920 ELSE
0930 EXEC HENTBIP
0940 ENDIF
0950 FOR Y := 1 TO R + 1 DO
0960 IF Y = 2 THEN OUTPUT "p"
0970 IF = 2 THEN
0980 EXEC TLI
0990 ELSE
1000 CLEAR
1010 ENDIF
1020 LET QT$ := "ÅRSOPGØRELSE FOR " + BKL$ + ":"
1030 EXEC LSKRIV3
1040 EXEC ÅRSOPG
1050 IF Y = 1 THEN EXEC RETURN
1060 IF Y = 2 THEN OUTPUT "t"
1070 NEXT Y
1080 ENDIF
1090 PRINT "*** VENT *** HOVEDPROGRAMMET INDLÆSES ***"
1100 CHAIN "DDE:SKAT85"
1110 PROC LSKRIV2
1120 LET PRB := QB
1130 PRINT QT$ ;
1140 PRINT USING "#########.## KR." : PRB
1150 ENDPROC LSKRIV2
1160 PROC LSKRIV1
1170 LET PRB := QB
1180 PRINT QT$ ;
1190 PRINT USING "######### KR." : PRB
1200 ENDPROC LSKRIV1
1210 PROC LSKRIV4
1220 LET PRB := QB
1230 PRINT QT$ ;
1240 PRINT USING "######### PCT." : PRB
1250 ENDPROC LSKRIV4
1260 PROC SVAR
1270 REPEAT
1280 INPUT S$
1290 IF $ = "q" OR S$ = "Q" THEN
1300 PRINT "Programmet kan kun afsluttes fra hovedprogrammet." ; CHR$ (7)
1310 ENDIF
1320 UNTIL S$ = "j" OR S$ = "n"
1330 PRINT LI$
1340 ENDPROC SVAR
1350 PROC LSKRIV
1360 PRINT
1370 ENDPROC LSKRIV
1380 PROC LSKRIV3
1390 PRINT QT$
1400 ENDPROC LSKRIV3
1410 PROC ÅRSOPG
1420 IF Y = 1 THEN LET DD6 := D6
1430 LET A(27) := SKG + AKT
1440 PRINT
1450 LET QT$ := "SLUTSKAT" + PIL$(1 : 23) ; QB := INT(D6)
1460 EXEC LSKRIV1
1470 FOR X := 24 TO 9 DO
1480 IF (X) > 0 AND X >< 28 AND X >< 29 THEN
1490 IF = 1 THEN
1500 LET D6 := D6 - A(X)
1510 ENDIF
1520 PRINT "- " ;
1530 ENDIF
1540 IF (X) > 0 AND (X = 28 OR X = 29) THEN
1550 IF = 1 THEN
1560 LET D6 := D6 + A(X)
1570 ENDIF
1580 PRINT "+ " ;
1590 ENDIF
1600 IF (X) > 0 THEN
1610 LET QT$ := A1$(X) ; QB := A(X)
1620 EXEC LSKRIV1
1630 ENDIF
1640 NEXT X
1650 LET QT$ := SP$(1 : 32) + "------------"
1660 EXEC LSKRIV3
1670 IF (D6) > 0 THEN
1680 LET QT$ := "RESTSKAT" + PIL$(1 : 23) ; QB := INT(D6)
1690 EXEC LSKRIV1
1700 ENDIF
1710 IF (D6) = 0 THEN
1720 LET QT$ := "FORSKUDSSKATTEN STEMMER MED SLUTSKATTEN."
1730 EXEC LSKRIV3
1740 ENDIF
1750 IF (D6) < 0 THEN
1760 LET QT$ := "OVERSKYDENDE SKAT" + PIL$(1 : 14) ; QB := INT(D6)
1770 EXEC LSKRIV1
1780 ENDIF
1790 IF (D6) >< 0 THEN
1800 LET QT$ := SP$(1 : 32) + "============"
1810 EXEC LSKRIV3
1820 ENDIF
1830 IF (21) > 0 THEN
1840 LET QT$ := "Pålignet B-skat forudsættes betalt."
1850 EXEC LSKRIV3
1860 ENDIF
1870 ENDPROC ÅRSOPG
1880 PROC LÆSF
1890 FOR X := 24 TO 9 DO
1900 IF >< 27 THEN
1910 IF (FIL$) = 0 THEN
1920 GET FIL$ : S$
1930 PRINT S$
1940 GET FIL$ : S$
1950 PRINT S$ ;
1960 INPUT "" : A(X)
1970 PRINT LI$
1980 ENDIF
1990 ENDIF
2000 NEXT X
2010 CLEAR
2020 ENDPROC LÆSF
2030 PROC RETURN
2040 LET S$ := "-"
2050 PRINT
2060 PRINT TAB(65) ;
2070 EDIT "TRYK -RETURN" : S$
2080 ENDPROC RETURN
2090 PROC TLI
2100 FOR X := 1 TO DO
2110 PRINT
2120 NEXT X
2130 ENDPROC TLI
2140 PROC GEMHOP
2150 OPEN "DDE:HSLUT",W
2160 FOR X := 1 TO DO
2170 IF X >< 3 THEN PUT "DDE:HSLUT" : A(30 - X)
2180 NEXT X
2190 CLOSE "DDE:HSLUT"
2200 ENDPROC GEMHOP
2210 PROC GEMBIP
2220 OPEN "DDE:BSLUT",W
2230 FOR X := 1 TO DO
2240 IF X >< 3 THEN PUT "DDE:BSLUT" : A(30 - X)
2250 NEXT X
2260 CLOSE "DDE:BSLUT"
2270 ENDPROC GEMBIP
2280 PROC HENTHOP
2290 OPEN "DDE:HSLUT",R
2300 FOR X := 1 TO DO
2310 IF X >< 3 THEN GET "DDE:HSLUT" : A(30 - X)
2320 NEXT X
2330 CLOSE "DDE:HSLUT"
2340 ENDPROC HENTHOP
2350 PROC HENTBIP
2360 OPEN "DDE:BSLUT",R
2370 FOR X := 1 TO DO
2380 IF X >< 3 THEN GET "DDE:BSLUT" : A(30 - X)
2390 NEXT X
2400 CLOSE "DDE:BSLUT"
2410 ENDPROC HENTBIP