DataMuseum.dk

top - download

    Length: 9902 (0x26ae)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »TWO.B«

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

SPC/1 COMAL-BIN

0010 DIM FIL7$(20),AKKTIM(10),AKKS$(10,16),AKK$(49),NR$(606),Å(100),M(30)
0020 DIM FIL8$(20),FIL9$(20),RESUL$(12),RESUL1$(12),B3$(12),SAT$(12),BEL$(12)
0100 DIM A1(V),A2(V),A3(V),A4(V),A5(V),A7$(8),A8$(8),A9$(E),B0$(E)
0120 DIM RES$(15),OP1$(12),OP2$(12),GSATS$(12),TIM$(12),AKKNR$(6)
0140 DIM C9$(16),D1$(71)
0150 DIM D2$(27),D3$(55),D4$(34),D5$(29),D6$(37),D7$(16),D8$(16)
0160 DIM E1$(16)
0162 DIM F1$(12),DD$(6)
0163 TI=10;EL=11;AZ=28
0170 B3$="          0+"
0370 PROC CALC(F2,F3,F4,F5)
0380 RES$=F5$;OP1$=F3$;OP2$=F4$;SI=B;FLAG=B;ART=F2-6*(F2>5)
0390 CALL "P641210:REGN"
0400 IF F2<6 AND FLAG THEN STOP
0430 F5$=RES$
0440 ENDPROC
0450 PROC INDAKK
0452 L=E;U=MAX
0454 IF U>B THEN
0456 REPEAT
0458 PEG=(L+U) DIV G
0460 IF AKKNR$>NR$((PEG-E)*6+E:6) THEN
0462 L=PEG+E
0464 ELSE
0466 U=PEG-E
0468 ENDIF
0470 UNTIL L>U OR AKKNR$=NR$((PEG-E)*6+E:6)
0472 ENDIF
0474 L=U+E
0476 IF NR$((L-E)*6+E:6)=AKKNR$ THEN
0478 FOUND=E
0480 PEG=Å(L)
0482 GET FIL8$,PEG:AKK$(E,27),TTIMER,RTIMER
0484 GET FIL8$,PEG+E:AKK$(28,49),M(E),M(G),M(V)
0486 GET FIL8$,PEG+G:M(4),M(5),M(6),M(7),M(8),M(W),M(10),M(11),M(12)
0488 GET FIL8$,PEG+V:M(13),M(14),M(15),M(16),M(17),M(18),M(19),M(20),M(21)
0490 GET FIL8$,PEG+4:M(22),M(23),M(24),M(25),M(26),M(27),M(28),M(29),M(30)
0492 EXEC FEJL(B,PEG,FIL8$)
0494 IF AKK$(E,6)<>AKKNR$ THEN FOUND=-E
0496 ELSE
0498 FOUND=B
0500 ENDIF
0502 ENDPROC
0504 PROC UDAKK
0506 PUT FIL8$,PEG:AKK$(E,27),TTIMER,RTIMER
0508 PUT FIL8$,PEG+E:AKK$(28,49),M(E),M(G),M(V)
0510 PUT FIL8$,PEG+G:M(4),M(5),M(6),M(7),M(8),M(W),M(10),M(11),M(12)
0512 PUT FIL8$,PEG+V:M(13),M(14),M(15),M(16),M(17),M(18),M(19),M(20),M(21)
0514 PUT FIL8$,PEG+4:M(22),M(23),M(24),M(25),M(26),M(27),M(28),M(29),M(30)
0516 EXEC FEJL(E,PEG,FIL8$)
0518 ENDPROC
0520 PROC INDSÆT
0522 FOUND=B
0524 U=MAX+E
0526 IF U<101 THEN
0528 FOUND=E;MAX=U
0530 GN=Å(U)
0532 PEG=U
0534 WHILE PEG>L DO
0536 Å(PEG)=Å(PEG-E)
0538 NR$((PEG-E)*6+E:6)=NR$((PEG-G)*6+E:6)
0540 PEG=PEG-E
0542 ENDWHILE
0544 Å(L)=GN
0546 NR$((L-E)*6+E:6)=AKKNR$
0548 PEG=GN
0550 EXEC UDAKK
0552 ENDIF
0554 ENDPROC
0556 PROC INDTABEL
0558 FIL9$="P641220:AKKTABEL"
0560 OPEN FIL9$,R
0562 EXEC FEJL(B,B,FIL9$)
0564 FOR I=E TO 10
0566 GET FIL9$:NR$((I-E)*60+E:60)
0568 NEXT I
0570 GET FIL9$:Å(E),Å(G),Å(V),Å(4),Å(5),Å(6),Å(7),Å(8),Å(W),Å(10)
0572 GET FIL9$:Å(11),Å(12),Å(13),Å(14),Å(15),Å(16),Å(17),Å(18),Å(19),Å(20)
0574 GET FIL9$:Å(21),Å(22),Å(23),Å(24),Å(25),Å(26),Å(27),Å(28),Å(29),Å(30)
0576 GET FIL9$:Å(31),Å(32),Å(33),Å(34),Å(35),Å(36),Å(37),Å(38),Å(39),Å(40)
0578 GET FIL9$:Å(41),Å(42),Å(43),Å(44),Å(45),Å(46),Å(47),Å(48),Å(49),Å(50)
0580 GET FIL9$:Å(51),Å(52),Å(53),Å(54),Å(55),Å(56),Å(57),Å(58),Å(59),Å(60)
0582 GET FIL9$:Å(61),Å(62),Å(63),Å(64),Å(65),Å(66),Å(67),Å(68),Å(69),Å(70)
0584 GET FIL9$:Å(71),Å(72),Å(73),Å(74),Å(75),Å(76),Å(77),Å(78),Å(79),Å(80)
0586 GET FIL9$:Å(81),Å(82),Å(83),Å(84),Å(85),Å(86),Å(87),Å(88),Å(89),Å(90)
0588 GET FIL9$:Å(91),Å(92),Å(93),Å(94),Å(95),Å(96),Å(97),Å(98),Å(99),Å(100)
0590 EXEC FEJL(E,B,FIL9$)
0592 FOR I=B TO 99
0594 IF NR$(I*6+E:6)="      " THEN
0596 MAX=I;I=100
0598 ENDIF
0600 NEXT I
0602 CLOSE FIL9$
0604 ENDPROC
0606 PROC UDTABEL
0608 OPEN FIL9$,W
0610 EXEC FEJL(G,B,FIL9$)
0612 FOR I=E TO 10
0614 PUT FIL9$:NR$((I-E)*60+E:60)
0616 NEXT I
0618 PUT FIL9$:Å(E),Å(G),Å(V),Å(4),Å(5),Å(6),Å(7),Å(8),Å(W),Å(10)
0620 PUT FIL9$:Å(11),Å(12),Å(13),Å(14),Å(15),Å(16),Å(17),Å(18),Å(19),Å(20)
0622 PUT FIL9$:Å(21),Å(22),Å(23),Å(24),Å(25),Å(26),Å(27),Å(28),Å(29),Å(30)
0624 PUT FIL9$:Å(31),Å(32),Å(33),Å(34),Å(35),Å(36),Å(37),Å(38),Å(39),Å(40)
0626 PUT FIL9$:Å(41),Å(42),Å(43),Å(44),Å(45),Å(46),Å(47),Å(48),Å(49),Å(50)
0628 PUT FIL9$:Å(51),Å(52),Å(53),Å(54),Å(55),Å(56),Å(57),Å(58),Å(59),Å(60)
0630 PUT FIL9$:Å(61),Å(62),Å(63),Å(64),Å(65),Å(66),Å(67),Å(68),Å(69),Å(70)
0632 PUT FIL9$:Å(71),Å(72),Å(73),Å(74),Å(75),Å(76),Å(77),Å(78),Å(79),Å(80)
0634 PUT FIL9$:Å(81),Å(82),Å(83),Å(84),Å(85),Å(86),Å(87),Å(88),Å(89),Å(90)
0636 PUT FIL9$:Å(91),Å(92),Å(93),Å(94),Å(95),Å(96),Å(97),Å(98),Å(99),Å(100)
0638 ENDPROC
0650 PROC INDREGNS(N)
0652 J=10*(N-E)
0654 FOR I=E TO 10
0656 GET FIL7$,J+I:AKKTIM(I),AKKS$(I)
0658 NEXT I
0660 EXEC FEJL(N,J,FIL7$)
0662 ENDPROC
0664 PROC UDREGNS(N)
0666 J=10*(N-E)
0668 FOR I=E TO 10
0670 PUT FIL7$,J+I:AKKTIM(I),AKKS$(I)
0672 NEXT I
0674 EXEC FEJL(-N,J,FIL7$)
0676 ENDPROC
0800 PROC INLØNMOD(G5)
0810 GET C9$,G*G5-E:D1$
0820 GET C9$,G*G5:D2$,G6,G7,G8,G9,H0,H1,H2,H3,H4,H5,H6
0830 EXEC FEJL(E,G5,C9$)
0840 ENDPROC
1890 PROC INDVIRK
1900 OPEN C9$,R
1910 EXEC FEJL(B,B,C9$)
1920 GET C9$,E:D3$
1930 GET C9$,G:D4$,I8,I9,J0
1940 ENDPROC
1950 PROC FEJL(J1,J2,J3)
1960 IF STATUS(J3$)<>B THEN
1970 OUTPUT T
1980 PRINT "FIL-FEJL ";J3$;STATUS(J3$),J1;J2
1990 STOP
2000 ENDIF
2010 ENDPROC
2710 PROC Æ(I1,I2)
2720 I1$=B3$
2730 IF I2<>B THEN
2740 I1$(W,TI)=",0";I0=ABS(I2);K0=INT((I0-INT(I0))*100+0.50001)
2770 IF I2<B THEN I1$(12)="-"
2780 FOR I=EL TO E STEP -E
2790 IF I<>W THEN
2800 I1$(I)=CHR(K0 MOD TI+48)
2810 K0=K0 DIV TI
2820 IF K0=B AND I<TI THEN I=B
2830 ELSE
2840 K0=INT(I0)
2850 ENDIF
2860 NEXT I
2870 ENDIF
2880 ENDPROC
2890 PROC PERVERT(I1,I2)
2900 I2=B
2910 FOR I=E TO LEN(I1$)-E
2920 IF I1$(I)<>" " AND I1$(I)<>"," THEN I2=TI*I2+ORD(I1$(I))-48
2930 NEXT I
2940 IF I1$(I)="-" THEN I2=-I2
2950 I2=I2/100
2960 ENDPROC
3440 PROC NÆSTE
3450 REPEAT
3460 F8=F8+E
3470 H1=E
3480 IF F8<=I9 THEN
3490 EXEC INLØNMOD(F8)
3500 IF A9$<>D2$(21) THEN H1=B
3510 IF B0$="A" AND D2$(24,25)>"89" THEN H1=B
3520 IF B0$="F" AND D2$(24,25)<"90" THEN H1=B
3530 ENDIF
3540 UNTIL H1>B
3550 ENDPROC
5010 PROC BEREGNAKKORD
5020 L0=(F8-E)*J0+E
5030 GET D7$,L0:D6$
5035 EXEC FEJL(B,L0,D7$)
5040 IF D6$(E)="1" THEN
5090 REPEAT
5100 IF D6$(10)>"0" AND D6$(10)<="9" THEN
5110 AKKNR$=D6$(5,10)
5120 AKKPEG,LEDPEG=B
5130 FOR I=E TO 10
5140 IF LEDPEG=B AND AKKS$(I,11,16)="      " THEN LEDPEG=I
5150 IF AKKS$(I,11,16)=AKKNR$ THEN AKKPEG=I;I=10
5160 NEXT I
5170 EXEC INDAKK
5180 IF AKKPEG=B AND LEDPEG>B THEN
5190 AKKPEG=LEDPEG
5200 AKKS$(AKKPEG,11,16)=AKKNR$
5210 AKKTIM(AKKPEG)=B
5220 IF FOUND=E THEN
5230 FOR I=E TO 30
5240 IF M(I)=B THEN LMPEG=I;M(I)=F8;I=50
5250 NEXT I
5260 IF I<50 THEN LEDPEG=B
5270 ELSE
5275 AKK$(E,6)=AKKNR$
5280 AKK$(7,27)="                     "
5285 AKK$(28,49)="         0+         0+"
5290 TTIMER,RTIMER=B
5300 FOR I=E TO 30
5310 M(I)=B
5320 NEXT I
5330 M(E)=F8
5340 LMPEG=E
5350 EXEC INDSÆT
5360 ENDIF
5370 ELSE
5390 IF AKKPEG>B THEN
5395 IF FOUND<>E THEN STOP
5400 LEDPEG=AKKPEG
5410 FOR I=E TO 30
5420 IF ABS(M(I))=F8 THEN LMPEG=I;I=50
5430 NEXT I
5440 IF I<50 THEN STOP
5441 ELSE
5442 LINIE=LINIE+E
5443 PRINT "OVERLØB";F8;"  ";AKKNR$
5444 D6$(5,10)="      "
5445 PUT D7$,L0:D6$
5446 EXEC FEJL(-E,-L0,D7$)
5447 L0=L0+E
5448 GET D7$,L0:D6$
5449 IF D6$(V,4)="39" THEN
5450 D6$(5,10)="      "
5451 D6$(11,20)=B3$(V,12)
5452 D6$(21,27)=B3$(6,12)
5453 D6$(28,37)=B3$(V,12)
5454 PUT D7$,L0:D6$
5455 ELSE
5456 L0=L0-E
5457 ENDIF
5458 EXEC FEJL(V,L0,D7$)
5459 ENDIF
5460 ENDIF
5470 IF LEDPEG>B THEN
5480 RESUL$=AKKS$(AKKPEG,E,10)
5490 AKKTIM(AKKPEG)=ABS(AKKTIM(AKKPEG))
5500 EXEC Æ(RESUL1$,AKKTIM(AKKPEG))
5510 IF AKKTIM(AKKPEG)=B THEN
5520 GSATS$=B3$
5530 ELSE
5540 EXEC CALC(V,RESUL$,RESUL1$,GSATS$)
5550 ENDIF
5560 TIM$=D6$(11,20)
5570 BEL$=D6$(28,37)
5580 SAT$=D6$(21,27)
5590 EXEC CALC(4,SAT$,B3$,SAT$)
5600 IF SI>B THEN
5610 EXEC CALC(4,BEL$,B3$,BEL$)
5620 IF SI>B THEN
5625 M(LMPEG)=ABS(M(LMPEG))
5626 ELSE
5627 M(LMPEG)=-ABS(M(LMPEG))
5628 ENDIF
5630 L0=L0+E
5640 GET D7$,L0:D6$
5645 EXEC FEJL(G,L0,D7$)
5650 IF D6$(E,4)<>"1 39" THEN STOP
5660 D6$(5,10)=AKKNR$
5670 EXEC CALC(4,SAT$,GSATS$,SAT$)
5680 IF SI=G THEN
5685 EXEC CALC(E,SAT$,GSATS$,SAT$)
5690 EXEC CALC(G,RESUL1$,SAT$,GSATS$)
5700 D6$(11,20)=RESUL1$(V,12)
5710 D6$(21,27)=SAT$(6,12)
5720 D6$(28,37)=GSATS$(V,12)
5730 EXEC CALC(B,BEL$,GSATS$,BEL$)
5740 ELSE
5750 D6$(11,20)=B3$(V,12)
5760 D6$(21,27)=B3$(6,12)
5770 D6$(28,37)=B3$(V,12)
5780 ENDIF
5790 PUT D7$,L0:D6$
5800 EXEC FEJL(E,-L0,D7$)
5960 ENDIF
5970 EXEC CALC(B,RESUL1$,TIM$,RESUL1$)
5980 EXEC PERVERT(RESUL1$,AKKTIM(AKKPEG))
5990 IF M(LMPEG)<B THEN AKKTIM(AKKPEG)=-ABS(AKKTIM(AKKPEG))
6000 EXEC Æ(RESUL1$,TTIMER)
6010 EXEC CALC(B,RESUL1$,TIM$,RESUL1$)
6020 EXEC PERVERT(RESUL1$,TTIMER)
6030 EXEC CALC(B,RESUL$,BEL$,RESUL$)
6040 AKKS$(AKKPEG,E,10)=RESUL$(V,12)
6050 RESUL$=AKK$(28,38)
6060 EXEC CALC(B,RESUL$,BEL$,RESUL$)
6070 AKK$(28,38)=RESUL$(G,12)
6080 EXEC UDAKK
6090 ENDIF
6100 ENDIF
8010 L0=L0+E
8020 GET D7$,L0:D6$
8030 EXEC FEJL(E,L0,D7$)
8040 UNTIL D6$(G)="*"
8170 ENDIF
8180 ENDPROC
8181 D8$="P641220:"
8182 E1$="P641210:"
8190 C9$=D8$+"VIRKKART"
8200 EXEC INDVIRK
8210 CLOSE C9$
8211 C9$=E1$+"PARMFIL"
8212 OPEN C9$,R
8213 GET C9$:A7$,A8$,DD$,E3,I6,I7,A9$
8214 GET C9$:B0$,A1(E),A1(G),A1(V),A2(E),A2(G),A2(V)
8215 GET C9$:A4(E),A4(G),A4(V),A5(E),A5(G),A5(V)
8216 GET C9$:A3(E),A3(G),A3(V),E4,E5
8217 CLOSE C9$
8220 C9$=D8$+"LØNMODRG"
8230 OPEN C9$,W
8240 D7$=D8$+"TRANSREG"
8250 OPEN D7$,W
8260 FIL8$="P641220:AKKHOVED"
8265 OPEN FIL8$,W
8270 EXEC FEJL(B,B,FIL8$)
8275 EXEC INDTABEL
8280 FIL7$="P641220:AKKREGNS"
8285 OPEN FIL7$,W
8290 EXEC FEJL(B,B,FIL7$)
8360 F8=B
8370 LINIE=B
8380 OUTPUT P
8390 REPEAT
8400 EXEC NÆSTE
8420 IF F8<=I9 THEN
8440 J=E
8450 REPEAT
8460 IF A1(J)=F8 OR A1(J)=-E THEN J=TI
8470 J=J+E
8480 UNTIL J>V
8490 IF J=EL THEN
8495 EXEC INDREGNS(F8)
8500 EXEC BEREGNAKKORD
8510 EXEC UDREGNS(F8)
8520 ENDIF
8850 ENDIF
8860 UNTIL F8=>I9
8861 WHILE LINIE MOD 72<>B DO
8862 PRINT
8863 LINIE=LINIE+E
8864 ENDWHILE
8865 OUTPUT T
8868 EXEC UDTABEL
8870 CLOSE
8880 CHAIN "P641210:THREE"