DataMuseum.dk

Presents historical artifacts from the history of:

MIKADOS

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about MIKADOS

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦b229e26dc⟧ SPC/1-COMAL-BIN

    Length: 3577 (0xdf9)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »LFRADRAG.B«

Derivation

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »LFRADRAG.B« 

SPC/1 COMAL-BIN

0200 PROC INDVIRK
0210 OPEN FIL$,R
0220 EXEC FEJL(B,B,FIL$)
0230 GET FIL$,V:DAD$
0240 CLOSE FIL$
0250 ENDPROC
0900 PROC INLØNMOD(N)
0902 GET FIL1$,G*N-E:POST1$
0904 GET FIL1$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
0906 EXEC FEJL(E,N,FIL1$)
0908 ENDPROC
1000 DIM STARTPER$(8),SLUTPER$(8),DAD$(6),FIL$(20)
1010 DIM RES$(15),OP1$(12),OP2$(12),TAH$(12)
1020 DIM TOTAL$(7,12),FIL1$(16),POST1$(71),POST2$(27)
1030 DIM RESUL$(12),RESUL1$(12),MF41$(50),MF42$(50),TOTAL1$(5,12)
1050 DIM MF4$(16)
1060 TAH$="          0+"
1070 DIM BL$(79)
1080 FOR I=E TO 79
1090 BL$=BL$+" "
1100 NEXT I
1110 PROC CALC(AR3,B1,B2,ES)
1120 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
1130 CALL "P641210:REGN"
1140 IF AR3<6 THEN
1150 IF FLAG THEN STOP
1160 ENDIF
1170 ES$=RES$
1180 ENDPROC
1390 PROC SKRIVHOVED
1400 PRINT
1410 SIDE=SIDE+E
1420 PRINT USING " SIDE ###":SIDE;
1425 PRINT "     UDSKRIFTSDATO ";DAD$;
1430 PRINT TAB(49);"LØNPERIODEN ";STARTPER$;" / ";SLUTPER$;
1440 LINIE=7
1450 PRINT TAB(34);"FRADRAGSLISTE"
1460 PRINT TAB(34);"*************"
1470 PRINT " LØN  NAVN";TAB(37);"LA";TAB(45);"LA";TAB(53);"LA";TAB(61);"LA";
1480 PRINT TAB(69);"LA";TAB(75);"IALT"
1490 PRINT " NR";TAB(37);"60";TAB(45);"61";TAB(53);"62";TAB(61);"63";TAB(69);
1500 PRINT "64"
1501 PRINT TAB(37);"65";TAB(45);"66";TAB(53);"67";TAB(61);"68";TAB(69);
1502 PRINT "69"
1510 ENDPROC
1580 PROC FEJL(P1,P2,P3)
1590 IF STATUS(P3$)<>B THEN
1600 OUTPUT T
1610 PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2
1620 STOP
1630 ENDIF
1640 ENDPROC
1650 FIL$="P641220:VIRKKART"
1660 EXEC INDVIRK
1675 FIL1$="P641220:LØNMODRG"
1680 OPEN FIL1$,R
1710 MF4$="P641210:FRADRAG"
1720 OPEN MF4$,R
1730 MAXLIN=72
1740 SIDE=B
1750 GET MF4$:STARTPER$,SLUTPER$
1760 OUTPUT P
1770 FOR I=E TO 7
1780 TOTAL$(I)=TAH$
1790 NEXT I
1800 EXEC SKRIVHOVED
1810 GET MF4$:LMNR,MF41$
1820 WHILE STATUS(MF4$)=B
1822 GET MF4$:LMNR,MF42$
1825 EXEC INLØNMOD(LMNR)
1840 IF LINIE>MAXLIN-W THEN
1850 WHILE LINIE<MAXLIN
1860 PRINT
1870 LINIE=LINIE+E
1880 ENDWHILE
1890 EXEC SKRIVHOVED
1910 ENDIF
1915 LINIE=LINIE+5
1920 TOTAL$(7)=TAH$
1930 FOR I=E TO 5
1940 RESUL$=MF41$(E+(I-E)*10:10)
1945 EXEC CALC(B,RESUL$,TOTAL$(7),TOTAL$(7))
1950 EXEC CALC(B,RESUL$,TOTAL$(I),TOTAL$(I))
1960 IF MF41$(I*10)="+" THEN MF41$(I*10)=" "
1962 RESUL$=MF42$(E+(I-E)*10:10)
1964 EXEC CALC(B,RESUL$,TOTAL1$(I),TOTAL1$(I))
1966 EXEC CALC(B,RESUL$,TOTAL$(7),TOTAL$(7))
1968 IF MF42$(I*10)="+" THEN MF42$(I*10)=" "
1970 NEXT I
1980 EXEC CALC(B,TOTAL$(7),TOTAL$(6),TOTAL$(6))
1990 RESUL1$=TOTAL$(7,V:10)
2000 IF RESUL1$(10)="+" THEN RESUL1$(10)=" "
2030 PRINT USING "####":LMNR;
2035 PRINT TAB(7);POST1$(E,25);
2040 PRINT TAB(38);MF41$(E,10);TAB(54);MF41$(11,20);TAB(70);RESUL1$;
2050 PRINT TAB(30);MF41$(21,30);TAB(46);MF41$(31,40);TAB(62);MF41$(41,50)
2055 PRINT TAB(38);MF42$(11,20);TAB(54);MF42$(31,40)
2060 PRINT TAB(30);MF42$(E,10);TAB(46);MF42$(21,30);TAB(62);MF42$(41,50)
2075 PRINT "************************************************************";
2076 PRINT "*******************";
2080 GET MF4$:LMNR,MF41$
2090 ENDWHILE
2095 IF STATUS(MF4$)<>19 THEN EXEC FEJL(LMNR,B,MF4$)
2100 FOR I=E TO 6
2110 IF TOTAL$(I,12)="+" THEN TOTAL$(I,12)=" "
2112 IF I<6 THEN
2114 IF TOTAL1$(I,12)="+" THEN TOTAL1$(I,12)=" "
2115 ENDIF
2120 NEXT I
2130 PRINT " ***";TAB(36);TOTAL$(E);TAB(52);TOTAL$(G);TAB(68);TOTAL$(6);
2132 PRINT TAB(28);TOTAL$(V);TAB(44);TOTAL$(4);TAB(60);TOTAL$(5)
2134 PRINT TAB(36);TOTAL1$(G);TAB(52);TOTAL1$(4)
2136 PRINT TAB(28);TOTAL1$(E);TAB(44);TOTAL1$(V);TAB(60);TOTAL1$(5)
2141 LINIE=LINIE+4
2142 WHILE LINIE<MAXLIN
2144 PRINT
2146 LINIE=LINIE+E
2148 ENDWHILE
2149 OUTPUT T
2150 CLOSE
2160 CHAIN "P641210:LBILAG"

Full view