DataMuseum.dk

top - download

    Length: 18693 (0x4905)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »THREE.B«

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

SPC/1 COMAL-BIN

0100 DIM A1(V),A2(V),A3(V),A4(V),A5(V),A6(G),A7$(8),A8$(8),A9$(E),B0$(E)
0120 DIM RES$(15),OP1$(12),OP2$(12),B1$(12),B2$(12),B3$(12),B4$(12),B5$(12)
0130 DIM B6$(50),B7(10),B8$(10,37),B9$(8,11),C0$(12),C1$(12),C2$(12),C3$(12)
0140 DIM C4$(12),C5$(45,11),C6$(55),C7$(40),C8$(50),C9$(16),D0$(16),D1$(71)
0150 DIM D2$(27),D3$(55),D4$(34),D5$(29),D6$(37),D7$(16),D8$(16),D9$(16)
0160 DIM E0$(16),E1$(16),E2$(16,12),E9$(79),F0$(79)
0162 DIM F1$(12),DD$(6),B61$(50),DAD$(6)
0163 TI=10;EL=11;AZ=28
0170 B3$="          0+";B5$="6,00+";B4$="100,00+"
0171 FOR I=E TO 16
0172 E2$(I)=B3$
0173 NEXT I
0200 A6(E),A6(G),E3,E4,E5=B
0230 FOR I=E TO 79
0240 E9$=E9$+" "
0250 NEXT I
0370 PROC C(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
0441 PROC OPTÆL(F6,F7)
0442 F1$=F7$;C2$=C5$(F6)
0443 EXEC C(0,C2$,F1$,F1$)
0444 C5$(F6)=F1$(G:EL)
0445 IF J5=73 AND C5$(F6,EL)="-" THEN C5$(F6)=B3$(G:EL)
0448 ENDPROC
0450 PROC UDTÆL
0460 J=W*(F8-E)
0470 FOR F9=E TO W
0480 FOR I=E TO 5
0490 C6$((I-E)*EL+E:EL)=C5$((F9-E)*5+I)
0500 NEXT I
0510 PUT D0$,J+F9:C6$
0520 NEXT F9
0530 EXEC F(-F8,-F9,D0$)
0540 ENDPROC
0550 PROC INDTÆL
0560 J=W*(F8-E)
0570 FOR F9=E TO W
0580 GET D0$,J+F9:C6$
0590 FOR I=E TO 5
0600 C5$((F9-E)*5+I)=C6$((I-E)*EL+E:EL)
0610 NEXT I
0620 NEXT F9
0630 EXEC F(F8,F9,D0$)
0640 ENDPROC
0641 PROC OP(F6,F7)
0642 F1$=F7$;C2$=E2$(F6)
0643 EXEC C(0,C2$,F1$,F1$)
0644 E2$(F6)=F1$
0645 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 F(1,G5,C9$)
0840 ENDPROC
0850 PROC UDLØNMOD(G5)
0860 PUT C9$,G*G5-E:D1$
0870 PUT C9$,G*G5:D2$,G6,G7,G8,G9,H0,H1,H2,H3,H4,H5,H6
0880 EXEC F(2,G5,C9$)
0890 ENDPROC
0900 PROC CONV(H7,H8,H9)
0910 I0=H8;H7$=""
0930 REPEAT
0940 H7$=CHR((I0 MOD TI)+48)+H7$;H9=H9-E;I0=I0 DIV TI
0970 IF H9<B AND I0=B THEN H9=B
0980 UNTIL H9=B
0990 ENDPROC
1890 PROC INDVIRK
1900 OPEN C9$,R
1910 EXEC F(0,0,C9$)
1920 GET C9$,E:D3$
1930 GET C9$,G:D4$,I8,I9,J0
1935 GET C9$,V:DAD$
1940 ENDPROC
1950 PROC F(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
2430 PROC Å
2440 EXEC CONV(OP1$,J5,2)
2450 F0$(E)=D5$(29);F0$(G,V)=OP1$;F0$(5:20)=D5$(G,21)
2480 IF F0$(43)="+" THEN F0$(43)=" "
2490 IF F0$(54)="+" THEN F0$(54)=" "
2500 IF F0$(62)="+" THEN F0$(62)=" "
2510 PRINT F0$;
2520 J6=J6+E;F0$=E9$
2540 ENDPROC
2550 PROC Z(G5)
2560 J5=G5
2570 GET D8$,G5:D5$,J7,J8,J9
2580 EXEC F(2,G5,D8$)
2590 ENDPROC
2600 PROC CONVDATE(I1,I2)
2610 K0=I2;I1$=""
2620 FOR I=8 TO E STEP -E
2625 I1$(I)=CHR(K0 MOD TI+48)
2630 IF I MOD V=B THEN
2631 I1$(I)="-"
2632 ELSE
2633 K0=K0 DIV TI
2634 ENDIF
2690 NEXT I
2700 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
2970 PROC SKRIVBUND
2980 IF J6>B THEN
2990 WHILE J6<K1-20
3000 PRINT
3010 J6=J6+E
3020 ENDWHILE
3030 EXEC CONV(C3$,G6,6)
3040 EXEC CONV(F1$,G7,4)
3050 C3$=C3$+F1$
3060 PRINT TAB(EL);"LØNMODTAGER ";C3$;
3070 PRINT USING " ####":F8;
3080 PRINT TAB(44);"ARBEJDSGIVER ";D3$(E,7)
3090 PRINT
3092 PRINT
3094 PRINT
3100 PRINT
3110 PRINT TAB(13);D1$(E,25);TAB(46);D3$(8,32)
3120 PRINT TAB(13);D1$(26,48)
3130 PRINT TAB(13);D1$(49,71);TAB(46);D3$(33,55)
3140 PRINT TAB(13);D2$(E,4);" ";D2$(5,18);TAB(46);D4$(E,4);" ";
3150 PRINT D4$(5,18)
3160 J6=J6+W
3170 WHILE J6<K1
3180 PRINT
3190 J6=J6+E
3200 ENDWHILE
3210 J6=B
3220 ENDIF
3230 ENDPROC
3240 PROC SKRIVHOVED(G5)
3250 PRINT
3260 A6(G5)=A6(G5)+E
3270 PRINT USING " SIDE####":A6(G5);
3275 PRINT "     UDSKRIFTSDATO ";DAD$;
3280 PRINT TAB(49);"LØNPERIODEN ";A7$;" / ";A8$;
3290 CASE G5 OF
3300 WHEN E
3310 J6=6
3320 PRINT TAB(33);"LØNSPECIFIKATION"
3330 PRINT TAB(33);"****************"
3340 PRINT
3350 PRINT " LA TEKST";TAB(26);"NUMMER      SALDO    ENHEDER    SATS  ";
3360 PRINT "UDBETALT/TRUKKET";
3370 WHEN G
3380 J6=5
3390 PRINT TAB(29);"FERIE- OG SH-OPGØRELSE"
3400 PRINT TAB(29);"**********************"
3410 PRINT
3420 ENDCASE
3430 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
3560 PROC BEREGNFERIE
3570 EXEC SKRIVHOVED(2)
3580 IF K2=B THEN EXEC INDTÆL
3585 K4=H1
3590 IF A4(K3)>H1 THEN K4=A4(K3)
3595 K5=H6
3640 IF A5(K3)<H6 OR H6=B THEN K5=A5(K3)
3690 K6=K5 MOD 100-K4 MOD 100
3700 K6=K6+30*(K5 DIV 100 MOD 100-K4 DIV 100 MOD 100)
3705 K7=INT(G*I7*K6/365+0.5)/G
3710 K6=K6+365*(K5 DIV 10000-K4 DIV 10000)
3720 IF A9$="1" THEN K7=B
3770 EXEC Æ(C3$,K7)
3800 C4$=C5$(29)
3810 EXEC C(0,C3$,C4$,F1$)
3820 C5$(29)=F1$(G:EL)
3830 IF K3=V THEN
3840 EXEC Æ(C3$,I7)
3850 EXEC C(4,F1$,C3$,C4$)
3860 IF SI=G THEN F1$=C3$
3870 ENDIF
3873 C4$=C5$(44)
3876 EXEC C(0,C4$,F1$,C4$)
3880 C5$(44)=C4$(G:EL)
3890 PRINT " FERIEKODE ";D2$(22);" OR-KODE ";D2$(24,25);" FAGGR-KODE";H5
3910 EXEC CONVDATE(C4$,K4)
3920 PRINT " ANSAT FRA ";C4$;" TIL ";
3930 EXEC CONVDATE(C4$,K5)
3940 EXEC C(3,F1$,B5$,C3$)
3945 IF C3$(8)=" " THEN C3$(8)="0"
3950 PRINT C4$;" FERIEDAGE ";F1$(7,TI);" HERAF ";C3$(8);" LØRDAGE"
3960 PRINT
3970 PRINT " LA TEKST";TAB(38);"SALDO    ENHEDER    SATS  UDBETALT/TRUKKET";
3990 IF C5$(16,EL)="+" THEN C5$(16,EL)=" "
4000 PRINT TAB(5);"FERIEBERETT LØN";TAB(42);"0 ";C5$(16)
4010 C5$(16)=B3$(G:EL)
4020 EXEC Z(90)
4025 EXEC OP(8,C5$(20))
4030 F0$(42)="0";F0$(44,54)=C5$(20)
4040 EXEC Å
4050 EXEC Z(91)
4055 EXEC OP(9,C5$(17))
4060 F0$(42)="0";F0$(44,54)=C5$(17)
4070 EXEC Å
4080 IF H0>B THEN
4090 EXEC Æ(C3$,H0)
4100 ELSE
4110 K8=INT(G9*12/365)
4120 EXEC Æ(C4$,K8)
4125 F1$=C5$(29)
4130 EXEC C(2,F1$,C4$,C3$)
4140 ENDIF
4150 B1$=C5$(20);C4$=C5$(17);C5$(20)=B3$(G:EL);C5$(17)=C5$(20)
4155 C5$(29)=C5$(20)
4190 EXEC C(0,B1$,C4$,B1$)
4200 EXEC OPTÆL(34,B1$)
4230 EXEC Z(82)
4235 F0$(33,43)=C5$(34)
4240 F0$(64+(B1$(12)="-")*6:TI)=B1$(G:TI)
4250 EXEC Å
4260 EXEC C(4,B1$,C3$,C4$)
4270 EXEC Z(92)
4280 F0$(45,54)=C3$(V:TI)
4290 IF SI=G THEN
4300 EXEC C(1,B1$,C3$,C4$)
4310 H0=B
4320 EXEC Æ(C3$,G8)
4330 F0$(56,62)=C3$(6:7)
4335 C3$(12)="-"
4340 EXEC C(2,C4$,C3$,B2$)
4350 EXEC C(3,B2$,B4$,B2$)
4355 B2$(TI,EL)="00"
4360 EXEC C(0,B1$,B2$,C0$)
4370 ELSE
4380 B2$=B3$
4390 C0$=B1$
4400 IF H0>B THEN
4410 EXEC C(1,C3$,B1$,C3$)
4420 EXEC PERVERT(C3$,H0)
4430 ENDIF
4440 ENDIF
4441 EXEC OPTÆL(40,B2$)
4442 EXEC OP(TI,B2$)
4444 F0$(33,43)=C5$(40)
4450 F0$(70,79)=B2$(G:TI)
4460 EXEC Å
4470 EXEC Z(93)
4480 F0$(64+6*(C0$(12)="-"):TI)=C0$(G:TI)
4490 EXEC Å
4500 PRINT
4510 J6=J6+6
4520 ENDPROC
4530 PROC BEREGNSH
4540 IF K9=B THEN
4550 EXEC SKRIVHOVED(2)
4560 IF K2=B THEN EXEC INDTÆL
4570 ENDIF
4580 PRINT " SH-KODE   ";D2$(23);" OR-KODE ";D2$(24,25);
4590 PRINT " FAGGR-KODE";H5
4600 PRINT
4610 PRINT " LA TEKST";TAB(38);"SALDO    ENHEDER    SATS  ";
4620 PRINT "UDBETALT/TRUKKET";
4630 EXEC Z(95)
4635 EXEC OP(EL,C5$(23))
4640 F0$(42)="0";F0$(44,54)=C5$(23)
4650 EXEC Å
4660 C3$=C5$(23);C5$(23)=B3$(G:EL)
4670 C4$=" "+C5$(26)
4675 IF C4$(12)="+" THEN EXEC C(1,B3$,C4$,C4$)
4680 EXEC Z(96)
4685 EXEC OP(12,C4$)
4690 F0$(42)="0";F0$(44,54)=C4$(G:EL)
4700 EXEC Å
4710 C5$(26)=B3$(G:EL)
4720 EXEC C(0,C3$,C4$,B1$)
4730 EXEC OPTÆL(34,B1$)
4760 EXEC Z(82)
4770 F0$(33,43)=C5$(34)
4780 EXEC Æ(C3$,G8)
4782 C4$=B3$
4785 C3$(12)="-"
4790 IF B1$(12)="+" THEN
4795 B2$=B1$
4800 F0$(64:TI)=B1$(G:TI)
4801 IF H0>B THEN
4802 EXEC Æ(C4$,H0)
4803 EXEC C(4,B1$,C4$,C2$)
4804 IF SI=G THEN
4805 EXEC C(1,B1$,C4$,B2$)
4806 H0=B
4807 ELSE
4808 EXEC C(1,C4$,B1$,C2$)
4809 B2$=B3$
4810 EXEC PERVERT(C2$,H0)
4811 ENDIF
4812 ENDIF
4819 EXEC C(2,C3$,B2$,C1$)
4820 EXEC C(3,C1$,B4$,C1$)
4830 C1$(TI,EL)="00"
4840 EXEC OPTÆL(40,C1$)
4860 ELSE
4870 F0$(70:TI)=B1$(G:TI)
4880 C1$=B3$
4890 ENDIF
4900 EXEC Å
4910 EXEC Z(97)
4915 EXEC OP(13,C1$)
4920 F0$(33,43)=C5$(40);F0$(45,54)=C4$(V:TI)
4930 F0$(56:6)=C3$(6:6);F0$(70:TI)=C1$(G:TI)
4940 EXEC Å
4950 EXEC C(0,C1$,B1$,C2$)
4960 EXEC Z(98)
4970 F0$(64+6*(C2$(12)="-"):TI)=C2$(G:TI)
4980 EXEC Å
4990 J6=J6+V
5000 ENDPROC
5010 PROC BEREGNLØN
5020 L0=(F8-E)*J0+E
5030 GET D7$,L0:D6$
5040 IF D6$(E)="1" THEN
5042 FOR I=E TO 8
5044 B9$(I)=B3$(G:EL)
5046 NEXT I
5050 L1=E
5060 L2=B
5062 D6$(E)="2"
5064 PUT D7$,L0:D6$
5070 EXEC SKRIVHOVED(1)
5080 EXEC INDTÆL
5090 REPEAT
5100 J5=ORD(D6$(V))-48
5110 IF D6$(4)<>" " THEN J5=J5*TI+ORD(D6$(4))-48
5120 IF J5<78 AND J5<>60 AND J5<>70 THEN
5130 EXEC Z(J5)
5140 IF J7>B THEN
5141 IF J7=G OR J7=4 OR J7=6 THEN
5143 C3$=D6$(EL:TI)
5144 EXEC OPTÆL(J7,C3$)
5146 J7=J7+E
5147 IF J7<6 THEN
5148 F1$=B9$(8)
5149 EXEC C(0,F1$,C3$,C4$)
5150 B9$(8)=C4$(G:EL)
5151 ENDIF
5152 ENDIF
5160 C3$=D6$(AZ:TI)
5170 EXEC OPTÆL(J7,C3$)
5190 ENDIF
5200 IF J8>B THEN
5220 C3$=D6$(AZ:TI)
5230 EXEC OPTÆL(J8,C3$)
5250 ENDIF
5260 IF J9>B THEN
5280 C3$=D6$(AZ:TI)
5290 EXEC OPTÆL(J9,C3$)
5310 ENDIF
5320 F0$(26:6)=D6$(5:6)
5330 CASE B=B OF
5340 WHEN (J5>B AND J5<60) OR (J5>61 AND J5<65)
5350 CASE J5 OF
5360 WHEN 41,49
5370 F0$(33,43)=C5$(J9)
5371 IF J5=49 THEN
5372 C8$(21,30)=D6$(AZ:TI)
5373 ELSE
5374 EXEC OP(2,D6$(AZ,37))
5375 ENDIF
5380 WHEN 42
5385 EXEC OP(3,D6$(AZ,37))
5390 F0$(33,43)=C5$(26)
5400 ENDCASE
5402 IF J5=40 THEN EXEC OP(1,D6$(AZ,37))
5405 IF J5>61 THEN
5406 D6$(37)="-"
5407 C3$=B6$(EL+20*(J5=62)+30*(J5=64):TI);C4$=D6$(AZ:TI)
5408 EXEC C(0,C3$,C4$,C3$)
5409 B6$(EL+20*(J5=62)+30*(J5=64):TI)=C3$(V:TI)
5415 ENDIF
5418 F0$(45,54)=D6$(EL:TI)
5420 F0$(56,62)=D6$(21:7)
5430 IF D6$(37)="+" THEN
5440 F0$(65:W)=D6$(AZ:W)
5450 ELSE
5460 F0$(71,79)=D6$(AZ:W)
5470 ENDIF
5480 WHEN J5=61 OR (J5>64 AND J5<70)
5490 D6$(37)="+"
5492 IF J5>67 THEN D6$(37)="-"
5500 F1$=D6$(EL:TI)
5510 C3$=D6$(AZ:TI)
5520 EXEC C(0,F1$,C3$,C4$)
5522 IF C4$(12)="-" THEN
5524 D6$(EL:TI)=B3$(V:TI)
5526 D6$(AZ:TI)=F1$
5528 ELSE
5530 D6$(EL:TI)=C4$(V:TI)
5531 ENDIF
5532 D6$(E)="2"
5533 D6$(37)="+"
5534 PUT D7$,L0:D6$
5535 D6$(37)="-"
5536 IF J5=61 THEN
5537 C3$=B6$(E,TI)
5538 ELSE
5539 C3$=B61$(E+TI*(J5=66)+20*(J5=67)+30*(J5=68)+40*(J5=69):TI)
5540 ENDIF
5542 C4$=D6$(AZ:TI)
5543 EXEC C(0,C3$,C4$,C3$)
5544 IF J5=61 THEN
5545 B6$(E,TI)=C3$(V:TI)
5546 ELSE
5547 B61$(E+TI*(J5=66)+20*(J5=67)+30*(J5=68)+40*(J5=69):TI)=C3$(V:TI)
5548 ENDIF
5550 F0$(34,43)=D6$(EL:TI)
5560 F0$(71,79)=D6$(AZ:W)
5570 WHEN J5=72
5575 EXEC OP(14,D6$(EL,20))
5580 F0$(33,43)=C5$(J8)
5590 F0$(45,54)=D6$(EL:TI)
5593 WHEN J5=73
5595 F0$(45,54)=D6$(EL:TI)
5600 WHEN J5=75
5610 F0$(45,54)=D6$(EL:TI)
5620 L2=(ORD(F0$(45))-48)*TI+ORD(F0$(46))-48
5630 L2=L2*100+(ORD(F0$(47))-48)*TI+ORD(F0$(48))-48
5640 L2=100*L2+(ORD(F0$(49))-48)*TI+ORD(F0$(50))-48
5650 ENDCASE
5660 EXEC Å
5670 FOR I=E TO 7
5680 IF D5$(I+21)="1" THEN
5690 C4$=D6$(AZ:TI)
5700 C3$=B9$(I)
5710 EXEC C(0,C4$,C3$,C4$)
5720 B9$(I)=C4$(G:EL)
5730 ENDIF
5740 NEXT I
5770 ELSE
5780 B7(L1)=L0
5790 B8$(L1)=D6$
5800 IF J5<78 THEN L3=L1
5810 L1=L1+E
5820 ENDIF
5830 IF J5<83 THEN
5840 L0=L0+E
5850 GET D7$,L0:D6$
5860 ENDIF
5870 UNTIL J5=83
5875 B8$(L1-G,37)="-"
5880 F1$=B8$(L1-G,AZ:TI)
5890 C3$=B9$(G)
5900 EXEC C(0,F1$,C3$,C4$)
5910 B9$(G)=C4$(G:EL)
5920 C3$=B9$(7)
5930 EXEC C(0,F1$,C3$,C4$)
5940 B9$(7)=C4$(G:EL)
5950 IF H6>B THEN
5960 C3$=B3$
5970 ELSE
5980 IF H0>B THEN
5990 EXEC Æ(C3$,H0)
6000 ELSE
6002 K8=INT(G9*12/365)
6004 EXEC Æ(C3$,K8)
6010 C4$=B8$(L1-E,EL:TI)
6020 CASE D2$(21) OF
6030 WHEN "1"
6040 F1$="1+"
6050 EXEC C(4,F1$,C4$,C3$)
6060 IF SI<>B THEN
6100 EXEC C(2,C3$,C4$,F1$)
6110 C3$=F1$
6120 ENDIF
6130 WHEN "2","3"
6140 F1$="7+"
6150 EXEC C(4,F1$,C4$,C3$)
6160 IF SI=B THEN
6170 K8=INT(G9*12/52)
6180 EXEC Æ(C3$,K8)
6190 ELSE
6220 EXEC C(2,C3$,C4$,C3$)
6230 ENDIF
6240 WHEN "4","5"
6250 F1$="14+"
6260 EXEC C(4,F1$,C4$,C3$)
6270 IF SI=B THEN
6280 K8=INT(G9*12/26)
6290 EXEC Æ(C3$,K8)
6300 ELSE
6330 EXEC C(2,C3$,C4$,C3$)
6340 ENDIF
6350 WHEN "6","7"
6360 F1$="30+"
6370 EXEC C(4,F1$,C4$,C3$)
6380 IF SI=B THEN
6390 EXEC Æ(C3$,G9)
6400 ELSE
6430 EXEC C(2,C3$,C4$,C3$)
6440 ENDIF
6450 ENDCASE
6470 ENDIF
6475 H6=L2
6480 ENDIF
6485 B8$(L1-E,EL:TI)=C3$(V:TI)
6490 F1$=B9$(G)
6500 EXEC C(4,F1$,C3$,C4$)
6510 IF SI=G THEN
6515 H0=B
6520 EXEC C(1,F1$,C3$,C4$)
6530 F1$=B8$(L1-E,21:7)
6540 EXEC C(2,C4$,F1$,C3$)
6550 EXEC C(3,C3$,B4$,C4$)
6555 C4$(TI,EL)="00"
6560 ELSE
6562 IF H0>B THEN
6564 EXEC C(1,C3$,F1$,C3$)
6566 EXEC PERVERT(C3$,H0)
6568 ENDIF
6570 C4$=B3$
6580 ENDIF
6585 C4$(12)="-"
6590 B8$(L1-E,AZ:TI)=C4$(V:TI)
6600 F1$=B9$(7)
6602 EXEC C(0,F1$,C4$,C3$)
6604 B9$(7)=C3$(G:EL)
6610 FOR I=E TO L3
6630 IF B8$(I,V,4)="60" THEN
6635 EXEC Z(60)
6640 C4$=B8$(L1-E,AZ:W)+"+"
6650 F1$=B9$(G)
6660 EXEC C(4,C4$,F1$,C3$)
6670 IF SI=E THEN
6680 EXEC C(1,F1$,C4$,C3$)
6690 F1$=B8$(I,21:7)
6700 EXEC C(2,C3$,F1$,C4$)
6710 EXEC C(3,C4$,B4$,C3$)
6715 C3$(TI,EL)="00"
6720 ELSE
6730 C3$="          0-"
6740 ENDIF
6750 C4$=B8$(I,EL:TI)
6760 EXEC C(4,C4$,C3$,F1$)
6770 IF SI=G THEN
6780 EXEC C(1,C4$,C3$,F1$)
6790 B8$(I,EL:TI)=F1$(V:TI)
6800 B8$(I,AZ:TI)=C3$(V:TI)
6810 ELSE
6820 B8$(I,EL:TI)=B3$(V:TI)
6830 B8$(I,AZ:TI)=C4$
6840 ENDIF
6842 C3$=B8$(I,AZ:TI)
6844 C4$=B9$(7)
6846 EXEC C(1,C4$,C3$,C4$)
6848 B9$(7)=C4$(G:EL)
6852 B8$(I,E)="2"
6854 PUT D7$,B7(I):B8$(I)
6855 B8$(I,37)="-"
6860 F0$(34,43)=B8$(I,EL:TI)
6870 F0$(71,79)=B8$(I,AZ:W)
6871 C3$=B8$(I,AZ:TI)
6872 C4$=B6$(21,30)
6873 EXEC C(0,C3$,C4$,C4$)
6875 B6$(21,30)=C4$(V:TI)
6876 C4$=B9$(5)
6877 EXEC C(0,C3$,C4$,C3$)
6878 B9$(5)=C3$(G:EL)
6880 ELSE
6881 EXEC Z(70)
6882 C3$=B8$(I,AZ:TI)
6883 EXEC OP(6,C3$)
6884 EXEC OPTÆL(J9,C3$)
6890 F0$(45,54)=B8$(I,EL:TI)
6900 F0$(67,75)=B8$(I,AZ:W)
6910 ENDIF
6920 F0$(26:6)=B8$(I,5:6)
6930 F0$(56,62)=B8$(I,21:7)
6940 EXEC Å
6950 IF J5=70 THEN
6960 EXEC Z(71)
6970 C3$=B8$(L1-E,21:7)
6980 C4$=B8$(I,AZ:TI)
6990 EXEC C(2,C3$,C4$,F1$)
7000 EXEC C(3,F1$,B4$,C3$)
7010 F0$(56,62)=B8$(L1-E,21:7)
7015 C3$(TI,EL)="00"
7020 F0$(67,75)=C3$(V:W)
7022 C3$(12)="-"
7026 EXEC OPTÆL(J9,C3$)
7027 EXEC OP(7,C3$)
7030 EXEC Å
7040 ENDIF
7070 NEXT I
7071 EXEC C(0,B9$(4),B9$(5),C3$)
7072 EXEC C(0,B9$(6),C3$,C3$)
7073 C7$(31,40)=C3$(V,12)
7074 EXEC OP(5,B9$(4))
7080 EXEC Z(76)
7090 C3$=B9$(E)
7100 EXEC OPTÆL(16,C3$)
7110 EXEC OPTÆL(EL,C3$)
7120 EXEC OPTÆL(31,C3$)
7130 F0$(33,43)=C5$(16)
7140 F0$(44,54)=B9$(E)
7150 F0$(56,62)=B9$(8,5:7)
7151 C3$=B9$(8)
7152 EXEC OPTÆL(30,C3$)
7153 C7$(E,TI)=C3$(G,EL)
7154 C8$(EL,20)=B9$(E,G:TI)
7160 EXEC Å
7170 EXEC Z(78)
7180 L3=L3+E
7190 C3$=B8$(L3,21:7)
7200 C4$=B9$(E)
7210 EXEC C(2,C3$,C4$,F1$)
7220 EXEC C(3,F1$,B4$,C3$)
7225 EXEC OP(15,C3$)
7230 F0$(45,54)=C3$(V:TI)
7250 EXEC OPTÆL(20,C3$)
7280 EXEC OPTÆL(14,C3$)
7300 F0$(33,43)=C5$(20)
7310 F0$(56,62)=B8$(L3,21:7)
7320 EXEC Å
7330 L3=L3+E
7340 IF B8$(L3,V,4)="79" THEN
7345 IF D2$(24,25)<"90" THEN
7350 EXEC Z(79)
7360 C3$=B8$(L3,21:7)
7370 C4$=B9$(E)
7380 EXEC C(2,C3$,C4$,F1$)
7390 EXEC C(3,F1$,B4$,C3$)
7395 EXEC OP(16,C3$)
7400 F0$(45,54)=C3$(V:TI)
7420 EXEC OPTÆL(15,C3$)
7450 EXEC OPTÆL(23,C3$)
7470 C3$=C5$(26)
7480 EXEC C(1,F1$,C3$,C4$)
7490 F0$(33,43)=C4$(G:EL)
7500 F0$(56,62)=B8$(L3,21:7)
7510 EXEC Å
7515 ENDIF
7520 L3=L3+E
7530 ENDIF
7540 EXEC Z(80)
7560 C3$=B8$(L3,AZ:TI)
7565 C7$(EL,20)=C3$
7570 EXEC OPTÆL(43,C3$)
7590 F0$(33,43)=C5$(43)
7600 F0$(45,54)=B8$(L3,EL:TI)
7610 F0$(56,62)=B8$(L3,21:7)
7620 F0$(71,79)=B8$(L3,AZ:W)
7630 EXEC Å
7640 L3=L3+E
7650 EXEC Z(82)
7660 C3$=B9$(G)
7680 EXEC OPTÆL(34,C3$)
7700 F0$(33,43)=C5$(34)
7710 F0$(45,54)=B9$(G,G:TI)
7720 EXEC Å
7730 EXEC Z(83)
7740 C3$=B8$(L3,AZ:TI)
7750 C8$(31,40)=C3$
7760 EXEC OPTÆL(40,C3$)
7780 F0$(33,43)=C5$(40)
7790 F0$(45,54)=B8$(L3,EL:TI)
7800 F0$(56,62)=B8$(L3,21:7)
7810 F0$(71,79)=B8$(L3,AZ:W)
7820 EXEC Å
7830 EXEC Z(84)
7840 C3$=B9$(V)
7850 EXEC OP(4,C3$)
7860 EXEC OPTÆL(37,C3$)
7880 F0$(33,43)=C5$(37)
7890 F0$(44,54)=B9$(V)
7892 EXEC C(0,B9$(2),B9$(3),C3$)
7894 C7$(21,30)=C3$(V,12)
7900 EXEC Å
7910 C3$=B9$(7)
7920 EXEC C(4,C3$,B3$,C4$)
7925 IF C3$(11)="-" THEN SI=E
7930 IF SI=G THEN
7940 IF H2>B AND (H3>B OR H4>B) THEN
7950 IF D4$(19,24)<>"000000" AND D4$(25,34)<>"0000000000" THEN
7960 SI=B
7970 EXEC Z(88)
7975 F0$(27,48)="Til disposition "+DD$
7980 F0$(64:TI)=B9$(7,E:TI)
7985 C8$(41,50)=B9$(7,G:TI)
7990 EXEC CONV(OP1$,0+H2 MOD 10000,4)
8000 D5$(5:4)=OP1$
8010 EXEC CONV(OP1$,H3,5)
8020 D5$(12:5)=OP1$
8030 EXEC CONV(OP1$,H4,5)
8040 D5$(17:5)=OP1$
8050 EXEC Å
8055 PUT E1$:F8,B9$(7)
8060 ENDIF
8070 ENDIF
8080 ELSE
8090 SI=G
8100 ENDIF
8110 IF SI=G THEN
8120 EXEC Z(89)
8130 F0$(64+6*(B9$(7,EL)="-"):TI)=B9$(7,E:TI)
8135 C8$(E,TI)=B9$(7,G:TI)
8140 EXEC Å
8150 ENDIF
8160 EXEC SKRIVBUND
8161 K2=E
8162 ELSE
8163 K2=B
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 D0$=D8$+"TÆLLEREG"
8270 OPEN D0$,W
8280 D8$=D8$+"LØNARTRG"
8290 OPEN D8$,R
8291 D9$=E1$+"LØNJOUR"
8292 OPEN D9$,W
8293 E0$=E1$+"FRADRAG"
8294 OPEN E0$,W
8295 E1$=E1$+"LØNBILAG"
8296 OPEN E1$,W
8350 K1=72
8355 J6=B
8360 F8=B
8370 F0$=E9$
8372 PUT D9$:A7$,A8$,A9$,B0$
8374 PUT E0$:A7$,A8$
8376 PUT E1$:I6
8380 OUTPUT P
8390 REPEAT
8400 EXEC NÆSTE
8410 L3,L4,K2,K9=B
8412 C7$=B3$(V:TI)+B3$(V:TI)+B3$(V:TI)+B3$(V:TI)
8414 C8$=C7$+B3$(V:TI)
8416 B6$=C8$
8417 B61$=B6$
8420 IF F8<=I9 THEN
8430 IF E3=E 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
8500 EXEC BEREGNLØN
8520 ENDIF
8530 ENDIF
8540 IF E4=E THEN
8550 K3=ORD(D2$(22))-48
8560 IF K3<4 THEN
8570 IF A2(K3)=F8 OR A2(K3)=-E THEN
8580 EXEC BEREGNFERIE
8590 K9=E
8600 ENDIF
8610 ENDIF
8620 ENDIF
8630 IF E5=E THEN
8640 K3=ORD(D2$(23))-48
8650 IF K3<4 THEN
8660 IF A3(K3)=F8 OR A3(K3)=-E THEN
8670 EXEC BEREGNSH
8680 L4=E
8690 ENDIF
8700 ENDIF
8710 ENDIF
8720 IF K9*L4=E THEN
8730 EXEC C(0,C0$,C2$,C3$)
8731 EXEC C(4,C3$,B3$,C3$)
8732 IF SI<>B THEN
8740 EXEC C(2,C0$,B4$,C4$)
8750 EXEC C(3,C4$,C3$,C4$)
8760 EXEC C(4,C4$,B4$,C3$)
8770 IF SI=G THEN C4$=B4$
8771 ELSE
8772 C4$=B3$
8773 ENDIF
8780 PRINT
8790 PRINT "Nettoferiepengene udgør ";C4$(6,EL);" %"
8800 J6=J6+G
8810 ENDIF
8815 IF K2+K9+L4>B THEN
8820 EXEC SKRIVBUND
8830 EXEC UDLØNMOD(F8)
8840 EXEC UDTÆL
8843 PUT D9$:F8,C7$
8844 PUT D9$:C8$
8845 ENDIF
8846 IF K2=E THEN
8847 PUT E0$:F8,B6$
8848 PUT E0$:F8,B61$
8849 ENDIF
8850 ENDIF
8860 UNTIL F8=>I9
8861 PUT D9$:I9+E,C7$
8862 PUT D9$:E2$(E),E2$(G),E2$(V),E2$(4),E2$(5),E2$(6)
8864 PUT D9$:E2$(7),E2$(8),E2$(W),E2$(TI),E2$(EL),E2$(12)
8866 PUT D9$:E2$(13),E2$(14),E2$(15),E2$(16)
8867 ENDFILE E0$
8868 ENDFILE E1$
8870 CLOSE
8875 OUTPUT T
8880 CHAIN "P641210:JOURNAL"