DataMuseum.dk

top - download

    Length: 11008 (0x2b00)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »AKKLØNBE.B«

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

SPC/1 COMAL-BIN

0100 PROC DATOCHECK(NR5,OK5)
0110 OK5=E
0120 ÅR=(ORD(NR5$(E))-48)*10+ORD(NR5$(G))-48
0130 MÅNED=(ORD(NR5$(V))-48)*10+ORD(NR5$(4))-48
0140 DATO=(ORD(NR5$(5))-48)*10+ORD(NR5$(6))-48
0150 IF DATO<E OR MÅNED<E OR MÅNED>12 OR DATO>31 THEN OK5=B
0160 IF OK5=B THEN EXIT
0170 CASE MÅNED OF
0180 WHEN 4,6,W,11
0190 IF DATO>30 THEN OK5=B
0200 WHEN G
0210 IF DATO>29 THEN OK5=B
0220 IF DATO=29 AND ÅR MOD 4<>B THEN OK5=B
0230 ENDCASE
0240 ENDPROC
0250 DIM RES$(15),OP1$(12),OP2$(12),TAH$(12),HUND$(12),MAX$(12),MAX1$(12)
0260 DIM RESUL$(12),RESUL1$(12),PR$(14),LINE$(20),POST6$(29)
0270 DIM FIL$(20),FIL1$(20),POST1$(71),POST2$(27),POST3$(55),POST4$(34)
0280 DIM AUT$(4,37),FIL5$(20)
0290 HUND$="100.00+"
0300 MAX$="1000000.00+"
0310 MAX1$="1000.00+"
0320 TAH$="0+"
0330 PROC INLØNMOD(N)
0340 GET FIL$,G*N-E:POST1$
0350 GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
0360 EXEC FEJL(E,N,FIL$)
0370 ENDPROC
0380 PROC INDVIRK
0390 OPEN FIL$,W
0400 EXEC FEJL(B,B,FIL$)
0410 GET FIL$,E:POST3$
0420 GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM
0430 ENDPROC
0440 PROC CHECK(NR1,OK1)
0450 OK1=B
0460 RESULT=B
0470 IF LEN(NR1$)>B THEN
0480 IF NR1$(E)="-" THEN
0490 FORTEGN=-E
0500 OK1=E
0510 ELSE
0520 FORTEGN=E
0530 ENDIF
0540 WHILE LEN(NR1$)>OK1
0550 OK1=OK1+E
0560 IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN
0570 FORTEGN=B
0580 OK1=LEN(NR1$)
0590 ENDIF
0600 RESULT=RESULT*10+ORD(NR1$(OK1))-48
0610 ENDWHILE
0620 OK1=OK1*FORTEGN
0630 IF OK1<B THEN OK1=OK1+E
0640 ENDIF
0650 ENDPROC
0660 PROC INDART(N)
0670 GET FIL5$,N:POST6$,KT,FSHT,ÅT
0680 EXEC FEJL(G,N,FIL5$)
0690 ENDPROC
0700 PROC FEJL(P1,P2,P3)
0710 IF STATUS(P3$)<>B THEN
0720 OUTPUT T
0730 PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2
0740 STOP
0750 ENDIF
0760 ENDPROC
0770 PROC CALC(AR3,B1,B2,ES)
0780 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0790 CALL "P641210:REGN"
0800 IF AR3<6 THEN
0810 IF FLAG THEN STOP
0820 ENDIF
0830 ES$=RES$
0840 ENDPROC
0850 PROC SKRIVSID
0860 CLEAR
0870 PRINT "             L Ø N B E R E G N I N G"
0880 PRINT "Lønnr ";
0890 PRINT USING "#### ":LMNR;
0900 PRINT "Navn ";POST1$(E,25)
0910 PRINT "Linie Lønart    Nummer     Enheder      Sats      Beløb"
0920 FOR I=E TO LAST
0930 PRINT USING "### ":I;
0940 PRINT "  ";SIDE$(FØRST+I,V:G);"        ";SIDE$(FØRST+I,5:6);"     ";
0950 RESUL$=SIDE$(FØRST+I,11:10)
0960 IF RESUL$(10)="+" THEN RESUL$(10)=" "
0970 PRINT RESUL$;
0980 RESUL$=SIDE$(FØRST+I,21:7)
0990 IF RESUL$(7)="+" THEN RESUL$(7)=" "
1000 PRINT "   ";RESUL$;"   ";
1010 RESUL$=SIDE$(FØRST+I,28:10)
1020 IF RESUL$(10)="+" THEN RESUL$(10)=" "
1030 PRINT RESUL$
1040 NEXT I
1050 ENDPROC
1060 PROC RETSID
1070 REPEAT
1080 REPEAT
1090 LINE$="0"
1100 CURSOR E,23
1110 EDIT "Linienr, 0: færdig  SL: slet linier ",LINE$
1120 IF LINE$<>"SL" THEN
1130 EXEC CHECK(LINE$,C)
1140 IF C<=B THEN RESULT=-E
1150 ELSE
1160 LINE$="N"
1170 CURSOR E,23
1180 EDIT "Slet: Alle : A, Linienrinterval : N  ",LINE$
1190 IF LINE$="A" THEN
1200 RESULT=B
1210 AT=B
1220 IT=(LMNR-E)*ATPLM+E
1230 UT=IT
1240 LAST=B;FØRST=B;SIDST=B
1250 ELSE
1260 REPEAT
1270 LF,LS=B
1280 CURSOR E,23
1290 PRINT "                                           "
1300 CURSOR E,23
1310 EDIT "Fra linienr ",LF
1320 CURSOR E,23
1330 EDIT "Til linienr ",LS
1340 LF=INT(LF)
1350 LS=INT(LS)
1360 UNTIL LS=>LF AND LF=>E AND LS<=LAST
1370 IF SIDE$(FØRST+LF,E,4)="1 39" THEN LF=LF+E
1380 LS=LS+E
1390 IF FØRST+LS<=SIDST AND SIDE$(FØRST+LS,E,4)="1 39" THEN LS=LS+E
1400 WHILE FØRST+LS<=SIDST
1410 SIDE$(FØRST+LF)=SIDE$(FØRST+LS)
1420 LF=LF+E
1430 LS=LS+E
1440 ENDWHILE
1450 AT=AT-LS+LF
1460 SIDST=SIDST-LS+LF
1470 LAST=SIDST-FØRST
1480 IF LAST>18 THEN LAST=18
1490 RESULT=-E
1500 ENDIF
1510 ENDIF
1520 UNTIL RESULT<=LAST
1530 LI=RESULT
1540 IF LI>B THEN EXEC INLINE(LI)
1550 IF LI<B THEN EXEC SKRIVSID
1560 UNTIL LI=B
1570 FØRST=FØRST+LAST
1580 ENDPROC
1590 PROC INDSID
1600 FOR I=E TO 18
1610 SIDE$(FØRST+I)="1 0       0         0      0         "
1620 SIDST=SIDST+E;AT=AT+E;LAST=I
1630 EXEC INLINE(I)
1640 I=LAST
1650 IF LANR=B THEN
1660 I=18
1670 ELSE
1680 IF AT=>ATPLM-4 THEN I=18
1690 ENDIF
1700 NEXT I
1710 ENDPROC
1720 PROC INDTRANS
1730 K=E
1740 REPEAT
1750 GET FIL1$,IT:SIDE$(K)
1760 IT=IT+E
1770 K=K+E
1780 UNTIL SIDE$(K-E,E)=" " OR SIDE$(K-E,G)="*" OR SIDE$(K-E,E)="2"
1790 IF SIDE$(K-E,E)=" " OR SIDE$(K-E,G)="*" THEN
1800 LAST=K-G
1810 IT=IT-E
1820 ELSE
1830 LAST=K-E
1840 ENDIF
1850 AT=AT+LAST
1860 FØRST=B;SIDST=LAST
1870 IF LAST>18 THEN LAST=18
1880 ENDPROC
1890 PROC UDATRANS
1900 FOR K=E TO LAST
1910 IF AUT$(K,E)="3" OR AUT$(K,E)="1" THEN
1920 AUT$(K,E)="1"
1930 PUT FIL1$,UT:AUT$(K)
1940 UT=UT+E
1950 ENDIF
1960 NEXT K
1970 ENDPROC
1980 PROC UDTRANS
1990 FOR K=E TO SIDST
2000 IF SIDE$(K,E)="3" OR SIDE$(K,E)="1" THEN
2010 SIDE$(K,E)="1"
2020 PUT FIL1$,UT:SIDE$(K)
2030 UT=UT+E
2040 ENDIF
2050 NEXT K
2060 ENDPROC
2070 PROC INLINE(LINIE)
2080 IF SIDE$(FØRST+LINIE,V:G)<>"39" THEN
2090 REPEAT
2100 REPEAT
2110 CURSOR 7,LINIE+V
2120 LINE$=SIDE$(FØRST+LINIE,V:G)
2130 SIDE$(FØRST+LINIE,V:G)="  "
2140 EDIT "",LINE$
2150 EXEC CHECK(LINE$,OK)
2160 IF RESULT=39 THEN OK=B
2170 UNTIL OK>B AND OK<V
2180 LANR=RESULT
2190 IF RESULT=B THEN
2200 QUQ=FØRST+LINIE
2210 WHILE QUQ<SIDST
2220 SIDE$(QUQ)=SIDE$(QUQ+E)
2230 QUQ=QUQ+E
2240 ENDWHILE
2250 SIDST=SIDST-E
2260 AT=AT-E
2270 LAST=SIDST-FØRST
2280 IF LAST>18 THEN LAST=18
2290 IF FØRST+LINIE<=SIDST AND SIDE$(FØRST+LINIE,E,4)="1 39" THEN GO TO 2200
2300 EXEC SKRIVSID
2310 ELSE
2320 EXEC INDART(LANR)
2330 IF POST6$(E)="1" AND POST6$(29)=" " THEN
2340 RESULT=B
2350 SIDE$(FØRST+LINIE,E:4)="1 "+CHR(LANR DIV 10+48)+CHR(LANR MOD 10+48)
2360 ENDIF
2370 ENDIF
2380 UNTIL RESULT=B
2390 IF LANR>B THEN
2400 LINE$="      "
2410 IF LANR<>73 AND LANR<>75 THEN
2420 REPEAT
2430 CURSOR 17,LINIE+V
2440 LINE$=SIDE$(FØRST+LINIE,5:6)
2450 SIDE$(FØRST+LINIE,5:6)="      "
2460 EDIT "",LINE$
2470 UNTIL LEN(LINE$)<=6 AND (LEN(LINE$)<6 OR SIDST<ATPLM-4)
2480 ENDIF
2490 SIDE$(FØRST+LINIE,5:6)=LINE$
2500 REPEAT
2510 REPEAT
2520 CURSOR 28,LINIE+V
2530 LINE$=SIDE$(FØRST+LINIE,11:10)
2540 IF LINE$(10)="+" THEN LINE$(10)=" "
2550 EDIT "",LINE$
2560 IF LANR=75 THEN
2570 EXEC DATOCHECK(LINE$,FLAG)
2580 FLAG=(FLAG=B)
2590 RESUL$="  "+LINE$(E,6)+"    "
2600 ELSE
2610 LINE$=LINE$+"+"
2620 EXEC CALC(6,LINE$,TAH$,RESUL$)
2630 ENDIF
2640 UNTIL FLAG=B
2650 IF LANR=75 THEN
2660 SI=E
2670 ELSE
2680 EXEC CALC(4,RESUL$,MAX$,MAX1$)
2690 ENDIF
2700 UNTIL SI=E
2710 SIDE$(FØRST+LINIE,11:10)=RESUL$(V:10)
2720 EXEC CALC(4,RESUL$,TAH$,MAX$)
2730 IF SI=B THEN
2740 ENH=B
2750 ELSE
2760 ENH=E
2770 ENDIF
2780 IF LANR<61 OR (LANR>61 AND LANR<65) OR LANR=70 THEN
2790 REPEAT
2800 REPEAT
2810 CURSOR 41,LINIE+V
2820 LINE$=SIDE$(FØRST+LINIE,21:7)
2830 IF LINE$(7)="+" THEN LINE$(7)=" "
2840 EDIT "",LINE$
2850 LINE$=LINE$+"+"
2860 EXEC CALC(6,LINE$,TAH$,RESUL$)
2870 UNTIL FLAG=B
2880 EXEC CALC(4,RESUL$,MAX1$,MAX$)
2890 UNTIL SI=E
2900 SIDE$(FØRST+LINIE,21:7)=RESUL$(6:7)
2910 EXEC CALC(4,RESUL$,TAH$,MAX$)
2920 IF SI=B THEN
2930 SATS=B
2940 ELSE
2950 SATS=E
2960 ENDIF
2970 ELSE
2980 SATS=B
2990 SIDE$(FØRST+LINIE,21:7)="       "
3000 ENDIF
3010 IF LANR<71 AND ENH*SATS=B AND LANR<>60 THEN
3020 REPEAT
3030 REPEAT
3040 CURSOR 51,LINIE+V
3050 LINE$=SIDE$(FØRST+LINIE,28:10)
3060 IF LINE$(10)="+" THEN LINE$(10)=" "
3070 EDIT "",LINE$
3080 LINE$=LINE$+"+"
3090 EXEC CALC(6,LINE$,TAH$,RESUL$)
3100 UNTIL FLAG=B
3110 EXEC CALC(4,RESUL$,MAX$,MAX1$)
3120 UNTIL SI=E
3130 IF LANR=49 THEN RESUL$(12)="-"
3140 SIDE$(FØRST+LINIE,28:10)=RESUL$(V:10)
3150 ELSE
3160 IF ENH*SATS=E AND LANR<>60 THEN
3170 LINE$=SIDE$(FØRST+LINIE,11:10)
3180 RESUL$=SIDE$(FØRST+LINIE,21:7)
3190 EXEC CALC(G,LINE$,RESUL$,RESUL1$)
3200 ELSE
3210 RESUL1$="          0+"
3220 ENDIF
3230 IF LANR=72 OR LANR=73 THEN RESUL1$(V:10)=SIDE$(FØRST+LINIE,11:10)
3240 IF LANR=49 THEN RESUL1$(12)="-"
3250 SIDE$(FØRST+LINIE,28:10)=RESUL1$(V:10)
3260 CURSOR 51,LINIE+V
3270 IF RESUL1$(12)="+" THEN RESUL1$(12)=" "
3280 PRINT RESUL1$(V:10)
3290 ENDIF
3300 KUK=FØRST+LINIE
3310 IF SIDE$(KUK,10)>"0" AND SIDE$(KUK,10)<="9" AND SATS>B THEN
3320 IF KUK=SIDST THEN
3330 IF LAST<18 THEN LAST=LAST+E
3340 SIDST=SIDST+E
3350 AT=AT+E
3360 SIDE$(SIDST)="1 39      0         0      0         "
3370 ELSE
3380 IF SIDE$(KUK+E,E,4)<>"1 39" THEN
3390 SIDST=SIDST+E
3400 AT=AT+E
3410 IF LAST<18 THEN LAST=LAST+E
3420 QUQ=SIDST
3430 WHILE QUQ>KUK+E
3440 SIDE$(QUQ)=SIDE$(QUQ-E)
3450 QUQ=QUQ-E
3460 ENDWHILE
3470 SIDE$(QUQ)="1 39      0         0      0         "
3480 ENDIF
3490 ENDIF
3500 EXEC SKRIVSID
3510 ELSE
3520 IF KUK<SIDST THEN
3530 IF SIDE$(KUK+E,E,4)="1 39" THEN
3540 QUQ=KUK+E
3550 WHILE QUQ<SIDST
3560 SIDE$(QUQ)=SIDE$(QUQ+E)
3570 QUQ=QUQ+E
3580 ENDWHILE
3590 SIDST=SIDST-E
3600 AT=AT-E
3610 LAST=SIDST-FØRST
3620 IF LAST>18 THEN LAST=18
3630 EXEC SKRIVSID
3640 ENDIF
3650 ENDIF
3660 ENDIF
3670 ENDIF
3680 ENDIF
3690 ENDPROC
3700 PROC AUTTRANS
3710 CLEAR
3720 PRINT "             L Ø N B E R E G N I N G"
3730 PRINT "Lønnr ";
3740 PRINT USING "#### ":LMNR;
3750 PRINT "Navn ";POST1$(E,25)
3760 PRINT "Linie Lønart    Nummer     Enheder      Sats      Beløb"
3770 IF POST2$(24,25)<"90" THEN
3780 II=G
3790 ELSE
3800 II=E
3810 ENDIF
3820 FOR I=E TO II
3830 CURSOR 7,V+I
3840 PRINT AUT$(I,G:V)
3850 REPEAT
3860 REPEAT
3870 CURSOR 41,V+I
3880 LINE$=AUT$(I,21:7)
3890 IF LINE$(7)="+" THEN LINE$(7)=" "
3900 EDIT "",LINE$
3910 LINE$=LINE$+"+"
3920 EXEC CALC(6,LINE$,TAH$,RESUL$)
3930 UNTIL FLAG=B
3940 EXEC CALC(4,RESUL$,HUND$,MAX$)
3950 UNTIL SI=E
3960 AUT$(I,21:7)=RESUL$(6:7)
3970 NEXT I
3980 CURSOR 7,6
3990 PRINT AUT$(V,G:V)
4000 REPEAT
4010 REPEAT
4020 CURSOR 51,6
4030 LINE$=AUT$(V,28:10)
4040 IF LINE$(10)="+" THEN LINE$(10)=" "
4050 EDIT "",LINE$
4060 LINE$=LINE$+"+"
4070 EXEC CALC(6,LINE$,TAH$,RESUL$)
4080 UNTIL FLAG=B
4090 EXEC CALC(4,RESUL$,MAX$,MAX1$)
4100 UNTIL SI=E
4110 AUT$(V,28:10)=RESUL$(V:10)
4120 LT=LT*100
4130 AUT$(4,21)=" "
4140 AUT$(4,22)=CHR(LT DIV 1000+48)
4150 AUT$(4,23)=CHR(LT DIV 100 MOD 10+48)
4160 AUT$(4,24)=","
4170 AUT$(4,25)=CHR(LT DIV 10 MOD 10+48)
4180 AUT$(4,26)=CHR(LT MOD 10+48)
4190 AUT$(4,27)="+"
4200 AUT$(4,11:10)="          "
4210 CASE POST2$(21) OF
4220 WHEN "1"
4230 AUT$(4,11)="1"
4240 WHEN "2","3"
4250 AUT$(4,11)="7"
4260 WHEN "4","5"
4270 AUT$(4,11:G)="14"
4280 WHEN "6","7"
4290 AUT$(4,11:G)="30"
4300 ENDCASE
4310 IF FD=B THEN
4320 CURSOR 7,7
4330 PRINT AUT$(4,G:V)
4340 REPEAT
4350 REPEAT
4360 CURSOR 28,7
4370 LINE$=AUT$(4,11:10)
4380 IF LINE$(10)="+" THEN LINE$(10)=" "
4390 EDIT "",LINE$
4400 LINE$=LINE$+"+"
4410 EXEC CALC(6,LINE$,TAH$,RESUL$)
4420 UNTIL FLAG=B
4430 EXEC CALC(4,RESUL$,HUND$,MAX$)
4440 UNTIL SI=E
4450 AUT$(4,11:10)=RESUL$(V:10)
4460 ENDIF
4470 LAST=4
4480 ENDPROC
4490 FIL$="P641220:VIRKKART"
4500 EXEC INDVIRK
4510 CLOSE FIL$
4520 DIM SIDE$(ATPLM-V,37)
4530 FIL$="P641220:LØNMODRG"
4540 OPEN FIL$,R
4550 FIL1$="P641220:TRANSREG"
4560 OPEN FIL1$,W
4570 FIL5$="P641220:LØNARTRG"
4580 OPEN FIL5$,R
4590 REPEAT
4600 CLEAR
4610 REPEAT
4620 LMNR=B
4630 EDIT "Lønnr ",LMNR
4640 UNTIL LMNR=>B AND LMNR<MLMNR
4650 IF LMNR>B THEN
4660 EXEC INLØNMOD(LMNR)
4670 IF LA<>B THEN
4680 IT=(LMNR-E)*ATPLM+E
4690 UT=IT
4700 AT=B
4710 EXEC INDTRANS
4720 REPEAT
4730 IF SIDE$(E,E)="2" THEN
4740 LAST=B
4750 ELSE
4760 EXEC SKRIVSID
4770 IF LAST>B THEN
4780 EXEC RETSID
4790 LAST=SIDST-FØRST
4800 IF LAST>18 THEN LAST=18
4810 ENDIF
4820 ENDIF
4830 UNTIL LAST=B OR IT=(LMNR-E)*ATPLM+E
4840 IF SIDE$(FØRST+E,E)<>"2" THEN
4850 IF IT>(LMNR-E)*ATPLM+E THEN
4860 FOR K=E TO 4
4870 GET FIL1$,IT:AUT$(K)
4880 IT=IT+E
4890 NEXT K
4900 ELSE
4910 AUT$(E)="1*78                0                "
4920 AUT$(G)="1*79                0                "
4930 AUT$(V)="1*80                       0         "
4940 AUT$(4)="1*83      0                          "
4950 ENDIF
4960 IF AT<ATPLM-4 THEN
4970 REPEAT
4980 LAST=B
4990 EXEC SKRIVSID
5000 EXEC INDSID
5010 IF LAST>B THEN EXEC RETSID
5020 UNTIL LAST<18
5030 ENDIF
5040 EXEC UDTRANS
5050 EXEC AUTTRANS
5060 EXEC UDATRANS
5070 AT=AT+4
5080 IF AT<ATPLM THEN
5090 SIDE$(E,E)=" "
5100 PUT FIL1$,UT:SIDE$(E)
5110 ENDIF
5120 ELSE
5130 PRINT "Lønmodtager ikke bogført"
5140 INPUT "RETURN",LINE$
5150 ENDIF
5160 ELSE
5170 PRINT "Lønmodtager findes ikke"
5180 INPUT "RETURN",LINE$
5190 ENDIF
5200 ENDIF
5210 UNTIL LMNR=B
5220 CLOSE FIL$
5230 CLOSE FIL1$
5240 CLOSE FIL5$
5250 CHAIN "P641210:STARTB"