DataMuseum.dk

top - download

    Length: 7584 (0x1da0)
    Notes: Mikados TextFile, Mikados_K
    Names: »SYSVEDL«

└─⟦ec8c1e0b0⟧ Bits:30007442 8" floppy ( MIKPROG vol. 1-3, MIKREL vol. 1-3, PCSE 4.7.80 vol 1-3, GL.SYS )
    └─ ⟦this⟧ »SYSVEDL« 

Text

0100 DIM MOMS$(12),LAND$(10,12),CB$(30),OP1$(12),OP2$(12)
0110 DIM RES$(14),TAL$(14),BLANK$(25),K1$(17),K2$(17),N$(6),D$(2),F$(17)
0120 DIM B$(2),A$(1),T1(9),TFIL$(18,10)
0130 ART=0
0140 PROC CALC(ART1,B1,B2,ES)
0150 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0;ART=ART1
0160 CALL "P641210:REGN"
0170 ES$=RES$
0180 IF FLAG THEN STOP 
0190 ENDPROC 
0200 PROC FEJL(NR1,NR2,NR3)
0210 IF STATUS(NR3$)<>0 THEN 
0220 PRINT STATUS(NR3$),NR1,NR2,NR3$
0230 STOP 
0240 ENDIF 
0250 ENDPROC 
0260 PROC START(G)
0270 CLEAR 
0280 CURSOR 20,1
0290 PRINT "Systemvedligeholdelse  ";G$
0300 CURSOR 15,9
0310 PRINT "0: Færdig"
0320 CURSOR 15,11
0330 PRINT "1: Oprettelse"
0340 CURSOR 15,13
0350 PRINT "2: Ændring"
0360 REPEAT 
0370 CURSOR 18,15
0380 INPUT "Vælg type (0-2): ",B$
0390 UNTIL B$=>"0" AND B$<"3"
0400 C=ORD(B$)-48
0410 IF C=2 THEN C=3
0420 CLEAR 
0430 CURSOR 20,1
0440 PRINT "Systemvedligeholdelse  ";G$
0450 ENDPROC 
0460 PROC INDTASTNING(CNR)
0470 REPEAT 
0480 CASE CNR OF 
0490 STOP 
0500 WHEN 1
0510 IF C<>3 THEN 
0520 REPEAT 
0530 CURSOR 3,23
0540 PRINT " 1  Momsprocent          :";BLANK$(1:20)
0550 CURSOR 28,23
0560 INPUT TAL$
0570 TAL$=TAL$+"+"
0580 EXEC CALC(5,TAL$,TAL$,TAL$)
0590 UNTIL FLAG=0
0600 MOMS$=TAL$(3:12)
0610 ENDIF 
0620 CURSOR 4,5
0630 PRINT "1  Momsprocent          :";MOMS$(1:11)
0640 WHEN 2
0650 CB$="Fakturanummer        :"
0660 WHEN 3
0670 CB$="Kreditnotanummer     :"
0680 WHEN 4
0690 CB$="Fakturajournalside   :"
0700 WHEN 5
0710 CB$="Kasserapportside     :"
0720 WHEN 6
0730 CB$="Posteringsarkside    :"
0740 WHEN 7
0750 CB$="Bogholderijournalside:"
0760 WHEN 8
0770 CB$="Dato (ÅÅmmdd)        :"
0780 WHEN 9
0790 CB$="Bilagsnummer         :"
0800 ENDCASE 
0810 IF CNR<>1 THEN EXEC INDTAST(CB$,CNR)
0820 IF C=2 THEN 
0830 CNR=10
0840 ELSE 
0850 CNR=CNR+1
0860 ENDIF 
0870 UNTIL CNR=10
0880 ENDPROC 
0890 PROC INDTAST(CA,H)
0900 IF C<>3 THEN 
0910 REPEAT 
0920 REPEAT 
0930 CURSOR 3,23
0940 PRINT H;" ";CA$;BLANK$(1:20)
0950 CURSOR 28,23
0960 INPUT TAL$
0970 L=LEN(TAL$)
0980 UNTIL L>0 AND L<7
0990 P=0;TEST=0
1000 FOR J=1 TO L
1010 P1=INT(ORD(TAL$(J))-48)
1020 IF P1=>0 AND P1<10 THEN 
1030 P=P*10+P1
1040 ELSE 
1050 TEST=1
1060 ENDIF 
1070 NEXT J
1080 UNTIL TEST=0
1090 T1(H-1)=P
1100 ENDIF 
1110 CURSOR 3,H*2+3
1120 PRINT H;" ";CA$;T1(H-1)
1130 ENDPROC 
1140 PROC FEKST(M,AR)
1150 IF C<>3 THEN 
1160 REPEAT 
1170 CURSOR 3,23
1180 PRINT M;BLANK$;BLANK$
1190 CURSOR 5,23
1200 INPUT CB$
1210 L=LEN(CB$)
1220 UNTIL L>0 AND L<13
1230 AR$(M)=CB$
1240 ENDIF 
1250 CURSOR 3,M*2+1
1260 PRINT M;" ";AR$(M);BLANK$
1270 ENDPROC 
1280 K1$="P641220:SYSTEM1"
1290 OPEN K1$,R
1300 EXEC FEJL(1,1,K1$)
1310 GET K1$,10:N$
1320 EXEC FEJL(1,2,K1$)
1330 GET K1$,36:K2$
1340 EXEC FEJL(1,3,K1$)
1350 CLOSE K1$
1360 EXEC FEJL(1,4,K1$)
1370 K2$=N$+K2$
1380 OPEN K2$,R
1390 EXEC FEJL(1,5,K2$)
1400 GET K2$,1:MOMS$
1410 EXEC FEJL(1,6,K2$)
1420 GET K2$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
1430 EXEC FEJL(1,7,K2$)
1440 FOR I=1 TO 3
1450 J=(I-1)*3+1
1460 GET K2$,I+2:LAND$(J),LAND$(J+1),LAND$(J+2)
1470 EXEC FEJL(1,8,K2$)
1480 NEXT I
1490 FOR I=1 TO 3
1500 J=(I-1)*3+1
1510 GET K2$,I+5:TFIL$(J),TFIL$(J+1),TFIL$(J+2)
1520 EXEC FEJL(1,9,K2$)
1530 NEXT I
1540 CLOSE K2$
1550 EXEC FEJL(1,10,K2$)
1560 BLANK$="                        "
1570 REPEAT 
1580 CLEAR 
1590 CURSOR 20,1
1600 PRINT "Systemvedligeholdelse";BLANK$
1610 CURSOR 15,7
1620 PRINT "0: Færdig"
1630 CURSOR 15,9
1640 PRINT "1: Diverse"
1650 CURSOR 15,11
1660 PRINT "2: Landenavne"
1670 CURSOR 15,13
1680 PRINT "3: Bogholderitekster"
1690 REPEAT 
1700 CURSOR 18,15
1710 INPUT "Vælg type (0-3) :",D$
1720 UNTIL D$=>"0" AND D$<"4"
1730 IF D$<>"0" THEN 
1740 REPEAT 
1750 CASE D$ OF 
1760 STOP 
1770 WHEN "1"
1780 F$="Diverse"
1790 WHEN "2"
1800 F$="Landenavne"
1810 WHEN "3"
1820 F$="Bogholderitekster"
1830 ENDCASE 
1840 EXEC START(F$)
1850 IF C=0 THEN EXIT 
1860 CASE D$ OF 
1870 STOP 
1880 WHEN "1"
1890 EXEC INDTASTNING(1)
1900 WHEN "2"
1910 FOR J=1 TO 9
1920 EXEC FEKST(J,LAND$)
1930 NEXT J
1940 WHEN "3"
1950 FOR J=1 TO 9
1960 EXEC FEKST(J,TFIL$)
1970 NEXT J
1980 ENDCASE 
1990 C=2
2000 REPEAT 
2010 REPEAT 
2020 CURSOR 3,23
2030 PRINT "Hvilket felt ønskes ændret , 0 for færdig";BLANK$
2040 CURSOR 45,23
2050 INPUT A$
2060 K=ORD(A$)-48
2070 UNTIL K>-1 AND K<10
2080 IF K=0 THEN EXIT 
2090 CASE D$ OF 
2100 STOP 
2110 WHEN "1"
2120 EXEC INDTASTNING(K)
2130 WHEN "2"
2140 EXEC FEKST(K,LAND$)
2150 WHEN "3"
2160 EXEC FEKST(K,TFIL$)
2170 ENDCASE 
2180 UNTIL K=0
2190 UNTIL C=0
2200 ENDIF 
2210 UNTIL D$="0"
2220 OPEN K2$,W
2230 EXEC FEJL(2,1,K2$)
2240 PUT K2$,1:MOMS$
2250 EXEC FEJL(2,2,K2$)
2260 PUT K2$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
2270 EXEC FEJL(2,3,K2$)
2280 FOR I=1 TO 3
2290 J=(I-1)*3+1
2300 PUT K2$,I+2:LAND$(J),LAND$(J+1),LAND$(J+2)
2310 EXEC FEJL(2,4,K2$)
2320 NEXT I
2330 FOR I=1 TO 3
2340 J=(I-1)*3+1
2350 PUT K2$,I+5:TFIL$(J),TFIL$(J+1),TFIL$(J+2)
2360 EXEC FEJL(2,5,K2$)
2370 NEXT I
2380 CLOSE K2$
2390 EXEC FEJL(2,6,K2$)
2400 CHAIN "P641210:OPSTART"