DataMuseum.dk

top - download

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

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

Mikados K File

0010DIM POST4$(34),FIL7$(20),AKKTIM(10),AKKS$(10,16),B3$(12),GSATS$(12) 
0100DIM AKK$(49),NR$(606),Å(100),M(30),FIL8$(20),FIL9$(20),AKKNR$(6),DAD$(6) 
0105DIM RES$(15),OP1$(12),OP2$(12),RESUL$(12),RESUL1$(12),TTIM$(12) 
0106DIM TUD$(12),HUND$(12) 
0110PROC CALC(AR3,B1,B2,ES) 
0115RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5) 
0120CALL "P641210:REGN" 
0125IF AR3<6 THEN  
0130IF FLAG THEN STOP  
0135ENDIF  
0140ES$=RES$ 
0145ENDPROC  
0150PROC SLET 
0151GN=Å(L) 
0152WHILE L<MAX DO  
0153NR$((L-E)*6+E:6)=NR$(L*6+E:6) 
0154Å(L)=Å(L+E) 
0155L=L+E 
0156ENDWHILE  
0157NR$((L-E)*6+E:6)="      " 
0158Å(L)=GN 
0159MAX=MAX-E 
0160ENDPROC  
0161PROC UDTABEL 
0162OPEN FIL9$,W 
0163EXEC FEJL(G,B,FIL9$) 
0164FOR I=E TO 10 
0165PUT FIL9$:NR$((I-E)*60+E:60) 
0166NEXT I 
0167PUT FIL9$:Å(E),Å(G),Å(V),Å(4),Å(5),Å(6),Å(7),Å(8),Å(W),Å(10) 
0168PUT FIL9$:Å(11),Å(12),Å(13),Å(14),Å(15),Å(16),Å(17),Å(18),Å(19),Å(20) 
0169PUT FIL9$:Å(21),Å(22),Å(23),Å(24),Å(25),Å(26),Å(27),Å(28),Å(29),Å(30) 
0170PUT FIL9$:Å(31),Å(32),Å(33),Å(34),Å(35),Å(36),Å(37),Å(38),Å(39),Å(40) 
0171PUT FIL9$:Å(41),Å(42),Å(43),Å(44),Å(45),Å(46),Å(47),Å(48),Å(49),Å(50) 
0172PUT FIL9$:Å(51),Å(52),Å(53),Å(54),Å(55),Å(56),Å(57),Å(58),Å(59),Å(60) 
0173PUT FIL9$:Å(61),Å(62),Å(63),Å(64),Å(65),Å(66),Å(67),Å(68),Å(69),Å(70) 
0174PUT FIL9$:Å(71),Å(72),Å(73),Å(74),Å(75),Å(76),Å(77),Å(78),Å(79),Å(80) 
0175PUT FIL9$:Å(81),Å(82),Å(83),Å(84),Å(85),Å(86),Å(87),Å(88),Å(89),Å(90) 
0176PUT FIL9$:Å(91),Å(92),Å(93),Å(94),Å(95),Å(96),Å(97),Å(98),Å(99),Å(100) 
0177ENDPROC  
0191DIM BL$(79),LINE$(50),FIL$(20) 
0192FIL$="P641220:VIRKKART" 
0193OPEN FIL$,R 
0194EXEC FEJL(B,B,FIL$) 
0195GET FIL$,V:DAD$ 
0196CLOSE FIL$ 
0200PROC INDAKK 
0203IF SV=E THEN  
0205L=E;U=MAX 
0210IF U>B THEN  
0215REPEAT  
0220PEG=(L+U) DIV G 
0225IF AKKNR$>NR$((PEG-E)*6+E:6) THEN  
0230L=PEG+E 
0235ELSE  
0240U=PEG-E 
0245ENDIF  
0250UNTIL L>U OR AKKNR$=NR$((PEG-E)*6+E:6) 
0255ENDIF  
0260L=U+E 
0261ELSE  
0262AKKNR$=NR$((L-E)*6+E:6) 
0263ENDIF  
0265IF NR$((L-E)*6+E:6)=AKKNR$ THEN  
0270FOUND=E 
0275PEG=Å(L) 
0280GET FIL8$,PEG:AKK$(E,27),TTIMER,RTIMER 
0285GET FIL8$,PEG+E:AKK$(28,49),M(E),M(G),M(V) 
0290GET FIL8$,PEG+G:M(4),M(5),M(6),M(7),M(8),M(W),M(10),M(11),M(12) 
0295GET FIL8$,PEG+V:M(13),M(14),M(15),M(16),M(17),M(18),M(19),M(20),M(21) 
0300GET FIL8$,PEG+4:M(22),M(23),M(24),M(25),M(26),M(27),M(28),M(29),M(30) 
0305EXEC FEJL(B,PEG,FIL8$) 
0310IF AKK$(E,6)<>AKKNR$ THEN FOUND=-E 
0315ELSE  
0320FOUND=B 
0325ENDIF  
0330ENDPROC  
0335PROC UDAKK 
0340PUT FIL8$,PEG:AKK$(E,27),TTIMER,RTIMER 
0345PUT FIL8$,PEG+E:AKK$(28,49),M(E),M(G),M(V) 
0350PUT FIL8$,PEG+G:M(4),M(5),M(6),M(7),M(8),M(W),M(10),M(11),M(12) 
0355PUT FIL8$,PEG+V:M(13),M(14),M(15),M(16),M(17),M(18),M(19),M(20),M(21) 
0360PUT FIL8$,PEG+4:M(22),M(23),M(24),M(25),M(26),M(27),M(28),M(29),M(30) 
0365EXEC FEJL(E,PEG,FIL8$) 
0370ENDPROC  
0375PROC INDTABEL 
0380FIL9$="P641220:AKKTABEL" 
0385OPEN FIL9$,R 
0390EXEC FEJL(B,B,FIL9$) 
0395FOR I=E TO 10 
0400GET FIL9$:NR$((I-E)*60+E:60) 
0405NEXT I 
0410GET FIL9$:Å(E),Å(G),Å(V),Å(4),Å(5),Å(6),Å(7),Å(8),Å(W),Å(10) 
0415GET FIL9$:Å(11),Å(12),Å(13),Å(14),Å(15),Å(16),Å(17),Å(18),Å(19),Å(20) 
0420GET FIL9$:Å(21),Å(22),Å(23),Å(24),Å(25),Å(26),Å(27),Å(28),Å(29),Å(30) 
0425GET FIL9$:Å(31),Å(32),Å(33),Å(34),Å(35),Å(36),Å(37),Å(38),Å(39),Å(40) 
0430GET FIL9$:Å(41),Å(42),Å(43),Å(44),Å(45),Å(46),Å(47),Å(48),Å(49),Å(50) 
0435GET FIL9$:Å(51),Å(52),Å(53),Å(54),Å(55),Å(56),Å(57),Å(58),Å(59),Å(60) 
0440GET FIL9$:Å(61),Å(62),Å(63),Å(64),Å(65),Å(66),Å(67),Å(68),Å(69),Å(70) 
0445GET FIL9$:Å(71),Å(72),Å(73),Å(74),Å(75),Å(76),Å(77),Å(78),Å(79),Å(80) 
0450GET FIL9$:Å(81),Å(82),Å(83),Å(84),Å(85),Å(86),Å(87),Å(88),Å(89),Å(90) 
0455GET FIL9$:Å(91),Å(92),Å(93),Å(94),Å(95),Å(96),Å(97),Å(98),Å(99),Å(100) 
0460EXEC FEJL(E,B,FIL9$) 
0465FOR I=B TO 99 
0470IF NR$(I*6+E:6)="      " THEN  
0475MAX=I;I=100 
0480ENDIF  
0485NEXT I 
0490CLOSE FIL9$ 
0495ENDPROC  
0500PROC INDREGNS(N) 
0510J=10*(N-E) 
0520FOR I=E TO 10 
0530GET FIL7$,J+I:AKKTIM(I),AKKS$(I) 
0540NEXT I 
0550EXEC FEJL(N,J,FIL7$) 
0560ENDPROC  
0600PROC UDREGNS(N) 
0610J=10*(N-E) 
0620FOR I=E TO 10 
0630PUT FIL7$,J+I:AKKTIM(I),AKKS$(I) 
0640NEXT I 
0650EXEC FEJL(-N,J,FIL7$) 
0660ENDPROC  
0850PROC INLØNMOD(N) 
0865GET FIL$,G*N-E:POST1$ 
0880GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD 
0895EXEC FEJL(E,N,FIL$) 
0910ENDPROC  
0915B3$="          0+" 
0916TI=10;EL=11 
0917HUND$="     100,00+" 
0920PROC Æ(I1,I2) 
0930I1$=B3$ 
0940IF I2<>B THEN  
0950I1$(W,TI)=",0";I0=ABS(I2);K0=INT((I0-INT(I0))*100+0.50001) 
0960IF I2<B THEN I1$(12)="-" 
0970FOR I=EL TO E STEP -E 
0980IF I<>W THEN  
0990I1$(I)=CHR(K0 MOD TI+48) 
1000K0=K0 DIV TI 
1010IF K0=B AND I<TI THEN I=B 
1020ELSE  
1030K0=INT(I0) 
1040ENDIF  
1050NEXT I 
1060ENDIF  
1070ENDPROC  
2980PROC SKRIVOPL 
2985TUD$=B3$;TTIM$=B3$ 
2990SLETK,AM,AFSL=B 
2995FOR I=E TO 30 
3000IF M(I)<>B THEN  
3005AM=AM+E 
3010IF M(I)<B THEN AFSL=AFSL+E 
3015ENDIF  
3020NEXT I 
3025IF DEL=V THEN SLETK=E 
3030IF DEL=G AND AFSL=AM THEN SLETK=G 
3035IF LINIE+AM+15>72 THEN  
3040WHILE LINIE<72 
3045PRINT  
3050LINIE=LINIE+E 
3055ENDWHILE  
3060PRINT  
3065PRINT "A K K O R D - L I S T E";TAB(60);"Dato ";DAD$ 
3070LINIE=G 
3075ENDIF  
3080PRINT  
3085PRINT  
3090PRINT  
3095PRINT "Akkord: ";AKK$(E,6);TAB(25);AKK$(7,27) 
3100PRINT  
3105PRINT "LØNNR   NAVN                        UDBETALT       TIMER"; 
3110PRINT "        GSATS    AFSLT" 
3115LINIE=LINIE+6 
3120FOR K=E TO 30 
3125IF M(K)<>B THEN  
3130LMNR=ABS(M(K)) 
3135EXEC INLØNMOD(LMNR) 
3140EXEC INDREGNS(LMNR) 
3145FOR J=E TO 10 
3150IF AKKS$(J,11,16)=AKKNR$ THEN J=J+20 
3155NEXT J 
3160J=J-21 
3165LINIE=LINIE+E 
3170IF J<E THEN  
3175PRINT "Indrapporter straks denne hændelse til H.S.MØLLER, og STOP" 
3180ELSE  
3185RESUL$=AKKS$(J,E,10) 
3190EXEC Æ(RESUL1$,ABS(AKKTIM(J))) 
3195EXEC CALC(B,TUD$,RESUL$,TUD$) 
3200EXEC CALC(B,TTIM$,RESUL1$,TTIM$) 
3205IF AKKTIM(J)<>B THEN  
3210EXEC CALC(V,RESUL$,RESUL1$,GSATS$) 
3215ELSE  
3220GSATS$=B3$ 
3225ENDIF  
3230IF RESUL1$(12)="+" THEN RESUL1$(12)=" " 
3235IF RESUL$(10)="+" THEN RESUL$(10)=" " 
3240IF GSATS$(12)="+" THEN GSATS$(12)=" " 
3245PRINT LMNR;TAB(W);POST1$(E,25);"  ";RESUL$;RESUL1$;" ";GSATS$;"   "; 
3250IF M(K)<B THEN  
3255PRINT "*****" 
3260IF SLETK>B THEN  
3265M(K)=B 
3270AKKTIM(J)=B 
3275AKKS$(J)="        0+      " 
3280EXEC UDREGNS(LMNR) 
3285ENDIF  
3290ELSE  
3295PRINT  
3300ENDIF  
3305ENDIF  
3310ENDIF  
3315NEXT K 
3320PRINT "---------------------------------------------------------------"; 
3325PRINT "---------------" 
3330EXEC CALC(4,TTIM$,B3$,B3$) 
3335IF SI>B THEN  
3340EXEC CALC(V,TUD$,TTIM$,GSATS$) 
3345ELSE  
3350GSATS$=B3$ 
3355ENDIF  
3360IF TTIM$(12)="+" THEN TTIM$(12)=" " 
3365IF TUD$(12)="+" THEN TUD$(12)=" " 
3370IF GSATS$(12)="+" THEN GSATS$(12)=" " 
3371PRINT "Total ";AM; 
3372IF AM=E THEN  
3373PRINT " medarbejder"; 
3374ELSE  
3375PRINT " medarbejdere"; 
3376ENDIF  
3379PRINT TAB(34);TUD$;TTIM$;" ";GSATS$;"   "; 
3380IF AFSL=AM THEN  
3385PRINT "*****" 
3390ELSE  
3395PRINT  
3400ENDIF  
3405PRINT  
3410RESUL$=AKK$(28,38) 
3415EXEC Æ(RESUL1$,TTIMER) 
3420IF TTIMER<>B THEN  
3425EXEC CALC(V,RESUL$,RESUL1$,GSATS$) 
3430ELSE  
3435GSATS$=B3$ 
3440ENDIF  
3445IF RESUL$(11)="+" THEN RESUL$(11)=" " 
3450IF RESUL1$(12)="+" THEN RESUL1$(12)=" " 
3455IF GSATS$(12)="+" THEN GSATS$(12)=" " 
3460PRINT "Totalt registreret på akkorden";TAB(35);RESUL$;RESUL1$;" ";GSATS$ 
3465TUD$=AKK$(39,49) 
3470EXEC Æ(TTIM$,RTIMER) 
3475IF RTIMER<>B THEN  
3480EXEC CALC(V,TUD$,TTIM$,GSATS$) 
3485ELSE  
3490GSATS$=B3$ 
3495ENDIF  
3500IF TUD$(11)="+" THEN TUD$(11)=" " 
3505IF TTIM$(12)="+" THEN TTIM$(12)=" " 
3510IF GSATS$(12)="+" THEN GSATS$(12)=" " 
3515PRINT "Budgetteret på akkorden";TAB(35);TUD$;TTIM$;" ";GSATS$ 
3516RESUL$=AKK$(28,38) 
3517EXEC Æ(RESUL1$,TTIMER) 
3518TUD$=AKK$(39,49) 
3519EXEC Æ(TTIM$,RTIMER) 
3520EXEC CALC(4,TUD$,B3$,B3$) 
3525IF SI>B THEN  
3530EXEC CALC(G,HUND$,RESUL$,RESUL$) 
3535EXEC CALC(V,RESUL$,TUD$,RESUL$) 
3540ELSE  
3545RESUL$=B3$ 
3550ENDIF  
3555EXEC CALC(4,TTIM$,B3$,B3$) 
3560IF SI>B THEN  
3565EXEC CALC(G,HUND$,RESUL1$,RESUL1$) 
3570EXEC CALC(V,RESUL1$,TTIM$,RESUL1$) 
3575ELSE  
3580RESUL1$=B3$ 
3585ENDIF  
3590IF RESUL$(12)="+" THEN RESUL$(12)=" " 
3595IF RESUL1$(12)="+" THEN RESUL1$(12)=" " 
3600PRINT "% effektueret";TAB(34);RESUL$;RESUL1$ 
3605PRINT  
3610PRINT  
3615PRINT  
3620LINIE=LINIE+W 
3625IF SLETK=G THEN  
3629AFSL=L 
3630EXEC SLET 
3631L=AFSL 
3635ELSE  
3640IF SLETK=E AND AFSL>B THEN EXEC UDAKK 
3645ENDIF  
3835ENDPROC  
4015PROC FEJL(P1,P2,P3) 
4030IF STATUS(P3$)<>B THEN  
4045OUTPUT T 
4060PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2 
4075STOP  
4090ENDIF  
4105ENDPROC  
4690DIM POST1$(71),POST2$(27) 
4720FOR I=E TO 79 
4735BL$=BL$+" " 
4750NEXT I 
6070FIL$="P641220:LØNMODRG" 
6085OPEN FIL$,R 
6100EXEC FEJL(B,B,FIL$) 
6102FIL8$="P641220:AKKHOVED" 
6104OPEN FIL8$,W 
6106EXEC FEJL(B,B,FIL8$) 
6108EXEC INDTABEL 
6110FIL7$="P641220:AKKREGNS" 
6112OPEN FIL7$,W 
6114EXEC FEJL(B,B,FIL7$) 
6130LINIE=72 
6250REPEAT  
6265SV=G 
6280CLEAR  
6295CURSOR 10,10 
6310PRINT "A K K O R D L I S T E" 
6325PRINT  
6340PRINT TAB(10);"0 Færdig" 
6355PRINT TAB(10);"1 Enkelt akkord" 
6370PRINT TAB(10);"2 Alle akkorder" 
6430PRINT  
6445REPEAT  
6460CURSOR E,19 
6475EDIT "          ",SV 
6490UNTIL SV=>B AND SV<=G 
6505IF SV>B THEN  
6506DEL=E;L=B 
6507REPEAT  
6508CLEAR  
6509PRINT TAB(10);"Kun udskrift                         1" 
6510PRINT TAB(10);"Slet afsluttede akkorder             2" 
6511PRINT TAB(10);"Slet afsluttede akkordmedarbejdere   3" 
6512EDIT "Vælg 1 - 3 ",DEL 
6513UNTIL DEL>B AND DEL<4 
6514IF SV<>G THEN  
6520REPEAT  
6530AKKNR$="      " 
6535EDIT "Akkordnr ",AKKNR$ 
6550UNTIL LEN(AKKNR$)<=6 
6551ENDIF  
6552OUTPUT P 
6553WHILE L<MAX 
6554IF SV=G THEN L=L+E 
6570EXEC INDAKK 
6580CASE SV OF  
6865WHEN E 
6880IF FOUND=E THEN  
6910EXEC SKRIVOPL 
6940ELSE  
6950OUTPUT T 
6955PRINT "Akkord findes ikke" 
6970INPUT "RETURN",LINE$ 
6980OUTPUT P 
6985ENDIF  
6990L=MAX 
7000WHEN G 
7060EXEC SKRIVOPL 
8005ENDCASE  
8006ENDWHILE  
8008OUTPUT T 
8010ENDIF  
8020UNTIL SV=B 
8022OUTPUT P 
8023WHILE LINIE<72 
8024PRINT  
8025LINIE=LINIE+E 
8026ENDWHILE  
8027OUTPUT T 
8028EXEC UDTABEL 
8035CLOSE  
8065CHAIN "P641210:STARTB"