⟦87c2266c0⟧

Mikados K File

0100DIM FELT12$(12),FELT15$(12),FELT26$(12),FELT29$(12),FELT30$(12) 
0105DIM FELT31$(12),FELT32$(12),FELT33$(12),FELT34$(12),FELT35$(12) 
0106DIM FELT36$(12) 
0110DIM STARTPER$(8),SLUTPER$(8),TV006$(12),KVT$(E),Å$(G),LP$(E) 
0120DIM RES$(15),OP1$(12),OP2$(12),TAH$(12),HUND$(12) 
0140DIM RESUL$(12),RESUL1$(12),TV$(45,11),POST5$(55),DAD$(6) 
0150DIM FIL$(16),FIL2$(16),POST1$(71),POST2$(27),POST3$(55),POST4$(34) 
0170TAH$="          0+" 
0171TV006$=TAH$;FELT12$=TAH$;FELT15$=TAH$;FELT26$=TAH$;FELT29$=TAH$ 
0172FELT30$=TAH$;FELT31$=TAH$;FELT32$=TAH$;FELT33$=TAH$;FELT34$=TAH$ 
0173FELT35$=TAH$;FELT36$=TAH$ 
0190HUND$="     100,00+" 
0210DIM X(5),Y(5),TYPE(5) 
0220DIM BL$(79),L$(79),LIN$(12) 
0230FOR I=E TO 79 
0240BL$=BL$+" " 
0250NEXT I 
0260X(E)=27 
0270X(G)=34 
0280X(4)=38 
0290X(5),X(V)=39 
0310Y(E),Y(G)=G;Y(V)=V;Y(4)=4;Y(5)=5 
0340TYPE(E),TYPE(G)=6 
0350TYPE(V),TYPE(5)=-E 
0360TYPE(4)=G 
0370PROC CALC(AR3,B1,B2,ES) 
0380RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5) 
0390CALL "P641210:REGN" 
0391IF AR3=V AND FLAG=6 THEN  
0392RES$=TAH$ 
0393FLAG=B 
0394ENDIF  
0400IF AR3<6 THEN  
0410IF FLAG THEN STOP  
0420ENDIF  
0430ES$=RES$ 
0440ENDPROC  
0450PROC UDTÆL 
0460J=W*(LMNR-E) 
0470FOR K=E TO V 
0480FOR I=E TO 5 
0490POST5$((I-E)*11+E:11)=TAH$(G:11) 
0500NEXT I 
0510PUT FIL2$,J+K:POST5$ 
0520NEXT K 
0530EXEC FEJL(-LMNR,-K,FIL2$) 
0540ENDPROC  
0550PROC INDTÆL 
0560J=W*(LMNR-E) 
0570FOR K=E TO V 
0580GET FIL2$,J+K:POST5$ 
0590FOR I=E TO 5 
0600TV$((K-E)*5+I)=POST5$((I-E)*11+E:11) 
0610NEXT I 
0620NEXT K 
0630EXEC FEJL(LMNR,K,FIL2$) 
0640ENDPROC  
0650PROC DATOCHECK(NR5,OK5) 
0660OK5=E 
0670ÅR=(ORD(NR5$(E))-48)*10+ORD(NR5$(G))-48 
0680MÅNED=(ORD(NR5$(V))-48)*10+ORD(NR5$(4))-48 
0690DATO=(ORD(NR5$(5))-48)*10+ORD(NR5$(6))-48 
0700IF DATO<E OR MÅNED<E OR MÅNED>12 OR DATO>31 THEN OK5=B 
0710IF OK5=B THEN EXIT  
0720CASE MÅNED OF  
0730WHEN 4,6,W,11 
0740IF DATO>30 THEN OK5=B 
0750WHEN G 
0760IF DATO>29 THEN OK5=B 
0770IF DATO=29 AND ÅR MOD 4<>B THEN OK5=B 
0780ENDCASE  
0790ENDPROC  
0800PROC INLØNMOD(N) 
0810GET FIL$,G*N-E:POST1$ 
0820GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD 
0830EXEC FEJL(E,N,FIL$) 
0840ENDPROC  
0900PROC CONV(NR2,OK22,CIF) 
0910OK2=OK22 
0920NR2$="" 
0930REPEAT  
0940NR2$=CHR((OK2 MOD 10)+48)+NR2$ 
0950CIF=CIF-E 
0960OK2=OK2 DIV 10 
0970IF CIF<B AND OK2=B THEN CIF=B 
0980UNTIL CIF=B 
0990ENDPROC  
1000PROC CHECK(NR1,OK1) 
1010OK1=B 
1020RESULT=B 
1030IF LEN(NR1$)>B THEN  
1040IF NR1$(E)="-" THEN  
1050FORTEGN=-E 
1060OK1=E 
1070ELSE  
1080FORTEGN=E 
1090ENDIF  
1100WHILE LEN(NR1$)>OK1 
1110OK1=OK1+E 
1120IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN  
1130FORTEGN=B 
1140OK1=LEN(NR1$) 
1150ENDIF  
1160RESULT=RESULT*10+ORD(NR1$(OK1))-48 
1170ENDWHILE  
1175RESULT=RESULT*FORTEGN 
1180OK1=OK1*FORTEGN 
1190IF OK1<B THEN OK1=OK1+E 
1200ENDIF  
1210ENDPROC  
1220PROC INOPL(OPL) 
1230EXEC INLINE(OPL) 
1240CASE OPL OF  
1250WHEN E 
1260REPEAT  
1270EXEC DATOCHECK(L$,I) 
1280IF I=B THEN EXEC INLINE(OPL) 
1290UNTIL I=E 
1295STD=RESULT 
1300EXEC CONVDATE(STARTPER$,RESULT) 
1310WHEN G 
1320REPEAT  
1330EXEC DATOCHECK(L$,I) 
1340IF I=B THEN EXEC INLINE(OPL) 
1350UNTIL I=E 
1355SLD=RESULT 
1360EXEC CONVDATE(SLUTPER$,RESULT) 
1370WHEN V 
1380WHILE L$<"1" OR L$>"4" 
1390EXEC INLINE(OPL) 
1400ENDWHILE  
1410KVT$=L$ 
1460WHEN 4 
1470Å$=L$ 
1540WHEN 5 
1550WHILE L$<"1" OR L$>"7" 
1560EXEC INLINE(OPL) 
1570ENDWHILE  
1580LP$=L$ 
1870ENDCASE  
1880ENDPROC  
1890PROC INDVIRK 
1900OPEN FIL$,R 
1910EXEC FEJL(B,B,FIL$) 
1920GET FIL$,E:POST3$ 
1930GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM 
1935GET FIL$,V:DAD$ 
1940ENDPROC  
1950PROC FEJL(P1,P2,P3) 
1960IF STATUS(P3$)<>B THEN  
1970OUTPUT T 
1980PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2 
1990STOP  
2000ENDIF  
2010ENDPROC  
2020PROC INLINE(N) 
2030REPEAT  
2040CURSOR X(N),Y(N) 
2050INPUT "",L$ 
2060IF TYPE(N)<B THEN  
2070IF LEN(L$)<=ABS(TYPE(N)) THEN  
2080OK=E 
2090FOR I=LEN(L$)+E TO ABS(TYPE(N)) 
2100L$(I)=" " 
2110NEXT I 
2120ELSE  
2130OK=B 
2140ENDIF  
2150ELSE  
2160EXEC CHECK(L$,OK) 
2170IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B 
2180ENDIF  
2190UNTIL OK<>B 
2200ENDPROC  
2210PROC SKRIVPICT 
2220CLEAR  
2230PRINT TAB(11);"Arbejderlønstatistik" 
2240PRINT " Lønperioden" 
2250PRINT " Kvartal 1,2,3 eller 4" 
2260PRINT " Årstal";TAB(36);"19" 
2270PRINT " Lønperiodekode 1,2,3,4,5,6 eller 7" 
2420ENDPROC  
2600PROC CONVDATE(NR1,OK1) 
2610OK11=OK1;NR1$="" 
2620FOR I=8 TO E STEP -E 
2630IF I MOD V=B THEN  
2640NR1$(I)="-" 
2650ELSE  
2660NR1$(I)=CHR(OK11 MOD 10+48) 
2670OK11=OK11 DIV 10 
2680ENDIF  
2690NEXT I 
2700ENDPROC  
2970PROC SKRIVBUND 
2980FOR I=E TO 13 
2990PRINT  
3000NEXT I 
3030EXEC CONV(RESUL$,C1,6) 
3040EXEC CONV(LIN$,C2,4) 
3050RESUL$=RESUL$+LIN$ 
3060PRINT TAB(11);"LØNMODTAGER ";RESUL$; 
3070PRINT USING " ####":LMNR; 
3080PRINT TAB(44);"ARBEJDSGIVER ";POST3$(E,7) 
3090PRINT  
3100PRINT  
3110PRINT TAB(13);POST1$(E,25);TAB(46);POST3$(8,32) 
3120PRINT  
3130PRINT TAB(46);POST3$(33,55) 
3140PRINT TAB(46);POST4$(E,4);" "; 
3150PRINT POST4$(5,18) 
3160FOR I=E TO 7 
3170PRINT  
3180NEXT I 
3230ENDPROC  
3440PROC NÆSTE 
3450REPEAT  
3460LMNR=LMNR+E 
3470LA=E 
3480IF LMNR<=MLMNR THEN  
3490EXEC INLØNMOD(LMNR) 
3500IF LP$<>POST2$(21) THEN LA=B 
3510IF POST2$(24,25)>"79" THEN LA=B 
3530ENDIF  
3540UNTIL LA>B 
3550ENDPROC  
3560PROC SKRIVHOVED 
3562PRINT  
3564SIDE=SIDE+E 
3566PRINT USING " SIDE ###":SIDE; 
3567PRINT "     UDSKRIFTSDATO ";DAD$; 
3568PRINT TAB(49);"LØNPERIODEN ";STARTPER$;" / ";SLUTPER$; 
3570PRINT TAB(20);"ARBEJDERLØNSTATISTIK FOR ";KVT$;". KVARTAL 19";Å$ 
3572PRINT TAB(20);"****************************************" 
3574PRINT  
3590IF STD>LA THEN  
3600STDA=STD 
3610ELSE  
3620STDA=LA 
3630ENDIF  
3640IF SLD<FD OR FD=B THEN  
3650SLDA=SLD 
3660ELSE  
3670SLDA=FD 
3680ENDIF  
3910EXEC CONVDATE(RESUL1$,STDA) 
3920PRINT " ANSAT FRA ";RESUL1$;" TIL "; 
3930EXEC CONVDATE(RESUL1$,SLDA) 
3940PRINT RESUL1$;" OR-KODE ";POST2$(24,25);" FAGGR-KODE";FG;" " 
3950PRINT  
3960PRINT TAB(16);"LØNDELE";TAB(39);"TV";TAB(47);"TIMER";TAB(59);"BELØB" 
3970ENDPROC  
8190FIL$="P641220:VIRKKART" 
8200EXEC INDVIRK 
8210CLOSE FIL$ 
8220FIL$="P641220:LØNMODRG" 
8230OPEN FIL$,R 
8260FIL2$="P641220:TÆLLEREG" 
8270OPEN FIL2$,W 
8300EXEC SKRIVPICT 
8310FOR J=E TO 5 
8330EXEC INOPL(J) 
8340NEXT J 
8350SIDE=B 
8360LMNR=B 
8370L$=BL$ 
8380OUTPUT P 
8390REPEAT  
8400EXEC NÆSTE 
8420IF LMNR<=MLMNR THEN  
8425EXEC INDTÆL 
8427EXEC SKRIVHOVED 
8430EXEC CALC(B,TV$(G),TV$(4),TV006$) 
8435EXEC CALC(V,TV$(E),TV006$,LIN$) 
8440EXEC CALC(G,TV$(G),LIN$,FELT12$) 
8441EXEC CALC(E,TV$(E),FELT12$,LIN$) 
8442EXEC CALC(B,TV$(V),FELT12$,FELT12$) 
8450EXEC CALC(B,TV$(5),LIN$,FELT15$) 
8455EXEC CALC(B,TV$(11),TV$(12),FELT26$) 
8460EXEC CALC(B,TV$(14),FELT26$,FELT26$) 
8465EXEC CALC(B,TV$(15),FELT26$,FELT26$) 
8470EXEC CALC(G,TV$(G),HUND$,FELT29$) 
8475EXEC CALC(V,FELT29$,TV006$,FELT29$) 
8480EXEC CALC(G,TV$(6),HUND$,FELT30$) 
8485EXEC CALC(V,FELT30$,TV006$,FELT30$) 
8490EXEC CALC(V,FELT12$,TV$(G),FELT31$) 
8495EXEC CALC(V,FELT15$,TV$(4),FELT32$) 
8500EXEC CALC(B,FELT12$,FELT15$,FELT33$) 
8505EXEC CALC(V,FELT33$,TV006$,FELT33$) 
8510EXEC CALC(V,TV$(7),TV006$,FELT34$) 
8515EXEC CALC(V,TV$(8),TV006$,FELT35$) 
8520EXEC CALC(V,TV$(W),TV006$,FELT36$) 
8521EXEC CALC(4,TV$(13),TAH$,TAH$) 
8522IF SI=B AND POST2$(26)="2" THEN TV$(13)="            " 
8525FOR I=E TO 15 
8530IF TV$(I,11)="+" THEN TV$(I,11)=" " 
8535NEXT I 
8537IF TV006$(12)="+" THEN TV006$(12)=" " 
8540IF FELT12$(12)="+" THEN FELT12$(12)=" " 
8545IF FELT15$(12)="+" THEN FELT15$(12)=" " 
8550IF FELT26$(12)="+" THEN FELT26$(12)=" " 
8555IF FELT29$(12)="+" THEN FELT29$(12)=" " 
8560IF FELT30$(12)="+" THEN FELT30$(12)=" " 
8565IF FELT31$(12)="+" THEN FELT31$(12)=" " 
8570IF FELT32$(12)="+" THEN FELT32$(12)=" " 
8575IF FELT33$(12)="+" THEN FELT33$(12)=" " 
8580IF FELT34$(12)="+" THEN FELT34$(12)=" " 
8585IF FELT35$(12)="+" THEN FELT35$(12)=" " 
8590IF FELT36$(12)="+" THEN FELT36$(12)=" " 
8595PRINT TAB(16);"AKKORDTIMER";TAB(38);"002 ";TV$(G) 
8600PRINT  
8605PRINT TAB(G);TV$(V);TAB(16);"AKKORDBELØB";TAB(38);"003";TAB(53);FELT12$ 
8610PRINT  
8615PRINT TAB(16);"TIDLØNSTIMER";TAB(38);"004 ";TV$(4) 
8620PRINT  
8625PRINT TAB(G);TV$(5);TAB(16);"TIDLØNSBELØB";TAB(38);"005";TAB(53);FELT15$ 
8630PRINT  
8635PRINT TAB(16);"TIMER IALT";TAB(38);"006";TV006$ 
8640PRINT  
8645PRINT TAB(16);"HERAF OVERTIMER";TAB(38);"007 ";TV$(6) 
8650PRINT  
8655PRINT TAB(16);"OVERTIDSTILLÆG";TAB(38);"008";TAB(54);TV$(7) 
8660PRINT  
8665PRINT TAB(16);"HOLDDRIFTSTILLÆG";TAB(38);"009";TAB(54);TV$(8) 
8670PRINT  
8675PRINT TAB(16);"GENETILLÆG";TAB(38);"010";TAB(54);TV$(W) 
8680PRINT  
8685PRINT TAB(16);"DIV U F ARBEJDST";TAB(38);"011";TAB(54);TV$(10) 
8690PRINT  
8695PRINT TAB(16);"FERIEBERETT LØN";TAB(38);"012";TAB(54);TV$(11) 
8700PRINT  
8705PRINT TAB(16);"SYGEFERIEPENGE";TAB(38);"013";TAB(54);TV$(12) 
8710PRINT  
8715PRINT TAB(16);"BEREGNEDE FERIEP";TAB(38);"015";TAB(54);TV$(14) 
8720PRINT  
8725PRINT TAB(16);"SH-OPSPARING";TAB(38);"016";TAB(54);TV$(15) 
8730PRINT  
8735PRINT TAB(16);"***";TAB(53);FELT26$ 
8740PRINT  
8741PRINT TAB(16);"SYGEDAGPENGE";TAB(38);"014";TAB(54);TV$(13) 
8742PRINT  
8745PRINT TAB(G);TV$(E);TAB(16);"TILLÆG TIL FORDELING";TAB(38);"001" 
8750PRINT  
8755PRINT TAB(6);"------%------  ---------------------GENNEMSNIT"; 
8760PRINT "----------------------" 
8765PRINT TAB(5);"AKKORD   OVERT   AKKORD   TIDLØN  TILSAMM  OVERTID"; 
8770PRINT "   HOLDDR    GENE" 
8775PRINT TAB(5);FELT29$(6,12);FELT30$(5,12);FELT31$(4,12);FELT32$(4,12); 
8780PRINT FELT33$(4,12);FELT34$(4,12);FELT35$(4,12);FELT36$(4,12) 
8820EXEC SKRIVBUND 
8840EXEC UDTÆL 
8850ENDIF  
8860UNTIL LMNR=>MLMNR 
8870CLOSE  
8880OUTPUT T 
8890CHAIN "P641210:STARTB"
DataMuseum.dk

MIKADOS

⟦87c2266c0⟧ TextFile

Derivation

Mikados K File

Full view
