|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 7552 (0x1d80)
Types: TextFile
Names: »OPG8.CBL«
└─⟦c154ac35e⟧ Bits:30002656 COBOL-programmer til undervisning
└─ ⟦this⟧ »OPG8.CBL«
IDENTIFICATION DIVISION.
PROGRAM-ID. OPG8.
AUTHOR. HOLD 4.
DATE-WRITTEN. 29.10.85.
DATE-COMPILED. 29.09.85.
*
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PICCOLINE.
OBJECT-COMPUTER. PICCOLINE.
SPECIAL-NAMES. CONSOLE IS CRT.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT LAES-FIL1 ASSIGN TO "IXPERSON.REG"
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS IXPERS-NR.
SELECT LAES-FIL2 ASSIGN TO "P-TRANS.TRA".
SELECT PRINTER ASSIGN TO "LST:".
*
*
DATA DIVISION.
FILE SECTION.
FD LAES-FIL1
LABEL RECORD IS STANDARD.
01 IXPERSREG.
02 IXPERS-NR PIC 9(10).
02 IXPERS-FNVN PIC X(15).
02 IXPERS-EFNVN PIC X(20).
02 IXPERS-GNVN PIC X(20).
02 IXPERS-POSTNR PIC 9(4).
02 IXPERS-BYNAVN PIC X(20).
02 IXPERS-TLFNR PIC 9(8).
*
FD LAES-FIL2
LABEL RECORD IS STANDARD.
01 TRANSREG.
02 TRANS-TYPE PIC 9.
02 TRANS-ARB.
05 TRANS-NR PIC 9(10).
05 TRANS-FNVN PIC X(15).
05 TRANS-EFNVN PIC X(20).
05 TRANS-GNVN PIC X(20).
05 TRANS-POSTNR PIC 9(4).
05 TRANS-BYNAVN PIC X(20).
05 TRANS-TLFNR PIC 9(8).
*
FD PRINTER
LABEL RECORD IS OMITTED.
01 PRINT-LINIE PIC X(132).
*
*
WORKING-STORAGE SECTION.
01 RAPPORT-LINIE.
02 RAPP-PERSNR PIC 99B99B99B9999.
02 FILLER PIC X(5) VALUE ": ".
02 KOMMENTAR PIC X(114) VALUE SPACE.
01 EOF-LAES1 PIC XXX VALUE "NEJ".
01 EOF-LAES2 PIC XXX VALUE "NEJ".
01 DATO PIC 999999.
01 OVERSKRIFT-1.
02 FILLER PIC X(37) VALUE SPACES.
02 OVS1 PIC X(45) VALUE
"A J O U R F Ø R I N G S R A P P O R T PR. ".
02 OVS1-DATO PIC 99B99B99.
02 FILLER PIC X(34) VALUE SPACES.
02 FILLER PIC XXXXX VALUE "SIDE ".
02 SIDE-NR PIC ZZ9.
01 OVERSKRIFT-2.
02 FILLER PIC X(132) VALUE
"PERSON-NUMMER: FORKLARING:".
01 LINIE-TAELLER PIC 99 VALUE 18.
01 SIDETAL PIC 999 VALUE 001.
*
*
PROCEDURE DIVISION.
STYR SECTION.
STYR-IND.
PERFORM OPEN-FILER.
PERFORM INDLAES-DATO.
PERFORM BEHANDL UNTIL EOF-LAES2="JA ".
PERFORM LUK-FILER.
STOP RUN.
STYR-UD.
EXIT.
*
*
OPEN-FILER SECTION.
OPEN-IND.
OPEN I-O LAES-FIL1.
OPEN INPUT LAES-FIL2.
OPEN OUTPUT PRINTER.
PERFORM LAES-LAES2.
OPEN-UD.
EXIT.
*
*
INDLAES-DATO SECTION.
DATO-IND.
PERFORM CLEAR.
DISPLAY "DAGS DATO:" AT 0101.
ACCEPT DATO AT 0112.
PERFORM CLEAR.
DATO-UD.
EXIT.
*
*
CLEAR SECTION.
CLS-IND.
DISPLAY SPACES UPON CRT.
CLS-UD.
EXIT.
*
*
BEHANDL SECTION.
BEH-IND.
IF TRANS-TYPE = 1
PERFORM OPRET
ELSE
IF TRANS-TYPE = 2
PERFORM AENDRE
ELSE
IF TRANS-TYPE = 3
PERFORM SLET.
PERFORM LAES-LAES2.
BEH-UD.
EXIT.
*
*
LUK-FILER SECTION.
LUK-IND.
CLOSE LAES-FIL1.
CLOSE LAES-FIL2.
CLOSE PRINTER.
LUK-UD.
EXIT.
*
*
OPRET SECTION.
OPR-IND.
MOVE "OPRETTET" TO KOMMENTAR.
WRITE IXPERSREG FROM TRANS-ARB INVALID KEY PERFORM FEJL-1.
PERFORM SKRIV-DETAIL.
OPR-UD.
EXIT.
*
*
AENDRE SECTION.
AENDRE-IND.
MOVE "ÆNDRET" TO KOMMENTAR.
MOVE TRANS-NR TO IXPERS-NR.
READ LAES-FIL1 INVALID KEY PERFORM FEJL-2.
IF TRANS-FNVN NOT = SPACES MOVE SPACES TO IXPERS-FNVN
MOVE TRANS-FNVN TO IXPERS-FNVN.
IF TRANS-EFNVN NOT = SPACES MOVE SPACES TO IXPERS-EFNVN
MOVE TRANS-EFNVN TO IXPERS-EFNVN.
IF TRANS-GNVN NOT = SPACES MOVE SPACES TO IXPERS-GNVN
MOVE TRANS-GNVN TO IXPERS-GNVN.
IF TRANS-POSTNR NOT = SPACES
MOVE TRANS-POSTNR TO IXPERS-POSTNR.
IF TRANS-BYNAVN NOT = SPACES MOVE SPACES TO IXPERS-BYNAVN
MOVE TRANS-BYNAVN TO IXPERS-BYNAVN.
IF TRANS-TLFNR NOT = ZEROES MOVE ZEROES TO IXPERS-TLFNR
MOVE TRANS-TLFNR TO IXPERS-TLFNR.
REWRITE IXPERSREG INVALID KEY PERFORM FEJL-2.
PERFORM SKRIV-DETAIL.
AENDRE-UD.
EXIT.
*
*
SLET SECTION.
SLET-IND.
MOVE "SLETTET" TO KOMMENTAR.
MOVE TRANS-NR TO IXPERS-NR.
READ LAES-FIL1 INVALID KEY PERFORM FEJL-3.
DELETE LAES-FIL1 INVALID KEY PERFORM FEJL-3.
PERFORM SKRIV-DETAIL.
SLET-UD.
EXIT.
*
*
SKRIV-DETAIL SECTION.
SK-DET-IND.
MOVE TRANS-NR TO RAPP-PERSNR.
MOVE SIDETAL TO SIDE-NR.
MOVE DATO TO OVS1-DATO.
PERFORM LINIE-SKRIV.
SK-DET-UD.
EXIT.
*
*
LINIE-SKRIV SECTION.
LS-IND.
IF LINIE-TAELLER = 18
WRITE PRINT-LINIE FROM OVERSKRIFT-1 AFTER ADVANCING PAGE
WRITE PRINT-LINIE FROM OVERSKRIFT-2 AFTER ADVANCING 2 LINES
ADD 1 TO SIDETAL
WRITE PRINT-LINIE FROM RAPPORT-LINIE
MOVE ZERO TO LINIE-TAELLER
ELSE
WRITE PRINT-LINIE FROM RAPPORT-LINIE AFTER ADVANCING 2 LINES.
ADD 1 TO LINIE-TAELLER.
LS-UD.
EXIT.
*
*
LAES-LAES2 SECTION.
L-L2-IND.
READ LAES-FIL2 AT END MOVE "JA " TO EOF-LAES2.
L-L2-UD.
EXIT.
*
*
FEJL-1 SECTION.
F1-IND.
MOVE "OPRETTELSE AF EKSISTERENDE POST" TO KOMMENTAR.
F1-UD.
EXIT.
*
*
FEJL-2 SECTION.
F2-IND.
MOVE "ÆNDRING AF IKKE-EKSISTERENDE POST" TO KOMMENTAR.
F2-UD.
EXIT.
*
*
FEJL-3 SECTION.
F3-IND.
MOVE "SLETTNING AF IKKE-EKSISTERENDE POST" TO KOMMENTAR.
F3-UD.
EXIT.
«eof»