DataMuseum.dk

top - download

    Length: 10112 (0x2780)
    Types: TextFile
    Notes: Mikados_K
    Names: »TV1.K«

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

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=E TO V 
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,W,10,11,12,13,15,16,17,18 
1310REPEAT  
1320LINE$=LINE$+"+" 
1330EXEC CALC(6,LINE$,TAH$,RESUL$) 
1340IF FLAG<>B THEN EXEC INLINE(OPL) 
1350UNTIL FLAG=B 
1360IF OPL<8 THEN  
1370T=OPL-G 
1380ELSE  
1390T=OPL-V 
1400ENDIF  
1403IF T=E OR T=V OR T=5 OR (T>6 AND T<11) THEN  
1405LINE$=TV$(11) 
1407PR$=TV$(T) 
1408ENDIF  
1410TV$(T)=RESUL$(G:11) 
1412IF T=E OR T=V OR T=5 OR (T>6 AND T<11) THEN  
1415EXEC CALC(E,RESUL$,PR$,RESUL1$) 
1417EXEC CALC(B,LINE$,RESUL1$,RESUL$) 
1419TV$(11)=RESUL$(G:11) 
1420ENDIF  
1430ENDCASE  
1440ENDPROC  
1441PROC SKRIVOPL 
1442RESUL$=TV$(E);RESUL1$=TV$(V) 
1443EXEC CALC(B,RESUL$,RESUL1$,RESUL1$) 
1444RESUL$=TV$(5) 
1445EXEC CALC(B,RESUL$,RESUL1$,RESUL1$) 
1446RESUL$=TV$(7) 
1447EXEC CALC(B,RESUL$,RESUL1$,RESUL1$) 
1448RESUL$=TV$(8) 
1449EXEC CALC(B,RESUL$,RESUL1$,RESUL1$) 
1450RESUL$=TV$(W) 
1451EXEC CALC(B,RESUL$,RESUL1$,RESUL1$) 
1452RESUL$=TV$(10) 
1453EXEC CALC(B,RESUL$,RESUL1$,RESUL1$) 
1454RESUL$=TV$(11) 
1455EXEC CALC(4,RESUL$,RESUL1$,RESUL1$) 
1456IF SI<>B THEN TV$(11)=RESUL1$(G:11) 
1457IF SI<>B THEN INPUT "TV12 KORRIGERET ,RETURN ",RESUL$ 
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 "A R B E J D E R L Ø N S T A T I S T I K";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,W,10,11,12,13,14,15,16,17,18 
1560IF J<8 THEN  
1570T=J-G 
1580ELSE  
1590T=J-V 
1600ENDIF  
1610RESUL$=TV$(T) 
1620EXEC TUD(RESUL$,PR$,E,B) 
1630LINE$=PR$ 
1640WHEN 8 
1650RESUL$=TV$(G) 
1660LINE$=TV$(4) 
1670EXEC CALC(B,LINE$,RESUL$,RESUL1$) 
1680EXEC TUD(RESUL1$,PR$,E,B) 
1690LINE$=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(40);"INDHOLD" 
1840ELSE  
1850IF N>G THEN  
1860IF N<8 THEN  
1870T=N-G 
1880ELSE  
1890T=N-V 
1900ENDIF  
1901IF N=8 THEN  
1902RESUL$="006" 
1903ELSE  
1910EXEC CONV(RESUL$,TVN(T),3) 
1915ENDIF  
1920PRINT RESUL$;" "; 
1930ENDIF  
1940PRINT PICT$(N);":";TAB(32);LINE$ 
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<8 THEN  
2120T=N-G 
2130ELSE  
2140T=N-V 
2150ENDIF  
2151IF N=8 THEN  
2152RESUL$="006" 
2153ELSE  
2160EXEC CONV(RESUL$,TVN(T),3) 
2165ENDIF  
2170PRINT RESUL$;" "; 
2180ENDIF  
2190PRINT PICT$(N);":"; 
2200CURSOR 32,Y(N) 
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(40);"INDHOLD" 
2400ELSE  
2410IF N>G THEN  
2420IF N<8 THEN  
2430T=N-G 
2440ELSE  
2450T=N-V 
2460ENDIF  
2461IF N=8 THEN  
2462RESUL$="006" 
2463ELSE  
2470EXEC CONV(RESUL$,TVN(T),3) 
2475ENDIF  
2480PRINT RESUL$;" "; 
2490ENDIF  
2500PRINT PICT$(N);":";TAB(32);LINE$; 
2505IF N>G THEN PRINT  
2510ENDIF  
2520ENDPROC  
2530A=18 
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 18 
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" 
2720PICT$(V)="Tillæg til fordeling" 
2730PICT$(4)="Akkordtimer" 
2740PICT$(5)="Akkordbeløb" 
2750PICT$(6)="Tidlønstimer" 
2760PICT$(7)="Tidlønsbeløb" 
2770PICT$(8)="Timer i alt" 
2780PICT$(W)="Heraf overtimer" 
2790PICT$(10)="Overtidstillæg" 
2800PICT$(11)="Holddriftstillæg" 
2810PICT$(12)="Genetillæg" 
2820PICT$(13)="Div U F arbejdst" 
2830PICT$(14)="Ferieberett løn" 
2840PICT$(15)="Sygeferiepenge" 
2850PICT$(16)="Sygedagpenge" 
2860PICT$(17)="Beregnede feriep" 
2870PICT$(18)="SH-opsparing" 
2880OUTP=B 
2890PROC INDTÆL(N) 
2900J=W*(N-E) 
2910FOR K=E TO V 
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 "         A R B E J D E R L Ø N S T A T I S T I K" 
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<19 AND SV1<>8 AND SV1<>14) 
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=21 TO 72 
3663PRINT  
3664NEXT 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$ 
3775CHAIN "P641210:STARTB" 
3780STOP