DataMuseum.dk

top - download

    Length: 10853 (0x2a65)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »BKLFERIE.B«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »BKLFERIE.B« 
└─⟦ff7f7aeee⟧ Bits:30009007 NBT	15/3-84
    └─⟦this⟧ »BKLFERIE.B« 

SPC/1 COMAL-BIN

0100 DIM A1(V),A2(V),A3(V),A4(V),A5(V),A6(G),A7$(8),A8$(8),A9$(E),B0$(E)
0120 DIM RES$(15),OP1$(12),OP2$(12),B1$(12),B2$(12),B3$(12),B4$(12),B5$(12)
0130 DIM B7(10),B8$(10,37),B9$(8,11),C0$(12),C1$(12),C2$(12),C3$(12)
0140 DIM C4$(12),C5$(45,11),C6$(55),C9$(16),D0$(16),D1$(71)
0150 DIM D2$(27),D3$(55),D4$(34),D5$(29),D6$(37),D7$(16),D8$(16),D9$(16)
0160 DIM E0$(16),E1$(16),E2$(16,12),E6(18),E7(18),E8(18),E9$(79),F0$(79)
0162 DIM F1$(12),DD$(6),PAGE$(19,68),ÅR$(G),KV$(E)
0170 B3$="          0+";B5$="       6,00+";B4$="     100,00+"
0171 FOR I=E TO 16
0172 E2$(I)=B3$
0173 NEXT I
0200 A6(E),A6(G),E3,E4,E5=B
0230 FOR I=E TO 79
0240 E9$=E9$+" "
0250 NEXT I
0251 FOR I=E TO 19
0253 PAGE$(I)=E9$(E,68)
0255 NEXT I
0260 E6(11),E6(14),E6(17)=27;E6(12),E6(15),E6(18)=34
0280 E8(4)=-4
0300 E6(4)=36;E6(5),E6(6)=39;E6(10),E6(13),E6(16)=23
0310 E7(4)=4;E7(5)=5;E7(6)=6
0320 E7(10),E7(11),E7(12)=12;E7(13),E7(14),E7(15)=13;E7(16),E7(17),E7(18)=14
0340 E8(11),E8(12),E8(14),E8(15),E8(17),E8(18)=6;E8(5),E8(6)=-E
0350 E8(10),E8(13),E8(16)=B
0370 PROC C(F2,F3,F4,F5)
0380 RES$=F5$;OP1$=F3$;OP2$=F4$;SI=B;FLAG=B;ART=F2-6*(F2>5)
0390 CALL "P641210:REGN"
0400 IF F2<6 AND FLAG THEN STOP
0430 F5$=RES$
0440 ENDPROC
0441 PROC OPTÆL(F6,F7)
0442 F1$=F7$;C2$=C5$(F6)
0443 EXEC C(0,C2$,F1$,F1$)
0444 C5$(F6)=F1$(G:11)
0448 ENDPROC
0450 PROC UDTÆL
0460 J=W*(F8-E)
0470 FOR F9=E TO W
0480 FOR I=E TO 5
0490 C6$((I-E)*11+E:11)=C5$((F9-E)*5+I)
0500 NEXT I
0510 PUT D0$,J+F9:C6$
0520 NEXT F9
0530 EXEC F(-F8,-F9,D0$)
0540 ENDPROC
0550 PROC INDTÆL
0560 J=W*(F8-E)
0570 FOR F9=E TO W
0580 GET D0$,J+F9:C6$
0590 FOR I=E TO 5
0600 C5$((F9-E)*5+I)=C6$((I-E)*11+E:11)
0610 NEXT I
0620 NEXT F9
0630 EXEC F(F8,F9,D0$)
0640 ENDPROC
0641 PROC OP(F6,F7)
0642 F1$=F7$;C2$=E2$(F6)
0643 EXEC C(0,C2$,F1$,F1$)
0644 E2$(F6)=F1$
0645 ENDPROC
0650 PROC DATOCHECK(G0,G1)
0660 G1=E
0670 G2=(ORD(G0$(E))-48)*10+ORD(G0$(G))-48
0680 G3=(ORD(G0$(V))-48)*10+ORD(G0$(4))-48
0690 G4=(ORD(G0$(5))-48)*10+ORD(G0$(6))-48
0700 IF G4<E OR G3<E OR G3>12 OR G4>31 THEN G1=B
0710 IF G1=B THEN EXIT
0720 CASE G3 OF
0730 WHEN 4,6,W,11
0740 IF G4>30 THEN G1=B
0750 WHEN G
0760 IF G4>29 THEN G1=B
0770 IF G4=29 AND G2 MOD 4<>B THEN G1=B
0780 ENDCASE
0790 ENDPROC
0800 PROC INLØNMOD(G5)
0810 GET C9$,G*G5-E:D1$
0820 GET C9$,G*G5:D2$,G6,G7,G8,G9,H0,H1,H2,H3,H4,H5,H6
0830 EXEC F(1,G5,C9$)
0840 ENDPROC
0850 PROC UDLØNMOD(G5)
0860 PUT C9$,G*G5-E:D1$
0870 PUT C9$,G*G5:D2$,G6,G7,G8,G9,H0,H1,H2,H3,H4,H5,H6
0880 EXEC F(2,G5,C9$)
0890 ENDPROC
0900 PROC CONV(H7,H8,H9)
0910 I0=H8;H7$=""
0930 REPEAT
0940 H7$=CHR((I0 MOD 10)+48)+H7$;H9=H9-E;I0=I0 DIV 10
0970 IF H9<B AND I0=B THEN H9=B
0980 UNTIL H9=B
0990 ENDPROC
1000 PROC CHECK(I1,I2)
1010 I2,I3=B
1030 IF LEN(I1$)>B THEN
1035 I4=E
1040 IF I1$(E)="-" THEN I4=-E;I2=E
1100 WHILE LEN(I1$)>I2
1110 I2=I2+E
1120 IF I1$(I2)<"0" OR I1$(I2)>"9" THEN I4=B;I2=LEN(I1$)
1160 I3=I3*10+ORD(I1$(I2))-48
1170 ENDWHILE
1175 I3=I3*I4;I2=I2*I4
1190 IF I2<B THEN I2=I2+E
1200 ENDIF
1210 ENDPROC
1211 PROC Ø
1212 REPEAT
1213 EXEC DATOCHECK(F0$,I)
1214 IF I=B THEN EXEC INLINE(I5)
1215 UNTIL I=E
1216 ENDPROC
1220 PROC INOPL(I5)
1230 EXEC INLINE(I5)
1240 CASE I5 OF
1460 WHEN 4
1470 REPEAT
1480 F0$=F0$+"+"
1490 EXEC C(6,F0$,B3$,F1$)
1500 IF FLAG<>B THEN EXEC INLINE(I5)
1510 UNTIL FLAG=B
1520 EXEC C(0,F0$,B3$,F1$)
1530 EXEC PERVERT(F1$,I7)
1540 WHEN 5
1550 WHILE F0$<"1" OR F0$>"7"
1560 EXEC INLINE(I5)
1570 ENDWHILE
1580 A9$=F0$
1590 WHEN 6
1600 WHILE F0$<>"A" AND F0$<>"F"
1610 EXEC INLINE(I5)
1620 ENDWHILE
1630 B0$=F0$
1660 WHEN 10,13,16
1670 A2(I5 DIV V-G)=I3
1680 IF I3<>B THEN
1690 E4=E
1700 ELSE
1710 I5=I5+G
1720 ENDIF
1730 WHEN 11,14,17
1740 EXEC Ø
1780 A4(I5 DIV 3-2)=I3
1790 WHEN 12,15,18
1800 EXEC Ø
1840 A5(I5 DIV 3-3)=I3
1870 ENDCASE
1880 ENDPROC
1890 PROC INDVIRK
1900 OPEN C9$,R
1910 EXEC F(0,0,C9$)
1920 GET C9$,E:D3$
1930 GET C9$,G:D4$,I8,I9,J0
1940 ENDPROC
1950 PROC F(J1,J2,J3)
1960 IF STATUS(J3$)<>B THEN
1970 OUTPUT T
1980 PRINT "FIL-FEJL ";J3$;STATUS(J3$),J1;J2
1990 STOP
2000 ENDIF
2010 ENDPROC
2020 PROC INLINE(G5)
2030 REPEAT
2040 CURSOR E6(G5),E7(G5)
2050 INPUT "",F0$
2060 IF E8(G5)<B THEN
2065 J4=B
2070 IF LEN(F0$)<=ABS(E8(G5)) THEN
2080 J4=E
2090 FOR I=LEN(F0$)+E TO ABS(E8(G5))
2100 F0$(I)=" "
2110 NEXT I
2140 ENDIF
2150 ELSE
2160 EXEC CHECK(F0$,J4)
2170 IF E8(G5)>B AND E8(G5)<>J4 THEN J4=B
2180 ENDIF
2190 UNTIL J4<>B
2200 ENDPROC
2210 PROC SKRIVPICT
2220 CLEAR
2230 PRINT TAB(17);"Afregning"
2240 PRINT
2250 PRINT
2260 PRINT " Maksimum feriedage i året"
2270 PRINT " Lønperiodekode 1,2,3,4,5,6 eller 7"
2280 PRINT " Arbejdere(A) eller funktionærer(F)"
2290 PRINT
2300 PRINT
2310 ;
2320 PRINT
2330 PRINT " Feriepengeopgørelse:     start-slutdag"
2340 PRINT " Feriekode 1/lønnr"
2350 PRINT " Feriekode 2/lønnr"
2360 PRINT " Feriekode 3/lønnr"
2420 ENDPROC
2600 PROC CONVDATE(I1,I2)
2610 K0=I2;I1$=""
2620 FOR I=6 TO E STEP -E
2625 I1$(I)=CHR(K0 MOD 10+48)
2633 K0=K0 DIV 10
2690 NEXT I
2700 ENDPROC
2710 PROC Æ(I1,I2)
2720 I1$="          0+"
2730 IF I2<>B THEN
2740 I1$(W,10)=",0";I0=ABS(I2);K0=INT((I0-INT(I0))*100+0.50001)
2770 IF I2<B THEN I1$(12)="-"
2780 FOR I=11 TO E STEP -E
2790 IF I<>W THEN
2800 I1$(I)=CHR(K0 MOD 10+48)
2810 K0=K0 DIV 10
2820 IF K0=B AND I<10 THEN I=B
2830 ELSE
2840 K0=INT(I0)
2850 ENDIF
2860 NEXT I
2870 ENDIF
2880 ENDPROC
2890 PROC PERVERT(I1,I2)
2900 I2=B
2910 FOR I=E TO LEN(I1$)-E
2920 IF I1$(I)<>" " AND I1$(I)<>"," THEN I2=10*I2+ORD(I1$(I))-48
2930 NEXT I
2940 IF I1$(I)="-" THEN I2=-I2
2950 I2=I2/100
2960 ENDPROC
2970 PROC SKRIVBUND
2980 PAGE$(16,PS+5:7)=D3$(E,7)
2990 PAGE$(17,PS+5:25)=D3$(8,32)
3000 PAGE$(18,PS+5:23)=D3$(33,55)
3010 PAGE$(19,PS+5:19)=D4$(E,4)+" "+D4$(5,18)
3020 IF PS=E THEN
3030 PS=38
3040 ELSE
3050 EXEC SKRIVPAGE
3060 PS=E
3070 ENDIF
3080 ENDPROC
3085 TAP=W
3090 PROC SKRIVPAGE
3092 LINE=E
3094 PRINT
3096 EXEC SL
3098 EXEC SL
3100 EXEC SL
3102 PRINT
3104 EXEC SL
3106 EXEC SL
3108 EXEC SL
3110 EXEC SL
3112 PRINT
3114 EXEC SL
3116 EXEC SL
3118 PRINT
3120 EXEC SL
3122 PRINT
3124 EXEC SL
3126 PRINT
3128 EXEC SL
3130 PRINT
3132 EXEC SL
3134 PRINT
3136 EXEC SL
3138 PRINT
3140 EXEC SL
3142 PRINT
3144 EXEC SL
3146 EXEC SL
3148 EXEC SL
3150 EXEC SL
3152 PRINT
3154 ;
3156 ;
3158 ;
3160 FOR I=E TO 19
3162 PAGE$(I)=E9$(E,68)
3164 NEXT I
3166 ENDPROC
3170 PROC SL
3180 PRINT TAB(TAP);PAGE$(LINE)
3190 LINE=LINE+E
3200 ENDPROC
3240 PROC SKRIVHOVED
3250 PAGE$(E,PS+24:G)=ÅR$
3255 PAGE$(G,PS+24:E)=KV$
3260 EXEC CONV(C3$,G6,6)
3265 EXEC CONV(F1$,G7,4)
3270 C3$=C3$+F1$
3275 PAGE$(V,PS+10:10)=C3$
3280 EXEC CONV(C3$,F8,4)
3285 PAGE$(4,PS+5:4)=C3$
3290 PAGE$(5,PS+5:25)=D1$(E,25)
3292 PAGE$(6,PS+5:23)=D1$(26,48)
3295 PAGE$(7,PS+5:19)=D2$(E,4)+" "+D2$(5,18)
3300 ENDPROC
3440 PROC NÆSTE
3450 REPEAT
3460 F8=F8+E
3470 H1=E
3480 IF F8<=I9 THEN
3490 EXEC INLØNMOD(F8)
3500 IF A9$<>D2$(21) THEN H1=B
3510 IF B0$="A" AND D2$(24,25)>"89" THEN H1=B
3520 IF B0$="F" AND D2$(24,25)<"90" THEN H1=B
3530 ENDIF
3540 UNTIL H1>B
3550 ENDPROC
3560 PROC BEREGNFERIE
3570 EXEC SKRIVHOVED
3580 EXEC INDTÆL
3585 K4=H1
3590 IF A4(K3)>H1 THEN K4=A4(K3)
3595 K5=H6
3640 IF A5(K3)<H6 OR H6=B THEN K5=A5(K3)
3690 K6=K5 MOD 100-K4 MOD 100
3700 K6=K6+30*(K5 DIV 100 MOD 100-K4 DIV 100 MOD 100)
3705 K7=INT(G*I7*K6/365+0.5)/G
3710 K6=K6+365*(K5 DIV 10000-K4 DIV 10000)
3720 IF A9$="1" THEN K7=B
3770 EXEC Æ(C3$,K7)
3800 C4$=C5$(29)
3810 EXEC C(0,C3$,C4$,F1$)
3820 C5$(29)=F1$(G:11)
3830 IF K3=V THEN
3840 EXEC Æ(C3$,I7)
3850 EXEC C(4,F1$,C3$,C4$)
3860 IF SI=G THEN F1$=C3$
3870 ENDIF
3873 C4$=C5$(44)
3876 EXEC C(0,C4$,F1$,C4$)
3880 C5$(44)=C4$(G:11)
3890 IF K4<>A4(K3) OR K5<>A5(K3) THEN
3910 EXEC CONVDATE(C4$,K4)
3920 PAGE$(W,PS+5:6)=C4$
3930 EXEC CONVDATE(C4$,K5)
3940 PAGE$(W,PS+14:6)=C4$
3945 ELSE
3950 PAGE$(8,PS+22:G)="**"
3960 ENDIF
3990 IF C5$(16,11)="+" THEN C5$(16,11)=" "
4000 PAGE$(10,PS+20:11)=C5$(16)
4010 C5$(16)=B3$(G:11)
4025 EXEC OP(8,C5$(20))
4030 PAGE$(11,PS+15:G)="16"
4040 PAGE$(11,PS+20:11)=C5$(20)
4055 EXEC OP(9,C5$(17))
4060 PAGE$(12,PS+20:11)=C5$(17)
4070 IF PAGE$(12,PS+30)="+" THEN PAGE$(12,PS+30)=" "
4080 IF H0>B THEN
4090 EXEC Æ(C3$,H0)
4100 ELSE
4110 K8=INT(G9*12/365)
4120 EXEC Æ(C4$,K8)
4125 F1$=C5$(29)
4130 EXEC C(2,F1$,C4$,C3$)
4140 ENDIF
4150 B1$=C5$(20);C4$=C5$(17);C5$(20)=B3$(G:11);C5$(17)=B3$(G:11)
4160 C5$(29)=C5$(20)
4190 EXEC C(0,B1$,C4$,B1$)
4200 EXEC OPTÆL(34,B1$)
4250 PAGE$(13,PS+20:11)=B1$(G:11)
4260 EXEC C(4,B1$,C3$,C4$)
4280 PAGE$(14,PS:10)=C3$(V:10)
4285 IF PAGE$(14,PS+W)="+" THEN PAGE$(14,PS+W)=" "
4290 IF SI=G THEN
4300 EXEC C(1,B1$,C3$,C4$)
4310 H0=B
4320 EXEC Æ(C3$,G8)
4335 C3$(12)="-"
4340 EXEC C(2,C4$,C3$,B2$)
4350 EXEC C(3,B2$,B4$,B2$)
4355 B2$(10,11)="00"
4360 EXEC C(0,B1$,B2$,C0$)
4370 ELSE
4380 B2$=B3$
4390 C0$=B1$
4400 IF H0>B THEN
4410 EXEC C(1,C3$,B1$,C3$)
4420 EXEC PERVERT(C3$,H0)
4430 ENDIF
4440 ENDIF
4441 EXEC OPTÆL(40,B2$)
4442 EXEC OP(10,B2$)
4470 PAGE$(14,PS+20:11)=B2$(G:11)
4480 PAGE$(15,PS+20:11)=C0$(G:11)
4520 ENDPROC
4530 PROC BEREGNSH
4635 EXEC OP(11,C5$(23))
4660 C3$=C5$(23);C5$(23)=B3$(G:11)
4670 C4$=" "+C5$(26)
4675 IF C4$(12)="+" THEN EXEC C(1,B3$,C4$,C4$)
4685 EXEC OP(12,C4$)
4710 C5$(26)=B3$(G:11)
4720 EXEC C(0,C3$,C4$,B1$)
4730 EXEC OPTÆL(34,B1$)
4780 EXEC Æ(C3$,G8)
4782 PAGE$(14,PS+10:5)=C3$(6:5)
4785 C3$(12)="-"
4790 IF B1$(12)="+" THEN
4810 EXEC C(2,C3$,B1$,C1$)
4820 EXEC C(3,C1$,B4$,C1$)
4830 C1$(10,11)="00"
4840 EXEC OPTÆL(40,C1$)
4860 ELSE
4880 C1$=B3$
4890 ENDIF
4892 F1$=PAGE$(11,PS+20:11)
4894 EXEC C(0,F1$,B1$,F1$)
4896 IF F1$(12)="+" THEN F1$(12)=" "
4898 PAGE$(11,PS+20:11)=F1$(G:11)
4900 F1$=PAGE$(13,PS+20:11)
4902 EXEC C(0,F1$,B1$,F1$)
4904 IF F1$(12)="+" THEN F1$(12)=" "
4906 PAGE$(13,PS+20:11)=F1$(G:11)
4915 EXEC OP(13,C1$)
4920 F1$=PAGE$(14,PS+20:11)
4922 EXEC C(0,F1$,C1$,F1$)
4924 IF F1$(12)="+" THEN F1$(12)=" "
4926 PAGE$(14,PS+20:11)=F1$(G:11)
4950 EXEC C(0,C1$,B1$,C2$)
4960 F1$=PAGE$(15,PS+20:11)
4962 EXEC C(0,F1$,C2$,F1$)
4964 IF F1$(12)="+" THEN F1$(12)=" "
4966 PAGE$(15,PS+20:11)=F1$(G:11)
5000 ENDPROC
8181 D8$="P641220:"
8182 E1$="P641210:"
8190 C9$=D8$+"VIRKKART"
8200 EXEC INDVIRK
8210 CLOSE C9$
8220 C9$=D8$+"LØNMODRG"
8230 OPEN C9$,W
8260 D0$=D8$+"TÆLLEREG"
8270 OPEN D0$,W
8291 D9$=E1$+"LØNJOUR"
8292 OPEN D9$,W
8300 EXEC SKRIVPICT
8310 FOR J=4 TO 18
8320 IF J=7 THEN J=10
8330 EXEC INOPL(J)
8340 NEXT J
8343 ÅR$=" "
8345 EDIT "Monter BKL's ferieopgørelser, RETURN",ÅR$
8350 PS=E
8355 ÅR$="82"
8356 KV$="1"
8357 EDIT "År ",ÅR$
8358 EDIT "Kvartal ",KV$
8360 F8=B
8365 A7$="00-00-00"
8366 A8$=A7$
8370 F0$=E9$
8372 PUT D9$:A7$,A8$,A9$,B0$
8380 OUTPUT P
8390 REPEAT
8400 EXEC NÆSTE
8410 L3,K9=B
8420 IF F8<=I9 THEN
8540 IF E4=E THEN
8550 K3=ORD(D2$(22))-48
8560 IF K3<4 THEN
8570 IF A2(K3)=F8 OR A2(K3)=-E THEN
8580 EXEC BEREGNFERIE
8585 EXEC BEREGNSH
8590 K9=E
8600 ENDIF
8610 ENDIF
8620 ENDIF
8815 IF K9>B THEN
8820 EXEC SKRIVBUND
8830 EXEC UDLØNMOD(F8)
8840 EXEC UDTÆL
8845 ENDIF
8850 ENDIF
8860 UNTIL F8=>I9
8862 PUT D9$:E2$(E),E2$(G),E2$(V),E2$(4),E2$(5),E2$(6)
8864 PUT D9$:E2$(7),E2$(8),E2$(W),E2$(10),E2$(11),E2$(12)
8866 PUT D9$:E2$(13),E2$(14),E2$(15),E2$(16)
8869 IF PS>E THEN EXEC SKRIVPAGE
8870 CLOSE
8875 OUTPUT T
8877 EDIT "Monter listepapir, RETURN",E9$
8880 CHAIN "P641210:JOURNAL"