|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 7584 (0x1da0)
Types: TextFile
Notes: Mikados_K
Names: »SYSVEDL.K«
└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
└─⟦this⟧ »SYSVEDL.K«
0100 REM SYSVEDL 0110 DIM MOMS$(12),LAND$(10,12),CB$(30),OP1$(12),OP2$(12) 0120 DIM RES$(14),TAL$(14),BLANK$(25),K1$(17),K2$(17),N$(6),D$(2),F$(17) 0130 DIM B$(2),A$(1),T1(9),TFIL$(18,10),AD$(5,7),AE$(5,29),AB$(5,30) 0140 ART=0 0150 PROC CALC(ART1,B1,B2,ES) 0160 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0;ART=ART1 0170 CALL "P641210:REGN" 0180 ES$=RES$ 0190 IF FLAG THEN STOP 0200 ENDPROC 0210 PROC FEJL(NR1,NR2,NR3) 0220 IF STATUS(NR3$)<>0 THEN 0230 PRINT STATUS(NR3$),NR1,NR2,NR3$ 0240 STOP 0250 ENDIF 0260 ENDPROC 0270 PROC START(G) 0280 CLEAR 0290 CURSOR 20,1 0300 PRINT "Systemvedligeholdelse ";G$ 0310 CURSOR 15,9 0320 PRINT "0: Færdig" 0330 CURSOR 15,11 0340 PRINT "1: Oprettelse" 0350 CURSOR 15,13 0360 PRINT "2: Ændring" 0370 REPEAT 0380 CURSOR 18,15 0390 INPUT "Vælg type (0-2): ",B$ 0400 UNTIL B$=>"0" AND B$<"3" 0410 C=ORD(B$)-48 0420 IF C=2 THEN C=3 0430 CLEAR 0440 CURSOR 20,1 0450 PRINT "Systemvedligeholdelse ";G$ 0460 ENDPROC 0470 PROC INDTASTNING(CNR) 0480 REPEAT 0490 CASE CNR OF 0500 STOP 0510 WHEN 1 0520 IF C<>3 THEN 0530 REPEAT 0540 CURSOR 3,23 0550 PRINT " 1 Momsprocent :";BLANK$(1:20) 0560 CURSOR 28,23 0570 INPUT TAL$ 0580 TAL$=TAL$+"+" 0590 EXEC CALC(5,TAL$,TAL$,TAL$) 0600 UNTIL FLAG=0 0610 MOMS$=TAL$(3:12) 0620 ENDIF 0630 CURSOR 4,5 0640 PRINT "1 Momsprocent :";MOMS$(1:11) 0650 WHEN 2 0660 CB$="Fakturanummer :" 0670 WHEN 3 0680 CB$="Kreditnotanummer :" 0690 WHEN 4 0700 CB$="Fakturajournalside :" 0710 WHEN 5 0720 CB$="Kasserapportside :" 0730 WHEN 6 0740 CB$="Posteringsarkside :" 0750 WHEN 7 0760 CB$="Bogholderijournalside:" 0770 WHEN 8 0780 CB$="Dato (ÅÅmmdd) :" 0790 WHEN 9 0800 CB$="Bilagsnummer :" 0810 ENDCASE 0820 IF CNR<>1 THEN EXEC INDTAST(CB$,CNR) 0830 IF C=2 THEN 0840 CNR=10 0850 ELSE 0860 CNR=CNR+1 0870 ENDIF 0880 UNTIL CNR=10 0890 ENDPROC 0900 PROC INDTAST(CA,H) 0910 IF C<>3 THEN 0920 REPEAT 0930 REPEAT 0940 CURSOR 3,23 0950 PRINT H;" ";CA$;BLANK$(1:20) 0960 CURSOR 28,23 0970 INPUT TAL$ 0980 L=LEN(TAL$) 0990 UNTIL L>0 AND L<7 1000 P=0;TEST=0 1010 FOR J=1 TO L 1020 P1=INT(ORD(TAL$(J))-48) 1030 IF P1=>0 AND P1<10 THEN 1040 P=P*10+P1 1050 ELSE 1060 TEST=1 1070 ENDIF 1080 NEXT J 1090 UNTIL TEST=0 1100 T1(H-1)=P 1110 ENDIF 1120 CURSOR 3,H*2+3 1130 PRINT H;" ";CA$;T1(H-1) 1140 ENDPROC 1150 PROC FEKST(M,AR,AC,XPOS,LÆ,AF) 1160 IF C<>3 THEN 1170 REPEAT 1180 CURSOR 3,23 1190 PRINT M;AC$;BLANK$;BLANK$(1:10);AF$ 1200 CURSOR XPOS,23 1210 INPUT CB$ 1220 L=LEN(CB$) 1230 UNTIL L>0 AND L<=LÆ 1240 AR$(M)=CB$ 1250 ENDIF 1260 CURSOR 3,M*2+1 1270 PRINT M;AC$;":";AR$(M);BLANK$ 1280 ENDPROC 1290 K1$="P641220:SYSTEM1" 1300 OPEN K1$,R 1310 EXEC FEJL(1,1,K1$) 1320 GET K1$,10:N$ 1330 EXEC FEJL(1,2,K1$) 1340 GET K1$,36:K2$ 1350 EXEC FEJL(1,3,K1$) 1360 CLOSE K1$ 1370 EXEC FEJL(1,4,K1$) 1380 K2$=N$+K2$ 1390 OPEN K2$,R 1400 EXEC FEJL(1,5,K2$) 1410 GET K2$,1:MOMS$ 1420 EXEC FEJL(1,6,K2$) 1430 GET K2$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9) 1440 EXEC FEJL(1,7,K2$) 1450 FOR I=1 TO 3 1460 J=(I-1)*3+1 1470 GET K2$,I+2:LAND$(J),LAND$(J+1),LAND$(J+2) 1480 EXEC FEJL(1,8,K2$) 1490 NEXT I 1500 FOR I=1 TO 3 1510 J=(I-1)*3+1 1520 GET K2$,I+5:TFIL$(J),TFIL$(J+1),TFIL$(J+2) 1530 EXEC FEJL(1,9,K2$) 1540 NEXT I 1550 GET K2$,18:AB$(1) 1560 EXEC FEJL(2,10,K2$) 1570 GET K2$,19:AB$(2) 1580 EXEC FEJL(2,11,K2$) 1590 GET K2$,20:AB$(5),AB$(4),AB$(3) 1600 EXEC FEJL(2,12,K2$) 1610 CLOSE K2$ 1620 EXEC FEJL(1,10,K2$) 1630 AD$(1)="Navn" 1640 AD$(2)="Gade" 1650 AD$(3)="Postnr" 1660 AD$(4)="By" 1670 AD$(5)="Diverse" 1680 AE$(1)="(max 30 tegn)" 1690 AE$(2)="(max 30 tegn)" 1700 AE$(3)="(max 4 tegn)" 1710 AE$(4)="(max 20 tegn)" 1720 AE$(5)="(listeoverskrift max 10 tegn)" 1730 BLANK$=" " 1740 REPEAT 1750 CLEAR 1760 CURSOR 20,1 1770 PRINT "Systemvedligeholdelse";BLANK$ 1780 CURSOR 15,7 1790 PRINT "0: Færdig" 1800 CURSOR 15,9 1810 PRINT "1: Diverse" 1820 CURSOR 15,11 1830 PRINT "2: Landenavne" 1840 CURSOR 15,13 1850 PRINT "3: Bogholderitekster" 1860 CURSOR 15,15 1870 PRINT "4: Firmaoplysninger" 1880 REPEAT 1890 CURSOR 18,17 1900 INPUT "Vælg type (0-4) :",D$ 1910 UNTIL D$=>"0" AND D$<"5" 1920 IF D$<>"0" THEN 1930 REPEAT 1940 CASE D$ OF 1950 STOP 1960 WHEN "1" 1970 F$="Diverse" 1980 WHEN "2" 1990 F$="Landenavne" 2000 WHEN "3" 2010 F$="Bogholderitekster" 2020 WHEN "4" 2030 F$="Firmaoplysninger" 2040 ENDCASE 2050 EXEC START(F$) 2060 IF C=0 THEN EXIT 2070 CASE D$ OF 2080 STOP 2090 WHEN "1" 2100 EXEC INDTASTNING(1) 2110 WHEN "2" 2120 FOR J=1 TO 9 2130 EXEC FEKST(J,LAND$,BLANK$(1),5,12,BLANK$(1)) 2140 NEXT J 2150 WHEN "3" 2160 FOR J=1 TO 9 2170 EXEC FEKST(J,TFIL$,BLANK$(1),5,12,BLANK$(1)) 2180 NEXT J 2190 WHEN "4" 2200 FOR J=1 TO 5 2210 J1=30-(J=3)*26-(J=4)*10-(J=5)*20 2220 EXEC FEKST(J,AB$,AD$(J),13,J1,AE$(J)) 2230 NEXT J 2240 ENDCASE 2250 C=2 2260 REPEAT 2270 REPEAT 2280 CURSOR 3,23 2290 PRINT "Hvilket felt ønskes ændret , 0 for færdig";BLANK$ 2300 CURSOR 45,23 2310 INPUT A$ 2320 K=ORD(A$)-48 2330 UNTIL K>-1 AND K<10 2340 IF K=0 THEN EXIT 2350 CASE D$ OF 2360 STOP 2370 WHEN "1" 2380 EXEC INDTASTNING(K) 2390 WHEN "2" 2400 EXEC FEKST(K,LAND$,BLANK$(1),5,12,BLANK$(1)) 2410 WHEN "3" 2420 EXEC FEKST(K,TFIL$,BLANK$(1),5,12,BLANK$(1)) 2430 WHEN "4" 2440 IF K<6 THEN 2450 J1=30-(K=3)*26-(K=4)*10-(K=5)*20 2460 EXEC FEKST(K,AB$,AD$(K),13,J1,AE$(K)) 2470 ENDIF 2480 ENDCASE 2490 UNTIL K=0 2500 UNTIL C=0 2510 ENDIF 2520 UNTIL D$="0" 2530 OPEN K2$,W 2540 EXEC FEJL(2,1,K2$) 2550 PUT K2$,1:MOMS$ 2560 EXEC FEJL(2,2,K2$) 2570 PUT K2$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9) 2580 EXEC FEJL(2,3,K2$) 2590 FOR I=1 TO 3 2600 J=(I-1)*3+1 2610 PUT K2$,I+2:LAND$(J),LAND$(J+1),LAND$(J+2) 2620 EXEC FEJL(2,4,K2$) 2630 NEXT I 2640 FOR I=1 TO 3 2650 J=(I-1)*3+1 2660 PUT K2$,I+5:TFIL$(J),TFIL$(J+1),TFIL$(J+2) 2670 EXEC FEJL(2,5,K2$) 2680 NEXT I 2690 PUT K2$,18:AB$(1) 2700 EXEC FEJL(2,15,K2$) 2710 PUT K2$,19:AB$(2) 2720 EXEC FEJL(2,16,K2$) 2730 PUT K2$,20:AB$(5,1:10),AB$(4,1:20),AB$(3,1:4) 2740 EXEC FEJL(2,17,K2$) 2750 CLOSE K2$ 2760 EXEC FEJL(2,6,K2$) 2770 CHAIN "P641210:OPSTART"