DataMuseum.dk

top - download

    Length: 5181 (0x143d)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »ÅRSOPL.B«

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

SPC/1 COMAL-BIN

0110 DIM STARTPER$(8),SLUTPER$(8),LP$(E),ORK$(E)
0120 DIM RES$(15),OP1$(12),OP2$(12),TAH$(12),TRE$(12)
0130 DIM TOTAL$(4,12),L$(12),LIN$(12)
0140 DIM RESUL$(12),RESUL1$(12),TV$(45,11)
0150 DIM FIL$(16),FIL2$(16),POST1$(71),POST2$(27),POST3$(55),POST4$(34)
0160 DIM MF1$(16)
0162 DIM POST5$(55)
0170 TAH$="          0+"
0180 TRE$="       3,00+"
0370 PROC CALC(AR3,B1,B2,ES)
0380 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0390 CALL "P641210:REGN"
0400 IF AR3<6 THEN
0410 IF FLAG THEN STOP
0420 ENDIF
0430 ES$=RES$
0440 ENDPROC
0550 PROC INDTÆL
0560 J=W*(LMNR-E)
0570 FOR K=E TO W
0580 GET FIL2$,J+K:POST5$
0590 FOR I=E TO 5
0600 TV$((K-E)*5+I)=POST5$((I-E)*11+E:11)
0610 NEXT I
0620 NEXT K
0630 EXEC FEJL(LMNR,K,FIL2$)
0640 ENDPROC
0800 PROC INLØNMOD(N)
0810 GET FIL$,G*N-E:POST1$
0820 GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
0830 EXEC FEJL(E,N,FIL$)
0840 ENDPROC
1000 PROC UDTÆL
1010 J=W*(LMNR-E)
1020 FOR K=E TO W
1030 FOR I=E TO 5
1040 POST5$((I-E)*11+E:11)=TV$((K-E)*5+I)
1050 NEXT I
1060 PUT FIL2$,J+K:POST5$
1070 NEXT K
1080 EXEC FEJL(-LMNR,-K,FIL2$)
1090 ENDPROC
1100 PROC UDLØNMOD(N)
1110 PUT FIL$,G*N-E:POST1$
1120 PUT FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD
1130 EXEC FEJL(G,N,FIL$)
1140 ENDPROC
1150 PROC CONV(NR2,OK22,CIF)
1160 OK2=OK22
1170 NR2$=""
1180 REPEAT
1190 NR2$=CHR((OK2 MOD 10)+48)+NR2$
1200 CIF=CIF-E
1210 OK2=OK2 DIV 10
1220 IF CIF<B AND OK2=B THEN CIF=B
1230 UNTIL CIF=B
1240 ENDPROC
1890 PROC INDVIRK
1900 OPEN FIL$,R
1910 EXEC FEJL(B,B,FIL$)
1920 GET FIL$,E:POST3$
1930 GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM
1940 ENDPROC
1950 PROC FEJL(P1,P2,P3)
1960 IF STATUS(P3$)<>B THEN
1970 OUTPUT T
1980 PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2
1990 STOP
2000 ENDIF
2010 ENDPROC
3440 PROC NÆSTE
3450 REPEAT
3460 LMNR=LMNR+E
3470 LA=E
3480 IF LMNR<=MLMNR THEN
3490 EXEC INLØNMOD(LMNR)
3500 IF LP$<>POST2$(21) THEN LA=B
3510 IF ORK$="A" AND POST2$(24,25)>"89" THEN LA=B
3520 IF ORK$="F" AND POST2$(24,25)<"90" THEN LA=B
3530 ENDIF
3540 UNTIL LA>B
3550 ENDPROC
8182 TOTAL$(E)=TAH$;TOTAL$(G)=TAH$
8183 TOTAL$(V)=TAH$;TOTAL$(4)=TAH$
8190 FIL$="P641220:VIRKKART"
8200 EXEC INDVIRK
8210 CLOSE FIL$
8220 FIL$="P641220:LØNMODRG"
8230 OPEN FIL$,W
8260 FIL2$="P641220:TÆLLEREG"
8270 OPEN FIL2$,W
8291 MF1$="P641210:LØNJOUR"
8292 OPEN MF1$,R
8300 INPUT "Isæt årsoplysningssedler, RETURN ",LP$
8350 MAXLIN=72
8360 LMNR=B
8370 ABL=B
8372 GET MF1$:STARTPER$,SLUTPER$,LP$,ORK$,MFD
8410 STD=100000*(ORD(STARTPER$(E))-48)+10000*(ORD(STARTPER$(G))-48)
8420 STD=STD+1000*(ORD(STARTPER$(4))-48)+100*(ORD(STARTPER$(5))-48)
8430 STD=STD+10*(ORD(STARTPER$(7))-48)+ORD(STARTPER$(8))-48
8440 SLD=100000*(ORD(SLUTPER$(E))-48)+10000*(ORD(SLUTPER$(G))-48)
8450 SLD=SLD+1000*(ORD(SLUTPER$(4))-48)+100*(ORD(SLUTPER$(5))-48)
8460 SLD=SLD+10*(ORD(SLUTPER$(7))-48)+ORD(SLUTPER$(8))-48
8465 CURSOR E,14
8470 OUTPUT P
8490 REPEAT
8500 EXEC NÆSTE
8510 IF LMNR<=MLMNR THEN
8520 EXEC INDTÆL
8521 EXEC CALC(B,TV$(34),TV$(37),RESUL$)
8522 EXEC CALC(G,TRE$,TV$(43),RESUL1$)
8523 TV$(34)=RESUL$(G:11)
8524 TV$(43)=RESUL1$(G:11)
8529 ABL=ABL+E
8530 EXEC CALC(B,TV$(43),TOTAL$(E),TOTAL$(E))
8540 EXEC CALC(B,TV$(34),TOTAL$(G),TOTAL$(G))
8542 EXEC CALC(B,TV$(40),TOTAL$(V),TOTAL$(V))
8544 EXEC CALC(B,TV$(37),TOTAL$(4),TOTAL$(4))
8545 TV$(34,W,11)="00 "
8546 TV$(43,W,11)="00 "
8547 TV$(40,W,11)="00 "
8548 TV$(37,W,11)="00 "
8550 IF STD>LA THEN
8560 STDA=STD
8570 ELSE
8580 STDA=LA
8590 ENDIF
8600 IF SLD<FD OR FD=B THEN
8602 SLDA=SLD
8604 ELSE
8606 SLDA=FD
8608 ENDIF
8609 IF FD>B THEN LA=B;FD=B
8610 FOR I=E TO 7
8612 IF TV$(34,I)=" " THEN TV$(34,I)="*"
8614 IF TV$(43,I)=" " THEN TV$(43,I)="*"
8616 IF TV$(40,I)=" " THEN TV$(40,I)="*"
8618 IF TV$(37,I)=" " THEN TV$(37,I)="*"
8620 NEXT I
8622 PRINT
8624 PRINT
8626 PRINT
8628 EXEC CONV(L$,C1,6)
8630 EXEC CONV(LIN$,C2,4)
8632 L$=L$+LIN$
8634 PRINT TAB(W);L$;TAB(58);POST3$(E,7)
8636 PRINT
8638 PRINT
8640 PRINT TAB(46);POST3$(8,32)
8642 PRINT TAB(46);POST3$(33,55)
8644 PRINT TAB(46);POST4$(E,4);" ";POST4$(5,18)
8646 PRINT
8648 PRINT TAB(W);POST1$(E,25);
8650 PRINT USING " ####":LMNR
8652 PRINT
8654 PRINT TAB(W);POST1$(26,48)
8656 PRINT TAB(W);POST1$(49,71)
8658 PRINT TAB(W);POST2$(E,4);" ";POST2$(5,18)
8660 PRINT
8662 PRINT
8664 PRINT TAB(24);STDA;"-";SLDA;" "
8666 PRINT
8668 PRINT
8670 PRINT TAB(68);"*";TV$(43,E,7)
8672 PRINT
8674 PRINT
8676 PRINT TAB(68);"*";TV$(34,E,7)
8678 PRINT
8680 PRINT
8682 PRINT
8684 PRINT
8686 PRINT TAB(68);"*";TV$(40,E,7)
8688 PRINT
8690 PRINT
8692 PRINT TAB(68);"*";TV$(37,E,7)
8694 FOR I=E TO 45
8696 TV$(I)=TAH$(G:11)
8698 NEXT I
8700 LT=B
8702 LF=B
8704 LR=B
8706 FOR I=33 TO 48
8708 PRINT
8710 NEXT I
8712 EXEC UDLØNMOD(LMNR)
8714 EXEC UDTÆL
8880 ENDIF
8890 UNTIL LMNR=>MLMNR
8900 FOR I=E TO 4
8910 FOR J=E TO 8
8920 IF TOTAL$(I,J)=" " THEN TOTAL$(I,J)="*"
8930 NEXT J
8940 NEXT I
8950 PRINT
8960 PRINT
8970 PRINT
8980 PRINT TAB(58);POST3$(E,7)
8990 PRINT
9000 PRINT
9010 PRINT TAB(46);POST3$(8,32)
9020 PRINT TAB(46);POST3$(33,55)
9030 PRINT TAB(46);POST4$(E,4);" ";POST4$(5,18)
9040 PRINT
9050 PRINT
9060 PRINT
9070 PRINT TAB(W);"**T O T A L B I L A G**"
9080 PRINT TAB(W);"ANTAL BILAG";ABL;" "
9090 PRINT
9100 PRINT
9110 PRINT
9120 PRINT
9130 PRINT
9140 PRINT
9150 PRINT TAB(68);TOTAL$(E,E,8)
9160 PRINT
9170 PRINT
9180 PRINT TAB(68);TOTAL$(G,E,8)
9190 PRINT
9200 PRINT
9210 PRINT
9220 PRINT
9230 PRINT TAB(68);TOTAL$(V,E,8)
9240 PRINT
9250 PRINT
9260 PRINT TAB(68);TOTAL$(4,E,8)
9265 FOR I=33 TO 48
9270 PRINT
9275 NEXT I
9730 CLOSE
9735 OUTPUT T
9740 CHAIN "P641210:STARTB"