DataMuseum.dk

top - download

    Length: 7119 (0x1bcf)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »LØNARTVD.B«

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

SPC/1 COMAL-BIN

0009 DIM POST6$(29),FIL5$(20),TVN(45)
0011 TVN(E)=E
0012 TVN(G)=G
0013 TVN(V)=V
0014 TVN(4)=4
0015 TVN(5)=5
0016 TVN(6)=7
0017 TVN(7)=8
0018 TVN(8)=W
0019 TVN(W)=10
0020 TVN(10)=11
0021 TVN(11)=12
0022 TVN(12)=13
0023 TVN(13)=14
0024 TVN(14)=15
0025 TVN(15)=16
0026 TVN(16)=112
0027 TVN(17)=113
0028 TVN(18)=313
0029 TVN(19)=413
0030 TVN(20)=115
0031 TVN(21)=315
0032 TVN(22)=415
0033 TVN(23)=116
0034 TVN(24)=316
0035 TVN(25)=416
0036 TVN(26)=117
0037 TVN(27)=317
0038 TVN(28)=417
0039 TVN(29)=123
0040 TVN(30)=206
0041 TVN(31)=212
0042 TVN(32)=214
0043 TVN(33)=218
0044 TVN(34)=219
0045 TVN(35)=319
0046 TVN(36)=419
0047 TVN(37)=220
0048 TVN(38)=320
0049 TVN(39)=420
0050 TVN(40)=221
0051 TVN(41)=321
0052 TVN(42)=421
0053 TVN(43)=222
0054 TVN(44)=223
0055 TVN(45)=224
0199 DIM FIL$(20),DAD$(6)
0200 PROC INDVIRK
0205 FIL$="P641220:VIRKKART"
0210 OPEN FIL$,R
0220 EXEC FEJL(B,B,FIL$)
0245 GET FIL$,V:DAD$
0247 CLOSE FIL$
0250 ENDPROC
1000 PROC CONV(NR2,OK22,CIF)
1015 OK2=OK22
1030 NR2$=""
1045 REPEAT
1060 NR2$=CHR((OK2 MOD 10)+48)+NR2$
1075 CIF=CIF-E
1090 OK2=OK2 DIV 10
1105 IF CIF<B AND OK2=B THEN CIF=B
1120 UNTIL CIF=B
1135 ENDPROC
1150 PROC CHECK(NR1,OK1)
1165 OK1=B
1180 RESULT=B
1195 IF LEN(NR1$)>B THEN
1210 IF NR1$(E)="-" THEN
1225 FORTEGN=-E
1240 OK1=E
1255 ELSE
1270 FORTEGN=E
1285 ENDIF
1300 WHILE LEN(NR1$)>OK1
1315 OK1=OK1+E
1330 IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN
1345 FORTEGN=B
1360 OK1=LEN(NR1$)
1375 ENDIF
1390 RESULT=RESULT*10+ORD(NR1$(OK1))-48
1405 ENDWHILE
1420 OK1=OK1*FORTEGN
1435 IF OK1<B THEN OK1=OK1+E
1450 ENDIF
1465 ENDPROC
1480 PROC INOPL(OPL)
1495 EXEC INLINE(OPL)
1510 CASE OPL OF
1525 WHEN E
1540 LANR=RESULT
1555 WHEN G
1556 WHILE LINE$(E)=" "
1557 EXEC INLINE(OPL)
1558 ENDWHILE
1559 POST6$(E)="1"
1570 POST6$(G,21)=LINE$
1585 WHEN V
1600 WHILE RESULT<E OR RESULT=6 OR RESULT>11
1601 EXEC INLINE(OPL)
1602 ENDWHILE
1610 KT=RESULT-(RESULT>6)
1620 ÅT=B
2950 ENDCASE
2965 ENDPROC
2980 PROC SKRIVOPL
2995 IF OUTP=B THEN CLEAR
2998 PRINT "L Ø N A R T S - K A R T O T E K";TAB(60);"Dato ";DAD$
3010 FOR J=E TO A
3025 CASE J OF
3040 WHEN E
3055 EXEC CONV(LINE$,LANR,2)
3056 LINE$=POST6$(29)+LINE$
3070 WHEN G
3085 LINE$=POST6$(G,21)
3100 WHEN V
3101 IF KT=B THEN
3102 TV=B
3103 ELSE
3104 TV=TVN(KT)
3105 ENDIF
3115 EXEC CONV(LINE$,TV,3)
3130 WHEN 4
3131 IF FSHT=B THEN
3132 TV=B
3133 ELSE
3134 TV=TVN(FSHT)
3135 ENDIF
3145 EXEC CONV(LINE$,TV,3)
3160 WHEN 5
3161 IF ÅT=B THEN
3162 TV=B
3163 ELSE
3164 TV=TVN(ÅT)
3165 ENDIF
3175 EXEC CONV(LINE$,TV,3)
3190 WHEN 6,7,8,W,10,11,12
3205 IF POST6$(16+J)="0" THEN
3220 LINE$="NEJ"
3235 ELSE
3250 LINE$=" JA"
3265 ENDIF
3730 ENDCASE
3745 IF OUTP=B THEN
3760 EXEC OUTLINE(J)
3775 ELSE
3790 EXEC OUTPLINE(J)
3805 ENDIF
3820 NEXT J
3835 ENDPROC
3850 PROC OUTLINE(N)
3865 CURSOR X(N),Y(N)
3880 IF N<4 THEN
3881 PRINT USING "### ":N;
3882 ELSE
3883 IF N>5 THEN PRINT "    ";
3884 ENDIF
3890 IF N>V AND N<6 THEN
3895 PRINT PICT$(N);":";LINE$
3896 ELSE
3897 PRINT PICT$(N);":";TAB(25);LINE$
3898 ENDIF
3910 ENDPROC
3925 PROC INDART(N)
3927 GET FIL5$,N:POST6$,KT,FSHT,ÅT
3929 EXEC FEJL(G,N,FIL5$)
3931 ENDPROC
3933 PROC UDART(N)
3935 PUT FIL5$,N:POST6$,KT,FSHT,ÅT
3937 EXEC FEJL(E,N,FIL5$)
3939 ENDPROC
3941 PROC CH(N)
3943 OKAY=B
3945 IF N<40 THEN OKAY=E
3947 IF N>42 AND N<49 THEN OKAY=E
3949 IF N>50 AND N<57 THEN OKAY=E
3951 IF N>57 AND N<60 THEN OKAY=E
3953 IF N>60 AND N<65 THEN OKAY=E
3955 IF N<40 THEN
3957 SF=V
3959 ELSE
3961 SF=G
3963 ENDIF
3965 ENDPROC
4015 PROC FEJL(P1,P2,P3)
4030 IF STATUS(P3$)<>B THEN
4045 OUTPUT T
4060 PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2
4075 STOP
4090 ENDIF
4105 ENDPROC
4120 PROC INLINE(N)
4135 REPEAT
4150 CURSOR 25,Y(N)
4165 PRINT BL$(E:ABS(TYPE(N))+6)
4180 CURSOR X(N),Y(N)
4195 PRINT USING "### ":N;
4214 PRINT PICT$(N);":";
4215 CURSOR 25,Y(N)
4225 INPUT "",LINE$
4240 IF TYPE(N)<B THEN
4255 IF LEN(LINE$)<=ABS(TYPE(N)) THEN
4270 OK=E
4285 FOR I=LEN(LINE$)+E TO ABS(TYPE(N))
4300 LINE$(I)=" "
4315 NEXT I
4330 ELSE
4345 OK=B
4360 ENDIF
4375 ELSE
4390 EXEC CHECK(LINE$,OK)
4405 IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B
4420 ENDIF
4435 UNTIL OK<>B
4450 ENDPROC
4465 PROC SKRIVPICT
4480 CLEAR
4490 PRINT "L Ø N A R T S - K A R T O T E K"
4495 FOR I=E TO A
4510 CURSOR X(I),Y(I)
4520 IF I<4 THEN
4525 PRINT USING "### ":I;
4526 ELSE
4527 IF I>5 THEN PRINT "    ";
4528 ENDIF
4540 PRINT PICT$(I);":"
4555 NEXT I
4570 ENDPROC
4585 PROC OUTPLINE(N)
4600 PRINT TAB(X(N));
4610 IF N<4 THEN
4615 PRINT USING "### ":N;
4616 ELSE
4617 IF N>5 THEN PRINT "    ";
4618 ENDIF
4620 IF N>V AND N<6 THEN
4630 PRINT PICT$(N);":";LINE$;
4632 ELSE
4634 PRINT PICT$(N);":";TAB(25);LINE$;
4635 ENDIF
4636 IF N<V OR N>4 THEN PRINT
4645 ENDPROC
4660 A=12
4675 DIM X(A),Y(A),PICT$(A,20),TYPE(A)
4705 DIM BL$(79),LINE$(30)
4720 FOR I=E TO 79
4735 BL$=BL$+" "
4750 NEXT I
4780 X(E)=E
4795 X(G)=E
4810 X(V)=E
4825 X(4)=35
4840 X(5)=45
4855 X(6)=E
4870 X(7)=E
4885 X(8)=E
4900 X(W)=E
4915 X(10)=E
4930 X(11)=E
4945 X(12)=E
5095 Y(E)=V
5110 Y(G)=5
5125 Y(V)=7
5140 Y(4)=7
5155 Y(5)=7
5170 Y(6)=W
5185 Y(7)=11
5200 Y(8)=13
5215 Y(W)=15
5230 Y(10)=17
5245 Y(11)=19
5260 Y(12)=21
5410 TYPE(E)=B
5425 TYPE(G)=-20
5440 TYPE(V)=B
5725 PICT$(E)="LA-nr"
5740 PICT$(G)="Tekst"
5755 PICT$(V)="Tælleværk nr"
5770 PICT$(4)=""
5785 PICT$(5)=""
5800 PICT$(6)="Ferieberett løn"
5815 PICT$(7)="Trækpligtig A-indk"
5830 PICT$(8)="Trækfri A-indk"
5845 PICT$(W)="Nettoløndel"
5860 PICT$(10)="Fradrag M saldo"
5875 PICT$(11)="Fradrag U saldo"
5890 PICT$(12)="Udbetaling"
6000 EXEC INDVIRK
6130 OUTP=B
6145 FIL5$="P641220:LØNARTRG"
6160 OPEN FIL5$,W
6175 EXEC FEJL(B,B,FIL5$)
6250 REPEAT
6265 SV=G
6280 CLEAR
6295 CURSOR 10,10
6310 PRINT "L Ø N A R T S - K A R T O T E K"
6325 PRINT
6340 PRINT TAB(10);"0 Færdig"
6355 PRINT TAB(10);"1 Ændring"
6370 PRINT TAB(10);"2 Udskrift på skærm"
6385 PRINT TAB(10);"3 Udskrift på printer"
6400 PRINT TAB(10);"4 Oprettelse"
6415 PRINT TAB(10);"5 Sletning"
6430 PRINT
6445 REPEAT
6460 CURSOR E,19
6475 EDIT "          ",SV
6490 UNTIL SV=>B AND SV<=5
6505 IF SV>B THEN
6520 REPEAT
6535 EXEC INOPL(1)
6550 UNTIL LANR=>B AND LANR<=99
6551 LISTE=B
6552 IF LANR=B THEN LISTE=E
6553 REPEAT
6554 IF LISTE=E THEN LANR=LANR+E
6565 EXEC INDART(LANR)
6580 CASE SV OF
6595 WHEN E
6600 EXEC CH(LANR)
6610 IF POST6$(E)="1" AND OKAY=E THEN
6625 EXEC SKRIVOPL
6640 REPEAT
6655 REPEAT
6670 SV1=B
6685 CURSOR E,23
6700 EDIT "Feltnr ",SV1
6715 UNTIL SV1>E AND SV1<=SF OR SV1=B
6730 IF SV1>B THEN
6745 EXEC INOPL(SV1)
6760 ENDIF
6775 UNTIL SV1=B
6790 EXEC UDART(LANR)
6805 ELSE
6820 PRINT "Lønart kan ikke ændres"
6835 INPUT "RETURN",LINE$
6850 ENDIF
6865 WHEN G
6880 IF POST6$(E)="1" THEN
6895 OUTP=B
6910 EXEC SKRIVOPL
6925 INPUT "RETURN",LINE$
6940 ELSE
6955 PRINT "Lønart findes ikke"
6970 INPUT "RETURN",LINE$
6985 ENDIF
7000 WHEN V
7015 IF POST6$(E)="1" OR LISTE=E THEN
7016 IF POST6$(E)="1" THEN
7030 OUTPUT P
7045 OUTP=E
7060 EXEC SKRIVOPL
7061 FOR I=12 TO 72
7062 PRINT
7063 NEXT I
7075 OUTP=B
7090 OUTPUT T
7095 ENDIF
7105 ELSE
7120 PRINT "Lønart findes ikke"
7135 INPUT "RETURN",LINE$
7150 ENDIF
7165 WHEN 4
7170 EXEC CH(LANR)
7180 IF POST6$(E)="1" OR OKAY=B THEN
7195 PRINT "Lønart må ikke oprettes"
7210 INPUT "RETURN",LINE$
7225 ELSE
7240 EXEC SKRIVOPL
7255 EXEC CONV(LINE$,LANR,2)
7260 LINE$=" "+LINE$
7270 EXEC OUTLINE(1)
7285 FOR J=G TO SF
7300 EXEC INOPL(J)
7315 NEXT J
7435 REPEAT
7450 REPEAT
7465 SV1=B
7480 CURSOR E,23
7495 EDIT "Feltnr ",SV1
7510 UNTIL SV1>E AND SV1<=SF OR SV1=B
7525 IF SV1>B THEN
7540 EXEC INOPL(SV1)
7555 ENDIF
7570 UNTIL SV1=B
7600 EXEC UDART(LANR)
7615 ENDIF
7630 WHEN 5
7640 EXEC CH(LANR)
7645 IF POST6$(E)="1" AND OKAY=E THEN
7660 SV1=G
7795 EXEC SKRIVOPL
7810 WHILE SV1<>B AND SV1<>E
7812 SV1=B
7825 CURSOR E,23
7840 EDIT "Sletning korrekt 1:  ",SV1
7855 ENDWHILE
7870 IF SV1=E THEN
7885 POST6$(E,21)="0                    "
7900 EXEC UDART(LANR)
7930 ENDIF
7945 ELSE
7960 PRINT "Lønart kan ikke slettes"
7975 INPUT "RETURN",LINE$
7990 ENDIF
8005 ENDCASE
8006 UNTIL LISTE=B OR LANR=>99
8010 ENDIF
8020 UNTIL SV=B
8050 CLOSE FIL5$
8065 CHAIN "P641210:STARTB"