DataMuseum.dk

top - download

    Length: 12640 (0x3160)
    Types: TextFile
    Notes: Mikados_K
    Names: »BKLFERIE.K«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »BKLFERIE.K« 

Mikados K File

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