DataMuseum.dk

top - download

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

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

Mikados K File

0100DIM POST4$(34),FIL7$(20),AKKTIM(10),AKKS$(10,16),B3$(12),TUD$(12) 
0110DIM AKK$(49),NR$(606),Å(100),M(30),FIL8$(20),FIL9$(20),AKKNR$(6),DAD$(6) 
0120DIM RES$(15),OP1$(12),OP2$(12),RESUL$(12),RESUL1$(12),TTIM$(12) 
0130DIM GSATS$(12) 
0140PROC CALC(AR3,B1,B2,ES) 
0150RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5) 
0160CALL "P641210:REGN" 
0170IF AR3<6 THEN  
0180IF FLAG THEN STOP  
0190ENDIF  
0200ES$=RES$ 
0210ENDPROC  
0220PROC CONV(NR2,OK22,CIF) 
0230OK2=ABS(OK22) 
0240NR2$="" 
0250REPEAT  
0260NR2$=CHR((OK2 MOD 10)+48)+NR2$ 
0270CIF=CIF-E 
0280OK2=OK2 DIV 10 
0290IF CIF<B AND OK2=B THEN CIF=B 
0300UNTIL CIF=B 
0310IF OK22<B THEN NR2$="-"+NR2$ 
0320ENDPROC  
0330PROC INDAKK 
0340L=E;U=MAX 
0350IF U>B THEN  
0360REPEAT  
0370PEG=(L+U) DIV G 
0380IF AKKNR$>NR$((PEG-E)*6+E:6) THEN  
0390L=PEG+E 
0400ELSE  
0410U=PEG-E 
0420ENDIF  
0430UNTIL L>U OR AKKNR$=NR$((PEG-E)*6+E:6) 
0440ENDIF  
0450L=U+E 
0460IF NR$((L-E)*6+E:6)=AKKNR$ THEN  
0470FOUND=E 
0480PEG=Å(L) 
0490GET FIL8$,PEG:AKK$(E,27),TTIMER,RTIMER 
0500GET FIL8$,PEG+E:AKK$(28,49),M(E),M(G),M(V) 
0510GET FIL8$,PEG+G:M(4),M(5),M(6),M(7),M(8),M(W),M(10),M(11),M(12) 
0520GET FIL8$,PEG+V:M(13),M(14),M(15),M(16),M(17),M(18),M(19),M(20),M(21) 
0530GET FIL8$,PEG+4:M(22),M(23),M(24),M(25),M(26),M(27),M(28),M(29),M(30) 
0540EXEC FEJL(B,PEG,FIL8$) 
0550IF AKK$(E,6)<>AKKNR$ THEN FOUND=-E 
0560ELSE  
0570FOUND=B 
0580ENDIF  
0590ENDPROC  
0600PROC INDTABEL 
0610FIL9$="P641220:AKKTABEL" 
0620OPEN FIL9$,R 
0630EXEC FEJL(B,B,FIL9$) 
0640FOR I=E TO 10 
0650GET FIL9$:NR$((I-E)*60+E:60) 
0660NEXT I 
0670GET FIL9$:Å(E),Å(G),Å(V),Å(4),Å(5),Å(6),Å(7),Å(8),Å(W),Å(10) 
0680GET FIL9$:Å(11),Å(12),Å(13),Å(14),Å(15),Å(16),Å(17),Å(18),Å(19),Å(20) 
0690GET FIL9$:Å(21),Å(22),Å(23),Å(24),Å(25),Å(26),Å(27),Å(28),Å(29),Å(30) 
0700GET FIL9$:Å(31),Å(32),Å(33),Å(34),Å(35),Å(36),Å(37),Å(38),Å(39),Å(40) 
0710GET FIL9$:Å(41),Å(42),Å(43),Å(44),Å(45),Å(46),Å(47),Å(48),Å(49),Å(50) 
0720GET FIL9$:Å(51),Å(52),Å(53),Å(54),Å(55),Å(56),Å(57),Å(58),Å(59),Å(60) 
0730GET FIL9$:Å(61),Å(62),Å(63),Å(64),Å(65),Å(66),Å(67),Å(68),Å(69),Å(70) 
0740GET FIL9$:Å(71),Å(72),Å(73),Å(74),Å(75),Å(76),Å(77),Å(78),Å(79),Å(80) 
0750GET FIL9$:Å(81),Å(82),Å(83),Å(84),Å(85),Å(86),Å(87),Å(88),Å(89),Å(90) 
0760GET FIL9$:Å(91),Å(92),Å(93),Å(94),Å(95),Å(96),Å(97),Å(98),Å(99),Å(100) 
0770EXEC FEJL(E,B,FIL9$) 
0780FOR I=B TO 99 
0790IF NR$(I*6+E:6)="      " THEN  
0800MAX=I;I=100 
0810ENDIF  
0820NEXT I 
0830CLOSE FIL9$ 
0840ENDPROC  
0850PROC INDREGNS(N) 
0860J=10*(N-E) 
0870FOR I=E TO 10 
0880GET FIL7$,J+I:AKKTIM(I),AKKS$(I) 
0890NEXT I 
0900EXEC FEJL(N,J,FIL7$) 
0910ENDPROC  
0920PROC INLØNMOD(N) 
0930GET FIL$,G*N-E:POST1$ 
0940GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD 
0950EXEC FEJL(E,N,FIL$) 
0960ENDPROC  
0970B3$="          0+" 
0980TI=10;EL=11 
0990PROC Æ(I1,I2) 
1000I1$=B3$ 
1010IF I2<>B THEN  
1020I1$(W,TI)=",0";I0=ABS(I2);K0=INT((I0-INT(I0))*100+0.50001) 
1030IF I2<B THEN I1$(12)="-" 
1040FOR I=EL TO E STEP -E 
1050IF I<>W THEN  
1060I1$(I)=CHR(K0 MOD TI+48) 
1070K0=K0 DIV TI 
1080IF K0=B AND I<TI THEN I=B 
1090ELSE  
1100K0=INT(I0) 
1110ENDIF  
1120NEXT I 
1130ENDIF  
1140ENDPROC  
1150PROC CHECK(NR1,OK1) 
1160OK1=B 
1170RESULT=B 
1180IF LEN(NR1$)>B THEN  
1190IF NR1$(E)="-" THEN  
1200FORTEGN=-E 
1210OK1=E 
1220ELSE  
1230FORTEGN=E 
1240ENDIF  
1250WHILE LEN(NR1$)>OK1 
1260OK1=OK1+E 
1270IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN  
1280FORTEGN=B 
1290OK1=LEN(NR1$) 
1300ENDIF  
1310RESULT=RESULT*10+ORD(NR1$(OK1))-48 
1320ENDWHILE  
1330OK1=OK1*FORTEGN 
1340IF OK1<B THEN OK1=OK1+E 
1350ENDIF  
1360ENDPROC  
1370PROC INOPL(OPL) 
1380CASE OPL OF  
1390WHEN E 
1400EXEC INLINE(OPL) 
1410LMNR=RESULT 
1420ENDCASE  
1430ENDPROC  
1440PROC SKRIVOPL 
1450PRINT  
1460IF LINIE=72 THEN  
1470LINIE=B 
1480PRINT "A K K O R D L I S T E - M E D A R B E J D E R O P D E L T"; 
1485PRINT TAB(60);"Dato ";DAD$ 
1490ELSE  
1500PRINT  
1510ENDIF  
1520PRINT  
1530PRINT  
1540EXEC CONV(LINE$,LMNR,0) 
1550PRINT "Lønmodtager : ";LMNR;TAB(25);POST1$(E,25) 
1560PRINT  
1570PRINT  
1580PRINT "AKKORD     TEKST                    UDBETALT       TIMER"; 
1590PRINT "        GSATS    AFSLT" 
1600AFSL,MANGLER=B 
1610TUD$=B3$;TTIM$=B3$ 
1620FOR J=E TO 10 
1630AKKNR$=AKKS$(J,11,16) 
1640IF AKKNR$<>"      " THEN  
1650EXEC INDAKK 
1660IF FOUND=E THEN  
1670RESUL$=AKKS$(J,E,10) 
1680EXEC Æ(RESUL1$,ABS(AKKTIM(J))) 
1690EXEC CALC(B,TUD$,RESUL$,TUD$) 
1700EXEC CALC(B,TTIM$,RESUL1$,TTIM$) 
1710IF AKKTIM(J)<>B THEN  
1720EXEC CALC(V,RESUL$,RESUL1$,GSATS$) 
1730ELSE  
1740GSATS$=B3$ 
1750ENDIF  
1760IF RESUL$(10)="+" THEN RESUL$(10)=" " 
1770IF RESUL1$(12)="+" THEN RESUL1$(12)=" " 
1780IF GSATS$(12)="+" THEN GSATS$(12)=" " 
1790PRINT AKKNR$;"     ";AKK$(7,27);"   ";RESUL$;RESUL1$;" ";GSATS$;"   "; 
1800IF AKKTIM(J)<B THEN  
1810AFSL=AFSL+E 
1820PRINT "*****" 
1830ELSE  
1840PRINT  
1850ENDIF  
1860ELSE  
1870PRINT "Indrapporter straks denne hændelse til H.S.Møller, og STOP" 
1880ENDIF  
1890ELSE  
1900MANGLER=MANGLER+E 
1910ENDIF  
1920NEXT J 
1930PRINT "---------------------------------------------------------------"; 
1940PRINT "---------------" 
1950EXEC CALC(4,TTIM$,B3$,B3$) 
1960IF SI>B THEN  
1970EXEC CALC(V,TUD$,TTIM$,GSATS$) 
1980ELSE  
1990GSATS$=B3$ 
2000ENDIF  
2010IF TTIM$(12)="+" THEN TTIM$(12)=" " 
2020IF TUD$(12)="+" THEN TUD$(12)=" " 
2030IF GSATS$(12)="+" THEN GSATS$(12)=" " 
2040PRINT "Total "; 
2041IF 10-MANGLER=E THEN  
2042PRINT 10-MANGLER;" akkord  "; 
2043ELSE  
2044PRINT 10-MANGLER;" akkorder"; 
2045ENDIF  
2046PRINT TAB(34);TUD$;TTIM$;" ";GSATS$; 
2050IF AFSL+MANGLER=10 THEN  
2060PRINT "   *****" 
2070ELSE  
2080PRINT  
2090ENDIF  
2100MANGLER=MANGLER+4 
2110WHILE MANGLER>B 
2120PRINT  
2130MANGLER=MANGLER-E 
2140ENDWHILE  
2150LINIE=LINIE+24 
2160ENDPROC  
2170PROC INDVIRK 
2180OPEN FIL$,W 
2190EXEC FEJL(B,B,FIL$) 
2200GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM 
2205GET FIL$,V:DAD$ 
2210ENDPROC  
2220PROC FEJL(P1,P2,P3) 
2230IF STATUS(P3$)<>B THEN  
2240OUTPUT T 
2250PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2 
2260STOP  
2270ENDIF  
2280ENDPROC  
2290PROC INLINE(N) 
2300REPEAT  
2310CURSOR X(N)+5+LEN(PICT$(N)),Y(N) 
2320PRINT BL$(E:ABS(TYPE(N))+V) 
2330CURSOR X(N),Y(N) 
2340PRINT USING "### ":N; 
2350PRINT PICT$(N);":"; 
2360INPUT "",LINE$ 
2370IF TYPE(N)<B THEN  
2380IF LEN(LINE$)<=ABS(TYPE(N)) THEN  
2390OK=E 
2400FOR I=LEN(LINE$)+E TO ABS(TYPE(N)) 
2410LINE$(I)=" " 
2420NEXT I 
2430ELSE  
2440OK=B 
2450ENDIF  
2460ELSE  
2470EXEC CHECK(LINE$,OK) 
2480IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B 
2490ENDIF  
2500UNTIL OK<>B 
2510ENDPROC  
2520A=E 
2530DIM X(A),Y(A),PICT$(A,20),TYPE(A) 
2540DIM POST1$(71),POST2$(27) 
2550DIM BL$(79),LINE$(50),FIL$(20) 
2560FOR I=E TO 79 
2570BL$=BL$+" " 
2580NEXT I 
2590FIL$="P641220:VIRKKART" 
2600X(E)=E 
2610Y(E)=G 
2620TYPE(E)=B 
2630PICT$(E)="Lønnr" 
2640EXEC INDVIRK 
2650CLOSE FIL$ 
2660FIL$="P641220:LØNMODRG" 
2670OPEN FIL$,R 
2680EXEC FEJL(B,B,FIL$) 
2690FIL8$="P641220:AKKHOVED" 
2700OPEN FIL8$,R 
2710EXEC FEJL(B,B,FIL8$) 
2720EXEC INDTABEL 
2730FIL7$="P641220:AKKREGNS" 
2740OPEN FIL7$,W 
2750EXEC FEJL(B,B,FIL7$) 
2760LINIE=72 
2770REPEAT  
2780SV=E 
2790CLEAR  
2800CURSOR 10,10 
2810PRINT "A K K O R D L I S T E - M E D A R B E J D E R O P D E L T" 
2820PRINT  
2830PRINT TAB(10);"0 Færdig" 
2840PRINT TAB(10);"1 Enkelt medarbejder" 
2850PRINT TAB(10);"2 Alle medarbejdere" 
2860PRINT  
2870REPEAT  
2880CURSOR E,19 
2890EDIT "          ",SV 
2900UNTIL SV=>B AND SV<=G 
2910IF SV>B THEN  
2920IF SV=E THEN  
2930REPEAT  
2940EXEC INOPL(1) 
2950UNTIL LMNR>B AND LMNR<=MLMNR 
2960ELSE  
2970LMNR=B 
2980ENDIF  
2990OUTPUT P 
3000REPEAT  
3010IF SV=G THEN LMNR=LMNR+E 
3020EXEC INLØNMOD(LMNR) 
3030IF LA<>B THEN EXEC INDREGNS(LMNR) 
3040CASE SV OF  
3050WHEN E 
3060IF LA<>B THEN  
3070EXEC SKRIVOPL 
3080ELSE  
3090OUTPUT T 
3100PRINT "Lønmodtager findes ikke" 
3110INPUT "RETURN",LINE$ 
3120OUTPUT P 
3130ENDIF  
3140WHEN G 
3150IF LA<>B THEN  
3160EXEC SKRIVOPL 
3170ENDIF  
3180ENDCASE  
3190UNTIL SV=E OR LMNR=>MLMNR 
3200OUTPUT T 
3210ENDIF  
3220UNTIL SV=B 
3230IF LINIE>B THEN  
3240OUTPUT P 
3250WHILE LINIE<72 
3260PRINT  
3270LINIE=LINIE+E 
3280ENDWHILE  
3290OUTPUT T 
3300ENDIF  
3310CLOSE  
3320CHAIN "P641210:STARTB"