Ziele Untersuchung
mit Columbo Integrität von
Datenbanken Interaktion und
Portierbarkeit Ergonomie der
Schnittstellen

Angebot Produkte Projekt Beratung

Mittel Analytik Modellierung Sprachen Algebra Logik Hardware Denken Kreativität

Zusammenhänge Gesellschaft Wirtschaft Branche Firma


products/sources/formale Sprachen/Cobol/verschiedene-Autoren/Cobug/ Datei vom 10.2.2008 mit Größe 3 kB

Quelle forclass.cob Sprache: Cobol

IDENTIFICATION DIVISION.
PROGRAM-ID. ASSGN8.
Author. Cobug.
* http://www.cobug.com/cobug/forums/microfocus/38.shtml
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PAYROLL-MASTER
ASSIGN TO "C0803.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRINT-FILE
ASSIGN TO "ASSGN8.RPT".
DATA DIVISION.
FILE SECTION.
FD PAYROLL-MASTER
LABEL RECORDS ARE STANDARD
RECORD CONTAINS 80 CHARACTERS
BLOCK CONTAINS 20 RECORDS.
01 MASTER-REC.
05 NAME-IN PIC X(20).
05 WEIGHT-IN PIC X(3).
05 HEIGHT-IN PIC XX.
05 EYE-COLOR-IN PIC X.
05 HAIR-COLOR-IN PIC X.
05 SEX-IN PIC X.
FD PRINT-FILE
LABEL RECORDS ARE OMITTED
RECORD CONTAINS 80 CHARACTERS.
01 REPORT-OUT PIC X(80).

WORKING-STORAGE SECTION.
01 ARE-THERE-MORE-RECORDS PIC XXX.

01 HEADING-LINE1.
05 PIC X(30) VALUE SPACES.
05 PIC X(12) VALUE
"MODEL REPORT".

05 PIC X(28) VALUE SPACES.

01 HEADING-LINE2.
05 PIC X(10) VALUE SPACES.
05 PIC X(4) VALUE
"NAME".
05 PIC X(19) VALUE SPACES.
05 PIC X(3) VALUE
"SEX".
05 PIC X(4) VALUE SPACES.
05 PIC X(6) VALUE
"WEIGHT".
05 PIC X(2) VALUE SPACES.
05 PIC X(6) VALUE
"HEIGHT".

05 PIC X(2) VALUE SPACES.
05 PIC X(9) VALUE
"EYE COLOR".
05 PIC X(2) VALUE SPACES.
05 PIC X(10) VALUE
"HAIR COLOR".
05 PIC X(3) VALUE SPACES.

01 DETAIL-LINE.
05 PIC X(10).
05 NAME-OUT PIC X(20).
05 PIC X(4).
05 SEX-OUT PIC X.
05 PIC X(6).
05 WEIGHT-OUT PIC X(3).
05 PIC X(6).
05 HEIGHT-OUT PIC XX.
05 PIC X(6).
05 EYE-COLOR-OUT PIC X(5).
05 PIC X(6).
05 HAIR-COLOR-OUT PIC X(6).
05 PIC X(5).

PROCEDURE DIVISION.
100-MAIN-MODULE.
PERFORM 100-INITIALIZATION-MODULE
PERFORM 200-PRINT-MODULE
UNTIL ARE-THERE-MORE-RECORDS = 'NO '.
CLOSE PAYROLL-MASTER
PRINT-FILE.
STOP RUN.
100-INITIALIZATION-MODULE.
OPEN INPUT PAYROLL-MASTER
OUTPUT PRINT-FILE.
MOVE 'YES' TO ARE-THERE-MORE-RECORDS.
PERFORM 300-TOP-OF-PAGE-MODULE.

PERFORM 600-READ-MODULE.
PERFORM 400-CALCULATION-MODULE.
200-PRINT-MODULE.
IF HAIR-COLOR-IN = 1
AND EYE-COLOR-IN = 1
AND SEX-IN = "M"
AND WEIGHT-IN >= 185 AND <= 200
AND HEIGHT-IN > 72
OR
HAIR-COLOR-IN = 2
AND EYE-COLOR-IN = 2
AND SEX-IN = "F"
AND WEIGHT-IN >= 110 AND <= 125
AND HEIGHT-IN >= 62 AND <=66
MOVE SPACES TO REPORT-OUT
MOVE NAME-IN TO NAME-OUT
MOVE SEX-IN TO SEX-OUT
MOVE WEIGHT-IN TO WEIGHT-OUT
MOVE HEIGHT-IN TO HEIGHT-OUT
MOVE EYE-COLOR-IN TO EYE-COLOR-OUT
MOVE HAIR-COLOR-IN TO HAIR-COLOR-OUT
MOVE DETAIL-LINE TO REPORT-OUT
WRITE REPORT-OUT AFTER ADVANCING 1 LINES
END-IF
PERFORM 600-READ-MODULE.

300-TOP-OF-PAGE-MODULE.
MOVE HEADING-LINE1 TO REPORT-OUT.
WRITE REPORT-OUT
AFTER ADVANCING 1 LINES.
MOVE SPACES TO REPORT-OUT.
WRITE REPORT-OUT AFTER ADVANCING 1 LINES.
MOVE HEADING-LINE2 TO REPORT-OUT.
WRITE REPORT-OUT AFTER ADVANCING 1 LINES.

400-CALCULATION-MODULE.
IF HAIR-COLOR-IN = 1
THEN
MOVE "BLONDE" TO HAIR-COLOR-OUT
END-IF
IF EYE-COLOR-IN = 1
THEN
MOVE "BLUE" TO EYE-COLOR-OUT
END-IF.

600-READ-MODULE.
READ PAYROLL-MASTER
AT END MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
END-READ.

quality100%

¤ Dauer der Verarbeitung: 0.14 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.