DataMuseum.dk

top - download

    Length: 8848 (0x2290)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »ABESTAT.B«

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

SPC/1 COMAL-BIN

0100 DIM FELT12$(12),FELT15$(12),FELT26$(12),FELT29$(12),FELT30$(12)
0105 DIM FELT31$(12),FELT32$(12),FELT33$(12),FELT34$(12),FELT35$(12)
0106 DIM FELT36$(12)
0110 DIM STARTPER$(8),SLUTPER$(8),TV006$(12),KVT$(E),Å$(G),LP$(E)
0120 DIM RES$(15),OP1$(12),OP2$(12),TAH$(12),HUND$(12)
0140 DIM RESUL$(12),RESUL1$(12),TV$(45,11),POST5$(55),DAD$(6)
0150 DIM FIL$(16),FIL2$(16),POST1$(71),POST2$(27),POST3$(55),POST4$(34)
0170 TAH$="          0+"
0171 TV006$=TAH$;FELT12$=TAH$;FELT15$=TAH$;FELT26$=TAH$;FELT29$=TAH$
0172 FELT30$=TAH$;FELT31$=TAH$;FELT32$=TAH$;FELT33$=TAH$;FELT34$=TAH$
0173 FELT35$=TAH$;FELT36$=TAH$
0190 HUND$="     100,00+"
0210 DIM X(5),Y(5),TYPE(5)
0220 DIM BL$(79),L$(79),LIN$(12)
0230 FOR I=E TO 79
0240 BL$=BL$+" "
0250 NEXT I
0260 X(E)=27
0270 X(G)=34
0280 X(4)=38
0290 X(5),X(V)=39
0310 Y(E),Y(G)=G;Y(V)=V;Y(4)=4;Y(5)=5
0340 TYPE(E),TYPE(G)=6
0350 TYPE(V),TYPE(5)=-E
0360 TYPE(4)=G
0370 PROC CALC(AR3,B1,B2,ES)
0380 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0390 CALL "P641210:REGN"
0391 IF AR3=V AND FLAG=6 THEN
0392 RES$=TAH$
0393 FLAG=B
0394 ENDIF
0400 IF AR3<6 THEN
0410 IF FLAG THEN STOP
0420 ENDIF
0430 ES$=RES$
0440 ENDPROC
0450 PROC UDTÆL
0460 J=W*(LMNR-E)
0470 FOR K=E TO V
0480 FOR I=E TO 5
0490 POST5$((I-E)*11+E:11)=TAH$(G:11)
0500 NEXT I
0510 PUT FIL2$,J+K:POST5$
0520 NEXT K
0530 EXEC FEJL(-LMNR,-K,FIL2$)
0540 ENDPROC
0550 PROC INDTÆL
0560 J=W*(LMNR-E)
0570 FOR K=E TO V
0580 GET FIL2$,J+K:POST5$
0590 FOR I=E TO 5
0600 TV$((K-E)*5+I)=POST5$((I-E)*11+E:11)
0610 NEXT I
0620 NEXT K
0630 EXEC FEJL(LMNR,K,FIL2$)
0640 ENDPROC
0650 PROC DATOCHECK(NR5,OK5)
0660 OK5=E
0670 ÅR=(ORD(NR5$(E))-48)*10+ORD(NR5$(G))-48
0680 MÅNED=(ORD(NR5$(V))-48)*10+ORD(NR5$(4))-48
0690 DATO=(ORD(NR5$(5))-48)*10+ORD(NR5$(6))-48
0700 IF DATO<E OR MÅNED<E OR MÅNED>12 OR DATO>31 THEN OK5=B
0710 IF OK5=B THEN EXIT
0720 CASE MÅNED OF
0730 WHEN 4,6,W,11
0740 IF DATO>30 THEN OK5=B
0750 WHEN G
0760 IF DATO>29 THEN OK5=B
0770 IF DATO=29 AND ÅR MOD 4<>B THEN OK5=B
0780 ENDCASE
0790 ENDPROC
0800 PROC INLØNMOD(N)
0810 GET FIL$,G*N-E:POST1$
0820 GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
0830 EXEC FEJL(E,N,FIL$)
0840 ENDPROC
0900 PROC CONV(NR2,OK22,CIF)
0910 OK2=OK22
0920 NR2$=""
0930 REPEAT
0940 NR2$=CHR((OK2 MOD 10)+48)+NR2$
0950 CIF=CIF-E
0960 OK2=OK2 DIV 10
0970 IF CIF<B AND OK2=B THEN CIF=B
0980 UNTIL CIF=B
0990 ENDPROC
1000 PROC CHECK(NR1,OK1)
1010 OK1=B
1020 RESULT=B
1030 IF LEN(NR1$)>B THEN
1040 IF NR1$(E)="-" THEN
1050 FORTEGN=-E
1060 OK1=E
1070 ELSE
1080 FORTEGN=E
1090 ENDIF
1100 WHILE LEN(NR1$)>OK1
1110 OK1=OK1+E
1120 IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN
1130 FORTEGN=B
1140 OK1=LEN(NR1$)
1150 ENDIF
1160 RESULT=RESULT*10+ORD(NR1$(OK1))-48
1170 ENDWHILE
1175 RESULT=RESULT*FORTEGN
1180 OK1=OK1*FORTEGN
1190 IF OK1<B THEN OK1=OK1+E
1200 ENDIF
1210 ENDPROC
1220 PROC INOPL(OPL)
1230 EXEC INLINE(OPL)
1240 CASE OPL OF
1250 WHEN E
1260 REPEAT
1270 EXEC DATOCHECK(L$,I)
1280 IF I=B THEN EXEC INLINE(OPL)
1290 UNTIL I=E
1295 STD=RESULT
1300 EXEC CONVDATE(STARTPER$,RESULT)
1310 WHEN G
1320 REPEAT
1330 EXEC DATOCHECK(L$,I)
1340 IF I=B THEN EXEC INLINE(OPL)
1350 UNTIL I=E
1355 SLD=RESULT
1360 EXEC CONVDATE(SLUTPER$,RESULT)
1370 WHEN V
1380 WHILE L$<"1" OR L$>"4"
1390 EXEC INLINE(OPL)
1400 ENDWHILE
1410 KVT$=L$
1460 WHEN 4
1470 Å$=L$
1540 WHEN 5
1550 WHILE L$<"1" OR L$>"7"
1560 EXEC INLINE(OPL)
1570 ENDWHILE
1580 LP$=L$
1870 ENDCASE
1880 ENDPROC
1890 PROC INDVIRK
1900 OPEN FIL$,R
1910 EXEC FEJL(B,B,FIL$)
1920 GET FIL$,E:POST3$
1930 GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM
1935 GET FIL$,V:DAD$
1940 ENDPROC
1950 PROC FEJL(P1,P2,P3)
1960 IF STATUS(P3$)<>B THEN
1970 OUTPUT T
1980 PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2
1990 STOP
2000 ENDIF
2010 ENDPROC
2020 PROC INLINE(N)
2030 REPEAT
2040 CURSOR X(N),Y(N)
2050 INPUT "",L$
2060 IF TYPE(N)<B THEN
2070 IF LEN(L$)<=ABS(TYPE(N)) THEN
2080 OK=E
2090 FOR I=LEN(L$)+E TO ABS(TYPE(N))
2100 L$(I)=" "
2110 NEXT I
2120 ELSE
2130 OK=B
2140 ENDIF
2150 ELSE
2160 EXEC CHECK(L$,OK)
2170 IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B
2180 ENDIF
2190 UNTIL OK<>B
2200 ENDPROC
2210 PROC SKRIVPICT
2220 CLEAR
2230 PRINT TAB(11);"Arbejderlønstatistik"
2240 PRINT " Lønperioden"
2250 PRINT " Kvartal 1,2,3 eller 4"
2260 PRINT " Årstal";TAB(36);"19"
2270 PRINT " Lønperiodekode 1,2,3,4,5,6 eller 7"
2420 ENDPROC
2600 PROC CONVDATE(NR1,OK1)
2610 OK11=OK1;NR1$=""
2620 FOR I=8 TO E STEP -E
2630 IF I MOD V=B THEN
2640 NR1$(I)="-"
2650 ELSE
2660 NR1$(I)=CHR(OK11 MOD 10+48)
2670 OK11=OK11 DIV 10
2680 ENDIF
2690 NEXT I
2700 ENDPROC
2970 PROC SKRIVBUND
2980 FOR I=E TO 13
2990 PRINT
3000 NEXT I
3030 EXEC CONV(RESUL$,C1,6)
3040 EXEC CONV(LIN$,C2,4)
3050 RESUL$=RESUL$+LIN$
3060 PRINT TAB(11);"LØNMODTAGER ";RESUL$;
3070 PRINT USING " ####":LMNR;
3080 PRINT TAB(44);"ARBEJDSGIVER ";POST3$(E,7)
3090 PRINT
3100 PRINT
3110 PRINT TAB(13);POST1$(E,25);TAB(46);POST3$(8,32)
3120 PRINT
3130 PRINT TAB(46);POST3$(33,55)
3140 PRINT TAB(46);POST4$(E,4);" ";
3150 PRINT POST4$(5,18)
3160 FOR I=E TO 7
3170 PRINT
3180 NEXT I
3230 ENDPROC
3440 PROC NÆSTE
3450 REPEAT
3460 LMNR=LMNR+E
3470 LA=E
3480 IF LMNR<=MLMNR THEN
3490 EXEC INLØNMOD(LMNR)
3500 IF LP$<>POST2$(21) THEN LA=B
3510 IF POST2$(24,25)>"79" THEN LA=B
3530 ENDIF
3540 UNTIL LA>B
3550 ENDPROC
3560 PROC SKRIVHOVED
3562 PRINT
3564 SIDE=SIDE+E
3566 PRINT USING " SIDE ###":SIDE;
3567 PRINT "     UDSKRIFTSDATO ";DAD$;
3568 PRINT TAB(49);"LØNPERIODEN ";STARTPER$;" / ";SLUTPER$;
3570 PRINT TAB(20);"ARBEJDERLØNSTATISTIK FOR ";KVT$;". KVARTAL 19";Å$
3572 PRINT TAB(20);"****************************************"
3574 PRINT
3590 IF STD>LA THEN
3600 STDA=STD
3610 ELSE
3620 STDA=LA
3630 ENDIF
3640 IF SLD<FD OR FD=B THEN
3650 SLDA=SLD
3660 ELSE
3670 SLDA=FD
3680 ENDIF
3910 EXEC CONVDATE(RESUL1$,STDA)
3920 PRINT " ANSAT FRA ";RESUL1$;" TIL ";
3930 EXEC CONVDATE(RESUL1$,SLDA)
3940 PRINT RESUL1$;" OR-KODE ";POST2$(24,25);" FAGGR-KODE";FG;" "
3950 PRINT
3960 PRINT TAB(16);"LØNDELE";TAB(39);"TV";TAB(47);"TIMER";TAB(59);"BELØB"
3970 ENDPROC
8190 FIL$="P641220:VIRKKART"
8200 EXEC INDVIRK
8210 CLOSE FIL$
8220 FIL$="P641220:LØNMODRG"
8230 OPEN FIL$,R
8260 FIL2$="P641220:TÆLLEREG"
8270 OPEN FIL2$,W
8300 EXEC SKRIVPICT
8310 FOR J=E TO 5
8330 EXEC INOPL(J)
8340 NEXT J
8350 SIDE=B
8360 LMNR=B
8370 L$=BL$
8380 OUTPUT P
8390 REPEAT
8400 EXEC NÆSTE
8420 IF LMNR<=MLMNR THEN
8425 EXEC INDTÆL
8427 EXEC SKRIVHOVED
8430 EXEC CALC(B,TV$(G),TV$(4),TV006$)
8435 EXEC CALC(V,TV$(E),TV006$,LIN$)
8440 EXEC CALC(G,TV$(G),LIN$,FELT12$)
8441 EXEC CALC(E,TV$(E),FELT12$,LIN$)
8442 EXEC CALC(B,TV$(V),FELT12$,FELT12$)
8450 EXEC CALC(B,TV$(5),LIN$,FELT15$)
8455 EXEC CALC(B,TV$(11),TV$(12),FELT26$)
8460 EXEC CALC(B,TV$(14),FELT26$,FELT26$)
8465 EXEC CALC(B,TV$(15),FELT26$,FELT26$)
8470 EXEC CALC(G,TV$(G),HUND$,FELT29$)
8475 EXEC CALC(V,FELT29$,TV006$,FELT29$)
8480 EXEC CALC(G,TV$(6),HUND$,FELT30$)
8485 EXEC CALC(V,FELT30$,TV006$,FELT30$)
8490 EXEC CALC(V,FELT12$,TV$(G),FELT31$)
8495 EXEC CALC(V,FELT15$,TV$(4),FELT32$)
8500 EXEC CALC(B,FELT12$,FELT15$,FELT33$)
8505 EXEC CALC(V,FELT33$,TV006$,FELT33$)
8510 EXEC CALC(V,TV$(7),TV006$,FELT34$)
8515 EXEC CALC(V,TV$(8),TV006$,FELT35$)
8520 EXEC CALC(V,TV$(W),TV006$,FELT36$)
8521 EXEC CALC(4,TV$(13),TAH$,TAH$)
8522 IF SI=B AND POST2$(26)="2" THEN TV$(13)="            "
8525 FOR I=E TO 15
8530 IF TV$(I,11)="+" THEN TV$(I,11)=" "
8535 NEXT I
8537 IF TV006$(12)="+" THEN TV006$(12)=" "
8540 IF FELT12$(12)="+" THEN FELT12$(12)=" "
8545 IF FELT15$(12)="+" THEN FELT15$(12)=" "
8550 IF FELT26$(12)="+" THEN FELT26$(12)=" "
8555 IF FELT29$(12)="+" THEN FELT29$(12)=" "
8560 IF FELT30$(12)="+" THEN FELT30$(12)=" "
8565 IF FELT31$(12)="+" THEN FELT31$(12)=" "
8570 IF FELT32$(12)="+" THEN FELT32$(12)=" "
8575 IF FELT33$(12)="+" THEN FELT33$(12)=" "
8580 IF FELT34$(12)="+" THEN FELT34$(12)=" "
8585 IF FELT35$(12)="+" THEN FELT35$(12)=" "
8590 IF FELT36$(12)="+" THEN FELT36$(12)=" "
8595 PRINT TAB(16);"AKKORDTIMER";TAB(38);"002 ";TV$(G)
8600 PRINT
8605 PRINT TAB(G);TV$(V);TAB(16);"AKKORDBELØB";TAB(38);"003";TAB(53);FELT12$
8610 PRINT
8615 PRINT TAB(16);"TIDLØNSTIMER";TAB(38);"004 ";TV$(4)
8620 PRINT
8625 PRINT TAB(G);TV$(5);TAB(16);"TIDLØNSBELØB";TAB(38);"005";TAB(53);FELT15$
8630 PRINT
8635 PRINT TAB(16);"TIMER IALT";TAB(38);"006";TV006$
8640 PRINT
8645 PRINT TAB(16);"HERAF OVERTIMER";TAB(38);"007 ";TV$(6)
8650 PRINT
8655 PRINT TAB(16);"OVERTIDSTILLÆG";TAB(38);"008";TAB(54);TV$(7)
8660 PRINT
8665 PRINT TAB(16);"HOLDDRIFTSTILLÆG";TAB(38);"009";TAB(54);TV$(8)
8670 PRINT
8675 PRINT TAB(16);"GENETILLÆG";TAB(38);"010";TAB(54);TV$(W)
8680 PRINT
8685 PRINT TAB(16);"DIV U F ARBEJDST";TAB(38);"011";TAB(54);TV$(10)
8690 PRINT
8695 PRINT TAB(16);"FERIEBERETT LØN";TAB(38);"012";TAB(54);TV$(11)
8700 PRINT
8705 PRINT TAB(16);"SYGEFERIEPENGE";TAB(38);"013";TAB(54);TV$(12)
8710 PRINT
8715 PRINT TAB(16);"BEREGNEDE FERIEP";TAB(38);"015";TAB(54);TV$(14)
8720 PRINT
8725 PRINT TAB(16);"SH-OPSPARING";TAB(38);"016";TAB(54);TV$(15)
8730 PRINT
8735 PRINT TAB(16);"***";TAB(53);FELT26$
8740 PRINT
8741 PRINT TAB(16);"SYGEDAGPENGE";TAB(38);"014";TAB(54);TV$(13)
8742 PRINT
8745 PRINT TAB(G);TV$(E);TAB(16);"TILLÆG TIL FORDELING";TAB(38);"001"
8750 PRINT
8755 PRINT TAB(6);"------%------  ---------------------GENNEMSNIT";
8760 PRINT "----------------------"
8765 PRINT TAB(5);"AKKORD   OVERT   AKKORD   TIDLØN  TILSAMM  OVERTID";
8770 PRINT "   HOLDDR    GENE"
8775 PRINT TAB(5);FELT29$(6,12);FELT30$(5,12);FELT31$(4,12);FELT32$(4,12);
8780 PRINT FELT33$(4,12);FELT34$(4,12);FELT35$(4,12);FELT36$(4,12)
8820 EXEC SKRIVBUND
8840 EXEC UDTÆL
8850 ENDIF
8860 UNTIL LMNR=>MLMNR
8870 CLOSE
8880 OUTPUT T
8890 CHAIN "P641210:STARTB"