DataMuseum.dk

top - download

    Length: 7584 (0x1da0)
    Types: TextFile
    Notes: Mikados_K
    Names: »ENTRETOT.K«

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

Mikados K File

0090 B=0;E=1;G=2;V=3;W=9
0100 PROC INLØNMOD(N)
0110 GET FIL1$,G*N:P7$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
0120 EXEC FEJL(E,N,FIL1$)
0130 ENDPROC 
0140 PROC NÆSTE
0150 REPEAT 
0160 LMNR=LMNR+E
0170 LA=E
0180 IF LMNR<=MLMNR THEN EXEC INLØNMOD(LMNR)
0190 UNTIL LA>B
0200 ENDPROC 
0210 DIM RES$(15),OP1$(12),OP2$(12)
0220 DIM FIL1$(16),PCT$(12)
0230 DIM RESUL$(12),RESUL1$(12),D1$(6),D2$(6),DAD$(6)
0240 DIM FIL$(16)
0250 DIM EN$(12),BE$(12),GRUPPE$(6),GRUPEN$(12),GRUPBEL$(12)
0260 PROC CALC(AR3,B1,B2,ES)
0270 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0280 CALL "P641210:REGN"
0290 IF AR3<6 AND FLAG THEN STOP 
0300 ES$=RES$
0310 ENDPROC 
0320 PROC INDVIRK
0330 OPEN FIL$,W
0340 EXEC FEJL(B,B,FIL$)
0350 GET FIL$,G:P7$,SLJNR,MLMNR,ATPLM
0355 GET FIL$,V:DAD$
0360 ENDPROC 
0370 PROC FEJL(P1,P2,P3)
0380 IF STATUS(P3$)<>B THEN 
0390 OUTPUT T
0400 PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2
0410 STOP 
0420 ENDIF 
0430 ENDPROC 
0440 PROC OPTÆL(N)
0450 RESUL$=P7$(11:10)
0460 RESUL1$=T$(N,7:10)
0470 EXEC CALC(B,RESUL$,RESUL1$,RESUL1$)
0480 T$(N,7:10)=RESUL1$(V:10)
0490 RESUL$=P7$(28:10)
0500 RESUL1$=T$(N,17:10)
0510 EXEC CALC(B,RESUL$,RESUL1$,RESUL1$)
0520 T$(N,17:10)=RESUL1$(V:10)
0530 ENDPROC 
0540 PROC PV(Å,Æ)
0550 IF Å$="+" THEN Å$=" "
0560 IF Æ$="+" THEN Æ$=" "
0570 ENDPROC 
0580 MAX=725
0590 DIM T$(MAX+E,26),P7$(37)
0600 FOR I=E TO MAX+E
0610 T$(I)="              0+        0+"
0620 NEXT I
0630 PROC FIND
0640 NR=E
0650 WHILE T$(NR,E:6)<>"      "
0660 IF T$(NR,E:6)=P7$(5:6) THEN EXIT 
0670 IF T$(NR,E:6)>P7$(5:6) THEN 
0680 NR=G*NR
0690 ELSE 
0700 NR=G*NR+E
0710 ENDIF 
0720 IF NR>MAX THEN EXIT 
0730 ENDWHILE 
0740 ENDPROC 
0750 PROC TRAVERSE
0760 IF NR<=MAX THEN 
0770 IF T$(NR,E:6)<>"      " THEN 
0780 NR=G*NR
0790 EXEC TRAVERSE
0800 NR=NR DIV G
0810 IF GRUPPE$="      " THEN GRUPPE$=T$(NR,E,5)
0820 IF LINIE>62 THEN EXEC HEAD
0830 IF GRUPPE$<>T$(NR,E,5) THEN 
0832 EXEC CALC(G,PCT$,GRUPBEL$,RESUL$)
0834 IF RESUL$(12)="+" THEN RESUL$(12)=" "
0840 EXEC PV(GRUPEN$(12),GRUPBEL$(12))
0850 PRINT "Total ";GRUPPE$,GRUPEN$(V:10),GRUPBEL$(V:10),RESUL$(V:10)
0860 PRINT 
0870 GRUPPE$=T$(NR,E,5)
0880 GRUPEN$="0+"
0890 GRUPBEL$=GRUPEN$;LINIE=LINIE+G
0900 ENDIF 
0910 LINIE=LINIE+E
0920 RESUL$=T$(NR,7:10)
0930 EXEC CALC(B,RESUL$,GRUPEN$,GRUPEN$)
0940 EXEC CALC(B,RESUL$,EN$,EN$)
0950 RESUL$=T$(NR,17:10)
0960 EXEC CALC(B,RESUL$,GRUPBEL$,GRUPBEL$)
0970 EXEC CALC(B,RESUL$,BE$,BE$)
0980 EXEC PV(T$(NR,16),T$(NR,26))
0990 PRINT T$(NR,E:6),T$(NR,7:10),T$(NR,17:10)
1000 NR=G*NR+E
1010 EXEC TRAVERSE
1020 NR=NR DIV G
1030 ENDIF 
1040 ENDIF 
1050 ENDPROC 
1060 PROC BINNEXT
1070 NR=NR*G+E
1080 IF NR>MAX THEN 
1090 WHILE NR MOD G=E
1100 NR=NR DIV G
1110 ENDWHILE 
1120 NR=NR DIV G
1130 ELSE 
1140 WHILE NR<=MAX DIV G
1150 NR=NR*G
1160 ENDWHILE 
1170 ENDIF 
1180 ENDPROC 
1190 PROC BINPREV
1200 NR=NR*G
1210 IF NR>MAX THEN 
1220 WHILE NR MOD G=B
1230 NR=NR DIV G
1240 ENDWHILE 
1250 NR=NR DIV G
1260 ELSE 
1270 WHILE NR<MAX DIV G
1280 NR=NR*G+E
1290 ENDWHILE 
1300 ENDIF 
1310 ENDPROC 
1320 PROC HEAD
1330 WHILE LINIE<72 AND LINIE>B
1340 PRINT 
1350 LINIE=LINIE+E
1360 ENDWHILE 
1370 SID=SID+E
1380 PRINT "Lønudgifter fordelt på entrepriser";TAB(55);"Side ";SID;TAB(67);
1390 PRINT "Dato ";DAD$
1400 PRINT TAB(55);"Periode ";D1$;" - ";D2$
1410 PRINT "Konto","  Enheder","    Beløb   ";PCT$(V:W);" * Beløb"
1420 PRINT 
1430 LINIE=4
1440 ENDPROC 
1450 CLEAR 
1460 INPUT "Periodestart ",D1$
1470 INPUT "Periodeslut  ",D2$
1490 FIL$="P641220:VIRKKART"
1500 EXEC INDVIRK
1510 CLOSE FIL$
1520 FIL1$="P641220:LØNMODRG"
1530 OPEN FIL1$,R
1540 FIL$="P641220:TRANSREG"
1550 OPEN FIL$,W
1560 EN$="0+"
1570 BE$=EN$
1580 REPEAT 
1590 PCT$="1,16"
1600 EDIT "Faktor ",PCT$
1605 PCT$=PCT$+"+"
1610 EXEC CALC(6,PCT$,EN$,PCT$)
1620 UNTIL SI=B
1630 NRP=B
1640 LMNR=B
1650 EXEC NÆSTE
1660 WHILE LMNR<=MLMNR
1670 IT=(LMNR-E)*ATPLM+E
1680 GET FIL$,IT:P7$
1690 IF P7$(E)="2" THEN 
1700 P7$(E)="3"
1710 PUT FIL$,IT:P7$
1720 WHILE P7$(V,4)<>"83"
1730 IF P7$(5:6)<>"      " THEN 
1740 RESUL$=P7$(11:10)
1750 EXEC CALC(B,EN$,RESUL$,EN$)
1760 RESUL$=P7$(28:10)
1770 EXEC CALC(B,BE$,RESUL$,BE$)
1780 EXEC FIND
1790 IF NR<=MAX THEN 
1800 IF T$(NR,E:6)=P7$(5:6) THEN 
1810 EXEC OPTÆL(NR)
1820 ELSE 
1830 NRP=NRP+E
1840 T$(NR,E:6)=P7$(5:6)
1850 T$(NR,7:10)=P7$(11:10)
1860 T$(NR,17:10)=P7$(28:10)
1870 ENDIF 
1880 ELSE 
1890 IF NRP=MAX THEN 
1900 EXEC OPTÆL(1+MAX)
1910 ELSE 
1920 AO,AN=B
1930 NR=NR DIV G
1940 GNR=NR
1950 REPEAT 
1960 AO=AO+E
1970 EXEC BINNEXT
1980 IF NR=B THEN EXIT 
1990 UNTIL T$(NR,E:6)="      "
2000 IF NR>B THEN 
2010 NR1=NR
2020 WHILE T$(NR1,E:6)="      "
2030 NR=NR1
2040 NR1=NR1 DIV G
2050 ENDWHILE 
2060 ENDIF 
2070 ONR=NR
2080 NR=GNR
2090 REPEAT 
2100 AN=AN+E
2110 EXEC BINPREV
2120 IF NR=B THEN EXIT 
2130 UNTIL T$(NR,E:6)="      " OR (AN=>AO AND ONR>B)
2140 IF NR>B THEN 
2150 NR1=NR
2160 WHILE T$(NR1,E:6)="      "
2170 NR=NR1
2180 NR1=NR1 DIV G
2190 ENDWHILE 
2200 ENDIF 
2210 NNR=NR
2220 IF NNR=B THEN AN=AO
2230 IF AO<=AN AND ONR>B THEN 
2240 IF P7$(5:6)>T$(GNR,E:6) THEN 
2250 T$(ONR)=T$(GNR)
2260 T$(GNR,E:6)=P7$(5:6);T$(GNR,7:10)=P7$(11:10);T$(GNR,17:10)=P7$(28:10)
2270 P7$(5:6)=T$(ONR,E:6);P7$(11:10)=T$(ONR,7:10);P7$(28:10)=T$(ONR,17:10)
2280 ENDIF 
2290 NR=ONR
2300 REPEAT 
2310 REPEAT 
2320 EXEC BINPREV
2330 UNTIL T$(NR,E:6)<>"      "
2340 T$(ONR)=T$(NR)
2350 ONR=NR
2360 UNTIL GNR=NR
2370 T$(NR,E:6)=P7$(5:6);T$(NR,7:10)=P7$(11:10);T$(NR,17:10)=P7$(28:10)
2380 ELSE 
2390 IF NNR=B THEN STOP 
2400 IF P7$(5:6)<T$(GNR,E:6) THEN 
2410 T$(NNR)=T$(GNR)
2420 T$(GNR,E:6)=P7$(5:6);T$(GNR,7:10)=P7$(11:10);T$(GNR,17:10)=P7$(28:10)
2430 P7$(5:6)=T$(NNR,E:6);P7$(11:10)=T$(NNR,7:10);P7$(28:10)=T$(NNR,17:10)
2440 ENDIF 
2450 NR=NNR
2460 REPEAT 
2470 REPEAT 
2480 EXEC BINNEXT
2490 UNTIL T$(NR,E:6)<>"      "
2500 T$(NNR)=T$(NR)
2510 NNR=NR
2520 UNTIL GNR=NR
2530 T$(NR,E:6)=P7$(5:6);T$(NR,7:10)=P7$(11:10);T$(NR,17:10)=P7$(28:10)
2540 ENDIF 
2550 NRP=NRP+E
2560 NR=B
2570 ENDIF 
2580 ENDIF 
2590 ENDIF 
2600 IF P7$(E)="2" THEN 
2610 P7$(E)="3"
2620 PUT FIL$,IT:P7$
2630 ENDIF 
2640 IT=IT+E
2650 GET FIL$,IT:P7$
2660 ENDWHILE 
2670 ENDIF 
2680 EXEC NÆSTE
2690 ENDWHILE 
2700 OUTPUT P
2710 SID,LINIE=B
2720 EXEC HEAD
2730 NR=E;LINIE=LINIE+G
2740 PRINT "Totalt indlæst    ";EN$(E,11),BE$(V,11)
2750 EN$="0+"
2760 BE$=EN$;GRUPEN$=EN$;GRUPBEL$=EN$;GRUPPE$="      "
2770 PRINT 
2780 EXEC TRAVERSE
2782 EXEC CALC(G,PCT$,GRUPBEL$,RESUL$)
2784 IF RESUL$(12)="+" THEN RESUL$(12)=" "
2790 EXEC PV(GRUPEN$(12),GRUPBEL$(12))
2800 PRINT "Total ";GRUPPE$,GRUPEN$(V:10),GRUPBEL$(V:10),RESUL$(V:10)
2810 PRINT 
2820 LINIE=LINIE+V
2822 EXEC CALC(G,PCT$,BE$,RESUL$)
2824 IF RESUL$(12)="+" THEN RESUL$(12)=" "
2830 EXEC PV(EN$(12),BE$(12))
2840 PRINT "Total",EN$(V:10),BE$(V:10),RESUL$(V:10)
2850 MAX=MAX+E
2860 IF T$(MAX,14)<>" " THEN 
2870 EXEC PV(T$(MAX,16),T$(MAX,26))
2880 PRINT "Ikke fordelt",T$(MAX,7:10),T$(MAX,17:10)
2890 ENDIF 
2900 WHILE LINIE<72 AND LINIE>B
2910 PRINT 
2920 LINIE=LINIE+E
2930 ENDWHILE 
2940 OUTPUT T
2950 CHAIN "P641210:STARTB"