DataMuseum.dk

top - download

    Length: 10301 (0x283d)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »AKKRVEDL.B«

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

SPC/1 COMAL-BIN

0010 DIM POST4$(34),FIL7$(20),AKKTIM(10),AKKS$(10,16),B3$(12),DAD$(6)
0100 DIM AKK$(49),NR$(606),Å(100),M(30),FIL8$(20),FIL9$(20),AKKNR$(6)
0105 DIM RES$(15),OP1$(12),OP2$(12),RESUL$(12),TAH$(12),RESUL1$(12)
0110 PROC CALC(AR3,B1,B2,ES)
0115 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0120 CALL "P641210:REGN"
0125 IF AR3<6 THEN
0130 IF FLAG THEN STOP
0135 ENDIF
0140 ES$=RES$
0145 ENDPROC
0150 PROC CONV(NR2,OK22,CIF)
0155 OK2=ABS(OK22)
0160 NR2$=""
0165 REPEAT
0170 NR2$=CHR((OK2 MOD 10)+48)+NR2$
0175 CIF=CIF-E
0180 OK2=OK2 DIV 10
0185 IF CIF<B AND OK2=B THEN CIF=B
0190 UNTIL CIF=B
0193 IF OK22<B THEN NR2$="-"+NR2$
0195 ENDPROC
0200 PROC INDAKK
0205 L=E;U=MAX
0210 IF U>B THEN
0215 REPEAT
0220 PEG=(L+U) DIV G
0225 IF AKKNR$>NR$((PEG-E)*6+E:6) THEN
0230 L=PEG+E
0235 ELSE
0240 U=PEG-E
0245 ENDIF
0250 UNTIL L>U OR AKKNR$=NR$((PEG-E)*6+E:6)
0255 ENDIF
0260 L=U+E
0265 IF NR$((L-E)*6+E:6)=AKKNR$ THEN
0270 FOUND=E
0275 PEG=Å(L)
0280 GET FIL8$,PEG:AKK$(E,27),TTIMER,RTIMER
0285 GET FIL8$,PEG+E:AKK$(28,49),M(E),M(G),M(V)
0290 GET FIL8$,PEG+G:M(4),M(5),M(6),M(7),M(8),M(W),M(10),M(11),M(12)
0295 GET FIL8$,PEG+V:M(13),M(14),M(15),M(16),M(17),M(18),M(19),M(20),M(21)
0300 GET FIL8$,PEG+4:M(22),M(23),M(24),M(25),M(26),M(27),M(28),M(29),M(30)
0305 EXEC FEJL(B,PEG,FIL8$)
0310 IF AKK$(E,6)<>AKKNR$ THEN FOUND=-E
0315 ELSE
0320 FOUND=B
0325 ENDIF
0330 ENDPROC
0335 PROC UDAKK
0340 PUT FIL8$,PEG:AKK$(E,27),TTIMER,RTIMER
0345 PUT FIL8$,PEG+E:AKK$(28,49),M(E),M(G),M(V)
0350 PUT FIL8$,PEG+G:M(4),M(5),M(6),M(7),M(8),M(W),M(10),M(11),M(12)
0355 PUT FIL8$,PEG+V:M(13),M(14),M(15),M(16),M(17),M(18),M(19),M(20),M(21)
0360 PUT FIL8$,PEG+4:M(22),M(23),M(24),M(25),M(26),M(27),M(28),M(29),M(30)
0365 EXEC FEJL(E,PEG,FIL8$)
0370 ENDPROC
0375 PROC INDTABEL
0380 FIL9$="P641220:AKKTABEL"
0385 OPEN FIL9$,R
0390 EXEC FEJL(B,B,FIL9$)
0395 FOR I=E TO 10
0400 GET FIL9$:NR$((I-E)*60+E:60)
0405 NEXT I
0410 GET FIL9$:Å(E),Å(G),Å(V),Å(4),Å(5),Å(6),Å(7),Å(8),Å(W),Å(10)
0415 GET FIL9$:Å(11),Å(12),Å(13),Å(14),Å(15),Å(16),Å(17),Å(18),Å(19),Å(20)
0420 GET FIL9$:Å(21),Å(22),Å(23),Å(24),Å(25),Å(26),Å(27),Å(28),Å(29),Å(30)
0425 GET FIL9$:Å(31),Å(32),Å(33),Å(34),Å(35),Å(36),Å(37),Å(38),Å(39),Å(40)
0430 GET FIL9$:Å(41),Å(42),Å(43),Å(44),Å(45),Å(46),Å(47),Å(48),Å(49),Å(50)
0435 GET FIL9$:Å(51),Å(52),Å(53),Å(54),Å(55),Å(56),Å(57),Å(58),Å(59),Å(60)
0440 GET FIL9$:Å(61),Å(62),Å(63),Å(64),Å(65),Å(66),Å(67),Å(68),Å(69),Å(70)
0445 GET FIL9$:Å(71),Å(72),Å(73),Å(74),Å(75),Å(76),Å(77),Å(78),Å(79),Å(80)
0450 GET FIL9$:Å(81),Å(82),Å(83),Å(84),Å(85),Å(86),Å(87),Å(88),Å(89),Å(90)
0455 GET FIL9$:Å(91),Å(92),Å(93),Å(94),Å(95),Å(96),Å(97),Å(98),Å(99),Å(100)
0460 EXEC FEJL(E,B,FIL9$)
0465 FOR I=B TO 99
0470 IF NR$(I*6+E:6)="      " THEN
0475 MAX=I;I=100
0480 ENDIF
0485 NEXT I
0490 CLOSE FIL9$
0495 ENDPROC
0500 PROC INDREGNS(N)
0510 J=10*(N-E)
0520 FOR I=E TO 10
0530 GET FIL7$,J+I:AKKTIM(I),AKKS$(I)
0540 NEXT I
0550 EXEC FEJL(N,J,FIL7$)
0560 ENDPROC
0600 PROC UDREGNS(N)
0610 J=10*(N-E)
0620 FOR I=E TO 10
0630 PUT FIL7$,J+I:AKKTIM(I),AKKS$(I)
0640 NEXT I
0650 EXEC FEJL(-N,J,FIL7$)
0660 ENDPROC
0850 PROC INLØNMOD(N)
0865 GET FIL$,G*N-E:POST1$
0880 GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
0895 EXEC FEJL(E,N,FIL$)
0910 ENDPROC
0915 B3$="          0+"
0916 TI=10;EL=11
0920 PROC Æ(I1,I2)
0930 I1$=B3$
0940 IF I2<>B THEN
0950 I1$(W,TI)=",0";I0=ABS(I2);K0=INT((I0-INT(I0))*100+0.50001)
0960 IF I2<B THEN I1$(12)="-"
0970 FOR I=EL TO E STEP -E
0980 IF I<>W THEN
0990 I1$(I)=CHR(K0 MOD TI+48)
1000 K0=K0 DIV TI
1010 IF K0=B AND I<TI THEN I=B
1020 ELSE
1030 K0=INT(I0)
1040 ENDIF
1050 NEXT I
1060 ENDIF
1070 ENDPROC
1150 PROC CHECK(NR1,OK1)
1165 OK1=B
1180 RESULT=B
1195 IF LEN(NR1$)>B THEN
1210 IF NR1$(E)="-" THEN
1225 FORTEGN=-E
1240 OK1=E
1255 ELSE
1270 FORTEGN=E
1285 ENDIF
1300 WHILE LEN(NR1$)>OK1
1315 OK1=OK1+E
1330 IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN
1345 FORTEGN=B
1360 OK1=LEN(NR1$)
1375 ENDIF
1390 RESULT=RESULT*10+ORD(NR1$(OK1))-48
1405 ENDWHILE
1420 OK1=OK1*FORTEGN
1435 IF OK1<B THEN OK1=OK1+E
1450 ENDIF
1465 ENDPROC
1480 PROC INOPL(OPL)
1510 CASE OPL OF
1525 WHEN E
1530 EXEC INLINE(OPL)
1540 LMNR=RESULT
1555 WHEN G
1570 POST1$(E,25)=LINE$
1585 WHEN V,4,5,6,7,8,W,10,11,12
1600 REPEAT
1610 LINE$=AKKS$(OPL-G,11,16)
1620 CURSOR E,OPL+V
1630 PRINT USING "### ":OPL
1640 CURSOR 11,OPL+V
1650 EDIT "",LINE$
1660 OK=B
1670 IF LEN(LINE$)>B AND LEN(LINE$)<=6 THEN
1680 OK=E
1690 FOR I=LEN(LINE$)+E TO 6
1700 LINE$=LINE$+" "
1705 IF LINE$="0     " THEN LINE$="      "
1710 NEXT I
1720 AKKNR$=LINE$
1730 IF AKKNR$<>"      " THEN
1740 EXEC INDAKK
1750 OK=FOUND
1760 ENDIF
1770 ENDIF
1780 UNTIL OK<>B
1790 IF OK<>E THEN STOP
1800 IF AKKS$(OPL-G,11,16)<>"      " THEN
1810 IF AKKNR$<>AKKS$(OPL-G,11,16) THEN
1820 AKKNR$=AKKS$(OPL-G,11,16)
1830 EXEC INDAKK
1840 IF FOUND<>E THEN STOP
1850 FOR I=E TO 30
1860 IF ABS(M(I))=LMNR THEN FOUND=B
1870 IF FOUND=B AND I<30 THEN M(I)=M(I+E)
1880 NEXT I
1890 IF FOUND=B THEN
1900 M(30)=B
1910 TTIMER=TTIMER-ABS(AKKTIM(OPL-G))
1920 RESUL$=AKK$(28,38)
1930 RESUL1$=AKKS$(OPL-G,E,10)
1940 EXEC CALC(E,RESUL$,RESUL1$,RESUL$)
1950 AKK$(28,38)=RESUL$(G:11)
1960 ELSE
1970 STOP
1980 ENDIF
1990 EXEC UDAKK
2000 AKKNR$=LINE$
2010 IF AKKNR$<>"      " THEN EXEC INDAKK
2020 ELSE
2030 TTIMER=TTIMER-ABS(AKKTIM(OPL-G))
2040 RESUL$=AKK$(28,38)
2050 RESUL1$=AKKS$(OPL-G,E,10)
2060 EXEC CALC(E,RESUL$,RESUL1$,RESUL$)
2070 AKK$(28,38)=RESUL$(G:11)
2080 ENDIF
2090 ENDIF
2100 IF AKKNR$<>"      " THEN
2110 IF AKKNR$<>AKKS$(OPL-G,11,16) THEN
2120 FOR I=E TO 30
2130 IF ABS(M(I))=LMNR THEN
2140 I=100
2150 ELSE
2160 IF M(I)=B THEN M(I)=LMNR;I=I+30
2170 ENDIF
2180 NEXT I
2185 CURSOR E,22
2190 IF I>100 THEN INPUT "Findes allerede på akkord, RETURN ",LINE$
2200 IF I<32 THEN INPUT "Ikke plads til flere på akkord, RETURN ",LINE$
2210 ELSE
2220 FOR I=E TO 30
2230 IF ABS(M(I))=LMNR THEN M(I)=LMNR;I=I+30
2240 NEXT I
2250 IF I<32 THEN STOP
2260 ENDIF
2270 I=I-31
2280 IF I>B AND I<31 THEN
2290 REPEAT
2300 LINE$=AKKS$(OPL-G,E,10)
2305 IF LINE$(10)="+" THEN LINE$(10)=" "
2310 CURSOR 22,OPL+V
2320 EDIT "",LINE$
2330 LINE$=LINE$+"+"
2340 EXEC CALC(6,LINE$,TAH$,RESUL$)
2350 UNTIL FLAG=B
2360 AKKS$(OPL-G,E,10)=RESUL$(V:10)
2370 RESUL1$=AKK$(28,38)
2380 EXEC CALC(B,RESUL$,RESUL1$,RESUL1$)
2390 AKK$(28,38)=RESUL1$(G:11)
2400 TIM=AKKTIM(OPL-G)
2410 CURSOR 37,OPL+V
2420 EDIT "",TIM
2430 AKKTIM(OPL-G)=TIM
2440 TTIMER=TTIMER+ABS(TIM)
2450 IF TIM<B THEN M(I)=-M(I)
2460 AKKS$(OPL-G,11,16)=AKKNR$
2470 EXEC UDAKK
2480 ELSE
2490 AKKNR$="      "
2500 ENDIF
2510 ENDIF
2520 IF AKKNR$="      " THEN
2530 AKKTIM(OPL-G)=B
2540 AKKS$(OPL-G)="                "
2550 ENDIF
2950 ENDCASE
2965 ENDPROC
2980 PROC SKRIVOPL
2995 IF OUTP=B THEN CLEAR
3000 PRINT "A K K O R D R E G N S K A B E R";TAB(60);"Dato ";DAD$
3010 FOR J=E TO A
3025 CASE J OF
3040 WHEN E
3055 EXEC CONV(LINE$,LMNR,0)
3070 WHEN G
3085 LINE$=POST1$(E,25)
3100 WHEN V,4,5,6,7,8,W,10,11,12
3115 EXEC Æ(RESUL$,AKKTIM(J-2))
3120 IF RESUL$(12)="+" THEN RESUL$(12)=" "
3125 LINE$="     "+AKKS$(J-G,11,16)+"     "+AKKS$(J-G,E,10)+"  "+RESUL$
3135 IF LINE$(26)="+" THEN LINE$(26)=" "
3730 ENDCASE
3732 IF J=V THEN
3734 PRINT
3736 PRINT
3738 PRINT "          AKKORD      UDBETALT         TIMER"
3740 ENDIF
3745 IF OUTP=B THEN
3760 EXEC OUTLINE(J)
3775 ELSE
3790 EXEC OUTPLINE(J)
3805 ENDIF
3820 NEXT J
3835 ENDPROC
3850 PROC OUTLINE(N)
3865 CURSOR X(N),Y(N)
3880 PRINT USING "### ":N;
3895 PRINT PICT$(N);":";LINE$
3910 ENDPROC
3925 PROC INDVIRK
3940 OPEN FIL$,W
3955 EXEC FEJL(B,B,FIL$)
3985 GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM
3990 GET FIL$,V:DAD$
4000 ENDPROC
4015 PROC FEJL(P1,P2,P3)
4030 IF STATUS(P3$)<>B THEN
4045 OUTPUT T
4060 PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2
4075 STOP
4090 ENDIF
4105 ENDPROC
4120 PROC INLINE(N)
4135 REPEAT
4150 CURSOR X(N)+5+LEN(PICT$(N)),Y(N)
4165 PRINT BL$(E:ABS(TYPE(N))+V)
4180 CURSOR X(N),Y(N)
4195 PRINT USING "### ":N;
4210 PRINT PICT$(N);":";
4225 INPUT "",LINE$
4240 IF TYPE(N)<B THEN
4255 IF LEN(LINE$)<=ABS(TYPE(N)) THEN
4270 OK=E
4285 FOR I=LEN(LINE$)+E TO ABS(TYPE(N))
4300 LINE$(I)=" "
4315 NEXT I
4330 ELSE
4345 OK=B
4360 ENDIF
4375 ELSE
4390 EXEC CHECK(LINE$,OK)
4405 IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B
4420 ENDIF
4435 UNTIL OK<>B
4450 ENDPROC
4585 PROC OUTPLINE(N)
4600 PRINT TAB(X(N));
4615 PRINT USING "### ":N;
4630 PRINT PICT$(N);":";LINE$;
4632 IF N=12 THEN
4634 PRINT
4636 ELSE
4638 IF Y(N)<Y(N+E) THEN PRINT
4640 ENDIF
4645 ENDPROC
4660 A=12
4675 DIM X(A),Y(A),PICT$(A,20),TYPE(A)
4690 DIM POST1$(71),POST2$(27)
4705 DIM BL$(79),LINE$(50),FIL$(20)
4720 FOR I=E TO 79
4735 BL$=BL$+" "
4750 NEXT I
4765 FIL$="P641220:VIRKKART"
4780 X(E)=E
4795 X(G)=30
4810 X(V)=E
4825 X(4)=E
4840 X(5)=E
4855 X(6)=E
4870 X(7)=E
4885 X(8)=E
4900 X(W)=E
4915 X(10)=E
4930 X(11)=E
4945 X(12)=E
5095 Y(E)=G
5110 Y(G)=G
5125 Y(V)=6
5140 Y(4)=7
5155 Y(5)=8
5170 Y(6)=W
5185 Y(7)=10
5200 Y(8)=11
5215 Y(W)=12
5230 Y(10)=13
5245 Y(11)=14
5260 Y(12)=15
5410 TYPE(E)=B
5425 TYPE(G)=-25
5440 FOR I=V TO 12
5450 TYPE(I)=-6
5455 PICT$(I)=""
5460 NEXT I
5725 PICT$(E)="Lønnr"
5740 PICT$(G)="Navn"
6040 EXEC INDVIRK
6055 CLOSE FIL$
6070 FIL$="P641220:LØNMODRG"
6085 OPEN FIL$,R
6100 EXEC FEJL(B,B,FIL$)
6102 FIL8$="P641220:AKKHOVED"
6104 OPEN FIL8$,W
6106 EXEC FEJL(B,B,FIL8$)
6108 EXEC INDTABEL
6110 FIL7$="P641220:AKKREGNS"
6112 OPEN FIL7$,W
6114 EXEC FEJL(B,B,FIL7$)
6130 OUTP=B
6145 TAH$="          0+"
6250 REPEAT
6265 SV=G
6280 CLEAR
6295 CURSOR 10,10
6310 PRINT "A K K O R D R E G N S K A B S - K A R T O T E K"
6325 PRINT
6340 PRINT TAB(10);"0 Færdig"
6355 PRINT TAB(10);"1 Ændring"
6370 PRINT TAB(10);"2 Udskrift på skærm"
6385 PRINT TAB(10);"3 Udskrift på printer"
6430 PRINT
6445 REPEAT
6460 CURSOR E,19
6475 EDIT "          ",SV
6490 UNTIL SV=>B AND SV<=V
6505 IF SV>B THEN
6520 REPEAT
6535 EXEC INOPL(1)
6550 UNTIL LMNR=>B AND LMNR<=MLMNR
6551 LISTE=B
6552 IF LMNR=B THEN LISTE=E
6553 REPEAT
6554 IF LISTE=E THEN LMNR=LMNR+E
6565 EXEC INLØNMOD(LMNR)
6570 IF LA<>B THEN EXEC INDREGNS(LMNR)
6580 CASE SV OF
6595 WHEN E
6610 IF LA<>B THEN
6625 EXEC SKRIVOPL
6640 REPEAT
6655 REPEAT
6670 SV1=B
6685 CURSOR E,23
6700 EDIT "Feltnr ",SV1
6715 UNTIL SV1>G AND SV1<13 OR SV1=B
6730 IF SV1>B THEN
6745 EXEC INOPL(SV1)
6750 EXEC SKRIVOPL
6760 ENDIF
6775 UNTIL SV1=B
6790 EXEC UDREGNS(LMNR)
6805 ELSE
6820 PRINT "Lønmodtager findes ikke"
6835 INPUT "RETURN",LINE$
6850 ENDIF
6865 WHEN G
6880 IF LA<>B THEN
6895 OUTP=B
6910 EXEC SKRIVOPL
6925 INPUT "RETURN",LINE$
6940 ELSE
6955 PRINT "Lønmodtager findes ikke"
6970 INPUT "RETURN",LINE$
6985 ENDIF
7000 WHEN V
7015 IF LA<>B OR LISTE=E THEN
7016 IF LA<>B THEN
7030 OUTPUT P
7045 OUTP=E
7050 PRINT
7051 PRINT
7060 EXEC SKRIVOPL
7062 FOR I=17 TO 72
7064 PRINT
7066 NEXT I
7075 OUTP=B
7090 OUTPUT T
7095 ENDIF
7105 ELSE
7120 PRINT "Lønmodtager findes ikke"
7135 INPUT "RETURN",LINE$
7150 ENDIF
8005 ENDCASE
8006 UNTIL LISTE=B OR LMNR=>MLMNR
8010 ENDIF
8020 UNTIL SV=B
8035 CLOSE
8065 CHAIN "P641210:STARTB"