ENVIRONMENT-DIVISION & FILE-SECTION
******************************************************************
IDENTIFICATION DIVISION.
******************************************************************
PROGRAM-ID. ARTP7.
******************************************************************
ENVIRONMENT DIVISION.
******************************************************************
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT E-ARTIKELDATEI ASSIGN TO "ARTIKEL.DAT"
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS FILE-STATUS.
******************************************************************
DATA DIVISION.
******************************************************************
FILE SECTION.
FD E-ARTIKELDATEI.
COPY "ARTIKEL.CPY".
|
WORKING-STORAGE - Definition der Eingabe-Datei
WORKING-STORAGE SECTION.
COPY "FILESTAT.CPY".
******************************************************************
* EINGABE-ARTIKELDATEI *
******************************************************************
01 E-ARTIKELSATZ-1.
05 E-ARTNR-1.
10 E-ARTGRP-1 PIC X(003).
10 E-ARTLFDNR-1 PIC X(003).
05 E-ARTGRP-BEZ-1 PIC X(20).
05 E-ARTGRP-BILD-1 PIC X(50).
05 E-ARTBEZ-1 PIC X(020).
05 E-GROESSEN-TABELLE-1 OCCURS 3
INDEXED BY IND-1.
10 E-GROESSE-1 PIC X(3).
10 E-PREIS-DM-1 PIC 9(004)V99.
10 E-PREIS-EURO-1 PIC 9(004)V99.
10 E-MENGE-1 PIC 9(003).
10 E-KOSTEN-1 PIC 9(003)V99.
05 E-FARB-TABELLE OCCURS 3.
10 E-FARBE-1 PIC X(15).
10 E-ORDER-NR-1 PIC X(007).
05 E-VWKOST-1 PIC 9(002)V9.
05 E-VTPROV-1 PIC 9(002)V9.
05 FILLER PIC X(033).
|
|
WORKING-STORAGE - Definition der Ausgabe-Strukturen Festlegung der einzelnen Objekte, die für Kopf-, Fußzeile, Wasserzeichen und Stempel verwendet werden sollen.
******************************************************************
* DRUCK-AUSGABESTRUKTUREN
******************************************************************
EXEC PRINT
01 TEXT P-WASSERZEICHEN
VALUE "Physisches Wasserzeichen"
FONT IS FONT-UEBER-1
SIZE IS 30 POINTS
TEXT-COLOR IS YELLOW
ROTATION IS 45 DEGREE.
01 TEXT P-STEMPEL
VALUE "J"
FONT IS FONT-STEMPEL
SIZE IS 150.
01 TEXT P-KOPFZEILE
VALUE "Physische Kopfzeile"
FONT IS FONT-UEBER-1.
01 TEXT P-FUSSZEILE
VALUE "Physische Fusszeile"
FONT IS FONT-UEBER-1.
01 TEXT L-WASSERZEICHEN
VALUE "Logisches Wasserzeichen"
FONT IS FONT-UEBER-1
TEXT-COLOR IS YELLOW
ROTATION IS 45 DEGREE.
01 TEXT L-STEMPEL
VALUE "C"
FONT IS FONT-STEMPEL.
01 TEXT L-KOPFZEILE
VALUE "Logische Kopfzeile"
FONT IS FONT-KOPF-2.
01 TEXT L-FUSSZEILE
VALUE "Logische Fusszeile"
FONT IS FONT-KOPF-2.
DEFINE GROUP G-P-KOPFZEILE.
USE REFERENCE P-KOPFZEILE
END-DEFINE
DEFINE GROUP G-P-FUSSZEILE.
USE REFERENCE P-FUSSZEILE
END-DEFINE
DEFINE GROUP G-P-WASSERZEICHEN.
USE REFERENCE P-WASSERZEICHEN
END-DEFINE
DEFINE GROUP G-P-STEMPEL.
USE REFERENCE P-STEMPEL
END-DEFINE
DEFINE GROUP G-L-KOPFZEILE.
USE REFERENCE L-KOPFZEILE
END-DEFINE
DEFINE GROUP G-L-FUSSZEILE.
USE REFERENCE L-FUSSZEILE
END-DEFINE
DEFINE GROUP G-L-WASSERZEICHEN.
USE REFERENCE L-WASSERZEICHEN
END-DEFINE
DEFINE GROUP G-L-STEMPEL.
USE REFERENCE L-STEMPEL
END-DEFINE
|
|
WORKING-STORAGE - Definition der Strukturen für die Druckzeilen Definition einzelnder Strukturen, die später als Druckzeilen dienen.
01 TEXT DECKBLATT
VALUE "Artikel-Umsatzliste"
ABSOLUTE VERTICAL POSITION IS 3 LINES
HORIZONTAL POSITION IS CENTERED
FONT IS FONT-UEBER-1
SIZE IS 16 POINTS.
01 A-UEBERSCHRIFT-1 PIC X(23)
VALUE "Umsatz und Rentabilit„t"
HORIZONTAL POSITION IS CENTERED
WIDTH IS REQUIRED PHYSICAL-SIZE
FONT IS FONT-UEBER-1.
01 A-ARTIKEL-KOPFZEILE
TEXT-DEFAULTS ARE
FONT IS FONT-KOPF-1.
05 FILLER PIC X(008)
VALUE "Art-Nr.".
05 A-ARTNR-1 PIC X(006).
05 FILLER PIC X(001) VALUE SPACE.
05 A-ARTBEZ-1 PIC X(020).
01 A-EINZELUMSATZ-KOPFZEILE
TEXT-DEFAULTS ARE
FONT IS FONT-NORMAL.
05 FILLER PIC X(006)
VALUE "GrӇe".
05 FILLER PIC X(003) VALUE SPACE.
05 FILLER PIC X(006)
VALUE "Umsatz"
CONTENTS-ALIGNMENT IS RIGHT.
05 FILLER PIC X(005) VALUE SPACE.
05 FILLER PIC X(006)
VALUE "Gewinn"
CONTENTS-ALIGNMENT IS RIGHT.
05 FILLER PIC X(005) VALUE SPACE.
05 FILLER PIC X(012)
VALUE "Rentabilit„t"
WIDTH IS REQUIRED PHYSICAL-SIZE.
01 A-ARTIKELSATZ-1.
05 A-GROESSE-1 PIC X(003).
05 FILLER PIC X(2) VALUE SPACE.
05 A-UMSATZ-1 PIC Z(6)9,99.
05 FILLER PIC X(1) VALUE SPACE.
05 A-GEWINN-1 PIC Z(6)9,99.
05 FILLER PIC X(1) VALUE SPACE.
05 FILLER PIC X(4) VALUE SPACE.
05 A-RENTAB-1 PIC Z9,99
CONTENTS-ALIGNMENT IS LEFT.
05 FILLER PIC X(044) VALUE SPACE.
END-EXEC
|
|
WORKING-STORAGE - Definition der PrintEasy-Ressourcen Definition der gewünschten Ressourcen, wie Schriften, Farben, Linien....
EXEC PRINT DEFINE SECTION.
DEFINE FONT FONT-NORMAL USING FONTNAME "ARIAL"
SIZE IS 7 POINTS
TEXT-COLOR IS BLACK
BACKGROUND-COLOR IS TRANSPARENT.
DEFINE FONT FONT-UEBER-1 USING FONTNAME "ARIAL"
SIZE IS 10 POINTS
TEXT-COLOR IS BLACK
BACKGROUND-COLOR IS TRANSPARENT
LETTER-SPACING IS EXPANDED
BOLD IS ON.
DEFINE FONT FONT-KOPF-1 USING FONTNAME "ARIAL"
SIZE IS 8 POINTS
TEXT-COLOR IS BLACK
BACKGROUND-COLOR IS TRANSPARENT
BOLD IS ON
UNDERLINE IS ON.
DEFINE FONT FONT-KOPF-2 USING FONTNAME "ARIAL"
SIZE IS 7 POINTS
TEXT-COLOR IS BLACK
BACKGROUND-COLOR IS TRANSPARENT
BOLD IS ON.
DEFINE FONT FONT-STEMPEL USING FONTNAME "WINGDINGS"
SIZE IS 100 POINTS
TEXT-COLOR IS RED
BACKGROUND-COLOR IS TRANSPARENT.
DEFINE LINETYPE LINIE-DUENN WITH
WIDTH IS THIN
STYLE IS SOLID
TYPE IS SINGLE
COLOR IS BLACK.
DEFINE LINETYPE LINIE-STRPKT WITH
WIDTH IS THIN
STYLE IS DASHDOT
TYPE IS SINGLE
COLOR IS BLACK.
DEFINE FILLTYPE LGRAY with style is solid
foreground-color is gray50.
END-EXEC
|
|
WORKING-STORAGE - Festlegung der programmweiten Standards Festlegen der Defaults z.B. für die Schrift.
EXEC PRINT DEFAULT SECTION.
DEFAULT FONT IS FONT-NORMAL
DEFAULT TOM-CHARACTER IS "A"
USING FONT-NORMAL.
END-EXEC
|
|
WORKING-STORAGE - Definition des Dokumentes Festlegung der Dokumentenstandards, Geräteoptionen, physischen und logischen Seiten
EXEC PRINT DOCUMENT SECTION.
DEFINE DOCUMENT DOC-UMSATZLISTE.
DOCUMENT DEFAULTS.
DEFAULT UNIT IS TOM.
DEVICE DESCRIPTION.
PRINTER IS PRINTER-DIALOG.
PHYSICAL PAGE DESCRIPTION.
PAPER IS A4
ORIENTATION IS PORTRAIT
MARGIN LEFT IS 20 MM
MARGIN RIGHT IS 20 MM
MARGIN TOP IS 25 MM
MARGIN BOTTOM IS 25 MM
WATERMARK
HORIZONTAL POSITION IS CENTERED
VERTICAL POSITION IS CENTERED
USING G-P-WASSERZEICHEN
STAMP
HORIZONTAL POSITION IS CENTERED
VERTICAL POSITION IS CENTERED
USING G-P-STEMPEL
HEADER
HORIZONTAL POSITION IS CENTERED
STARTS 15 MM
USING G-P-KOPFZEILE
FOOTER
HORIZONTAL POSITION IS CENTERED
STARTS 15 MM
USING G-P-FUSSZEILE
PHYSICAL PAGE IS TILED
HORIZONTALLY 2
WITH GUTTER 10 MM
GUTTER-LINE IS ON USING LINETYPE LINIE-STRPKT
VERTICALLY 2
WITH GUTTER 10 MM
GUTTER-LINE IS ON USING LINETYPE LINIE-STRPKT.
LOGICAL PAGE DESCRIPTION.
FIRST PAGE.
BORDER IS ON USING LINETYPE LINIE-DUENN
MARGIN LEFT IS 5 MM
MARGIN RIGHT IS 5 MM
MARGIN TOP IS 5 MM
MARGIN BOTTOM IS 5 MM
SHADOW IS on USING filltype lgray.
OTHER PAGE.
BORDER IS ON USING LINETYPE LINIE-DUENN
MARGIN LEFT IS 5 MM
MARGIN RIGHT IS 5 MM
MARGIN TOP IS 5 MM
MARGIN BOTTOM IS 5 MM
SHADOW IS on USING filltype lgray
WATERMARK
HORIZONTAL POSITION IS CENTERED
VERTICAL POSITION IS CENTERED
USING G-L-WASSERZEICHEN
STAMP
HORIZONTAL POSITION IS CENTERED
VERTICAL POSITION IS CENTERED
USING G-L-STEMPEL
HEADER
HORIZONTAL POSITION IS CENTERED
USING G-L-KOPFZEILE
FOOTER
HORIZONTAL POSITION IS CENTERED
USING G-L-FUSSZEILE.
END-EXEC
|
|
WORKING-STORAGE - Sonstige Bereiche Rechen- und Hilfsfelder
******************************************************************
*
******************************************************************
01 RECHENFELDER.
05 Z-UMSATZ-1 PIC S9(007)V99
BINARY VALUE ZERO.
05 Z-GEWINN-1 PIC S9(007)V99
BINARY VALUE ZERO.
01 PE-MESSAGE PIC X(100) VALUE SPACE.
01 PE-MESSAGE-LAENGE PIC 9(09) VALUE ZERO.
01 PE-HEADING PIC X(40) VALUE SPACE.
01 PE-HEADING-LAENGE PIC 9(09) VALUE ZERO.
01 PE-MBOX-TYP PIC 9(09) VALUE ZERO.
01 PE-MBOX-RC PIC 9(09) VALUE ZERO.
01 PE-WARNING-ZAEHLER PIC 9(09) VALUE ZERO.
******************************************************************
* PRINTEASY DEFINITIONEN
******************************************************************
|
|
WORKING-STORAGE - Sonstige Bereiche PrintEasy-Copystrecken
COPY "PE-CA.CPY".
COPY "PEMBOX.CPY".
COPY "PEDOCINF.CPY".
|
|
PROCEDURE DIVISION Steuerungslogik
******************************************************************
PROCEDURE DIVISION.
******************************************************************
******************************************************************
STEUERUNG SECTION.
******************************************************************
STEUERUNG-ST.
PERFORM VORLAUF
PERFORM ARTIKEL-LESEN
PERFORM WITH TEST BEFORE
UNTIL DATEI-ENDE
PERFORM ARTIKEL-KOPFZEILE
PERFORM WITH TEST AFTER
VARYING IND-1
FROM 1 BY 1
UNTIL IND-1 = 3
PERFORM RENT-BERECHNEN
PERFORM UEBERTRAGEN
PERFORM ART-RENT-AUSGEBEN
END-PERFORM
PERFORM ARTIKEL-LESEN
END-PERFORM
PERFORM NACHLAUF
.
STEUERUNG-EX.
STOP RUN.
|
|
PROCEDURE DIVISION - Vorlauf Eingabe-Datei eröffnen
******************************************************************
VORLAUF SECTION.
******************************************************************
VORLAUF-ST.
OPEN INPUT E-ARTIKELDATEI
|
|
PROCEDURE DIVISION - Vorlauf Ausnahme- und Fehlerbehandlung einstellen
EXEC PRINT
WHENEVER PE-INFO WRITE LOGFILE
END-EXEC
EXEC PRINT
WHENEVER PE-WARNING PERFORM WARNING-ROUTINE
AND WRITE LOGFILE
END-EXEC
EXEC PRINT
WHENEVER PE-ERROR PERFORM ERROR-ROUTINE
AND WRITE LOGFILE
END-EXEC
MOVE ZERO TO PE-WARNING-ZAEHLER
|
|
PROCEDURE DIVISION - Vorlauf Ressourcen initialisieren
EXEC PRINT
INITIALIZE RESOURCES
END-EXEC
|
|
PROCEDURE DIVISION - Vorlauf Dokument öffnen und Deckblatt ausgeben
EXEC PRINT
OPEN DOCUMENT DOC-UMSATZLISTE
PREVIEW IS ON MODE IS DIRECT
PRINTING IS OFF
PREVIEW-SIZE IS MAXIMIZED
DOCUMENT-SIZE IS MAXIMIZED
END-EXEC
EXEC PRINT
PLACE DECKBLATT UPON DOCUMENT DOC-UMSATZLISTE
END-EXEC
.
VORLAUF-EX.
EXIT.
|
PROCEDURE DIVISION - Artikeldatei lesen
******************************************************************
ARTIKEL-LESEN SECTION.
******************************************************************
ARTIKEL-LESEN-ST.
MOVE SPACES TO ARTIKELSATZ-1
READ E-ARTIKELDATEI INTO E-ARTIKELSATZ-1
AT END CONTINUE
END-READ
.
ARTIKEL-LESEN-EX.
EXIT.
|
|
PROCEDURE DIVISION - Gruppenwechsel - Artikelkopf ausgeben Nach Seiten- oder Gruppenwechsel neuen Artikelkopf ausgeben
******************************************************************
ARTIKEL-KOPFZEILE SECTION.
******************************************************************
ARTIKEL-KOPFZEILE-ST.
EXEC PRINT
NEXT LOGICAL PAGE OF DOC-UMSATZLISTE
END-EXEC
EXEC PRINT
PLACE A-UEBERSCHRIFT-1 UPON DOCUMENT DOC-UMSATZLISTE
END-EXEC
MOVE E-ARTNR-1 TO A-ARTNR-1
MOVE E-ARTBEZ-1 TO A-ARTBEZ-1
EXEC PRINT
PLACE A-ARTIKEL-KOPFZEILE UPON DOCUMENT DOC-UMSATZLISTE
AFTER 1 LINES
END-EXEC
EXEC PRINT
PLACE A-EINZELUMSATZ-KOPFZEILE UPON DOCUMENT DOC-UMSATZLISTE
AFTER 2 LINES
END-EXEC
.
ARTIKEL-KOPFZEILE-EX.
EXIT.
|
PROCEDURE DIVISION - Übertragungs- und Berechnungsteile
******************************************************************
UEBERTRAGEN SECTION.
******************************************************************
UEBERTRAGEN-ST.
MOVE E-GROESSE-1(IND-1) TO A-GROESSE-1
.
UEBERTRAGE-EX.
EXIT.
******************************************************************
RENT-BERECHNEN SECTION.
******************************************************************
RENT-BERECHNEN-ST.
MULTIPLY E-PREIS-DM-1(IND-1) BY E-MENGE-1(IND-1)
GIVING A-UMSATZ-1
Z-UMSATZ-1
*
COMPUTE A-GEWINN-1 ROUNDED
Z-GEWINN-1 ROUNDED
= Z-UMSATZ-1
- E-KOSTEN-1(IND-1) * E-MENGE-1(IND-1)
- ( E-VWKOST-1 * E-KOSTEN-1(IND-1)
* E-MENGE-1(IND-1) / 100 )
- ( E-VTPROV-1 * E-PREIS-DM-1(IND-1)
* E-MENGE-1(IND-1) / 100 )
*
COMPUTE A-RENTAB-1 ROUNDED
= Z-GEWINN-1 * 100 / Z-UMSATZ-1
.
RENT-BERECHNEN-EX.
EXIT.
|
PROCEDURE DIVISION - Rentabilität drucken
******************************************************************
ART-RENT-AUSGEBEN SECTION.
******************************************************************
ART-RENT-AUSGEBEN-ST.
EXEC PRINT
PLACE A-ARTIKELSATZ-1 UPON DOCUMENT DOC-UMSATZLISTE
AFTER ADVANCING 1 LINES
END-EXEC
.
ART-RENT-AUSGEBEN-EX.
EXIT.
|
|
PROCEDURE DIVISION - Nachlauf Eingabe-Datei schließen
******************************************************************
NACHLAUF SECTION.
******************************************************************
NACHLAUF-ST.
CLOSE E-ARTIKELDATEI
|
|
PROCEDURE DIVISION - Nachlauf Dokument schließen und drucken
EXEC PRINT
CLOSE DOCUMENT DOC-UMSATZLISTE
END-EXEC
IF PE-WARNING-ZAEHLER > ZERO
THEN
PERFORM WARNING-HINWEIS
ELSE
CONTINUE
END-IF
.
NACHLAUF-EX.
EXIT.
|
|
PROCEDURE DIVISION - Fehler- & Warnungsroutinen Behandlung von Warnungen
******************************************************************
WARNING-ROUTINE SECTION.
******************************************************************
WARNING-ROUTINE-ST.
IF PE-CODE = 8045
THEN
CONTINUE
ELSE
ADD 1 TO PE-WARNING-ZAEHLER
END-IF
.
WARNING-ROUTINE-EX.
EXIT.
******************************************************************
WARNING-HINWEIS SECTION.
******************************************************************
WARNING-HINWEIS-ST.
MOVE "PRINTEASY BEISPIEL" TO PE-HEADING
MOVE "ES SIND WARNINGS AUFGETRETEN! SIEHE PRNEASY.LOG!"
TO PE-MESSAGE
MOVE 100 TO PE-MESSAGE-LAENGE
MOVE 40 TO PE-HEADING-LAENGE
COMPUTE PE-MBOX-TYP = PEMB-OK + PEMB-ICONINFORMATION
+ PEMB-APPLMODAL
CALL "PETOOLS_MESSAGE_BOX" USING PE-MESSAGE
PE-MESSAGE-LAENGE
PE-HEADING
PE-HEADING-LAENGE
PE-MBOX-TYP
PE-MBOX-RC
.
WARNING-HINWEIS-EX.
EXIT.
|
|
PROCEDURE DIVISION - Fehler- & Warnungsroutinen Behandlung von Fehlern
******************************************************************
ERROR-ROUTINE SECTION.
******************************************************************
ERROR-ROUTINE-ST.
MOVE "Es ist ein Fehler aufgetreten!"
TO PE-HEADING
MOVE SPACE TO PE-MESSAGE
STRING PE-ERRM-TEXT DELIMITED BY LOW-VALUES
INTO PE-MESSAGE
END-STRING
MOVE 100 TO PE-MESSAGE-LAENGE
MOVE 40 TO PE-HEADING-LAENGE
COMPUTE PE-MBOX-TYP = PEMB-OK + PEMB-ICONSTOP
+ PEMB-APPLMODAL
CALL "PETOOLS_MESSAGE_BOX" USING PE-MESSAGE
PE-MESSAGE-LAENGE
PE-HEADING
PE-HEADING-LAENGE
PE-MBOX-TYP
PE-MBOX-RC
CLOSE E-ARTIKELDATEI
EXEC PRINT
DESTROY DOCUMENT DOC-UMSATZLISTE
END-EXEC
STOP RUN
.
ERROR-ROUTINE-EX.
EXIT.
|
