DataMuseum.dk

top - download

    Length: 4984 (0x1378)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »AKKULIST.B«

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

SPC/1 COMAL-BIN

0100 DIM TVN(45)
0110 TVN(E)=E
0120 TVN(G)=G
0130 TVN(V)=V
0140 TVN(4)=4
0150 TVN(5)=5
0160 TVN(6)=7
0170 TVN(7)=8
0180 TVN(8)=W
0190 TVN(W)=10
0200 TVN(10)=11
0210 TVN(11)=12
0220 TVN(12)=13
0230 TVN(13)=14
0240 TVN(14)=15
0250 TVN(15)=16
0260 TVN(16)=112
0270 TVN(17)=113
0280 TVN(18)=313
0290 TVN(19)=413
0300 TVN(20)=115
0310 TVN(21)=315
0320 TVN(22)=415
0330 TVN(23)=116
0340 TVN(24)=316
0350 TVN(25)=416
0360 TVN(26)=117
0370 TVN(27)=317
0380 TVN(28)=417
0390 TVN(29)=123
0400 TVN(30)=206
0410 TVN(31)=212
0420 TVN(32)=214
0430 TVN(33)=218
0440 TVN(34)=219
0450 TVN(35)=319
0460 TVN(36)=419
0470 TVN(37)=220
0480 TVN(38)=320
0490 TVN(39)=420
0500 TVN(40)=221
0510 TVN(41)=321
0520 TVN(42)=421
0530 TVN(43)=222
0540 TVN(44)=223
0550 TVN(45)=224
0560 PROC INLØNMOD(N)
0570 GET FIL1$,G*N-E:POST1$
0580 GET FIL1$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
0590 EXEC FEJL(E,N,FIL1$)
0600 ENDPROC
0610 PROC NÆSTE
0620 REPEAT
0630 LMNR=LMNR+E
0640 LA=E
0650 IF LMNR<=MLMNR THEN EXEC INLØNMOD(LMNR)
0660 UNTIL LA>B
0670 ENDPROC
0680 DIM RES$(15),OP1$(12),OP2$(12),POST1$(71),POST2$(27),ARS$(G),POST6$(29)
0690 DIM FIL1$(16),FIL5$(16),FIL2$(16),POST3$(55),RESUL2$(12),TOT$(12)
0700 DIM RESUL$(12),RESUL1$(12),POST5$(55),TV$(45,11),DAD$(6)
0710 DIM FIL$(16)
0720 DIM EN$(12),BE$(12),POST4$(34)
0730 PROC CALC(AR3,B1,B2,ES)
0740 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0750 CALL "P641210:REGN"
0760 IF AR3<6 AND FLAG THEN STOP
0770 ES$=RES$
0780 ENDPROC
0790 PROC INDVIRK
0800 OPEN FIL$,R
0810 EXEC FEJL(B,B,FIL$)
0820 GET FIL$,E:POST3$
0830 GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM
0840 GET FIL$,V:DAD$
0850 ENDPROC
0860 PROC FEJL(P1,P2,P3)
0870 IF STATUS(P3$)<>B THEN
0880 OUTPUT T
0890 PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2
0900 STOP
0910 ENDIF
0920 ENDPROC
0930 DIM P7$(37)
0940 PROC INDART(N)
0950 GET FIL5$,N:POST6$,KT,FSHT,ÅT
0960 EXEC FEJL(G,N,FIL5$)
0970 ENDPROC
0980 PROC INDTÆL(N)
0990 IF N<>OLMNR THEN
1000 OLMNR=N
1010 J=W*(N-E)
1020 FOR K=E TO W
1030 GET FIL2$,J+K:POST5$
1040 FOR I=E TO 5
1050 TV$((K-E)*5+I)=POST5$((I-E)*11+E:11)
1060 NEXT I
1070 NEXT K
1080 EXEC FEJL(N,K,FIL2$)
1090 ENDIF
1100 ENDPROC
1110 PROC HEAD
1120 WHILE LINIE<72
1130 PRINT
1140 LINIE=LINIE+E
1150 ENDWHILE
1160 SID=SID+E
1170 PRINT
1180 PRINT POST3$(8,32);TAB(30);"S A L D O L I S T E";TAB(57);"Dato ";DAD$;
1190 PRINT "  Side";SID
1200 PRINT "LØNART";LANR;TAB(30);POST6$(G,21);TAB(52);
1210 CASE TYP OF
1220 WHEN 4
1230 PRINT "SALDOAKKUMULERENDE";
1240 WHEN V
1250 PRINT "ÅRS-TÆLLEVÆRK";TVN(ÅT);
1260 WHEN G
1270 PRINT "F-SH-TÆLLEVÆRK";TVN(FSHT);
1280 WHEN E
1290 PRINT "KVARTALS-TÆLLEVÆRK";TVN(KT);
1300 ENDCASE
1310 PRINT
1320 PRINT
1330 PRINT "LMNR   NAVN";TAB(39);"GL.SALDO       PERIODEN       NY SALDO"
1340 LINIE=6
1350 ENDPROC
1360 FIL$="P641220:VIRKKART"
1370 EXEC INDVIRK
1380 CLOSE FIL$
1390 FIL1$="P641220:LØNMODRG"
1400 OPEN FIL1$,R
1410 FIL$="P641220:TRANSREG"
1420 OPEN FIL$,R
1430 FIL2$="P641220:TÆLLEREG"
1440 OPEN FIL2$,R
1450 FIL5$="P641220:LØNARTRG"
1460 OPEN FIL5$,R
1470 REPEAT
1480 EN$="          0+"
1490 BE$=EN$;TOT$=EN$
1500 LINIE=72;SID=B
1510 OLMNR,LMNR=B
1520 REPEAT
1530 CLEAR
1540 PRINT "L I S T E   O V E R   A K K U M U L E R E D E   S A L D I"
1550 LANR=B
1560 EDIT "Lønart ,0 for færdig ",LANR
1570 LANR=INT(LANR)
1580 TYP=B
1590 IF LANR>B AND LANR<100 THEN
1600 EXEC INDART(LANR)
1610 IF KT<>B THEN TYP=E
1620 IF FSHT<>B THEN TYP=G
1630 IF ÅT<>B THEN TYP=V
1640 IF POST6$(26)="1" THEN TYP=4
1650 IF POST6$(29)<>" " OR POST6$(E)<>"1" THEN TYP=B
1660 ENDIF
1670 UNTIL TYP>B OR LANR=B
1680 REPEAT
1690 ALLE=G
1700 EDIT "Kun afregnede: 0, alle: 1 ",ALLE
1710 UNTIL ALLE=E OR ALLE=B
1720 IF LANR>B THEN
1730 ARS$=CHR(LANR DIV 10+48)+CHR(LANR MOD 10+48)
1740 OUTPUT P
1750 EXEC NÆSTE
1760 WHILE LMNR<=MLMNR
1770 IT=(LMNR-E)*ATPLM+E
1780 GET FIL$,IT:P7$
1790 IF P7$(E)="2" OR (ALLE=E AND P7$(E)="3") THEN
1800 WHILE P7$(V,4)<>"83"
1810 IF P7$(V,4)=ARS$ THEN
1820 IF LINIE>69 THEN EXEC HEAD
1830 IF TYP<4 THEN EXEC INDTÆL(LMNR)
1840 CASE TYP OF
1850 WHEN 4
1860 RESUL$=" "+P7$(11:10)
1870 WHEN V
1880 RESUL$=TV$(ÅT)
1890 WHEN G
1900 RESUL$=TV$(FSHT)
1910 WHEN E
1920 RESUL$=TV$(KT)
1930 ENDCASE
1940 RESUL1$=P7$(28:10)
1950 EXEC CALC(E,RESUL$,RESUL1$,RESUL2$)
1960 EXEC CALC(B,EN$,RESUL$,EN$)
1970 EXEC CALC(B,BE$,RESUL1$,BE$)
1980 EXEC CALC(B,TOT$,RESUL2$,TOT$)
1990 IF RESUL$(11)="+" THEN RESUL$(11)=" "
2000 IF RESUL1$(10)="+" THEN RESUL1$(10)=" "
2010 IF RESUL2$(12)="+" THEN RESUL2$(12)=" "
2020 PRINT LMNR;TAB(8);POST1$(E,25);"   ";RESUL2$;"     ";RESUL1$;
2030 PRINT "    ";RESUL$
2040 LINIE=LINIE+E
2050 ENDIF
2060 IT=IT+E
2070 GET FIL$,IT:P7$
2080 ENDWHILE
2090 ENDIF
2100 EXEC NÆSTE
2110 ENDWHILE
2120 IF LINIE<72 THEN
2130 PRINT "--------------------------------------------------------------";
2140 PRINT "--------------"
2150 IF TOT$(12)="+" THEN TOT$(12)=" "
2160 IF BE$(12)="+" THEN BE$(12)=" "
2170 IF EN$(12)="+" THEN EN$(12)=" "
2180 PRINT "Total";TAB(36);TOT$;"   ";BE$;"   ";EN$
2190 LINIE=LINIE+G
2200 WHILE LINIE<72 AND LINIE>B
2210 PRINT
2220 LINIE=LINIE+E
2230 ENDWHILE
2240 ENDIF
2250 OUTPUT T
2260 ENDIF
2270 UNTIL LANR=B
2280 CHAIN "P641210:STARTB"