DataMuseum.dk

top - download

    Length: 10192 (0x27d0)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »AKKALIST.B«

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

SPC/1 COMAL-BIN

0010 DIM POST4$(34),FIL7$(20),AKKTIM(10),AKKS$(10,16),B3$(12),GSATS$(12)
0100 DIM AKK$(49),NR$(606),Å(100),M(30),FIL8$(20),FIL9$(20),AKKNR$(6),DAD$(6)
0105 DIM RES$(15),OP1$(12),OP2$(12),RESUL$(12),RESUL1$(12),TTIM$(12)
0106 DIM TUD$(12),HUND$(12)
0110 PROC CALC(AR3,B1,B2,ES)
0115 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0120 CALL "P641210:REGN"
0125 IF AR3<6 THEN
0130 IF FLAG THEN STOP
0135 ENDIF
0140 ES$=RES$
0145 ENDPROC
0150 PROC SLET
0151 GN=Å(L)
0152 WHILE L<MAX DO
0153 NR$((L-E)*6+E:6)=NR$(L*6+E:6)
0154 Å(L)=Å(L+E)
0155 L=L+E
0156 ENDWHILE
0157 NR$((L-E)*6+E:6)="      "
0158 Å(L)=GN
0159 MAX=MAX-E
0160 ENDPROC
0161 PROC UDTABEL
0162 OPEN FIL9$,W
0163 EXEC FEJL(G,B,FIL9$)
0164 FOR I=E TO 10
0165 PUT FIL9$:NR$((I-E)*60+E:60)
0166 NEXT I
0167 PUT FIL9$:Å(E),Å(G),Å(V),Å(4),Å(5),Å(6),Å(7),Å(8),Å(W),Å(10)
0168 PUT FIL9$:Å(11),Å(12),Å(13),Å(14),Å(15),Å(16),Å(17),Å(18),Å(19),Å(20)
0169 PUT FIL9$:Å(21),Å(22),Å(23),Å(24),Å(25),Å(26),Å(27),Å(28),Å(29),Å(30)
0170 PUT FIL9$:Å(31),Å(32),Å(33),Å(34),Å(35),Å(36),Å(37),Å(38),Å(39),Å(40)
0171 PUT FIL9$:Å(41),Å(42),Å(43),Å(44),Å(45),Å(46),Å(47),Å(48),Å(49),Å(50)
0172 PUT FIL9$:Å(51),Å(52),Å(53),Å(54),Å(55),Å(56),Å(57),Å(58),Å(59),Å(60)
0173 PUT FIL9$:Å(61),Å(62),Å(63),Å(64),Å(65),Å(66),Å(67),Å(68),Å(69),Å(70)
0174 PUT FIL9$:Å(71),Å(72),Å(73),Å(74),Å(75),Å(76),Å(77),Å(78),Å(79),Å(80)
0175 PUT FIL9$:Å(81),Å(82),Å(83),Å(84),Å(85),Å(86),Å(87),Å(88),Å(89),Å(90)
0176 PUT FIL9$:Å(91),Å(92),Å(93),Å(94),Å(95),Å(96),Å(97),Å(98),Å(99),Å(100)
0177 ENDPROC
0191 DIM BL$(79),LINE$(50),FIL$(20)
0192 FIL$="P641220:VIRKKART"
0193 OPEN FIL$,R
0194 EXEC FEJL(B,B,FIL$)
0195 GET FIL$,V:DAD$
0196 CLOSE FIL$
0200 PROC INDAKK
0203 IF SV=E THEN
0205 L=E;U=MAX
0210 IF U>B THEN
0215 REPEAT
0220 PEG=(L+U) DIV G
0225 IF AKKNR$>NR$((PEG-E)*6+E:6) THEN
0230 L=PEG+E
0235 ELSE
0240 U=PEG-E
0245 ENDIF
0250 UNTIL L>U OR AKKNR$=NR$((PEG-E)*6+E:6)
0255 ENDIF
0260 L=U+E
0261 ELSE
0262 AKKNR$=NR$((L-E)*6+E:6)
0263 ENDIF
0265 IF NR$((L-E)*6+E:6)=AKKNR$ THEN
0270 FOUND=E
0275 PEG=Å(L)
0280 GET FIL8$,PEG:AKK$(E,27),TTIMER,RTIMER
0285 GET FIL8$,PEG+E:AKK$(28,49),M(E),M(G),M(V)
0290 GET FIL8$,PEG+G:M(4),M(5),M(6),M(7),M(8),M(W),M(10),M(11),M(12)
0295 GET FIL8$,PEG+V:M(13),M(14),M(15),M(16),M(17),M(18),M(19),M(20),M(21)
0300 GET FIL8$,PEG+4:M(22),M(23),M(24),M(25),M(26),M(27),M(28),M(29),M(30)
0305 EXEC FEJL(B,PEG,FIL8$)
0310 IF AKK$(E,6)<>AKKNR$ THEN FOUND=-E
0315 ELSE
0320 FOUND=B
0325 ENDIF
0330 ENDPROC
0335 PROC UDAKK
0340 PUT FIL8$,PEG:AKK$(E,27),TTIMER,RTIMER
0345 PUT FIL8$,PEG+E:AKK$(28,49),M(E),M(G),M(V)
0350 PUT FIL8$,PEG+G:M(4),M(5),M(6),M(7),M(8),M(W),M(10),M(11),M(12)
0355 PUT FIL8$,PEG+V:M(13),M(14),M(15),M(16),M(17),M(18),M(19),M(20),M(21)
0360 PUT FIL8$,PEG+4:M(22),M(23),M(24),M(25),M(26),M(27),M(28),M(29),M(30)
0365 EXEC FEJL(E,PEG,FIL8$)
0370 ENDPROC
0375 PROC INDTABEL
0380 FIL9$="P641220:AKKTABEL"
0385 OPEN FIL9$,R
0390 EXEC FEJL(B,B,FIL9$)
0395 FOR I=E TO 10
0400 GET FIL9$:NR$((I-E)*60+E:60)
0405 NEXT I
0410 GET FIL9$:Å(E),Å(G),Å(V),Å(4),Å(5),Å(6),Å(7),Å(8),Å(W),Å(10)
0415 GET FIL9$:Å(11),Å(12),Å(13),Å(14),Å(15),Å(16),Å(17),Å(18),Å(19),Å(20)
0420 GET FIL9$:Å(21),Å(22),Å(23),Å(24),Å(25),Å(26),Å(27),Å(28),Å(29),Å(30)
0425 GET FIL9$:Å(31),Å(32),Å(33),Å(34),Å(35),Å(36),Å(37),Å(38),Å(39),Å(40)
0430 GET FIL9$:Å(41),Å(42),Å(43),Å(44),Å(45),Å(46),Å(47),Å(48),Å(49),Å(50)
0435 GET FIL9$:Å(51),Å(52),Å(53),Å(54),Å(55),Å(56),Å(57),Å(58),Å(59),Å(60)
0440 GET FIL9$:Å(61),Å(62),Å(63),Å(64),Å(65),Å(66),Å(67),Å(68),Å(69),Å(70)
0445 GET FIL9$:Å(71),Å(72),Å(73),Å(74),Å(75),Å(76),Å(77),Å(78),Å(79),Å(80)
0450 GET FIL9$:Å(81),Å(82),Å(83),Å(84),Å(85),Å(86),Å(87),Å(88),Å(89),Å(90)
0455 GET FIL9$:Å(91),Å(92),Å(93),Å(94),Å(95),Å(96),Å(97),Å(98),Å(99),Å(100)
0460 EXEC FEJL(E,B,FIL9$)
0465 FOR I=B TO 99
0470 IF NR$(I*6+E:6)="      " THEN
0475 MAX=I;I=100
0480 ENDIF
0485 NEXT I
0490 CLOSE FIL9$
0495 ENDPROC
0500 PROC INDREGNS(N)
0510 J=10*(N-E)
0520 FOR I=E TO 10
0530 GET FIL7$,J+I:AKKTIM(I),AKKS$(I)
0540 NEXT I
0550 EXEC FEJL(N,J,FIL7$)
0560 ENDPROC
0600 PROC UDREGNS(N)
0610 J=10*(N-E)
0620 FOR I=E TO 10
0630 PUT FIL7$,J+I:AKKTIM(I),AKKS$(I)
0640 NEXT I
0650 EXEC FEJL(-N,J,FIL7$)
0660 ENDPROC
0850 PROC INLØNMOD(N)
0865 GET FIL$,G*N-E:POST1$
0880 GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
0895 EXEC FEJL(E,N,FIL$)
0910 ENDPROC
0915 B3$="          0+"
0916 TI=10;EL=11
0917 HUND$="     100,00+"
0920 PROC Æ(I1,I2)
0930 I1$=B3$
0940 IF I2<>B THEN
0950 I1$(W,TI)=",0";I0=ABS(I2);K0=INT((I0-INT(I0))*100+0.50001)
0960 IF I2<B THEN I1$(12)="-"
0970 FOR I=EL TO E STEP -E
0980 IF I<>W THEN
0990 I1$(I)=CHR(K0 MOD TI+48)
1000 K0=K0 DIV TI
1010 IF K0=B AND I<TI THEN I=B
1020 ELSE
1030 K0=INT(I0)
1040 ENDIF
1050 NEXT I
1060 ENDIF
1070 ENDPROC
2980 PROC SKRIVOPL
2985 TUD$=B3$;TTIM$=B3$
2990 SLETK,AM,AFSL=B
2995 FOR I=E TO 30
3000 IF M(I)<>B THEN
3005 AM=AM+E
3010 IF M(I)<B THEN AFSL=AFSL+E
3015 ENDIF
3020 NEXT I
3025 IF DEL=V THEN SLETK=E
3030 IF DEL=G AND AFSL=AM THEN SLETK=G
3035 IF LINIE+AM+15>72 THEN
3040 WHILE LINIE<72
3045 PRINT
3050 LINIE=LINIE+E
3055 ENDWHILE
3060 PRINT
3065 PRINT "A K K O R D - L I S T E";TAB(60);"Dato ";DAD$
3070 LINIE=G
3075 ENDIF
3080 PRINT
3085 PRINT
3090 PRINT
3095 PRINT "Akkord: ";AKK$(E,6);TAB(25);AKK$(7,27)
3100 PRINT
3105 PRINT "LØNNR   NAVN                        UDBETALT       TIMER";
3110 PRINT "        GSATS    AFSLT"
3115 LINIE=LINIE+6
3120 FOR K=E TO 30
3125 IF M(K)<>B THEN
3130 LMNR=ABS(M(K))
3135 EXEC INLØNMOD(LMNR)
3140 EXEC INDREGNS(LMNR)
3145 FOR J=E TO 10
3150 IF AKKS$(J,11,16)=AKKNR$ THEN J=J+20
3155 NEXT J
3160 J=J-21
3165 LINIE=LINIE+E
3170 IF J<E THEN
3175 PRINT "Indrapporter straks denne hændelse til H.S.MØLLER, og STOP"
3180 ELSE
3185 RESUL$=AKKS$(J,E,10)
3190 EXEC Æ(RESUL1$,ABS(AKKTIM(J)))
3195 EXEC CALC(B,TUD$,RESUL$,TUD$)
3200 EXEC CALC(B,TTIM$,RESUL1$,TTIM$)
3205 IF AKKTIM(J)<>B THEN
3210 EXEC CALC(V,RESUL$,RESUL1$,GSATS$)
3215 ELSE
3220 GSATS$=B3$
3225 ENDIF
3230 IF RESUL1$(12)="+" THEN RESUL1$(12)=" "
3235 IF RESUL$(10)="+" THEN RESUL$(10)=" "
3240 IF GSATS$(12)="+" THEN GSATS$(12)=" "
3245 PRINT LMNR;TAB(W);POST1$(E,25);"  ";RESUL$;RESUL1$;" ";GSATS$;"   ";
3250 IF M(K)<B THEN
3255 PRINT "*****"
3260 IF SLETK>B THEN
3265 M(K)=B
3270 AKKTIM(J)=B
3275 AKKS$(J)="        0+      "
3280 EXEC UDREGNS(LMNR)
3285 ENDIF
3290 ELSE
3295 PRINT
3300 ENDIF
3305 ENDIF
3310 ENDIF
3315 NEXT K
3320 PRINT "---------------------------------------------------------------";
3325 PRINT "---------------"
3330 EXEC CALC(4,TTIM$,B3$,B3$)
3335 IF SI>B THEN
3340 EXEC CALC(V,TUD$,TTIM$,GSATS$)
3345 ELSE
3350 GSATS$=B3$
3355 ENDIF
3360 IF TTIM$(12)="+" THEN TTIM$(12)=" "
3365 IF TUD$(12)="+" THEN TUD$(12)=" "
3370 IF GSATS$(12)="+" THEN GSATS$(12)=" "
3371 PRINT "Total ";AM;
3372 IF AM=E THEN
3373 PRINT " medarbejder";
3374 ELSE
3375 PRINT " medarbejdere";
3376 ENDIF
3379 PRINT TAB(34);TUD$;TTIM$;" ";GSATS$;"   ";
3380 IF AFSL=AM THEN
3385 PRINT "*****"
3390 ELSE
3395 PRINT
3400 ENDIF
3405 PRINT
3410 RESUL$=AKK$(28,38)
3415 EXEC Æ(RESUL1$,TTIMER)
3420 IF TTIMER<>B THEN
3425 EXEC CALC(V,RESUL$,RESUL1$,GSATS$)
3430 ELSE
3435 GSATS$=B3$
3440 ENDIF
3445 IF RESUL$(11)="+" THEN RESUL$(11)=" "
3450 IF RESUL1$(12)="+" THEN RESUL1$(12)=" "
3455 IF GSATS$(12)="+" THEN GSATS$(12)=" "
3460 PRINT "Totalt registreret på akkorden";TAB(35);RESUL$;RESUL1$;" ";GSATS$
3465 TUD$=AKK$(39,49)
3470 EXEC Æ(TTIM$,RTIMER)
3475 IF RTIMER<>B THEN
3480 EXEC CALC(V,TUD$,TTIM$,GSATS$)
3485 ELSE
3490 GSATS$=B3$
3495 ENDIF
3500 IF TUD$(11)="+" THEN TUD$(11)=" "
3505 IF TTIM$(12)="+" THEN TTIM$(12)=" "
3510 IF GSATS$(12)="+" THEN GSATS$(12)=" "
3515 PRINT "Budgetteret på akkorden";TAB(35);TUD$;TTIM$;" ";GSATS$
3516 RESUL$=AKK$(28,38)
3517 EXEC Æ(RESUL1$,TTIMER)
3518 TUD$=AKK$(39,49)
3519 EXEC Æ(TTIM$,RTIMER)
3520 EXEC CALC(4,TUD$,B3$,B3$)
3525 IF SI>B THEN
3530 EXEC CALC(G,HUND$,RESUL$,RESUL$)
3535 EXEC CALC(V,RESUL$,TUD$,RESUL$)
3540 ELSE
3545 RESUL$=B3$
3550 ENDIF
3555 EXEC CALC(4,TTIM$,B3$,B3$)
3560 IF SI>B THEN
3565 EXEC CALC(G,HUND$,RESUL1$,RESUL1$)
3570 EXEC CALC(V,RESUL1$,TTIM$,RESUL1$)
3575 ELSE
3580 RESUL1$=B3$
3585 ENDIF
3590 IF RESUL$(12)="+" THEN RESUL$(12)=" "
3595 IF RESUL1$(12)="+" THEN RESUL1$(12)=" "
3600 PRINT "% effektueret";TAB(34);RESUL$;RESUL1$
3605 PRINT
3610 PRINT
3615 PRINT
3620 LINIE=LINIE+W
3625 IF SLETK=G THEN
3629 AFSL=L
3630 EXEC SLET
3631 L=AFSL
3635 ELSE
3640 IF SLETK=E AND AFSL>B THEN EXEC UDAKK
3645 ENDIF
3835 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
4690 DIM POST1$(71),POST2$(27)
4720 FOR I=E TO 79
4735 BL$=BL$+" "
4750 NEXT I
6070 FIL$="P641220:LØNMODRG"
6085 OPEN FIL$,R
6100 EXEC FEJL(B,B,FIL$)
6102 FIL8$="P641220:AKKHOVED"
6104 OPEN FIL8$,W
6106 EXEC FEJL(B,B,FIL8$)
6108 EXEC INDTABEL
6110 FIL7$="P641220:AKKREGNS"
6112 OPEN FIL7$,W
6114 EXEC FEJL(B,B,FIL7$)
6130 LINIE=72
6250 REPEAT
6265 SV=G
6280 CLEAR
6295 CURSOR 10,10
6310 PRINT "A K K O R D L I S T E"
6325 PRINT
6340 PRINT TAB(10);"0 Færdig"
6355 PRINT TAB(10);"1 Enkelt akkord"
6370 PRINT TAB(10);"2 Alle akkorder"
6430 PRINT
6445 REPEAT
6460 CURSOR E,19
6475 EDIT "          ",SV
6490 UNTIL SV=>B AND SV<=G
6505 IF SV>B THEN
6506 DEL=E;L=B
6507 REPEAT
6508 CLEAR
6509 PRINT TAB(10);"Kun udskrift                         1"
6510 PRINT TAB(10);"Slet afsluttede akkorder             2"
6511 PRINT TAB(10);"Slet afsluttede akkordmedarbejdere   3"
6512 EDIT "Vælg 1 - 3 ",DEL
6513 UNTIL DEL>B AND DEL<4
6514 IF SV<>G THEN
6520 REPEAT
6530 AKKNR$="      "
6535 EDIT "Akkordnr ",AKKNR$
6550 UNTIL LEN(AKKNR$)<=6
6551 ENDIF
6552 OUTPUT P
6553 WHILE L<MAX
6554 IF SV=G THEN L=L+E
6570 EXEC INDAKK
6580 CASE SV OF
6865 WHEN E
6880 IF FOUND=E THEN
6910 EXEC SKRIVOPL
6940 ELSE
6950 OUTPUT T
6955 PRINT "Akkord findes ikke"
6970 INPUT "RETURN",LINE$
6980 OUTPUT P
6985 ENDIF
6990 L=MAX
7000 WHEN G
7060 EXEC SKRIVOPL
8005 ENDCASE
8006 ENDWHILE
8008 OUTPUT T
8010 ENDIF
8020 UNTIL SV=B
8022 OUTPUT P
8023 WHILE LINIE<72
8024 PRINT
8025 LINIE=LINIE+E
8026 ENDWHILE
8027 OUTPUT T
8028 EXEC UDTABEL
8035 CLOSE
8065 CHAIN "P641210:STARTB"