DataMuseum.dk

top - download

    Length: 15168 (0x3b40)
    Types: TextFile
    Notes: Mikados_K
    Names: »AKKLØNBE.K«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »AKKLØNBE.K« 

Mikados K File

0001PROC DATOCHECK(NR5,OK5) 
0002OK5=E 
0003ÅR=(ORD(NR5$(E))-48)*10+ORD(NR5$(G))-48 
0004MÅNED=(ORD(NR5$(V))-48)*10+ORD(NR5$(4))-48 
0005DATO=(ORD(NR5$(5))-48)*10+ORD(NR5$(6))-48 
0006IF DATO<E OR MÅNED<E OR MÅNED>12 OR DATO>31 THEN OK5=B 
0007IF OK5=B THEN EXIT  
0008CASE MÅNED OF  
0009WHEN 4,6,W,11 
0010IF DATO>30 THEN OK5=B 
0011WHEN G 
0012IF DATO>29 THEN OK5=B 
0013IF DATO=29 AND ÅR MOD 4<>B THEN OK5=B 
0014ENDCASE  
0015ENDPROC  
0100DIM RES$(15),OP1$(12),OP2$(12),TAH$(12),HUND$(12),MAX$(12),MAX1$(12) 
0120DIM RESUL$(12),RESUL1$(12),PR$(14),LINE$(20),POST6$(29) 
0140DIM FIL$(20),FIL1$(20),POST1$(71),POST2$(27),POST3$(55),POST4$(34) 
0160DIM AUT$(4,37),FIL5$(20) 
0180HUND$="100.00+" 
0200MAX$="1000000.00+" 
0220MAX1$="1000.00+" 
0240TAH$="0+" 
0260PROC INLØNMOD(N) 
0280GET FIL$,G*N-E:POST1$ 
0300GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD 
0320EXEC FEJL(E,N,FIL$) 
0340ENDPROC  
0360PROC INDVIRK 
0380OPEN FIL$,W 
0400EXEC FEJL(B,B,FIL$) 
0420GET FIL$,E:POST3$ 
0440GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM 
0460ENDPROC  
0480PROC CHECK(NR1,OK1) 
0500OK1=B 
0520RESULT=B 
0540IF LEN(NR1$)>B THEN  
0560IF NR1$(E)="-" THEN  
0580FORTEGN=-E 
0600OK1=E 
0620ELSE  
0640FORTEGN=E 
0660ENDIF  
0680WHILE LEN(NR1$)>OK1 
0700OK1=OK1+E 
0720IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN  
0740FORTEGN=B 
0760OK1=LEN(NR1$) 
0780ENDIF  
0800RESULT=RESULT*10+ORD(NR1$(OK1))-48 
0820ENDWHILE  
0840OK1=OK1*FORTEGN 
0860IF OK1<B THEN OK1=OK1+E 
0880ENDIF  
0900ENDPROC  
0920PROC INDART(N) 
0940GET FIL5$,N:POST6$,KT,FSHT,ÅT 
0960EXEC FEJL(G,N,FIL5$) 
0980ENDPROC  
1000PROC FEJL(P1,P2,P3) 
1020IF STATUS(P3$)<>B THEN  
1040OUTPUT T 
1060PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2 
1080STOP  
1100ENDIF  
1120ENDPROC  
1140PROC CALC(AR3,B1,B2,ES) 
1160RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5) 
1180CALL "P641210:REGN" 
1200IF AR3<6 THEN  
1220IF FLAG THEN STOP  
1240ENDIF  
1260ES$=RES$ 
1280ENDPROC  
1300PROC SKRIVSID 
1320CLEAR  
1340PRINT "             L Ø N B E R E G N I N G" 
1360PRINT "Lønnr "; 
1380PRINT USING "#### ":LMNR; 
1400PRINT "Navn ";POST1$(E,25) 
1420PRINT "Linie Lønart    Nummer     Enheder      Sats      Beløb" 
1440FOR I=E TO LAST 
1460PRINT USING "### ":I; 
1480PRINT "  ";SIDE$(FØRST+I,V:G);"        ";SIDE$(FØRST+I,5:6);"     "; 
1500RESUL$=SIDE$(FØRST+I,11:10) 
1520IF RESUL$(10)="+" THEN RESUL$(10)=" " 
1540PRINT RESUL$; 
1560RESUL$=SIDE$(FØRST+I,21:7) 
1580IF RESUL$(7)="+" THEN RESUL$(7)=" " 
1600PRINT "   ";RESUL$;"   "; 
1620RESUL$=SIDE$(FØRST+I,28:10) 
1640IF RESUL$(10)="+" THEN RESUL$(10)=" " 
1660PRINT RESUL$ 
1680NEXT I 
1700ENDPROC  
1720PROC RETSID 
1740REPEAT  
1760REPEAT  
1780LINE$="0" 
1800CURSOR E,23 
1820EDIT "Linienr, 0: færdig  SL: slet linier ",LINE$ 
1840IF LINE$<>"SL" THEN  
1860EXEC CHECK(LINE$,C) 
1880IF C<=B THEN RESULT=-E 
1900ELSE  
1905LINE$="N" 
1907CURSOR E,23 
1910EDIT "Slet: Alle : A, Linienrinterval : N  ",LINE$ 
1915IF LINE$="A" THEN  
1920RESULT=B 
1940AT=B 
1960IT=(LMNR-E)*ATPLM+E 
1980UT=IT 
2000LAST=B;FØRST=B;SIDST=B 
2002ELSE  
2004REPEAT  
2006LF,LS=B 
2008CURSOR E,23 
2009PRINT "                                           " 
2010CURSOR E,23 
2012EDIT "Fra linienr ",LF 
2014CURSOR E,23 
2016EDIT "Til linienr ",LS 
2018LF=INT(LF) 
2020LS=INT(LS) 
2022UNTIL LS=>LF AND LF=>E AND LS<=LAST 
2023IF SIDE$(FØRST+LF,E,4)="1 39" THEN LF=LF+E 
2024LS=LS+E 
2026IF FØRST+LS<=SIDST AND SIDE$(FØRST+LS,E,4)="1 39" THEN LS=LS+E 
2028WHILE FØRST+LS<=SIDST 
2030SIDE$(FØRST+LF)=SIDE$(FØRST+LS) 
2032LF=LF+E 
2034LS=LS+E 
2036ENDWHILE  
2038AT=AT-LS+LF 
2040SIDST=SIDST-LS+LF 
2042LAST=SIDST-FØRST 
2044IF LAST>18 THEN LAST=18 
2046RESULT=-E 
2048ENDIF  
2058ENDIF  
2059UNTIL RESULT<=LAST 
2060LI=RESULT 
2080IF LI>B THEN EXEC INLINE(LI) 
2090IF LI<B THEN EXEC SKRIVSID 
2100UNTIL LI=B 
2105FØRST=FØRST+LAST 
2120ENDPROC  
2140PROC INDSID 
2160FOR I=E TO 18 
2180SIDE$(FØRST+I)="1 0       0         0      0         " 
2190SIDST=SIDST+E;AT=AT+E;LAST=I 
2200EXEC INLINE(I) 
2210I=LAST 
2220IF LANR=B THEN  
2260I=18 
2280ELSE  
2320IF AT=>ATPLM-4 THEN I=18 
2340ENDIF  
2360NEXT I 
2380ENDPROC  
2400PROC INDTRANS 
2420K=E 
2440REPEAT  
2460GET FIL1$,IT:SIDE$(K) 
2480IT=IT+E 
2500K=K+E 
2520UNTIL SIDE$(K-E,E)=" " OR SIDE$(K-E,G)="*" OR SIDE$(K-E,E)="2" 
2540IF SIDE$(K-E,E)=" " OR SIDE$(K-E,G)="*" THEN  
2560LAST=K-G 
2580IT=IT-E 
2600ELSE  
2620LAST=K-E 
2640ENDIF  
2660AT=AT+LAST 
2665FØRST=B;SIDST=LAST 
2670IF LAST>18 THEN LAST=18 
2680ENDPROC  
2700PROC UDATRANS 
2720FOR K=E TO LAST 
2740IF AUT$(K,E)="3" OR AUT$(K,E)="1" THEN  
2750AUT$(K,E)="1" 
2760PUT FIL1$,UT:AUT$(K) 
2780UT=UT+E 
2800ENDIF  
2820NEXT K 
2860ENDPROC  
2880PROC UDTRANS 
2900FOR K=E TO SIDST 
2920IF SIDE$(K,E)="3" OR SIDE$(K,E)="1" THEN  
2930SIDE$(K,E)="1" 
2940PUT FIL1$,UT:SIDE$(K) 
2960UT=UT+E 
2980ENDIF  
3000NEXT K 
3040ENDPROC  
3060PROC INLINE(LINIE) 
3070IF SIDE$(FØRST+LINIE,V:G)<>"39" THEN  
3080REPEAT  
3100REPEAT  
3120CURSOR 7,LINIE+V 
3140LINE$=SIDE$(FØRST+LINIE,V:G) 
3150SIDE$(FØRST+LINIE,V:G)="  " 
3160EDIT "",LINE$ 
3180EXEC CHECK(LINE$,OK) 
3190IF RESULT=39 THEN OK=B 
3200UNTIL OK>B AND OK<V 
3220LANR=RESULT 
3240IF RESULT=B THEN  
3242QUQ=FØRST+LINIE 
3244WHILE QUQ<SIDST 
3246SIDE$(QUQ)=SIDE$(QUQ+E) 
3248QUQ=QUQ+E 
3250ENDWHILE  
3252SIDST=SIDST-E 
3254AT=AT-E 
3256LAST=SIDST-FØRST 
3258IF LAST>18 THEN LAST=18 
3259IF FØRST+LINIE<=SIDST AND SIDE$(FØRST+LINIE,E,4)="1 39" THEN GO TO 3242 
3260EXEC SKRIVSID 
3280ELSE  
3300EXEC INDART(LANR) 
3320IF POST6$(E)="1" AND POST6$(29)=" " THEN  
3340RESULT=B 
3360SIDE$(FØRST+LINIE,E:4)="1 "+CHR(LANR DIV 10+48)+CHR(LANR MOD 10+48) 
3380ENDIF  
3400ENDIF  
3420UNTIL RESULT=B 
3440IF LANR>B THEN  
3450LINE$="      " 
3460IF LANR<>73 AND LANR<>75 THEN  
3480REPEAT  
3500CURSOR 17,LINIE+V 
3520LINE$=SIDE$(FØRST+LINIE,5:6) 
3530SIDE$(FØRST+LINIE,5:6)="      " 
3540EDIT "",LINE$ 
3560UNTIL LEN(LINE$)<=6 AND (LEN(LINE$)<6 OR SIDST<ATPLM-4) 
3570ENDIF  
3580SIDE$(FØRST+LINIE,5:6)=LINE$ 
3620REPEAT  
3640REPEAT  
3660CURSOR 28,LINIE+V 
3680LINE$=SIDE$(FØRST+LINIE,11:10) 
3700IF LINE$(10)="+" THEN LINE$(10)=" " 
3720EDIT "",LINE$ 
3721IF LANR=75 THEN  
3722EXEC DATOCHECK(LINE$,FLAG) 
3723FLAG=(FLAG=B) 
3724RESUL$="  "+LINE$(E,6)+"    " 
3730ELSE  
3740LINE$=LINE$+"+" 
3760EXEC CALC(6,LINE$,TAH$,RESUL$) 
3770ENDIF  
3780UNTIL FLAG=B 
3785IF LANR=75 THEN  
3790SI=E 
3795ELSE  
3800EXEC CALC(4,RESUL$,MAX$,MAX1$) 
3805ENDIF  
3820UNTIL SI=E 
3840SIDE$(FØRST+LINIE,11:10)=RESUL$(V:10) 
3860EXEC CALC(4,RESUL$,TAH$,MAX$) 
3880IF SI=B THEN  
3900ENH=B 
3920ELSE  
3940ENH=E 
3960ENDIF  
3980IF LANR<61 OR (LANR>61 AND LANR<65) OR LANR=70 THEN  
4000REPEAT  
4020REPEAT  
4040CURSOR 41,LINIE+V 
4060LINE$=SIDE$(FØRST+LINIE,21:7) 
4080IF LINE$(7)="+" THEN LINE$(7)=" " 
4100EDIT "",LINE$ 
4120LINE$=LINE$+"+" 
4140EXEC CALC(6,LINE$,TAH$,RESUL$) 
4160UNTIL FLAG=B 
4180EXEC CALC(4,RESUL$,MAX1$,MAX$) 
4200UNTIL SI=E 
4220SIDE$(FØRST+LINIE,21:7)=RESUL$(6:7) 
4240EXEC CALC(4,RESUL$,TAH$,MAX$) 
4260IF SI=B THEN  
4280SATS=B 
4300ELSE  
4320SATS=E 
4340ENDIF  
4360ELSE  
4380SATS=B 
4390SIDE$(FØRST+LINIE,21:7)="       " 
4400ENDIF  
4420IF LANR<71 AND ENH*SATS=B AND LANR<>60 THEN  
4440REPEAT  
4460REPEAT  
4480CURSOR 51,LINIE+V 
4500LINE$=SIDE$(FØRST+LINIE,28:10) 
4520IF LINE$(10)="+" THEN LINE$(10)=" " 
4540EDIT "",LINE$ 
4560LINE$=LINE$+"+" 
4580EXEC CALC(6,LINE$,TAH$,RESUL$) 
4600UNTIL FLAG=B 
4620EXEC CALC(4,RESUL$,MAX$,MAX1$) 
4640UNTIL SI=E 
4650IF LANR=49 THEN RESUL$(12)="-" 
4660SIDE$(FØRST+LINIE,28:10)=RESUL$(V:10) 
4680ELSE  
4700IF ENH*SATS=E AND LANR<>60 THEN  
4720LINE$=SIDE$(FØRST+LINIE,11:10) 
4740RESUL$=SIDE$(FØRST+LINIE,21:7) 
4760EXEC CALC(G,LINE$,RESUL$,RESUL1$) 
4780ELSE  
4800RESUL1$="          0+" 
4820ENDIF  
4821IF LANR=72 OR LANR=73 THEN RESUL1$(V:10)=SIDE$(FØRST+LINIE,11:10) 
4830IF LANR=49 THEN RESUL1$(12)="-" 
4840SIDE$(FØRST+LINIE,28:10)=RESUL1$(V:10) 
4860CURSOR 51,LINIE+V 
4880IF RESUL1$(12)="+" THEN RESUL1$(12)=" " 
4900PRINT RESUL1$(V:10) 
4901ENDIF  
4903KUK=FØRST+LINIE 
4904IF SIDE$(KUK,10)>"0" AND SIDE$(KUK,10)<="9" AND SATS>B THEN  
4906IF KUK=SIDST THEN  
4908IF LAST<18 THEN LAST=LAST+E 
4910SIDST=SIDST+E 
4912AT=AT+E 
4914SIDE$(SIDST)="1 39      0         0      0         " 
4916ELSE  
4918IF SIDE$(KUK+E,E,4)<>"1 39" THEN  
4920SIDST=SIDST+E 
4922AT=AT+E 
4924IF LAST<18 THEN LAST=LAST+E 
4926QUQ=SIDST 
4928WHILE QUQ>KUK+E 
4930SIDE$(QUQ)=SIDE$(QUQ-E) 
4932QUQ=QUQ-E 
4934ENDWHILE  
4936SIDE$(QUQ)="1 39      0         0      0         " 
4938ENDIF  
4940ENDIF  
4941EXEC SKRIVSID 
4942ELSE  
4944IF KUK<SIDST THEN  
4946IF SIDE$(KUK+E,E,4)="1 39" THEN  
4948QUQ=KUK+E 
4950WHILE QUQ<SIDST 
4952SIDE$(QUQ)=SIDE$(QUQ+E) 
4954QUQ=QUQ+E 
4956ENDWHILE  
4958SIDST=SIDST-E 
4960AT=AT-E 
4962LAST=SIDST-FØRST 
4964IF LAST>18 THEN LAST=18 
4965EXEC SKRIVSID 
4966ENDIF  
4968ENDIF  
4970ENDIF  
4977ENDIF  
4978ENDIF  
4979ENDPROC  
4980PROC AUTTRANS 
5000CLEAR  
5020PRINT "             L Ø N B E R E G N I N G" 
5040PRINT "Lønnr "; 
5060PRINT USING "#### ":LMNR; 
5080PRINT "Navn ";POST1$(E,25) 
5100PRINT "Linie Lønart    Nummer     Enheder      Sats      Beløb" 
5120IF POST2$(24,25)<"90" THEN  
5140II=G 
5160ELSE  
5180II=E 
5200ENDIF  
5220FOR I=E TO II 
5240CURSOR 7,V+I 
5260PRINT AUT$(I,G:V) 
5280REPEAT  
5300REPEAT  
5320CURSOR 41,V+I 
5340LINE$=AUT$(I,21:7) 
5360IF LINE$(7)="+" THEN LINE$(7)=" " 
5380EDIT "",LINE$ 
5400LINE$=LINE$+"+" 
5420EXEC CALC(6,LINE$,TAH$,RESUL$) 
5440UNTIL FLAG=B 
5460EXEC CALC(4,RESUL$,HUND$,MAX$) 
5480UNTIL SI=E 
5500AUT$(I,21:7)=RESUL$(6:7) 
5520NEXT I 
5540CURSOR 7,6 
5560PRINT AUT$(V,G:V) 
5580REPEAT  
5600REPEAT  
5620CURSOR 51,6 
5640LINE$=AUT$(V,28:10) 
5660IF LINE$(10)="+" THEN LINE$(10)=" " 
5680EDIT "",LINE$ 
5700LINE$=LINE$+"+" 
5720EXEC CALC(6,LINE$,TAH$,RESUL$) 
5740UNTIL FLAG=B 
5760EXEC CALC(4,RESUL$,MAX$,MAX1$) 
5780UNTIL SI=E 
5800AUT$(V,28:10)=RESUL$(V:10) 
5820LT=LT*100 
5840AUT$(4,21)=" " 
5860AUT$(4,22)=CHR(LT DIV 1000+48) 
5880AUT$(4,23)=CHR(LT DIV 100 MOD 10+48) 
5900AUT$(4,24)="," 
5920AUT$(4,25)=CHR(LT DIV 10 MOD 10+48) 
5940AUT$(4,26)=CHR(LT MOD 10+48) 
5960AUT$(4,27)="+" 
5980AUT$(4,11:10)="          " 
6000CASE POST2$(21) OF  
6020WHEN "1" 
6040AUT$(4,11)="1" 
6060WHEN "2","3" 
6080AUT$(4,11)="7" 
6100WHEN "4","5" 
6120AUT$(4,11:G)="14" 
6140WHEN "6","7" 
6160AUT$(4,11:G)="30" 
6180ENDCASE  
6200IF FD=B THEN  
6220CURSOR 7,7 
6240PRINT AUT$(4,G:V) 
6260REPEAT  
6280REPEAT  
6300CURSOR 28,7 
6320LINE$=AUT$(4,11:10) 
6340IF LINE$(10)="+" THEN LINE$(10)=" " 
6360EDIT "",LINE$ 
6380LINE$=LINE$+"+" 
6400EXEC CALC(6,LINE$,TAH$,RESUL$) 
6420UNTIL FLAG=B 
6440EXEC CALC(4,RESUL$,HUND$,MAX$) 
6460UNTIL SI=E 
6480AUT$(4,11:10)=RESUL$(V:10) 
6500ENDIF  
6520LAST=4 
6540ENDPROC  
6560FIL$="P641220:VIRKKART" 
6580EXEC INDVIRK 
6600CLOSE FIL$ 
6610DIM SIDE$(ATPLM-V,37) 
6620FIL$="P641220:LØNMODRG" 
6640OPEN FIL$,R 
6660FIL1$="P641220:TRANSREG" 
6680OPEN FIL1$,W 
6700FIL5$="P641220:LØNARTRG" 
6720OPEN FIL5$,R 
6740REPEAT  
6760CLEAR  
6780REPEAT  
6800LMNR=B 
6820EDIT "Lønnr ",LMNR 
6840UNTIL LMNR=>B AND LMNR<MLMNR 
6860IF LMNR>B THEN  
6880EXEC INLØNMOD(LMNR) 
6900IF LA<>B THEN  
6920IT=(LMNR-E)*ATPLM+E 
6940UT=IT 
6960AT=B 
6970EXEC INDTRANS 
6980REPEAT  
7005IF SIDE$(E,E)="2" THEN  
7010LAST=B 
7015ELSE  
7020EXEC SKRIVSID 
7040IF LAST>B THEN  
7060EXEC RETSID 
7070LAST=SIDST-FØRST 
7080IF LAST>18 THEN LAST=18 
7100ENDIF  
7110ENDIF  
7120UNTIL LAST=B OR IT=(LMNR-E)*ATPLM+E 
7130IF SIDE$(FØRST+E,E)<>"2" THEN  
7140IF IT>(LMNR-E)*ATPLM+E THEN  
7160FOR K=E TO 4 
7180GET FIL1$,IT:AUT$(K) 
7200IT=IT+E 
7220NEXT K 
7240ELSE  
7260AUT$(E)="1*78                0                " 
7280AUT$(G)="1*79                0                " 
7300AUT$(V)="1*80                       0         " 
7320AUT$(4)="1*83      0                          " 
7340ENDIF  
7355IF AT<ATPLM-4 THEN  
7360REPEAT  
7370LAST=B 
7380EXEC SKRIVSID 
7400EXEC INDSID 
7420IF LAST>B THEN EXEC RETSID 
7460UNTIL LAST<18 
7470ENDIF  
7475EXEC UDTRANS 
7480EXEC AUTTRANS 
7500EXEC UDATRANS 
7520AT=AT+4 
7540IF AT<ATPLM THEN  
7560SIDE$(E,E)=" " 
7580PUT FIL1$,UT:SIDE$(E) 
7600ENDIF  
7605ELSE  
7607PRINT "Lønmodtager ikke bogført" 
7610INPUT "RETURN",LINE$ 
7615ENDIF  
7620ELSE  
7640PRINT "Lønmodtager findes ikke" 
7660INPUT "RETURN",LINE$ 
7680ENDIF  
7700ENDIF  
7720UNTIL LMNR=B 
7740CLOSE FIL$ 
7760CLOSE FIL1$ 
7780CLOSE FIL5$ 
7800CHAIN "P641210:STARTB"