DataMuseum.dk

top - download

    Length: 7584 (0x1da0)
    Types: TextFile
    Notes: Mikados_K
    Names: »AKKULIST.K«

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

Mikados K File

0001DIM TVN(45) 
0002TVN(E)=E 
0003TVN(G)=G 
0004TVN(V)=V 
0005TVN(4)=4 
0006TVN(5)=5 
0007TVN(6)=7 
0008TVN(7)=8 
0009TVN(8)=W 
0010TVN(W)=10 
0011TVN(10)=11 
0012TVN(11)=12 
0013TVN(12)=13 
0014TVN(13)=14 
0015TVN(14)=15 
0016TVN(15)=16 
0017TVN(16)=112 
0018TVN(17)=113 
0019TVN(18)=313 
0020TVN(19)=413 
0021TVN(20)=115 
0022TVN(21)=315 
0023TVN(22)=415 
0024TVN(23)=116 
0025TVN(24)=316 
0026TVN(25)=416 
0027TVN(26)=117 
0028TVN(27)=317 
0029TVN(28)=417 
0030TVN(29)=123 
0031TVN(30)=206 
0032TVN(31)=212 
0033TVN(32)=214 
0034TVN(33)=218 
0035TVN(34)=219 
0036TVN(35)=319 
0037TVN(36)=419 
0038TVN(37)=220 
0039TVN(38)=320 
0040TVN(39)=420 
0041TVN(40)=221 
0042TVN(41)=321 
0043TVN(42)=421 
0044TVN(43)=222 
0045TVN(44)=223 
0046TVN(45)=224 
0100PROC INLØNMOD(N) 
0110GET FIL1$,G*N-E:POST1$ 
0120GET FIL1$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD 
0130EXEC FEJL(E,N,FIL1$) 
0140ENDPROC  
0150PROC NÆSTE 
0160REPEAT  
0170LMNR=LMNR+E 
0180LA=E 
0190IF LMNR<=MLMNR THEN EXEC INLØNMOD(LMNR) 
0200UNTIL LA>B 
0210ENDPROC  
0220DIM RES$(15),OP1$(12),OP2$(12),POST1$(71),POST2$(27),ARS$(G),POST6$(29) 
0230DIM FIL1$(16),FIL5$(16),FIL2$(16),POST3$(55),RESUL2$(12),TOT$(12) 
0240DIM RESUL$(12),RESUL1$(12),POST5$(55),TV$(45,11),DAD$(6) 
0250DIM FIL$(16) 
0260DIM EN$(12),BE$(12),POST4$(34) 
0270PROC CALC(AR3,B1,B2,ES) 
0280RES$=ES$;OP1$=B1$;OP2$=B2$;SI=B;FLAG=B;ART=AR3-6*(AR3>5) 
0290CALL "P641210:REGN" 
0300IF AR3<6 AND FLAG THEN STOP  
0310ES$=RES$ 
0320ENDPROC  
0330PROC INDVIRK 
0340OPEN FIL$,R 
0350EXEC FEJL(B,B,FIL$) 
0360GET FIL$,E:POST3$ 
0370GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM 
0375GET FIL$,V:DAD$ 
0380ENDPROC  
0390PROC FEJL(P1,P2,P3) 
0400IF STATUS(P3$)<>B THEN  
0410OUTPUT T 
0420PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2 
0430STOP  
0440ENDIF  
0450ENDPROC  
0460DIM P7$(37) 
0470PROC INDART(N) 
0480GET FIL5$,N:POST6$,KT,FSHT,ÅT 
0490EXEC FEJL(G,N,FIL5$) 
0500ENDPROC  
0510PROC INDTÆL(N) 
0515IF N<>OLMNR THEN  
0516OLMNR=N 
0520J=W*(N-E) 
0530FOR K=E TO W 
0540GET FIL2$,J+K:POST5$ 
0550FOR I=E TO 5 
0560TV$((K-E)*5+I)=POST5$((I-E)*11+E:11) 
0570NEXT I 
0580NEXT K 
0590EXEC FEJL(N,K,FIL2$) 
0595ENDIF  
0600ENDPROC  
0610PROC HEAD 
0620WHILE LINIE<72 
0630PRINT  
0640LINIE=LINIE+E 
0650ENDWHILE  
0660SID=SID+E 
0670PRINT  
0680PRINT POST3$(8,32);TAB(30);"S A L D O L I S T E";TAB(57);"Dato ";DAD$; 
0681PRINT "  Side";SID 
0700PRINT "LØNART";LANR;TAB(30);POST6$(G,21);TAB(52); 
0701CASE TYP OF  
0702WHEN 4 
0703PRINT "SALDOAKKUMULERENDE"; 
0704WHEN V 
0705PRINT "ÅRS-TÆLLEVÆRK";TVN(ÅT); 
0706WHEN G 
0707PRINT "F-SH-TÆLLEVÆRK";TVN(FSHT); 
0708WHEN E 
0709PRINT "KVARTALS-TÆLLEVÆRK";TVN(KT); 
0710ENDCASE  
0717PRINT  
0718PRINT  
0720PRINT "LMNR   NAVN";TAB(39);"GL.SALDO       PERIODEN       NY SALDO" 
0730LINIE=6 
0740ENDPROC  
0750FIL$="P641220:VIRKKART" 
0760EXEC INDVIRK 
0770CLOSE FIL$ 
0780FIL1$="P641220:LØNMODRG" 
0790OPEN FIL1$,R 
0800FIL$="P641220:TRANSREG" 
0810OPEN FIL$,R 
0820FIL2$="P641220:TÆLLEREG" 
0830OPEN FIL2$,R 
0840FIL5$="P641220:LØNARTRG" 
0850OPEN FIL5$,R 
0855REPEAT  
0860EN$="          0+" 
0870BE$=EN$;TOT$=EN$ 
0880LINIE=72;SID=B 
0890OLMNR,LMNR=B 
0900REPEAT  
0910CLEAR  
0920PRINT "L I S T E   O V E R   A K K U M U L E R E D E   S A L D I" 
0930LANR=B 
0940EDIT "Lønart ,0 for færdig ",LANR 
0950LANR=INT(LANR) 
0960TYP=B 
0970IF LANR>B AND LANR<100 THEN  
0980EXEC INDART(LANR) 
0990IF KT<>B THEN TYP=E 
1000IF FSHT<>B THEN TYP=G 
1010IF ÅT<>B THEN TYP=V 
1020IF POST6$(26)="1" THEN TYP=4 
1030IF POST6$(29)<>" " OR POST6$(E)<>"1" THEN TYP=B 
1040ENDIF  
1050UNTIL TYP>B OR LANR=B 
1051REPEAT  
1052ALLE=G 
1053EDIT "Kun afregnede: 0, alle: 1 ",ALLE 
1054UNTIL ALLE=E OR ALLE=B 
1055IF LANR>B THEN  
1060ARS$=CHR(LANR DIV 10+48)+CHR(LANR MOD 10+48) 
1070OUTPUT P 
1080EXEC NÆSTE 
1090WHILE LMNR<=MLMNR 
1100IT=(LMNR-E)*ATPLM+E 
1110GET FIL$,IT:P7$ 
1120IF P7$(E)="2" OR (ALLE=E AND P7$(E)="3") THEN  
1130WHILE P7$(V,4)<>"83" 
1140IF P7$(V,4)=ARS$ THEN  
1150IF LINIE>69 THEN EXEC HEAD 
1160IF TYP<4 THEN EXEC INDTÆL(LMNR) 
1170CASE TYP OF  
1180WHEN 4 
1190RESUL$=" "+P7$(11:10) 
1200WHEN V 
1210RESUL$=TV$(ÅT) 
1220WHEN G 
1230RESUL$=TV$(FSHT) 
1240WHEN E 
1250RESUL$=TV$(KT) 
1260ENDCASE  
1270RESUL1$=P7$(28:10) 
1280EXEC CALC(E,RESUL$,RESUL1$,RESUL2$) 
1290EXEC CALC(B,EN$,RESUL$,EN$) 
1300EXEC CALC(B,BE$,RESUL1$,BE$) 
1310EXEC CALC(B,TOT$,RESUL2$,TOT$) 
1320IF RESUL$(11)="+" THEN RESUL$(11)=" " 
1330IF RESUL1$(10)="+" THEN RESUL1$(10)=" " 
1340IF RESUL2$(12)="+" THEN RESUL2$(12)=" " 
1350PRINT LMNR;TAB(8);POST1$(E,25);"   ";RESUL2$;"     ";RESUL1$; 
1360PRINT "    ";RESUL$ 
1370LINIE=LINIE+E 
1380ENDIF  
1390IT=IT+E 
1400GET FIL$,IT:P7$ 
1410ENDWHILE  
1420ENDIF  
1430EXEC NÆSTE 
1440ENDWHILE  
1445IF LINIE<72 THEN  
1450PRINT "--------------------------------------------------------------"; 
1460PRINT "--------------" 
1470IF TOT$(12)="+" THEN TOT$(12)=" " 
1480IF BE$(12)="+" THEN BE$(12)=" " 
1490IF EN$(12)="+" THEN EN$(12)=" " 
1495PRINT "Total";TAB(36);TOT$;"   ";BE$;"   ";EN$ 
1500LINIE=LINIE+G 
1510WHILE LINIE<72 AND LINIE>B 
1520PRINT  
1530LINIE=LINIE+E 
1540ENDWHILE  
1545ENDIF  
1550OUTPUT T 
1554ENDIF  
1555UNTIL LANR=B 
1560CHAIN "P641210:STARTB"