DataMuseum.dk

top - download

    Length: 7540 (0x1d74)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »TV3.B«

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

SPC/1 COMAL-BIN

0100 DIM RES$(15),OP1$(12),OP2$(12),TAH$(12),BLB3$(15),DAD$(6)
0110 DIM RESUL$(12),RESUL1$(12),TVN(45),TV$(45,11),POST5$(55),PR$(14)
0120 DIM FIL$(20),FIL2$(20),POST1$(71),POST2$(27),POST3$(55),POST4$(34)
0130 TAH$="          0+"
0140 PROC TUD(BLB4,UBLB2,TEGN2,STØR2)
0150 BLB3$=BLB4$
0160 EXEC CALC(5,BLB3$,TAH$,UBLB2$)
0170 IF TEGN2=B THEN UBLB2$=UBLB2$(E:13)
0180 IF TEGN2=E AND UBLB2$(LEN(UBLB2$))="+" THEN UBLB2$(LEN(UBLB2$))=" "
0190 IF STØR2=E THEN UBLB2$=UBLB2$(4:LEN(UBLB2$)-V)
0200 ENDPROC
0210 PROC CALC(AR3,B1,B2,ES)
0220 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0230 CALL "P641210:REGN"
0240 IF AR3<6 THEN
0250 IF FLAG THEN STOP
0260 ENDIF
0270 ES$=RES$
0280 ENDPROC
0290 FIL$="P641220:VIRKKART"
0300 EXEC INDVIRK
0310 CLOSE FIL$
0320 FIL$="P641220:LØNMODRG"
0330 FIL2$="P641220:TÆLLEREG"
0340 OPEN FIL$,R
0350 EXEC FEJL(B,B,FIL$)
0360 OPEN FIL2$,W
0370 EXEC FEJL(B,B,FIL2$)
0380 PROC UDTÆL(N)
0390 J=W*(N-E)
0400 FOR K=6 TO W
0410 FOR I=E TO 5
0420 POST5$((I-E)*11+E:11)=TV$((K-E)*5+I)
0430 NEXT I
0440 PUT FIL2$,J+K:POST5$
0450 NEXT K
0460 EXEC FEJL(-N,-K,FIL2$)
0470 ENDPROC
0480 TVN(E)=E
0490 TVN(G)=G
0500 TVN(V)=V
0510 TVN(4)=4
0520 TVN(5)=5
0530 TVN(6)=7
0540 TVN(7)=8
0550 TVN(8)=W
0560 TVN(W)=10
0570 TVN(10)=11
0580 TVN(11)=12
0590 TVN(12)=13
0600 TVN(13)=14
0610 TVN(14)=15
0620 TVN(15)=16
0630 TVN(16)=112
0640 TVN(17)=113
0650 TVN(18)=313
0660 TVN(19)=413
0670 TVN(20)=115
0680 TVN(21)=315
0690 TVN(22)=415
0700 TVN(23)=116
0710 TVN(24)=316
0720 TVN(25)=416
0730 TVN(26)=117
0740 TVN(27)=317
0750 TVN(28)=417
0760 TVN(29)=123
0770 TVN(30)=206
0780 TVN(31)=212
0790 TVN(32)=214
0800 TVN(33)=218
0810 TVN(34)=219
0820 TVN(35)=319
0830 TVN(36)=419
0840 TVN(37)=220
0850 TVN(38)=320
0860 TVN(39)=420
0870 TVN(40)=221
0880 TVN(41)=321
0890 TVN(42)=421
0900 TVN(43)=222
0910 TVN(44)=223
0920 TVN(45)=224
0930 PROC CONV(NR2,OK22,CIF)
0940 OK2=OK22
0950 NR2$=""
0960 REPEAT
0970 NR2$=CHR((OK2 MOD 10)+48)+NR2$
0980 CIF=CIF-E
0990 OK2=OK2 DIV 10
1000 IF CIF<B AND OK2=B THEN CIF=B
1010 UNTIL CIF=B
1020 ENDPROC
1030 PROC CHECK(NR1,OK1)
1040 OK1=B
1050 RESULT=B
1060 IF LEN(NR1$)>B THEN
1070 IF NR1$(E)="-" THEN
1080 FORTEGN=-E
1090 OK1=E
1100 ELSE
1110 FORTEGN=E
1120 ENDIF
1130 WHILE LEN(NR1$)>OK1
1140 OK1=OK1+E
1150 IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN
1160 FORTEGN=B
1170 OK1=LEN(NR1$)
1180 ENDIF
1190 RESULT=RESULT*10+ORD(NR1$(OK1))-48
1200 ENDWHILE
1210 OK1=OK1*FORTEGN
1220 IF OK1<B THEN OK1=OK1+E
1230 ENDIF
1240 ENDPROC
1250 PROC INOPL(OPL)
1260 EXEC INLINE(OPL)
1270 CASE OPL OF
1280 WHEN E
1290 LMNR=RESULT
1300 WHEN V,4,5,6,7,8,W,10,11,12
1310 REPEAT
1320 LINE$=LINE$+"+"
1330 EXEC CALC(6,LINE$,TAH$,RESUL$)
1340 IF FLAG<>B THEN EXEC INLINE(OPL)
1350 UNTIL FLAG=B
1355 EXEC CALC(B,LINE$,TAH$,RESUL$)
1360 CASE OPL OF
1362 WHEN V,4,5,6,10,11,12
1364 IF OPL<7 THEN
1366 T=27+OPL
1368 ELSE
1370 T=33+OPL
1372 ENDIF
1374 WHEN 7,8,W
1376 T=OPL*V+13
1378 PR$=TV$(T)
1380 LINE$=TV$(T+E)
1382 EXEC CALC(B,PR$,LINE$,RESUL1$)
1384 TV$(T+E)=RESUL1$(G:11)
1386 LINE$=TV$(T+G)
1388 EXEC CALC(B,RESUL$,LINE$,RESUL1$)
1390 TV$(T+G)=RESUL1$(G:11)
1392 ENDCASE
1410 TV$(T)=RESUL$(G:11)
1430 ENDCASE
1440 ENDPROC
1450 PROC SKRIVOPL
1460 IF OUTP=B THEN CLEAR
1470 PRINT "L Ø N M O D T A G E R K A R T O T E K - T Æ L L E V Æ R K E R"
1480 PRINT "Å R S - O P G Ø R E L S E";TAB(60);"Dato ";DAD$
1490 FOR J=E TO A
1500 CASE J OF
1510 WHEN E
1520 EXEC CONV(LINE$,LMNR,0)
1530 WHEN G
1540 LINE$=POST1$(E,25)
1550 WHEN V,4,5,6,7,8,W,10,11,12
1560 IF J<7 THEN
1570 T=27+J
1580 ELSE
1582 IF J>W THEN
1584 T=33+J
1586 ELSE
1588 T=V*J+13
1590 ENDIF
1600 ENDIF
1610 RESUL$=TV$(T)
1620 EXEC TUD(RESUL$,PR$,E,B)
1630 LINE$=PR$
1700 ENDCASE
1710 IF OUTP=B THEN
1720 EXEC OUTLINE(J)
1730 ELSE
1740 EXEC OUTPLINE(J)
1750 ENDIF
1760 NEXT J
1770 ENDPROC
1780 PROC OUTLINE(N)
1790 CURSOR X(N),Y(N)
1800 PRINT USING "### ":N;
1810 IF N=G THEN
1820 PRINT PICT$(N);":";LINE$
1830 PRINT TAB(6);"TV TEKST";TAB(38);"INDHOLD"
1840 ELSE
1850 IF N>G THEN
1860 IF N<7 THEN
1870 T=27+N
1880 ELSE
1882 IF N>W THEN
1884 T=33+N
1886 ELSE
1888 T=V*N+13
1890 ENDIF
1900 ENDIF
1910 EXEC CONV(RESUL$,TVN(T),3)
1920 PRINT RESUL$;" ";PICT$(N);":";TAB(32);LINE$
1930 ELSE
1940 PRINT PICT$(N);": ";LINE$
1945 ENDIF
1950 ENDIF
1960 ENDPROC
1970 PROC FEJL(P1,P2,P3)
1980 IF STATUS(P3$)<>B THEN
1990 OUTPUT T
2000 PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2
2010 STOP
2020 ENDIF
2030 ENDPROC
2040 PROC INLINE(N)
2050 REPEAT
2060 CURSOR 32,Y(N)
2070 PRINT BL$(E:ABS(TYPE(N))+6)
2080 CURSOR X(N),Y(N)
2090 PRINT USING "### ":N;
2100 IF N>G THEN
2110 IF N<7 THEN
2120 T=27+N
2130 ELSE
2132 IF N>W THEN
2134 T=33+N
2136 ELSE
2138 T=V*N+13
2140 ENDIF
2150 ENDIF
2160 EXEC CONV(RESUL$,TVN(T),3)
2170 PRINT RESUL$;" ";PICT$(N);":";
2175 CURSOR 32,Y(N)
2180 ELSE
2190 PRINT PICT$(N);": ";
2200 ENDIF
2210 INPUT "",LINE$
2220 IF TYPE(N)<B THEN
2230 IF LEN(LINE$)<=ABS(TYPE(N)) THEN
2240 OK=E
2250 ELSE
2260 OK=B
2270 ENDIF
2280 ELSE
2290 EXEC CHECK(LINE$,OK)
2300 IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B
2310 ENDIF
2320 UNTIL OK<>B
2330 ENDPROC
2340 PROC OUTPLINE(N)
2350 PRINT TAB(X(N));
2360 PRINT USING "### ":N;
2370 IF N=G THEN
2380 PRINT PICT$(N);":";LINE$
2390 PRINT TAB(6);"TV TEKST";TAB(38);"INDHOLD"
2400 ELSE
2410 IF N>G THEN
2420 IF N<7 THEN
2430 T=27+N
2440 ELSE
2442 IF N>W THEN
2444 T=33+N
2446 ELSE
2448 T=V*N+13
2450 ENDIF
2460 ENDIF
2470 EXEC CONV(RESUL$,TVN(T),3)
2480 PRINT RESUL$;" ";PICT$(N);":";TAB(32);LINE$
2490 ELSE
2500 PRINT PICT$(N);": ";LINE$;
2505 ENDIF
2510 ENDIF
2520 ENDPROC
2530 A=12
2540 DIM X(A),Y(A),PICT$(A,20),TYPE(A)
2550 DIM BL$(79),LINE$(30)
2560 FOR I=E TO 79
2570 BL$=BL$+" "
2580 NEXT I
2590 X(E)=E
2600 X(G)=36
2610 FOR I=V TO A
2620 X(I)=E
2630 Y(I)=I+G
2640 TYPE(I)=-11
2650 NEXT I
2660 Y(E)=V
2670 Y(G)=V
2680 TYPE(E)=B
2690 TYPE(G)=B
2700 PICT$(E)="Lønnr"
2710 PICT$(G)="Navn"
2760 PICT$(V)="Timer ialt"
2770 PICT$(4)="Ferieberett løn"
2830 PICT$(5)="Sygedagpenge"
2840 PICT$(6)="Ferietillæg"
2860 PICT$(7)="Trækpligtig A-indk"
2870 PICT$(8)="Trækfri A-indk"
2871 PICT$(W)="A-skat"
2872 PICT$(10)="ATP"
2873 PICT$(11)="Feriedage"
2874 PICT$(12)="Pensionsbidrag"
2880 OUTP=B
2890 PROC INDTÆL(N)
2900 J=W*(N-E)
2910 FOR K=6 TO W
2920 GET FIL2$,J+K:POST5$
2930 FOR I=E TO 5
2940 TV$((K-E)*5+I)=POST5$((I-E)*11+E:11)
2950 NEXT I
2960 NEXT K
2970 EXEC FEJL(N,K,FIL2$)
2980 ENDPROC
2990 PROC INLØNMOD(N)
3000 GET FIL$,G*N-E:POST1$
3010 GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
3020 EXEC FEJL(E,N,FIL$)
3030 ENDPROC
3040 PROC INDVIRK
3050 OPEN FIL$,W
3060 EXEC FEJL(B,B,FIL$)
3070 GET FIL$,E:POST3$
3080 GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM
3085 GET FIL$,V:DAD$
3090 ENDPROC
3100 REPEAT
3110 SV=G
3120 CLEAR
3130 CURSOR 10,10
3140 PRINT "L Ø N M O D T A G E R K A R T O T E K - T Æ L L E V Æ R K E R"
3150 PRINT "         Å R S - O P G Ø R E L S E"
3160 PRINT
3170 PRINT TAB(10);"0 Færdig"
3180 PRINT TAB(10);"1 Ændring"
3190 PRINT TAB(10);"2 Udskrift på skærm"
3200 PRINT TAB(10);"3 Udskrift på printer"
3210 PRINT
3220 REPEAT
3230 CURSOR E,18
3240 EDIT "          ",SV
3250 UNTIL SV=>B AND SV<=V
3260 IF SV>B THEN
3270 REPEAT
3280 EXEC INOPL(1)
3290 UNTIL LMNR=>B AND LMNR<=MLMNR
3291 LISTE=B
3292 IF LMNR=B THEN LISTE=E
3295 REPEAT
3296 IF LISTE=E THEN LMNR=LMNR+E
3300 EXEC INLØNMOD(LMNR)
3310 CASE SV OF
3320 WHEN E
3330 IF LA<>B THEN
3340 EXEC INDTÆL(LMNR)
3350 EXEC SKRIVOPL
3360 REPEAT
3370 REPEAT
3380 SV1=B
3390 CURSOR E,23
3400 EDIT "Feltnr ",SV1
3410 UNTIL SV1=B OR (SV1>G AND SV1<13)
3420 IF SV1>B THEN
3430 EXEC INOPL(SV1)
3440 ENDIF
3450 UNTIL SV1=B
3460 EXEC UDTÆL(LMNR)
3470 ELSE
3480 PRINT "Lønmodtager findes ikke"
3490 INPUT "RETURN",LINE$
3500 ENDIF
3510 WHEN G
3520 IF LA<>B THEN
3530 OUTP=B
3540 EXEC INDTÆL(LMNR)
3550 EXEC SKRIVOPL
3560 INPUT "RETURN",LINE$
3570 ELSE
3580 PRINT "Lønmodtager findes ikke"
3590 INPUT "RETURN",LINE$
3600 ENDIF
3610 WHEN V
3620 IF LA<>B OR LISTE=E THEN
3625 IF LA<>B THEN
3630 OUTPUT P
3640 OUTP=E
3650 EXEC INDTÆL(LMNR)
3660 EXEC SKRIVOPL
3662 FOR I=15 TO 72
3664 PRINT
3666 NEXT I
3670 OUTP=B
3680 OUTPUT T
3685 ENDIF
3690 ELSE
3700 PRINT "Lønmodtager findes ikke"
3710 INPUT "RETURN",LINE$
3720 ENDIF
3730 ENDCASE
3735 UNTIL LISTE=B OR LMNR=>MLMNR
3740 ENDIF
3750 UNTIL SV=B
3760 CLOSE FIL$
3770 CLOSE FIL2$
3780 CHAIN "P641210:STARTB"