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. |