DataMuseum.dk

top - download

    Length: 4665 (0x1239)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »ONE.B«

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

SPC/1 COMAL-BIN

0100 DIM A1(V),A2(V),A3(V),A4(V),A5(V),A6(G),A7$(8),A8$(8),A9$(E),B0$(E)
0120 DIM RES$(15),OP1$(12),OP2$(12),B1$(12),B2$(12),B3$(12)
0130 DIM B6$(50),B7(10),C0$(12),C1$(12),C2$(12),C3$(12)
0140 DIM C4$(12),C6$(55),C7$(40),C8$(50),C9$(16),D0$(16),D1$(71)
0150 DIM D2$(27),D3$(55),D4$(34),D5$(29),D6$(37),D7$(16),D8$(16),D9$(16)
0160 DIM E0$(16),E1$(16),E6(21),E7(21),E8(21),F0$(79)
0162 DIM F1$(12),DD$(6)
0163 TI=10;EL=11;AZ=28
0170 B3$="          0+"
0200 A6(E),A6(G),E3,E4,E5=B
0260 E6(E),E6(EL),E6(14),E6(17)=27;E6(G),E6(V),E6(12),E6(15),E6(18)=34
0280 E6(7)=29;E6(8)=33;E6(W)=37;E7(19)=17;E7(20)=18;E7(21)=19;E8(4)=-4
0300 E6(4)=36;E6(5),E6(6)=39;E6(TI),E6(13),E6(16),E6(19),E6(20),E6(21)=23
0310 E7(E),E7(G)=G;E7(V)=V;E7(4)=4;E7(5)=5;E7(6)=6;E7(7),E7(8),E7(W)=W
0320 E7(TI),E7(EL),E7(12)=12;E7(13),E7(14),E7(15)=13;E7(16),E7(17),E7(18)=14
0340 E8(E),E8(G),E8(EL),E8(12),E8(14),E8(15),E8(17),E8(18)=6;E8(5),E8(6)=-E
0350 E8(V),E8(7),E8(8),E8(W),E8(TI),E8(13),E8(16),E8(19),E8(20),E8(21)=B
0370 PROC C(F2,F3,F4,F5)
0380 RES$=F5$;OP1$=F3$;OP2$=F4$;SI=B;FLAG=B;ART=F2-6*(F2>5)
0390 CALL "P641210:REGN"
0400 IF F2<6 AND FLAG THEN STOP
0430 F5$=RES$
0440 ENDPROC
0650 PROC DATOCHECK(G0,G1)
0660 G1=E
0670 G2=(ORD(G0$(E))-48)*TI+ORD(G0$(G))-48
0680 G3=(ORD(G0$(V))-48)*TI+ORD(G0$(4))-48
0690 G4=(ORD(G0$(5))-48)*TI+ORD(G0$(6))-48
0700 IF G4<E OR G3<E OR G3>12 OR G4>31 THEN G1=B
0710 IF G1=B THEN EXIT
0720 CASE G3 OF
0730 WHEN 4,6,W,EL
0740 IF G4>30 THEN G1=B
0750 WHEN G
0760 IF G4>29 THEN G1=B
0770 IF G4=29 AND G2 MOD 4<>B THEN G1=B
0780 ENDCASE
0790 ENDPROC
1000 PROC CHECK(I1,I2)
1010 I2,I3=B
1030 IF LEN(I1$)>B THEN
1035 I4=E
1040 IF I1$(E)="-" THEN I4=-E;I2=E
1100 WHILE LEN(I1$)>I2
1110 I2=I2+E
1120 IF I1$(I2)<"0" OR I1$(I2)>"9" THEN I4=B;I2=LEN(I1$)
1160 I3=I3*TI+ORD(I1$(I2))-48
1170 ENDWHILE
1175 I3=I3*I4;I2=I2*I4
1190 IF I2<B THEN I2=I2+E
1200 ENDIF
1210 ENDPROC
1211 PROC Ø
1212 REPEAT
1213 EXEC DATOCHECK(F0$,I)
1214 IF I=B THEN EXEC INLINE(I5)
1215 UNTIL I=E
1216 ENDPROC
1220 PROC INOPL(I5)
1230 EXEC INLINE(I5)
1240 CASE I5 OF
1250 WHEN E
1260 EXEC Ø
1300 EXEC CONVDATE(A7$,I3)
1310 WHEN G
1320 EXEC Ø
1360 EXEC CONVDATE(A8$,I3)
1370 WHEN V
1380 IF I3>B THEN
1390 EXEC Ø
1430 ENDIF
1440 I6=I3;DD$=F0$
1450 IF I6<>-E THEN E3=E
1460 WHEN 4
1470 REPEAT
1480 F0$=F0$+"+"
1490 EXEC C(6,F0$,B3$,F1$)
1500 IF FLAG<>B THEN EXEC INLINE(I5)
1510 UNTIL FLAG=B
1520 EXEC C(0,F0$,B3$,F1$)
1530 EXEC PERVERT(F1$,I7)
1540 WHEN 5
1550 WHILE F0$<"1" OR F0$>"7"
1560 EXEC INLINE(I5)
1570 ENDWHILE
1580 A9$=F0$
1590 WHEN 6
1600 WHILE F0$<>"A" AND F0$<>"F"
1610 EXEC INLINE(I5)
1620 ENDWHILE
1630 B0$=F0$
1640 WHEN 7,8,W
1650 A1(I5-6)=I3
1660 WHEN TI,13,16
1670 A2(I5 DIV V-G)=I3
1680 IF I3<>B THEN
1690 E4=E
1700 ELSE
1710 I5=I5+G
1720 ENDIF
1730 WHEN EL,14,17
1740 EXEC Ø
1780 A4(I5 DIV 3-2)=I3
1790 WHEN 12,15,18
1800 EXEC Ø
1840 A5(I5 DIV 3-3)=I3
1850 WHEN 19,20,21
1860 A3(I5-18)=I3
1865 IF I3<>B THEN E5=E
1870 ENDCASE
1880 ENDPROC
1950 PROC F(J1,J2,J3)
1960 IF STATUS(J3$)<>B THEN
1970 OUTPUT T
1980 PRINT "FIL-FEJL ";J3$;STATUS(J3$),J1;J2
1990 STOP
2000 ENDIF
2010 ENDPROC
2020 PROC INLINE(G5)
2030 REPEAT
2040 CURSOR E6(G5),E7(G5)
2050 INPUT "",F0$
2060 IF E8(G5)<B THEN
2065 J4=B
2070 IF LEN(F0$)<=ABS(E8(G5)) THEN
2080 J4=E
2090 FOR I=LEN(F0$)+E TO ABS(E8(G5))
2100 F0$(I)=" "
2110 NEXT I
2140 ENDIF
2150 ELSE
2160 EXEC CHECK(F0$,J4)
2170 IF E8(G5)>B AND E8(G5)<>J4 THEN J4=B
2180 ENDIF
2190 UNTIL J4<>B
2200 ENDPROC
2210 PROC SKRIVPICT
2220 CLEAR
2230 PRINT TAB(17);"Afregning"
2240 PRINT " Lønperioden"
2250 PRINT " Dispositionsdato, lønoverførsel"
2260 PRINT " Maksimum feriedage i året"
2270 PRINT " Lønperiodekode 1,2,3,4,5,6 eller 7"
2280 PRINT " Arbejdere(A) eller funktionærer(F)"
2290 PRINT
2300 PRINT " Lønspecifikationer"
2310 PRINT " Gruppe/lønnr"
2320 PRINT
2330 PRINT " Feriepengeopgørelse:     start-slutdag"
2340 PRINT " Feriekode 1/lønnr"
2350 PRINT " Feriekode 2/lønnr"
2360 PRINT " Feriekode 3/lønnr"
2370 PRINT
2380 PRINT " SH-opgørelse"
2390 PRINT " SH-kode 1/lønnr"
2400 PRINT " SH-kode 2/lønnr"
2410 PRINT " SH-kode 3/lønnr"
2420 ENDPROC
2600 PROC CONVDATE(I1,I2)
2610 K0=I2;I1$=""
2620 FOR I=8 TO E STEP -E
2625 I1$(I)=CHR(K0 MOD TI+48)
2630 IF I MOD V=B THEN
2631 I1$(I)="-"
2632 ELSE
2633 K0=K0 DIV TI
2634 ENDIF
2690 NEXT I
2700 ENDPROC
2890 PROC PERVERT(I1,I2)
2900 I2=B
2910 FOR I=E TO LEN(I1$)-E
2920 IF I1$(I)<>" " AND I1$(I)<>"," THEN I2=TI*I2+ORD(I1$(I))-48
2930 NEXT I
2940 IF I1$(I)="-" THEN I2=-I2
2950 I2=I2/100
2960 ENDPROC
8300 EXEC SKRIVPICT
8310 FOR J=E TO 21
8320 IF J=7 AND E3=B THEN J=TI
8330 EXEC INOPL(J)
8340 NEXT J
8350 D8$="P641210:PARMFIL"
8360 OPEN D8$,W
8370 PUT D8$:A7$,A8$,DD$,E3,I6,I7,A9$
8380 PUT D8$:B0$,A1(E),A1(G),A1(V),A2(E),A2(G),A2(V)
8390 PUT D8$:A4(E),A4(G),A4(V),A5(E),A5(G),A5(V)
8400 PUT D8$:A3(E),A3(G),A3(V),E4,E5
8410 CLOSE
8415 IF E3=E THEN
8420 CHAIN "P641210:TWO"
8425 ELSE
8430 CHAIN "P641210:THREE"
8440 ENDIF