DataMuseum.dk

top - download

    Length: 7549 (0x1d7d)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »AKKMLIST.B«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »AKKMLIST.B« 
└─⟦ff7f7aeee⟧ Bits:30009007 NBT	15/3-84
    └─⟦this⟧ »AKKMLIST.B« 

SPC/1 COMAL-BIN

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