DataMuseum.dk

top - download

    Length: 5056 (0x13c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »OPSTART1.K«

└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
    └─⟦this⟧ »OPSTART1.K« 

Mikados K File

PROGRAM OPSTART;
TYPE
SYSPOST=RECORD
(*DATO1,DATO2,
  UGENR,
  MAXEXC,
  ORDRENR1-2,
  FAKTNR1-2,
  KREDNTNR1-2,
  BILAGSNR1-2,JOURFILNR,MOMS*) 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;
       PROCSTAT=RECORD
       NP:INTEGER;
       NROSTART:INTEGER
       END;
NPFILE = FILE OF PROCSTAT;
VAR    F:SYSFILE;
       I:INTEGER;
       QUQ:^INTEGER;
       NRPF:NPFILE;
       FIL:STRING(20);
       TEKST:STRING(13);
       CH:CHAR;
       R1,R:REAL;
BEGIN
  FIL:='PROCSTAT:P2:0:I';
(*$C-*)
  REPEAT
  REWRITE(NRPF,FIL);
  SEEK(NRPF,1);
  I:=IORESULT;
  IF I<>0 THEN BEGIN WRITELN('Ret fejl ved plade i drev 2, RETURN');
                     READLN END
  UNTIL I=0;
(*$C+*)
  GET(NRPF);
  IF NRPF^.NP=-1 THEN
  BEGIN
WRITELN(LIST,'<ShhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhHHHHHHHHHHHH>');
WRITELN(LIST,'<SvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvVVVVVVVVVVVVVVVV>');
WRITELN(LIST,'<Smmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm>');
    NRPF^.NP:=0;
    FIL:='SYSREG1:P2:1:I';
    REWRITE(F,FIL);
    SEEK(F,1);
    GET(F);
    CLEARSCREEN;
    GOTOXY(20,10);
    R:=F^.HELTAL(1)*10000.0+F^.HELTAL(2)+1;
    WRITELN('Systemdato : ',R:10:-2,'     (J/N) ');
    REPEAT
      GOTOXY(57,10);READLN;READ(CH)
    UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N') OR (CH='j') OR (CH='n'));
    R1:=R;
    IF (CH='N') OR (CH='n') THEN
    REPEAT
      GOTOXY(45,10);WRITELN('Ny dato     ');
      REPEAT
        GOTOXY(57,10);READLN;READ(R1)
      UNTIL (IORESULT=0);
      IF ((R1-R)<-1) OR ((R1-R)>2) THEN
      BEGIN
        GOTOXY(20,11);WRITELN('Ny dato    : ',R1:10:-2,'  J/N ');
        REPEAT
          GOTOXY(57,11);READLN;READ(CH)
        UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N') OR (CH='j') OR (CH='n'))
      END
      ELSE CH:='J';
    UNTIL (CH='J') OR (CH='j');
    F^.HELTAL(1):=TRUNC(R1/10000);
    F^.HELTAL(2):=TRUNC(R1-F^.HELTAL(1)*10000.0);
    GOTOXY(20,12);
    I:=F^.HELTAL(3);
    WRITELN('Ugenr      : ',I:10,'     (J/N) ');
    REPEAT
      GOTOXY(57,12);READLN;READ(CH)
    UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N') OR (CH='j') OR (CH='n'));
    IF (CH='N') OR (CH='n') THEN
    REPEAT
      GOTOXY(45,12);WRITELN('Nyt ugenr    ');
      REPEAT
        GOTOXY(57,12);READLN;READ(I)
      UNTIL (IORESULT=0);
      IF ((I-F^.HELTAL(3))<-1) OR ((I-F^.HELTAL(3))>2) THEN
      BEGIN
        GOTOXY(20,13);WRITELN('Nyt ugenr  : ',I:10,'  J/N ');
        REPEAT
          GOTOXY(57,13);READLN;READ(CH)
        UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N') OR (CH='j') OR (CH='n'))
      END
      ELSE CH:='J';
    UNTIL (CH='J') OR (CH='j');
    F^.HELTAL(3):=I;
    REPEAT
      GOTOXY(20,14);WRITELN('Betalingsdato ',F^.BETADAT,' (J/N) ');
      REPEAT
        GOTOXY(57,14);READLN;READ(CH)
      UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N') OR (CH='j') OR (CH='n'));
      IF (CH='N') OR (CH='n') THEN
      BEGIN
        GOTOXY(20,15);WRITELN('Ny dato');
        REPEAT
          GOTOXY(34,15);READLN;READ(TEKST)
        UNTIL IORESULT=0;
        FOR I:=1 TO 13 DO F^.BETADAT(I):=' ';
        FOR I:=1 TO LENGTH(TEKST) DO F^.BETADAT(I):=TEKST(I)
      END
    UNTIL (CH='J') OR (CH='j');
    NRPF^.NROSTART:=NRPF^.NROSTART+1;
    SEEK(F,1);
    PUT(F);
    CLOSE(F)
  END;
  NRPF^.NP:=NRPF^.NP+1;
  SEEK(NRPF,1);
  PUT(NRPF);
  CLOSE(NRPF);
  CHAIN('INTRE   *1','HOVSA1:P1',QUQ)
END.