⟦ebcd44f4f⟧

Mikados K File

0100DIM RES$(15),OP1$(12),OP2$(12),TAH$(12),BLB3$(15),DAD$(6) 
0110DIM RESUL$(12),RESUL1$(12),TVN(45),TV$(45,11),POST5$(55),PR$(14) 
0120DIM FIL$(20),FIL2$(20),POST1$(71),POST2$(27),POST3$(55),POST4$(34) 
0130TAH$="          0+" 
0140PROC TUD(BLB4,UBLB2,TEGN2,STØR2) 
0150BLB3$=BLB4$ 
0160EXEC CALC(5,BLB3$,TAH$,UBLB2$) 
0170IF TEGN2=B THEN UBLB2$=UBLB2$(E:13) 
0180IF TEGN2=E AND UBLB2$(LEN(UBLB2$))="+" THEN UBLB2$(LEN(UBLB2$))=" " 
0190IF STØR2=E THEN UBLB2$=UBLB2$(4:LEN(UBLB2$)-V) 
0200ENDPROC  
0210PROC CALC(AR3,B1,B2,ES) 
0220RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5) 
0230CALL "P641210:REGN" 
0240IF AR3<6 THEN  
0250IF FLAG THEN STOP  
0260ENDIF  
0270ES$=RES$ 
0280ENDPROC  
0290FIL$="P641220:VIRKKART" 
0300EXEC INDVIRK 
0310CLOSE FIL$ 
0320FIL$="P641220:LØNMODRG" 
0330FIL2$="P641220:TÆLLEREG" 
0340OPEN FIL$,R 
0350EXEC FEJL(B,B,FIL$) 
0360OPEN FIL2$,W 
0370EXEC FEJL(B,B,FIL2$) 
0380PROC UDTÆL(N) 
0390J=W*(N-E) 
0400FOR K=6 TO W 
0410FOR I=E TO 5 
0420POST5$((I-E)*11+E:11)=TV$((K-E)*5+I) 
0430NEXT I 
0440PUT FIL2$,J+K:POST5$ 
0450NEXT K 
0460EXEC FEJL(-N,-K,FIL2$) 
0470ENDPROC  
0480TVN(E)=E 
0490TVN(G)=G 
0500TVN(V)=V 
0510TVN(4)=4 
0520TVN(5)=5 
0530TVN(6)=7 
0540TVN(7)=8 
0550TVN(8)=W 
0560TVN(W)=10 
0570TVN(10)=11 
0580TVN(11)=12 
0590TVN(12)=13 
0600TVN(13)=14 
0610TVN(14)=15 
0620TVN(15)=16 
0630TVN(16)=112 
0640TVN(17)=113 
0650TVN(18)=313 
0660TVN(19)=413 
0670TVN(20)=115 
0680TVN(21)=315 
0690TVN(22)=415 
0700TVN(23)=116 
0710TVN(24)=316 
0720TVN(25)=416 
0730TVN(26)=117 
0740TVN(27)=317 
0750TVN(28)=417 
0760TVN(29)=123 
0770TVN(30)=206 
0780TVN(31)=212 
0790TVN(32)=214 
0800TVN(33)=218 
0810TVN(34)=219 
0820TVN(35)=319 
0830TVN(36)=419 
0840TVN(37)=220 
0850TVN(38)=320 
0860TVN(39)=420 
0870TVN(40)=221 
0880TVN(41)=321 
0890TVN(42)=421 
0900TVN(43)=222 
0910TVN(44)=223 
0920TVN(45)=224 
0930PROC CONV(NR2,OK22,CIF) 
0940OK2=OK22 
0950NR2$="" 
0960REPEAT  
0970NR2$=CHR((OK2 MOD 10)+48)+NR2$ 
0980CIF=CIF-E 
0990OK2=OK2 DIV 10 
1000IF CIF<B AND OK2=B THEN CIF=B 
1010UNTIL CIF=B 
1020ENDPROC  
1030PROC CHECK(NR1,OK1) 
1040OK1=B 
1050RESULT=B 
1060IF LEN(NR1$)>B THEN  
1070IF NR1$(E)="-" THEN  
1080FORTEGN=-E 
1090OK1=E 
1100ELSE  
1110FORTEGN=E 
1120ENDIF  
1130WHILE LEN(NR1$)>OK1 
1140OK1=OK1+E 
1150IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN  
1160FORTEGN=B 
1170OK1=LEN(NR1$) 
1180ENDIF  
1190RESULT=RESULT*10+ORD(NR1$(OK1))-48 
1200ENDWHILE  
1210OK1=OK1*FORTEGN 
1220IF OK1<B THEN OK1=OK1+E 
1230ENDIF  
1240ENDPROC  
1250PROC INOPL(OPL) 
1260EXEC INLINE(OPL) 
1270CASE OPL OF  
1280WHEN E 
1290LMNR=RESULT 
1300WHEN V,4,5,6,7,8,W,10,11,12 
1310REPEAT  
1320LINE$=LINE$+"+" 
1330EXEC CALC(6,LINE$,TAH$,RESUL$) 
1340IF FLAG<>B THEN EXEC INLINE(OPL) 
1350UNTIL FLAG=B 
1355EXEC CALC(B,LINE$,TAH$,RESUL$) 
1360CASE OPL OF  
1362WHEN V,4,5,6,10,11,12 
1364IF OPL<7 THEN  
1366T=27+OPL 
1368ELSE  
1370T=33+OPL 
1372ENDIF  
1374WHEN 7,8,W 
1376T=OPL*V+13 
1378PR$=TV$(T) 
1380LINE$=TV$(T+E) 
1382EXEC CALC(B,PR$,LINE$,RESUL1$) 
1384TV$(T+E)=RESUL1$(G:11) 
1386LINE$=TV$(T+G) 
1388EXEC CALC(B,RESUL$,LINE$,RESUL1$) 
1390TV$(T+G)=RESUL1$(G:11) 
1392ENDCASE  
1410TV$(T)=RESUL$(G:11) 
1430ENDCASE  
1440ENDPROC  
1450PROC SKRIVOPL 
1460IF OUTP=B THEN CLEAR  
1470PRINT "L Ø N M O D T A G E R K A R T O T E K - T Æ L L E V Æ R K E R" 
1480PRINT "Å R S - O P G Ø R E L S E";TAB(60);"Dato ";DAD$ 
1490FOR J=E TO A 
1500CASE J OF  
1510WHEN E 
1520EXEC CONV(LINE$,LMNR,0) 
1530WHEN G 
1540LINE$=POST1$(E,25) 
1550WHEN V,4,5,6,7,8,W,10,11,12 
1560IF J<7 THEN  
1570T=27+J 
1580ELSE  
1582IF J>W THEN  
1584T=33+J 
1586ELSE  
1588T=V*J+13 
1590ENDIF  
1600ENDIF  
1610RESUL$=TV$(T) 
1620EXEC TUD(RESUL$,PR$,E,B) 
1630LINE$=PR$ 
1700ENDCASE  
1710IF OUTP=B THEN  
1720EXEC OUTLINE(J) 
1730ELSE  
1740EXEC OUTPLINE(J) 
1750ENDIF  
1760NEXT J 
1770ENDPROC  
1780PROC OUTLINE(N) 
1790CURSOR X(N),Y(N) 
1800PRINT USING "### ":N; 
1810IF N=G THEN  
1820PRINT PICT$(N);":";LINE$ 
1830PRINT TAB(6);"TV TEKST";TAB(38);"INDHOLD" 
1840ELSE  
1850IF N>G THEN  
1860IF N<7 THEN  
1870T=27+N 
1880ELSE  
1882IF N>W THEN  
1884T=33+N 
1886ELSE  
1888T=V*N+13 
1890ENDIF  
1900ENDIF  
1910EXEC CONV(RESUL$,TVN(T),3) 
1920PRINT RESUL$;" ";PICT$(N);":";TAB(32);LINE$ 
1930ELSE  
1940PRINT PICT$(N);": ";LINE$ 
1945ENDIF  
1950ENDIF  
1960ENDPROC  
1970PROC FEJL(P1,P2,P3) 
1980IF STATUS(P3$)<>B THEN  
1990OUTPUT T 
2000PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2 
2010STOP  
2020ENDIF  
2030ENDPROC  
2040PROC INLINE(N) 
2050REPEAT  
2060CURSOR 32,Y(N) 
2070PRINT BL$(E:ABS(TYPE(N))+6) 
2080CURSOR X(N),Y(N) 
2090PRINT USING "### ":N; 
2100IF N>G THEN  
2110IF N<7 THEN  
2120T=27+N 
2130ELSE  
2132IF N>W THEN  
2134T=33+N 
2136ELSE  
2138T=V*N+13 
2140ENDIF  
2150ENDIF  
2160EXEC CONV(RESUL$,TVN(T),3) 
2170PRINT RESUL$;" ";PICT$(N);":"; 
2175CURSOR 32,Y(N) 
2180ELSE  
2190PRINT PICT$(N);": "; 
2200ENDIF  
2210INPUT "",LINE$ 
2220IF TYPE(N)<B THEN  
2230IF LEN(LINE$)<=ABS(TYPE(N)) THEN  
2240OK=E 
2250ELSE  
2260OK=B 
2270ENDIF  
2280ELSE  
2290EXEC CHECK(LINE$,OK) 
2300IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B 
2310ENDIF  
2320UNTIL OK<>B 
2330ENDPROC  
2340PROC OUTPLINE(N) 
2350PRINT TAB(X(N)); 
2360PRINT USING "### ":N; 
2370IF N=G THEN  
2380PRINT PICT$(N);":";LINE$ 
2390PRINT TAB(6);"TV TEKST";TAB(38);"INDHOLD" 
2400ELSE  
2410IF N>G THEN  
2420IF N<7 THEN  
2430T=27+N 
2440ELSE  
2442IF N>W THEN  
2444T=33+N 
2446ELSE  
2448T=V*N+13 
2450ENDIF  
2460ENDIF  
2470EXEC CONV(RESUL$,TVN(T),3) 
2480PRINT RESUL$;" ";PICT$(N);":";TAB(32);LINE$ 
2490ELSE  
2500PRINT PICT$(N);": ";LINE$; 
2505ENDIF  
2510ENDIF  
2520ENDPROC  
2530A=12 
2540DIM X(A),Y(A),PICT$(A,20),TYPE(A) 
2550DIM BL$(79),LINE$(30) 
2560FOR I=E TO 79 
2570BL$=BL$+" " 
2580NEXT I 
2590X(E)=E 
2600X(G)=36 
2610FOR I=V TO A 
2620X(I)=E 
2630Y(I)=I+G 
2640TYPE(I)=-11 
2650NEXT I 
2660Y(E)=V 
2670Y(G)=V 
2680TYPE(E)=B 
2690TYPE(G)=B 
2700PICT$(E)="Lønnr" 
2710PICT$(G)="Navn" 
2760PICT$(V)="Timer ialt" 
2770PICT$(4)="Ferieberett løn" 
2830PICT$(5)="Sygedagpenge" 
2840PICT$(6)="Ferietillæg" 
2860PICT$(7)="Trækpligtig A-indk" 
2870PICT$(8)="Trækfri A-indk" 
2871PICT$(W)="A-skat" 
2872PICT$(10)="ATP" 
2873PICT$(11)="Feriedage" 
2874PICT$(12)="Pensionsbidrag" 
2880OUTP=B 
2890PROC INDTÆL(N) 
2900J=W*(N-E) 
2910FOR K=6 TO W 
2920GET FIL2$,J+K:POST5$ 
2930FOR I=E TO 5 
2940TV$((K-E)*5+I)=POST5$((I-E)*11+E:11) 
2950NEXT I 
2960NEXT K 
2970EXEC FEJL(N,K,FIL2$) 
2980ENDPROC  
2990PROC INLØNMOD(N) 
3000GET FIL$,G*N-E:POST1$ 
3010GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD 
3020EXEC FEJL(E,N,FIL$) 
3030ENDPROC  
3040PROC INDVIRK 
3050OPEN FIL$,W 
3060EXEC FEJL(B,B,FIL$) 
3070GET FIL$,E:POST3$ 
3080GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM 
3085GET FIL$,V:DAD$ 
3090ENDPROC  
3100REPEAT  
3110SV=G 
3120CLEAR  
3130CURSOR 10,10 
3140PRINT "L Ø N M O D T A G E R K A R T O T E K - T Æ L L E V Æ R K E R" 
3150PRINT "         Å R S - O P G Ø R E L S E" 
3160PRINT  
3170PRINT TAB(10);"0 Færdig" 
3180PRINT TAB(10);"1 Ændring" 
3190PRINT TAB(10);"2 Udskrift på skærm" 
3200PRINT TAB(10);"3 Udskrift på printer" 
3210PRINT  
3220REPEAT  
3230CURSOR E,18 
3240EDIT "          ",SV 
3250UNTIL SV=>B AND SV<=V 
3260IF SV>B THEN  
3270REPEAT  
3280EXEC INOPL(1) 
3290UNTIL LMNR=>B AND LMNR<=MLMNR 
3291LISTE=B 
3292IF LMNR=B THEN LISTE=E 
3295REPEAT  
3296IF LISTE=E THEN LMNR=LMNR+E 
3300EXEC INLØNMOD(LMNR) 
3310CASE SV OF  
3320WHEN E 
3330IF LA<>B THEN  
3340EXEC INDTÆL(LMNR) 
3350EXEC SKRIVOPL 
3360REPEAT  
3370REPEAT  
3380SV1=B 
3390CURSOR E,23 
3400EDIT "Feltnr ",SV1 
3410UNTIL SV1=B OR (SV1>G AND SV1<13) 
3420IF SV1>B THEN  
3430EXEC INOPL(SV1) 
3440ENDIF  
3450UNTIL SV1=B 
3460EXEC UDTÆL(LMNR) 
3470ELSE  
3480PRINT "Lønmodtager findes ikke" 
3490INPUT "RETURN",LINE$ 
3500ENDIF  
3510WHEN G 
3520IF LA<>B THEN  
3530OUTP=B 
3540EXEC INDTÆL(LMNR) 
3550EXEC SKRIVOPL 
3560INPUT "RETURN",LINE$ 
3570ELSE  
3580PRINT "Lønmodtager findes ikke" 
3590INPUT "RETURN",LINE$ 
3600ENDIF  
3610WHEN V 
3620IF LA<>B OR LISTE=E THEN  
3625IF LA<>B THEN  
3630OUTPUT P 
3640OUTP=E 
3650EXEC INDTÆL(LMNR) 
3660EXEC SKRIVOPL 
3662FOR I=15 TO 72 
3664PRINT  
3666NEXT I 
3670OUTP=B 
3680OUTPUT T 
3685ENDIF  
3690ELSE  
3700PRINT "Lønmodtager findes ikke" 
3710INPUT "RETURN",LINE$ 
3720ENDIF  
3730ENDCASE  
3735UNTIL LISTE=B OR LMNR=>MLMNR 
3740ENDIF  
3750UNTIL SV=B 
3760CLOSE FIL$ 
3770CLOSE FIL2$ 
3780CHAIN "P641210:STARTB"
DataMuseum.dk

MIKADOS

⟦ebcd44f4f⟧ TextFile

Derivation

Mikados K File

Full view
