|
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: 8736 (0x2220)
Types: TextFile
Notes: Mikados_K
Names: »SYSVEDL.K«
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
└─⟦this⟧ »SYSVEDL.K«
PROGRAM SYSVEDL;
TYPE
SYSPOST=RECORD
(*DATO1,DATO2,
UGENR,
MAXEXC,
ORDRENR1-2,
FAKTNR1-2,
KREDNTNR1-2,
BILAGSNR1-2,JOURFILNR,MOMS,
KASSFILNR,KASSJOURFILNR,KASSSID,
FAKJOURNR,POSTJOURNR,LA1-5*)
HELTAL: ARRAY (1..24) OF INTEGER;
KGB:ARRAY (1..5) OF REAL;
BETADAT:PACKED ARRAY (1..13) OF CHAR;
(*KIKKODE,ÆNDKODE*) KODE:ARRAY (1..2) OF PACKED ARRAY (1..10) OF CHAR
END;
SYSFILE=FILE OF SYSPOST;
VAR I,J:INTEGER;
R:REAL;
FILNAVN:STRING(20);
TEKST:STRING(13);
F:SYSFILE;
QUQ:^INTEGER;
PROCEDURE PRSYSOPL;
BEGIN
WITH F^ DO
BEGIN
CLEARSCREEN;
GOTOXY(1,1);
WRITELN('1 DATO',' ':26,HELTAL(1)*10000.0+HELTAL(2):10:-2);
WRITELN('2 UGENR',' ':25,HELTAL(3):10);
WRITELN('3 MAXEXCESS-KUNDEREG',' ':12,HELTAL(4):10);
WRITELN('4 ORDRENR',' ':23,HELTAL(5)*10000.0+HELTAL(6):10:-2);
WRITELN('5 FAKTURANR',' ':21,HELTAL(7)*10000.0+HELTAL(8):10:-2);
WRITELN('6 KREDITNOTANR',' ':18,HELTAL(9)*10000.0+HELTAL(10):10:-2);
WRITELN('7 BILAGSNR',' ':22,HELTAL(11)*10000.0+HELTAL(12):10:-2);
WRITELN('8 JOURNALFILNR',' ':18,HELTAL(13):10);
WRITELN('9 MOMS',' ':26,HELTAL(14)/100:10:2);
WRITELN('10 KASSRAPFILNR',' ':18,HELTAL(15):10);
WRITELN('11 KASJOURFILNR',' ':18,HELTAL(16):10);
WRITELN('12 KASSRAPSIDNR',' ':18,HELTAL(17):10);
WRITELN('13 FAKJOURSIDNR',' ':18,HELTAL(18):10);
WRITELN('14 KASJOURSIDNR',' ':18,HELTAL(19):10);
WRITELN('15 KASSE',' ':25,KGB(1)/100:10:2);
WRITELN('16 BANK',' ':26,KGB(2)/100:10:2);
WRITELN('17 GIRO',' ':26,KGB(3)/100:10:2);
WRITELN('18 RABAT',' ':25,KGB(4)/100:10:2);
WRITELN('19 RENTE',' ':25,KGB(5)/100:10:2);
WRITELN('20 BETALINGSDATO',' ':17,BETADAT);
WRITE('21 KIKKEKODE',' ':21);
IF FILNAVN='KLAUS-KLUDDER' THEN WRITELN(KODE(1)) ELSE WRITELN;
WRITE('22 PILLEKODE',' ':21);
IF FILNAVN='KLAUS-KLUDDER' THEN WRITELN(KODE(2)) ELSE WRITELN
END
END;
PROCEDURE ININT(I,J,INDEX,MIN,MAX:INTEGER);
VAR K:INTEGER;
BEGIN
REPEAT
GOTOXY(I,J);READLN;READ(K)
UNTIL (IORESULT=0) AND (K>=MIN) AND (K<=MAX);
F^.HELTAL(INDEX):=K
END;
PROCEDURE INREAL(I,J,INDEX1,INDEX2:INTEGER;MIN,MAX:REAL);
VAR R:REAL;
BEGIN
REPEAT
GOTOXY(I,J);READLN;READ(R)
UNTIL (IORESULT=0) AND (R>=MIN) AND (R<=MAX);
F^.HELTAL(INDEX1):=TRUNC(R/10000.0);
F^.HELTAL(INDEX2):=TRUNC(R-F^.HELTAL(INDEX1)*10000.0)
END;
PROCEDURE SYSOPL(O:INTEGER);
BEGIN
WITH F^ DO
BEGIN
CASE O OF
1: BEGIN
GOTOXY(1,1);
WRITELN('1 DATO');
INREAL(30,1,1,2,800000.0,990000.0)
END;
2: BEGIN
GOTOXY(1,2);
WRITELN('2 UGENR');
ININT(30,2,3,1,53)
END;
3: BEGIN
GOTOXY(1,3);
WRITELN('3 MAXEXCESS-KUNDEREG');
ININT(30,3,4,0,1000)
END;
4: BEGIN
GOTOXY(1,4);
WRITELN('4 ORDRENUMMER');
INREAL(30,4,5,6,0.0,10000000.0)
END;
5: BEGIN
GOTOXY(1,5);
WRITELN('5 FAKTURANR');
INREAL(30,5,7,8,0.0,10000000.0)
END;
6: BEGIN
GOTOXY(1,6);
WRITELN('6 KREDITNOTANR');
INREAL(30,6,9,10,0.0,10000000.0)
END;
7: BEGIN
GOTOXY(1,7);
WRITELN('7 BILAGSNR');
INREAL(30,7,11,12,0.0,10000000.0)
END;
8: BEGIN
GOTOXY(1,8);
WRITELN('8 JOURNALFILNR');
ININT(30,8,13,1,1000)
END;
20: BEGIN
GOTOXY(1,20);
WRITELN('20 BETALINGSDATO');
REPEAT
GOTOXY(30,20);
READLN;READ(TEKST)
UNTIL IORESULT=0;
FOR I:=1 TO 13 DO BETADAT(I):=' ';
FOR I:=1 TO LENGTH(TEKST) DO BETADAT(I):=TEKST(I)
END;
9: BEGIN
GOTOXY(1,9);
WRITELN('9 MOMS');
REPEAT
GOTOXY(30,9);
READLN;READ(R)
UNTIL (IORESULT=0) AND (R>=0) AND (R<=100);
HELTAL(14):=TRUNC(R*100)
END;
21: BEGIN
GOTOXY(1,21);
WRITELN('21 KIKKEKODE');
REPEAT
GOTOXY(30,21);
READLN;READ(TEKST)
UNTIL (IORESULT=0) AND (LENGTH(TEKST)<11);
FOR I:=1 TO 10 DO KODE(1,I):=' ';
FOR I:=1 TO LENGTH(TEKST) DO KODE(1,I):=TEKST(I)
END;
22: BEGIN
GOTOXY(1,22);
WRITELN('22 PILLEKODE');
REPEAT
GOTOXY(30,22);
READLN;READ(TEKST)
UNTIL (IORESULT=0) AND (LENGTH(TEKST)<11);
FOR I:=1 TO 10 DO KODE(2,I):=' ';
FOR I:=1 TO LENGTH(TEKST) DO KODE(2,I):=TEKST(I)
END;
10: BEGIN
GOTOXY(1,10);
WRITELN('10 KASSRAPFILNR');
ININT(30,10,15,1,1000)
END;
11: BEGIN
GOTOXY(1,11);
WRITELN('11 KASJOURFILNR');
ININT(30,11,16,1,1000)
END;
12: BEGIN
GOTOXY(1,12);
WRITELN('12 KASSRAPSIDNR');
ININT(30,12,17,1,10000)
END;
13: BEGIN
GOTOXY(1,13);
WRITELN('13 FAKJOURSIDNR');
ININT(30,13,18,1,10000)
END;
14: BEGIN
GOTOXY(1,14);
WRITELN('14 KASJOURSIDNR');
ININT(30,14,19,1,10000)
END;
15: BEGIN
GOTOXY(1,15);
WRITELN('15 KASSE');
REPEAT
GOTOXY(30,15);READLN;READ(KGB(1))
UNTIL IORESULT=0;
KGB(1):=100*KGB(1)
END;
16: BEGIN
GOTOXY(1,16);
WRITELN('16 BANK');
REPEAT
GOTOXY(30,16);READLN;READ(KGB(2))
UNTIL IORESULT=0;
KGB(2):=100*KGB(2)
END;
17: BEGIN
GOTOXY(1,17);
WRITELN('17 GIRO');
REPEAT
GOTOXY(30,17);READLN;READ(KGB(3))
UNTIL IORESULT=0;
KGB(3):=100*KGB(3)
END;
18: BEGIN
GOTOXY(1,18);
WRITELN('18 RABAT');
REPEAT
GOTOXY(30,18);READLN;READ(KGB(4))
UNTIL IORESULT=0;
KGB(4):=100*KGB(4)
END;
19: BEGIN
GOTOXY(1,19);
WRITELN('19 RENTE');
REPEAT
GOTOXY(30,19);READLN;READ(KGB(5))
UNTIL IORESULT=0;
KGB(5):=100*KGB(5)
END;
END
END;
END;
BEGIN
FILNAVN:='SYSREG:P2:1:I';
REWRITE(F,FILNAVN);
SEEK(F,1);
GET(F);
CLEARSCREEN;
REPEAT
GOTOXY(1,1);
WRITELN('OPRETTE, KIKKE ELL. ÆNDRE (1/2/3)');
GOTOXY(40,1);
READLN;READ(I)
UNTIL (IORESULT=0) AND (I>0) AND (I<4);
CASE I OF
1:BEGIN
CLEARSCREEN;
FOR J:=1 TO 22 DO SYSOPL(J);
SEEK(F,1);
PUT(F)
END;
2:BEGIN
REPEAT
GOTOXY(1,2);
WRITELN('ADGANGSKODE');
GOTOXY(20,2);READLN;READ(FILNAVN)
UNTIL IORESULT=0;
PRSYSOPL
END;
3:BEGIN
REPEAT
GOTOXY(1,2);
WRITELN('ADGANGSKODE');
GOTOXY(20,2);READLN;READ(FILNAVN)
UNTIL IORESULT=0;
PRSYSOPL;
REPEAT
REPEAT
GOTOXY(1,23);
WRITELN('HVILKET FELT SKAL ÆNDRES, 0 FOR SLUT');
GOTOXY(40,23);READLN;READ(I)
UNTIL (IORESULT=0) AND (I>=0) AND (I<23);
CASE I OF
1,2,20: SYSOPL(I);
9,21,22: IF FILNAVN='KLAUS-KLUDDER' THEN SYSOPL(I);
3,4,5,6,7,8,10,11,12,13,14,15,16,17,18,19:BEGIN
GOTOXY(1,23);
WRITELN('ÆNDRING IKKE TILLADT, TRYK RETURN NÅR FORSTÅET');
GOTOXY(40,23);
READLN;READ(J);
IF J=4711 THEN SYSOPL(I)
END;
END;
UNTIL I=0;
SEEK(F,1);
PUT(F)
END
END;
CLOSE(F);
CHAIN('INTRE *1','HOVSA:P1',QUQ)
END.