|
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: 16224 (0x3f60)
Types: TextFile
Notes: Mikados_K
Names: »QFAKTURA.K«
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
└─⟦this⟧ »QFAKTURA.K«
PROGRAM FAKTURERING;
(*$IISFHEAD*)
VPOST=RECORD
A :AR;
HELTAL:ARRAY (1..11) OF INTEGER;
(*VARENR,LVRNDØR,OPRLAND,PAKENHED,FORVLEVU,DATSBES1,DATSBES2,DATSORD1,
DATSORD2,DÆKGRASÅ,ANAFTILG*)
NAVN:ARRAY (1..2) OF PACKED ARRAY(1..30) OF CHAR;
(*VARENAVN,NAVNHOSLEVERANDØR*)
REELTAL :ARRAY (1..15) OF REAL
(*PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,
RESAFIORDRE,STASBEST,ASOLGTIÅ,ASOLGTSÅ,OMSIÅR,OMSSÅR,DÆKBIDTD*)
END;
PLUOLINE = RECORD
VNR :ARRAY (1..3) OF INTEGER;
(*VNR,LEVERET,BESTILT*)
PRIS: REAL
END;
OLINE = RECORD
VNR :ARRAY (1..2) OF INTEGER;
(*VNR,BESTILT*)
PRIS: REAL
END;
PLUORPOST=RECORD
A:AR;
HEAD:ARRAY (1..12) OF INTEGER;
LINE:ARRAY (1..2) OF PACKED ARRAY (1..30) OF CHAR;
(*KNR1,KNR2,ONR1,ONR2,SIDE,LEVUGE,ORDREDATO1-2,LEVKODE,BETAKODE,
RESTORDREKODE,RABAT*)
ORDRELIN : ARRAY (1..15) OF PLUOLINE
END;
ORDREPOST = RECORD
A:AR;
(*
KNR1,KNR2,
NR1,NR2,
SIDE,
LEVUGE,ORDREDATO1-2,LEVKODE,BETAKODE,RESTORDREKODE,RABAT*)
HEAD :ARRAY(1..12) OF INTEGER;
LINE:ARRAY (1..2) OF PACKED ARRAY (1..30) OF CHAR;
ORDRELIN : ARRAY (1..15) OF OLINE
END;
KPOST=RECORD
A:AR;
NR:ARRAY (1..23) OF INTEGER;
NAVN: ARRAY (1..3) OF PACKED ARRAY (1..30) OF CHAR;
LANDSBY:PACKED ARRAY (1..20) OF CHAR;
POSTNR:PACKED ARRAY (1..25) OF CHAR;
TLF:PACKED ARRAY (1..10) OF CHAR;
SALDOKØB:ARRAY (1..9) OF REAL
END;
FAKPOST= RECORD
FORSEND:INTEGER;
EMBAL,FRAGT:REAL;
HEAD:ARRAY (1..12) OF INTEGER;
LINE:ARRAY (1..2) OF PACKED ARRAY (1..30) OF CHAR;
DITTO:ARRAY (1..2) OF PACKED ARRAY (1..20) OF CHAR;
TRANSPORTØR,AKOLLI:PACKED ARRAY (1..30) OF CHAR;
KODE8,KODE9,BRUTTOVÆGT:INTEGER;
ORDRELIN: ARRAY(1..15) OF PLUOLINE
END;
FAKFILE=FILE OF FAKPOST;
VZONE= RECORD
H:ISFHEAD;
T:ARRAY(1..451) OF INTEGER
END;
PLUZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..1118) OF INTEGER
END;
ORDZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..930) OF INTEGER
END;
KZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..918) OF INTEGER
END;
RORPOST=RECORD
A:AR;
(* KNR1,KNR2,
VNR,
DAT1,DAT2:INTEGER;*) HEAD:ARRAY(1..5) OF INTEGER;
ANTAL:REAL
END;
RORZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..327) OF INTEGER
END;
VAR FROR,FVAR,FORD,FPLU,FKUN : ISF;
FAKFIL:FAKFILE;
VZ:VZONE;
KZ:KZONE;
OZ:ORDZONE;
RZ:RORZONE;
RESTORD:RORPOST;
LIN:STRING(30);
PZ:PLUZONE;
ORDRE:ORDREPOST;
VARE:VPOST;
PLUORD:PLUORPOST;
KUNDE:KPOST;
FNAVN:STRING(20);
IER,I,J,K,L
:INTEGER;
R,R1 :REAL;
TMÅDE,UDPSTED,
SENDTPR:ARRAY (1..20) OF PACKED ARRAY (1..30) OF CHAR;
QUQ:^INTEGER;
SEGMENT PROCEDURE INIT;
BEGIN
SENDTPR(1):='Post ';
SENDTPR(2):='Luftpost ';
SENDTPR(3):='Bane ';
SENDTPR(4):='Fragtmand ';
SENDTPR(5):='Samson / Liniegods ';
SENDTPR(6):='Samson / Olson & Wright ';
SENDTPR(7):='Leman ';
SENDTPR(8):='Deres transportør ';
SENDTPR(9):='Skib ';
SENDTPR(10):='Veritas ';
SENDTPR(11):='DFDS ';
SENDTPR(12):='Faroe ship ';
SENDTPR(13):='Vogn / bil ';
SENDTPR(14):='Afhentet ';
FOR I:=15 TO 19 DO
SENDTPR(I):= ' ';
SENDTPR(20):='Brevdue ';
TMÅDE(1):= 'Dansk skib 11';
TMÅDE(2):= 'Udenlandsk skib 15';
TMÅDE(3):= 'Bane 20';
TMÅDE(4):= 'Post 30';
TMÅDE(5):= 'Fly 40';
TMÅDE(6):= 'Dansk bil 51';
TMÅDE(7):= 'Udenlandsk bil 55';
TMÅDE(8):= 'Anden transportmåde 90';
FOR I:=9 TO 20 DO
TMÅDE(I):= '______________________________';
UDPSTED(1):= ' 010';
UDPSTED(2):= ' 020';
UDPSTED(3):= 'Københavns havn 040';
UDPSTED(4):= 'Københavns frihavn 041';
UDPSTED(5):= 'Dragør havn 044';
UDPSTED(6):= 'Københavns lufthavn 050';
UDPSTED(7):= 'Gedser havn 593';
UDPSTED(8):= 'Padborg 650';
UDPSTED(9):= 'Rødby havn 730';
FOR I:=10 TO 20 DO
UDPSTED(I):='______________________________'
END;
(*$R-,L-,IIOPEN*)
(*$IEXCOMCOP*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$INEXTREC*)
(*$IDELETE*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$R+,L+*)
PROCEDURE ERROR;
BEGIN
WRITELN('FEJL I REGISTER ',IER);
ICLOSE(VZ.H,FVAR);
ICLOSE(OZ.H,FORD);
ICLOSE(PZ.H,FPLU);
ICLOSE(KZ.H,FKUN);
ICLOSE(RZ.H,FROR);
WRITELN('ICLOSE ',IER);
I:=I DIV 0
END;
PROCEDURE TILBAGE;
VAR RESTNÅET:BOOLEAN;
BEGIN
RESTNÅET:=FALSE;
(*TILBAGEFØRING*)
WITH PLUORD DO
REPEAT
FOR J:=1 TO 15 DO IF ORDRELIN(J).VNR(1)<>0 THEN
BEGIN
IF RESTNÅET THEN
BEGIN
RESTORD.HEAD(1):=HEAD(1);
RESTORD.HEAD(2):=HEAD(2);
RESTORD.HEAD(3):=ORDRELIN(J).VNR(1);
RESTORD.ANTAL:=0;
RESTORD.HEAD(4):=0;RESTORD.HEAD(5):=0;
GETREC(RZ.H,FROR,RESTORD.A);
RESTORD.ANTAL:=RESTORD.ANTAL+ORDRELIN(J).VNR(3);
IF (HEAD(7)>RESTORD.HEAD(4)) OR
((HEAD(7)=RESTORD.HEAD(4)) AND (HEAD(8)>RESTORD.HEAD(5))) THEN
BEGIN
RESTORD.HEAD(4):=HEAD(7);
RESTORD.HEAD(5):=HEAD(8)
END;
IF IER=0 THEN PUTREC(RZ.H,FROR,RESTORD.A)
ELSE
IF IER=-6 THEN INSERT(RZ.H,FROR,RESTORD.A);
IF IER<>0 THEN ERROR;
ORDRE.ORDRELIN(J).VNR(1):=0
END
ELSE
BEGIN
VARE.HELTAL(1):=ORDRELIN(J).VNR(1);
GETREC(VZ.H,FVAR,VARE.A);
IF (IER<>0) AND (IER<>-6) THEN ERROR; (*?*)
IF IER=0 THEN
BEGIN
VARE.REELTAL(4):=VARE.REELTAL(4)+ORDRELIN(J).VNR(2);
VARE.REELTAL(7):=VARE.REELTAL(7)+ORDRELIN(J).VNR(2);
PUTREC(VZ.H,FVAR,VARE.A);
ORDRE.ORDRELIN(J).VNR(1):=ORDRELIN(J).VNR(1);
ORDRE.ORDRELIN(J).VNR(2):=ORDRELIN(J).VNR(3);
ORDRE.ORDRELIN(J).PRIS:=ORDRELIN(J).PRIS
END
END
END
ELSE
BEGIN
IF ORDRELIN(J).VNR(1)=1 THEN RESTNÅET:=TRUE;
ORDRE.ORDRELIN(J).VNR(1):=0;
END;
FOR I:=1 TO 12 DO ORDRE.HEAD(I):=HEAD(I);
ORDRE.LINE(1):=LINE(1);
ORDRE.LINE(2):=LINE(2);
INSERT(OZ.H,FORD,ORDRE.A);
DELETE(PZ.H,FPLU,A)
UNTIL ORDRE.HEAD(5)=99
END;
PROCEDURE ÆNDRING;
BEGIN
REPEAT
GOTOXY(1,23);WRITELN('VARENUMMER, 0 FOR SLUT ');
GOTOXY(40,23);READLN;READ(I)
UNTIL (IORESULT=0) AND ((I=0) OR ((I>999) AND (I<10000)));
J:=1;
WHILE I<>0 DO
WITH PLUORD DO
BEGIN
WHILE (I<>ORDRELIN(J).VNR(1)) AND (I<>0) DO
BEGIN
J:=J+1;
IF J>15 THEN
BEGIN
IF HEAD(5)<99 THEN
BEGIN
PUTREC(PZ.H,FPLU,A);
NEXTREC(PZ.H,FPLU,A)
END
ELSE I:=0;
J:=1
END
END;
IF I=0 THEN
BEGIN
GOTOXY(1,23);WRITELN('VARENUMMER FINDES IKKE')
END
ELSE
BEGIN
VARE.HELTAL(1):=ORDRELIN(J).VNR(1);
GETREC(VZ.H,FVAR,VARE.A);
IF (IER<>0) AND (IER<>-6) THEN ERROR; (*?*)
IF IER=0 THEN
BEGIN
GOTOXY(1,5);
WRITELN(VARE.HELTAL(1):5,' ',VARE.NAVN(1),
ORDRELIN(J).PRIS/100:12:2,
ORDRELIN(J).VNR(2):10,
ORDRELIN(J).VNR(3)-ORDRELIN(J).VNR(2):10);
REPEAT
GOTOXY(63,5);READLN;READ(K)
UNTIL (IORESULT=0) AND (K>=0) AND (K<=ORDRELIN(J).VNR(3));
VARE.REELTAL(9):=VARE.REELTAL(9)+ORDRELIN(J).VNR(2)-K;
VARE.HELTAL(11):=VARE.HELTAL(11)+K-ORDRELIN(J).VNR(2);
ORDRELIN(J).VNR(2):=K;
GOTOXY(1,5);WRITELN(VARE.HELTAL(1):5,' ',VARE.NAVN(1),
ORDRELIN(J).PRIS/100:12:2,
ORDRELIN(J).VNR(2):10,
ORDRELIN(J).VNR(3)-ORDRELIN(J).VNR(2):10);
PUTREC(VZ.H,FVAR,VARE.A)
END
END;
REPEAT
GOTOXY(1,23);WRITELN('VARENUMMER, 0 FOR SLUT');
GOTOXY(40,23);READLN;READ(I)
UNTIL (IORESULT=0) AND ((I=0) OR ((I>999) AND (I<10000)));
END
END;
PROCEDURE UÆNDRET;
CONST BANE=3;
POST=1;
DERES=8;
VAR J,F:INTEGER;
R:REAL;
PROCEDURE EXTEND;
BEGIN
IF KUNDE.NR(18)=1 THEN
WITH FAKFIL^ DO
BEGIN
GOTOXY(1,19);
WRITELN('Leveringsbetingelser ');
FOR J:=1 TO 20 DO LIN(J):=' ';
GOTOXY(30,19);
EDIT(LIN:20);
FOR J:=1 TO 20 DO DITTO(1,J):=LIN(J);
GOTOXY(1,21);
WRITELN('Pakning');
FOR J:=1 TO 20 DO LIN(J):=' ';
GOTOXY(10,21);
EDIT(LIN:20);
FOR J:=1 TO 20 DO DITTO(2,J):=LIN(J);
REPEAT
GOTOXY(1,22);
WRITELN('Bruttovægt');
GOTOXY(12,22);
READLN;READ(BRUTTOVÆGT)
UNTIL IORESULT=0;
GOTOXY(1,23);
WRITELN('Antal kolli og art');
LIN:=' ';
GOTOXY(20,23);
EDIT(LIN:30);
FOR J:=1 TO 30 DO AKOLLI(J):=LIN(J)
END
END;
BEGIN
CLEARSCREEN;
KUNDE.NR(1):=PLUORD.HEAD(1);
KUNDE.NR(2):=PLUORD.HEAD(2);
GETREC(KZ.H,FKUN,KUNDE.A);
IF IER<>0 THEN ERROR;
LIN:='123456789012345678901234567890';
REPEAT
GOTOXY(1,1);WRITELN('FORSENDELSESMÅDE ');
FOR I:=1 TO 10 DO
WRITELN(2*I-1:3,' ',SENDTPR(2*I-1),2*I:5,' ',SENDTPR(2*I));
GOTOXY(40,1);READLN;READ(F)
UNTIL (IORESULT=0) AND (F>0) AND (F<21);
FAKFIL^.FORSEND:=F;
FAKFIL^.KODE8:=0;
FAKFIL^.KODE9:=0;
FILLCHAR(FAKFIL^.TRANSPORTØR,30,' ');
IF KUNDE.NR(18)=1 THEN
WITH FAKFIL^ DO
CASE F OF
POST : BEGIN
KODE8:=4;(*TRANSPORTMÅDETABEL*)
KODE9:=1 (*UDPASSAGESTEDTABEL*)
END;
BANE : BEGIN
KODE8:=3; (*TRANSPORTMÅDETABEL*)
KODE9:=2 (*UDPASSAGESTEDTABEL*)
END;
DERES: BEGIN
FOR J:=1 TO 30 DO LIN(J):=' ';
GOTOXY(1,12);
WRITELN('Transportør');
GOTOXY(14,12);
EDIT(LIN:30);
FOR J:=1 TO 30 DO TRANSPORTØR(J):=LIN(J)
END;
5,6,7,11,12: TRANSPORTØR:=SENDTPR(F);
OTHERWISE
BEGIN
CLEARSCREEN;
REPEAT
GOTOXY(1,1);
WRITELN('Transportmåde');
FOR I:=1 TO 10 DO
WRITELN(2*I-1:3,' ',
TMÅDE(2*I-1),2*I:5,' ',
TMÅDE(2*I));
GOTOXY(40,1);READLN;READ(KODE8)
UNTIL (IORESULT=0) AND (KODE8>0) AND (KODE8<21);
CLEARSCREEN;
REPEAT
GOTOXY(1,1);
WRITELN('Udpassagested');
FOR I:=1 TO 10 DO
WRITELN(2*I-1:3,' ',
UDPSTED(2*I-1),2*I:5,' ',
UDPSTED(2*I));
GOTOXY(40,1);READLN;READ(KODE9)
UNTIL (IORESULT=0) AND (KODE9>0) AND (KODE9<21)
END;
R:=0;
REPEAT
GOTOXY(1,13);WRITELN('FRAGT ');
GOTOXY(40,13);READLN;READ(R)
UNTIL IORESULT=0;
FAKFIL^.FRAGT:=R*100;
R:=0;
IF KUNDE.NR(15)=1 THEN
REPEAT
GOTOXY(1,13);WRITELN('EMBALLAGE ');
GOTOXY(40,13);READLN;READ(R)
UNTIL IORESULT=0;
FAKFIL^.EMBAL:=R*100;
GOTOXY(1,15);
WRITELN('TEKST 1 ');
FOR J:=1 TO 30 DO LIN(J):=PLUORD.LINE(1,J);
GOTOXY(11,15);
EDIT(LIN:30);
FOR J:=1 TO 30 DO FAKFIL^.LINE(1,J):=LIN(J);
GOTOXY(1,16);
WRITELN('TEKST 2 ');
FOR J:=1 TO 30 DO LIN(J):=PLUORD.LINE(2,J);
GOTOXY(11,16);
EDIT(LIN:30);
FOR J:=1 TO 30 DO FAKFIL^.LINE(2,J):=LIN(J);
EXTEND;
REPEAT
FAKFIL^.HEAD:=PLUORD.HEAD;
FAKFIL^.ORDRELIN:=PLUORD.ORDRELIN;
PUT(FAKFIL);
DELETE(PZ.H,FPLU,PLUORD.A)
UNTIL FAKFIL^.HEAD(5)=99
END;
BEGIN
CLEARSCREEN;
GOTOXY(1,1);WRITELN('FAKTURERING');
FNAVN:='REGVARE:P1:0000:I';
REWRITE(FVAR,FNAVN);
IOPEN(VZ.H,FVAR,SKRIV);IF IER<>0 THEN ERROR;
FNAVN:='ORDRERG:P2:0000:I';
REWRITE(FORD,FNAVN);
IOPEN(OZ.H,FORD,SKRIV);IF IER<>0 THEN ERROR;
FNAVN:='PLUOR:P2:0000:I';
REWRITE(FPLU,FNAVN);
IOPEN(PZ.H,FPLU,SKRIV);IF IER<>0 THEN ERROR;
FNAVN:='KUNDERG:P2:0000:I';
RESET(FKUN,FNAVN);
IOPEN(KZ.H,FKUN,LÆS);IF IER<>0 THEN ERROR;
FNAVN:='RESTREG:P2:0000:I';
REWRITE(FROR,FNAVN);
IOPEN(RZ.H,FROR,SKRIV);IF IER<>0 THEN ERROR;
FNAVN:='FAKREG:P2:30:I';
REWRITE(FAKFIL,FNAVN);
REPEAT
GOTOXY(1,23);WRITELN('INDTAST KUNDENUMMER ORDRENUMMER ');
GOTOXY(40,23);READLN;READ(R1,R)
UNTIL (IORESULT=0) AND (((R>99999.0) AND (R<1000000.0)) OR (R=0)) AND
(((R1>9999.0) AND (R1<100000.0)) OR (R1=0));
INIT;
WHILE R1<>0 DO
WITH PLUORD DO
BEGIN
I:=TRUNC(R/10000);
J:=TRUNC(R-10000.0*I);
K:=TRUNC(R1/10000);
L:=TRUNC(R1-10000.0*K);
HEAD(1):=K;HEAD(2):=L;
HEAD(3):=I;HEAD(4):=J;
HEAD(5):=0;
NEXTREC(PZ.H,FPLU,A);
IF IER>0 THEN ERROR;
IF (HEAD(3)<>I) OR (HEAD(4)<>J) OR (HEAD(1)<>K) OR (HEAD(2)<>L) THEN
BEGIN
GOTOXY(1,24);
WRITELN('ORDREN FINDES IKKE')
END
ELSE
BEGIN
CLEARSCREEN;
REPEAT
GOTOXY(1,19);
WRITELN('SKAL ORDREN FAKTURERES UÆNDRET (1)');
WRITELN('ER DER ÆNDRINGER I.F.T. PAKKELISTE (2)');
WRITELN('SKAL ORDREN TILBAGEFØRES TIL ORDREREG (3)');
WRITELN('ORDREN SKAL IKKE FAKTURERES (4)');
GOTOXY(1,23);READLN;READ(I)
UNTIL (IORESULT=0) AND (I>0) AND (I<5);
IF I=3 THEN
TILBAGE
ELSE
BEGIN
WHILE I=2 DO
BEGIN
(*ÆNDRINGER*)
CLEARSCREEN;
ÆNDRING;
REPEAT
GOTOXY(1,23);WRITELN('FÆRDIG (1), FLERE ÆNDRINGER (2)');
GOTOXY(50,23);READLN;READ(I)
UNTIL (IORESULT=0) AND ((I=1) OR (I=2));
PUTREC(PZ.H,FPLU,A);
HEAD(5):=0;
NEXTREC(PZ.H,FPLU,A)
END;
(*UÆNDRET*)
IF I<4 THEN
BEGIN
UÆNDRET;
END
END;
END;
REPEAT
CLEARSCREEN;
GOTOXY(1,23);WRITELN('INDTAST KUNDENUMMER, ORDRENUMMER ');
GOTOXY(40,23);READLN;READ(R1,R)
UNTIL (IORESULT=0) AND (((R>99999.0) AND (R<1000000.0)) OR (R=0.0)) AND
(((R1>9999.0) AND (R1<100000.0)) OR (R1=0.0));
END;
FAKFIL^.HEAD(1):=0;
FAKFIL^.HEAD(2):=0;
PUT(FAKFIL);
ICLOSE(VZ.H,FVAR);
ICLOSE(OZ.H,FORD);
ICLOSE(PZ.H,FPLU);
ICLOSE(KZ.H,FKUN);
ICLOSE(RZ.H,FROR);
WRITELN('CHAIN NORMFAKT');
CHAIN('INTRE *1','NORMFAKT:P1',QUQ); (*TOLDSORT,TOLDFAKT*)
END.