DataMuseum.dk

top - download

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

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

Mikados K File

0010DIM POST4$(34),FIL7$(20),AKKTIM(10),AKKS$(10,16),B3$(12),DAD$(6) 
0100DIM AKK$(49),NR$(606),Å(100),M(30),FIL8$(20),FIL9$(20),AKKNR$(6) 
0105DIM RES$(15),OP1$(12),OP2$(12),RESUL$(12),TAH$(12),RESUL1$(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 CONV(NR2,OK22,CIF) 
0155OK2=ABS(OK22) 
0160NR2$="" 
0165REPEAT  
0170NR2$=CHR((OK2 MOD 10)+48)+NR2$ 
0175CIF=CIF-E 
0180OK2=OK2 DIV 10 
0185IF CIF<B AND OK2=B THEN CIF=B 
0190UNTIL CIF=B 
0193IF OK22<B THEN NR2$="-"+NR2$ 
0195ENDPROC  
0200PROC INDAKK 
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 
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 
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  
1150PROC CHECK(NR1,OK1) 
1165OK1=B 
1180RESULT=B 
1195IF LEN(NR1$)>B THEN  
1210IF NR1$(E)="-" THEN  
1225FORTEGN=-E 
1240OK1=E 
1255ELSE  
1270FORTEGN=E 
1285ENDIF  
1300WHILE LEN(NR1$)>OK1 
1315OK1=OK1+E 
1330IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN  
1345FORTEGN=B 
1360OK1=LEN(NR1$) 
1375ENDIF  
1390RESULT=RESULT*10+ORD(NR1$(OK1))-48 
1405ENDWHILE  
1420OK1=OK1*FORTEGN 
1435IF OK1<B THEN OK1=OK1+E 
1450ENDIF  
1465ENDPROC  
1480PROC INOPL(OPL) 
1510CASE OPL OF  
1525WHEN E 
1530EXEC INLINE(OPL) 
1540LMNR=RESULT 
1555WHEN G 
1570POST1$(E,25)=LINE$ 
1585WHEN V,4,5,6,7,8,W,10,11,12 
1600REPEAT  
1610LINE$=AKKS$(OPL-G,11,16) 
1620CURSOR E,OPL+V 
1630PRINT USING "### ":OPL 
1640CURSOR 11,OPL+V 
1650EDIT "",LINE$ 
1660OK=B 
1670IF LEN(LINE$)>B AND LEN(LINE$)<=6 THEN  
1680OK=E 
1690FOR I=LEN(LINE$)+E TO 6 
1700LINE$=LINE$+" " 
1705IF LINE$="0     " THEN LINE$="      " 
1710NEXT I 
1720AKKNR$=LINE$ 
1730IF AKKNR$<>"      " THEN  
1740EXEC INDAKK 
1750OK=FOUND 
1760ENDIF  
1770ENDIF  
1780UNTIL OK<>B 
1790IF OK<>E THEN STOP  
1800IF AKKS$(OPL-G,11,16)<>"      " THEN  
1810IF AKKNR$<>AKKS$(OPL-G,11,16) THEN  
1820AKKNR$=AKKS$(OPL-G,11,16) 
1830EXEC INDAKK 
1840IF FOUND<>E THEN STOP  
1850FOR I=E TO 30 
1860IF ABS(M(I))=LMNR THEN FOUND=B 
1870IF FOUND=B AND I<30 THEN M(I)=M(I+E) 
1880NEXT I 
1890IF FOUND=B THEN  
1900M(30)=B 
1910TTIMER=TTIMER-ABS(AKKTIM(OPL-G)) 
1920RESUL$=AKK$(28,38) 
1930RESUL1$=AKKS$(OPL-G,E,10) 
1940EXEC CALC(E,RESUL$,RESUL1$,RESUL$) 
1950AKK$(28,38)=RESUL$(G:11) 
1960ELSE  
1970STOP  
1980ENDIF  
1990EXEC UDAKK 
2000AKKNR$=LINE$ 
2010IF AKKNR$<>"      " THEN EXEC INDAKK 
2020ELSE  
2030TTIMER=TTIMER-ABS(AKKTIM(OPL-G)) 
2040RESUL$=AKK$(28,38) 
2050RESUL1$=AKKS$(OPL-G,E,10) 
2060EXEC CALC(E,RESUL$,RESUL1$,RESUL$) 
2070AKK$(28,38)=RESUL$(G:11) 
2080ENDIF  
2090ENDIF  
2100IF AKKNR$<>"      " THEN  
2110IF AKKNR$<>AKKS$(OPL-G,11,16) THEN  
2120FOR I=E TO 30 
2130IF ABS(M(I))=LMNR THEN  
2140I=100 
2150ELSE  
2160IF M(I)=B THEN M(I)=LMNR;I=I+30 
2170ENDIF  
2180NEXT I 
2185CURSOR E,22 
2190IF I>100 THEN INPUT "Findes allerede på akkord, RETURN ",LINE$ 
2200IF I<32 THEN INPUT "Ikke plads til flere på akkord, RETURN ",LINE$ 
2210ELSE  
2220FOR I=E TO 30 
2230IF ABS(M(I))=LMNR THEN M(I)=LMNR;I=I+30 
2240NEXT I 
2250IF I<32 THEN STOP  
2260ENDIF  
2270I=I-31 
2280IF I>B AND I<31 THEN  
2290REPEAT  
2300LINE$=AKKS$(OPL-G,E,10) 
2305IF LINE$(10)="+" THEN LINE$(10)=" " 
2310CURSOR 22,OPL+V 
2320EDIT "",LINE$ 
2330LINE$=LINE$+"+" 
2340EXEC CALC(6,LINE$,TAH$,RESUL$) 
2350UNTIL FLAG=B 
2360AKKS$(OPL-G,E,10)=RESUL$(V:10) 
2370RESUL1$=AKK$(28,38) 
2380EXEC CALC(B,RESUL$,RESUL1$,RESUL1$) 
2390AKK$(28,38)=RESUL1$(G:11) 
2400TIM=AKKTIM(OPL-G) 
2410CURSOR 37,OPL+V 
2420EDIT "",TIM 
2430AKKTIM(OPL-G)=TIM 
2440TTIMER=TTIMER+ABS(TIM) 
2450IF TIM<B THEN M(I)=-M(I) 
2460AKKS$(OPL-G,11,16)=AKKNR$ 
2470EXEC UDAKK 
2480ELSE  
2490AKKNR$="      " 
2500ENDIF  
2510ENDIF  
2520IF AKKNR$="      " THEN  
2530AKKTIM(OPL-G)=B 
2540AKKS$(OPL-G)="                " 
2550ENDIF  
2950ENDCASE  
2965ENDPROC  
2980PROC SKRIVOPL 
2995IF OUTP=B THEN CLEAR  
3000PRINT "A K K O R D R E G N S K A B E R";TAB(60);"Dato ";DAD$ 
3010FOR J=E TO A 
3025CASE J OF  
3040WHEN E 
3055EXEC CONV(LINE$,LMNR,0) 
3070WHEN G 
3085LINE$=POST1$(E,25) 
3100WHEN V,4,5,6,7,8,W,10,11,12 
3115EXEC Æ(RESUL$,AKKTIM(J-2)) 
3120IF RESUL$(12)="+" THEN RESUL$(12)=" " 
3125LINE$="     "+AKKS$(J-G,11,16)+"     "+AKKS$(J-G,E,10)+"  "+RESUL$ 
3135IF LINE$(26)="+" THEN LINE$(26)=" " 
3730ENDCASE  
3732IF J=V THEN  
3734PRINT  
3736PRINT  
3738PRINT "          AKKORD      UDBETALT         TIMER" 
3740ENDIF  
3745IF OUTP=B THEN  
3760EXEC OUTLINE(J) 
3775ELSE  
3790EXEC OUTPLINE(J) 
3805ENDIF  
3820NEXT J 
3835ENDPROC  
3850PROC OUTLINE(N) 
3865CURSOR X(N),Y(N) 
3880PRINT USING "### ":N; 
3895PRINT PICT$(N);":";LINE$ 
3910ENDPROC  
3925PROC INDVIRK 
3940OPEN FIL$,W 
3955EXEC FEJL(B,B,FIL$) 
3985GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM 
3990GET FIL$,V:DAD$ 
4000ENDPROC  
4015PROC FEJL(P1,P2,P3) 
4030IF STATUS(P3$)<>B THEN  
4045OUTPUT T 
4060PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2 
4075STOP  
4090ENDIF  
4105ENDPROC  
4120PROC INLINE(N) 
4135REPEAT  
4150CURSOR X(N)+5+LEN(PICT$(N)),Y(N) 
4165PRINT BL$(E:ABS(TYPE(N))+V) 
4180CURSOR X(N),Y(N) 
4195PRINT USING "### ":N; 
4210PRINT PICT$(N);":"; 
4225INPUT "",LINE$ 
4240IF TYPE(N)<B THEN  
4255IF LEN(LINE$)<=ABS(TYPE(N)) THEN  
4270OK=E 
4285FOR I=LEN(LINE$)+E TO ABS(TYPE(N)) 
4300LINE$(I)=" " 
4315NEXT I 
4330ELSE  
4345OK=B 
4360ENDIF  
4375ELSE  
4390EXEC CHECK(LINE$,OK) 
4405IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B 
4420ENDIF  
4435UNTIL OK<>B 
4450ENDPROC  
4585PROC OUTPLINE(N) 
4600PRINT TAB(X(N)); 
4615PRINT USING "### ":N; 
4630PRINT PICT$(N);":";LINE$; 
4632IF N=12 THEN  
4634PRINT  
4636ELSE  
4638IF Y(N)<Y(N+E) THEN PRINT  
4640ENDIF  
4645ENDPROC  
4660A=12 
4675DIM X(A),Y(A),PICT$(A,20),TYPE(A) 
4690DIM POST1$(71),POST2$(27) 
4705DIM BL$(79),LINE$(50),FIL$(20) 
4720FOR I=E TO 79 
4735BL$=BL$+" " 
4750NEXT I 
4765FIL$="P641220:VIRKKART" 
4780X(E)=E 
4795X(G)=30 
4810X(V)=E 
4825X(4)=E 
4840X(5)=E 
4855X(6)=E 
4870X(7)=E 
4885X(8)=E 
4900X(W)=E 
4915X(10)=E 
4930X(11)=E 
4945X(12)=E 
5095Y(E)=G 
5110Y(G)=G 
5125Y(V)=6 
5140Y(4)=7 
5155Y(5)=8 
5170Y(6)=W 
5185Y(7)=10 
5200Y(8)=11 
5215Y(W)=12 
5230Y(10)=13 
5245Y(11)=14 
5260Y(12)=15 
5410TYPE(E)=B 
5425TYPE(G)=-25 
5440FOR I=V TO 12 
5450TYPE(I)=-6 
5455PICT$(I)="" 
5460NEXT I 
5725PICT$(E)="Lønnr" 
5740PICT$(G)="Navn" 
6040EXEC INDVIRK 
6055CLOSE FIL$ 
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$) 
6130OUTP=B 
6145TAH$="          0+" 
6250REPEAT  
6265SV=G 
6280CLEAR  
6295CURSOR 10,10 
6310PRINT "A K K O R D R E G N S K A B S - K A R T O T E K" 
6325PRINT  
6340PRINT TAB(10);"0 Færdig" 
6355PRINT TAB(10);"1 Ændring" 
6370PRINT TAB(10);"2 Udskrift på skærm" 
6385PRINT TAB(10);"3 Udskrift på printer" 
6430PRINT  
6445REPEAT  
6460CURSOR E,19 
6475EDIT "          ",SV 
6490UNTIL SV=>B AND SV<=V 
6505IF SV>B THEN  
6520REPEAT  
6535EXEC INOPL(1) 
6550UNTIL LMNR=>B AND LMNR<=MLMNR 
6551LISTE=B 
6552IF LMNR=B THEN LISTE=E 
6553REPEAT  
6554IF LISTE=E THEN LMNR=LMNR+E 
6565EXEC INLØNMOD(LMNR) 
6570IF LA<>B THEN EXEC INDREGNS(LMNR) 
6580CASE SV OF  
6595WHEN E 
6610IF LA<>B THEN  
6625EXEC SKRIVOPL 
6640REPEAT  
6655REPEAT  
6670SV1=B 
6685CURSOR E,23 
6700EDIT "Feltnr ",SV1 
6715UNTIL SV1>G AND SV1<13 OR SV1=B 
6730IF SV1>B THEN  
6745EXEC INOPL(SV1) 
6750EXEC SKRIVOPL 
6760ENDIF  
6775UNTIL SV1=B 
6790EXEC UDREGNS(LMNR) 
6805ELSE  
6820PRINT "Lønmodtager findes ikke" 
6835INPUT "RETURN",LINE$ 
6850ENDIF  
6865WHEN G 
6880IF LA<>B THEN  
6895OUTP=B 
6910EXEC SKRIVOPL 
6925INPUT "RETURN",LINE$ 
6940ELSE  
6955PRINT "Lønmodtager findes ikke" 
6970INPUT "RETURN",LINE$ 
6985ENDIF  
7000WHEN V 
7015IF LA<>B OR LISTE=E THEN  
7016IF LA<>B THEN  
7030OUTPUT P 
7045OUTP=E 
7050PRINT  
7051PRINT  
7060EXEC SKRIVOPL 
7062FOR I=17 TO 72 
7064PRINT  
7066NEXT I 
7075OUTP=B 
7090OUTPUT T 
7095ENDIF  
7105ELSE  
7120PRINT "Lønmodtager findes ikke" 
7135INPUT "RETURN",LINE$ 
7150ENDIF  
8005ENDCASE  
8006UNTIL LISTE=B OR LMNR=>MLMNR 
8010ENDIF  
8020UNTIL SV=B 
8035CLOSE  
8065CHAIN "P641210:STARTB"