PROGRAM FAKTURERING; (*$IISFHEAD*)
 VPOST=RECORD
        A       :AR;(        HELTAL:ARRAY (1..11) OF INTEGER;(G (*VARENR,LVRND\R,OPRLAND,PAKENHED,FORVLEVU,DATSBES1,DATSBES2,DATSORD1,G   DATSORD2,D[KGRAS],ANAFTILG*)9        NAVN:ARRAY (1..2) OF PACKED ARRAY(1..30) OF CHAR;9 (*VARENAVN,NAVNHOSLEVERAND\R*)&        REELTAL :ARRAY (1..15) OF REAL&D (*PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,DB   RESAFIORDRE,STASBEST,ASOLGTI],ASOLGTS],OMSI]R,OMSS]R,D[KBIDTD*)B  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;:A (*KNR1,KNR2,ONR1,ONR2,SIDE,LEVUGE,ORDREDATO1-2,LEVKODE,BETAKODE,A   RESTORDREKODE,RABAT*),        ORDRELIN : ARRAY (1..15) OF PLUOLINE,  END; ORDREPOST = RECORD
        A:AR;
 (*        KNR1,KNR2,        NR1,NR2,
        SIDE,
B        LEVUGE,ORDREDATO1-2,LEVKODE,BETAKODE,RESTORDREKODE,RABAT*)B&        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;%9       LINE:ARRAY (1..2) OF PACKED ARRAY (1..30) OF CHAR;9:       DITTO:ARRAY (1..2) OF PACKED ARRAY (1..20) OF CHAR;:7       TRANSPORT\R,AKOLLI:PACKED ARRAY (1..30) OF CHAR;7&       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,9        DAT1,DAT2:INTEGER;*) HEAD:ARRAY(1..5) OF INTEGER;9        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                          ';/0  SENDTPR(10):='Veritas                       ';00  SENDTPR(11):='DFDS                          ';00  SENDTPR(12):='Faroe ship                    ';00  SENDTPR(13):='Vogn / bil                    ';00  SENDTPR(14):='Afhentet                      ';0  FOR I:=15 TO 19 DO0  SENDTPR(I):= '                              ';00  SENDTPR(20):='Brevdue                       ';00  TM]DE(1):=   'Dansk skib                  11';00  TM]DE(2):=   'Udenlandsk skib             15';00  TM]DE(3):=   'Bane                        20';00  TM]DE(4):=   'Post                        30';00  TM]DE(5):=   'Fly                         40';00  TM]DE(6):=   'Dansk bil                   51';00  TM]DE(7):=   'Udenlandsk bil              55';00  TM]DE(8):=   'Anden transportm}de         90';0  FOR I:=9 TO 20 DO0    TM]DE(I):= '______________________________';00  UDPSTED(1):= '                           010';00  UDPSTED(2):= '                           020';00  UDPSTED(3):= 'K|benhavns havn            040';00  UDPSTED(4):= 'K|benhavns frihavn         041';00  UDPSTED(5):= 'Drag|r havn                044';00  UDPSTED(6):= 'K|benhavns lufthavn        050';00  UDPSTED(7):= 'Gedser havn                593';00  UDPSTED(8):= 'Padborg                    650';00  UDPSTED(9):= 'R|dby havn                 730';0  FOR I:=10 TO 20 DO0    UDPSTED(I):='______________________________'0END; (*$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);(3               RESTORD.HEAD(3):=ORDRELIN(J).VNR(1);3                RESTORD.ANTAL:=0; 5               RESTORD.HEAD(4):=0;RESTORD.HEAD(5):=0;5+               GETREC(RZ.H,FROR,RESTORD.A);+?               RESTORD.ANTAL:=RESTORD.ANTAL+ORDRELIN(J).VNR(3);?.               IF (HEAD(7)>RESTORD.HEAD(4)) OR.M               ((HEAD(7)=RESTORD.HEAD(4)) AND (HEAD(8)>RESTORD.HEAD(5))) THENM               BEGIN*                 RESTORD.HEAD(4):=HEAD(7);*)                 RESTORD.HEAD(5):=HEAD(8))               END;8               IF IER=0 THEN PUTREC(RZ.H,FROR,RESTORD.A)8               ELSE:               IF IER=-6 THEN INSERT(RZ.H,FROR,RESTORD.A);:$               IF IER<>0 THEN ERROR;$*               ORDRE.ORDRELIN(J).VNR(1):=0*             END             ELSE             BEGIN0             VARE.HELTAL(1):=ORDRELIN(J).VNR(1);0&             GETREC(VZ.H,FVAR,VARE.A);&8             IF (IER<>0) AND (IER<>-6) THEN ERROR; (*?*)8             IF IER=0 THEN             BEGINA             VARE.REELTAL(4):=VARE.REELTAL(4)+ORDRELIN(J).VNR(2);AA             VARE.REELTAL(7):=VARE.REELTAL(7)+ORDRELIN(J).VNR(2);A&             PUTREC(VZ.H,FVAR,VARE.A);&:             ORDRE.ORDRELIN(J).VNR(1):=ORDRELIN(J).VNR(1);::             ORDRE.ORDRELIN(J).VNR(2):=ORDRELIN(J).VNR(3);:5             ORDRE.ORDRELIN(J).PRIS:=ORDRELIN(J).PRIS5             END             END           END           ELSE           BEGIN9             IF ORDRELIN(J).VNR(1)=1 THEN RESTN]ET:=TRUE;9)             ORDRE.ORDRELIN(J).VNR(1):=0;)           END;4           FOR I:=1 TO 12 DO ORDRE.HEAD(I):=HEAD(I);4"           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   BEGIN0     WHILE (I<>ORDRELIN(J).VNR(1)) AND (I<>0) DO0
     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
5       GOTOXY(1,23);WRITELN('VARENUMMER FINDES IKKE')5     END	     ELSE	
     BEGIN
*       VARE.HELTAL(1):=ORDRELIN(J).VNR(1);*        GETREC(VZ.H,FVAR,VARE.A); 7       IF (IER<>0) AND (IER<>-6) THEN ERROR;      (*?*)7       IF IER=0 THEN       BEGIN       GOTOXY(1,5);5       WRITELN(VARE.HELTAL(1):5,'     ',VARE.NAVN(1),5)               ORDRELIN(J).PRIS/100:12:2,)%               ORDRELIN(J).VNR(2):10,%9               ORDRELIN(J).VNR(3)-ORDRELIN(J).VNR(2):10);9
       REPEAT
$         GOTOXY(63,5);READLN;READ(K)$A       UNTIL (IORESULT=0) AND (K>=0) AND (K<=ORDRELIN(J).VNR(3));A=       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;A       GOTOXY(1,5);WRITELN(VARE.HELTAL(1):5,'     ',VARE.NAVN(1),A5                           ORDRELIN(J).PRIS/100:12:2,51                           ORDRELIN(J).VNR(2):10,1E                           ORDRELIN(J).VNR(3)-ORDRELIN(J).VNR(2):10);E       PUTREC(VZ.H,FVAR,VARE.A)
       END
	     END;	     REPEAT7        GOTOXY(1,23);WRITELN('VARENUMMER, 0 FOR SLUT');7$        GOTOXY(40,23);READLN;READ(I)$?     UNTIL (IORESULT=0) AND ((I=0) OR ((I>999) AND (I<10000)));?   ENDEND;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)'  ENDEND;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';(  REPEAT3       GOTOXY(1,1);WRITELN('FORSENDELSESM]DE    ');3       FOR I:=1 TO 10 DOF         WRITELN(2*I-1:3,'  ',SENDTPR(2*I-1),2*I:5,'  ',SENDTPR(2*I));F"       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);3           FOR J:=1 TO 30 DO TRANSPORT\R(J):=LIN(J)3
         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)%4    UNTIL (IORESULT=0) AND (KODE8>0) AND (KODE8<21);4    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)%3    UNTIL (IORESULT=0) AND (KODE9>0) AND (KODE9<21)3  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)=99END;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);  REPEATL       GOTOXY(1,23);WRITELN('INDTAST KUNDENUMMER ORDRENUMMER             ');L&       GOTOXY(40,23);READLN;READ(R1,R)&G  UNTIL (IORESULT=0) AND (((R>99999.0) AND (R<1000000.0)) OR (R=0)) ANDGE                         (((R1>9999.0) AND (R1<100000.0)) OR (R1=0));E  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;I     IF (HEAD(3)<>I) OR (HEAD(4)<>J) OR (HEAD(1)<>K) OR (HEAD(2)<>L) THENI
     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;           REPEATH               GOTOXY(1,23);WRITELN('F[RDIG (1),  FLERE [NDRINGER (2)');H+               GOTOXY(50,23);READLN;READ(I)+3           UNTIL (IORESULT=0) AND ((I=1) OR (I=2));3           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;N        GOTOXY(1,23);WRITELN('INDTAST KUNDENUMMER, ORDRENUMMER             ');N'        GOTOXY(40,23);READLN;READ(R1,R)'L     UNTIL (IORESULT=0) AND (((R>99999.0) AND (R<1000000.0)) OR (R=0.0)) ANDLJ                            (((R1>9999.0) AND (R1<100000.0)) OR (R1=0.0));J  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');A     CHAIN('INTRE   *1','NORMFAKT:P1',QUQ); (*TOLDSORT,TOLDFAKT*)AEND.                          2000  K|benhavn  F       ¤01-353317                           ~~~~                              Falkoner  Alle 42                                 2000  K|benhavn  F       ¤01-353317                           ~~~~                              Falkoner  Alle 42                                 2000  K|benhavn  F       ¤01-353317