|
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: 7936 (0x1f00)
Types: TextFile
Names: »OPG9.LST«
└─⟦c154ac35e⟧ Bits:30002656 COBOL-programmer til undervisning
└─ ⟦this⟧ »OPG9.LST«
\f
* Level II COBOL V2.1 OPG9.CBL Page 0001
*
* Options:
IDENTIFICATION DIVISION.
PROGRAM-ID. OPG9.
AUTHOR. HOLD 4.
DATE-WRITTEN. 12/11/85.
DATE-COMPILED. 12/11/85.
*
* PROGRAMMET LÆSER FILEN "IXPERSON.REG" FRA DISKEN
* OG UDSKRIVER EN LISTE MED OPLYSNINGER PÅ PRINTEREN.
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PICCOLINE.
SPECIAL-NAMES. CONSOLE IS CRT,DECIMAL-POINT IS COMMA.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INDFIL ASSIGN TO "IXPERSON.REG"
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS IXPERS-NR.
SELECT LISTE ASSIGN TO "LST:".
*
DATA DIVISION.
FILE SECTION.
FD INDFIL
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 LISTE
LABEL RECORD IS OMITTED.
01 UDLINIE PIC X(132).
*
WORKING-STORAGE SECTION.
01 OVERSKRIFT0.
02 FILLER PIC X(132) VALUE SPACE.
01 OVERSKRIFT1.
02 FILLER PIC X(30) VALUE SPACE.
02 FILLER PIC X(20) VALUE "CPR-LISTE".
02 FILLER PIC X(5) VALUE "PR.".
02 MMDDAA PIC 99B99B99.
02 FILLER PIC X(26) VALUE SPACE.
02 FILLER PIC X(6) VALUE "SIDE".
02 SIDENR PIC 999.
02 FILLER PIC X(33) VALUE SPACE.
01 OVERSKRIFT2.
02 FILLER PIC X(14) VALUE "PERSON-NR:".
02 FILLER PIC X(16) VALUE "FORNAVN:".
02 FILLER PIC X(21) VALUE "EFTERNAVN:".
02 FILLER PIC X(21) VALUE "GADENAVN:".
02 FILLER PIC X(26) VALUE "P-NR BYNAVN:".
02 FILLER PIC X(8) VALUE "TLF-NR:".
02 FILLER PIC X(26) VALUE SPACE.
01 PERSREG1.
\f
* Level II COBOL V2.1 OPG9.CBL Page 0002
*
02 PERS-NR1 PIC 99.99.99B9999B.
02 PERS-FNVN1 PIC X(16).
02 PERS-EFNVN1 PIC X(21).
02 PERS-GNVN1 PIC X(21).
02 PERS-POSTNR1 PIC 9999B.
02 PERS-BYNAVN1 PIC X(21).
02 PERS-TLFNR1 PIC 99.999999.
02 FILLER PIC X(25) VALUE SPACE.
01 TAELLER PIC 99 VALUE 18.
01 DATO PIC 999999.
01 EFTERSKRIFT PIC X(132) VALUE "CPR-LISTE FÆRDIG".
01 TIL-NR PIC 9(10).
01 FRA-NR PIC 9(10).
01 EOF PIC X(4) VALUE SPACE.
01 OKAY PIC 9 VALUE 2.
*
*
PROCEDURE DIVISION.
STYRINGS SECTION.
STYR-IND.
PERFORM INIT.
PERFORM LAES-INTERVAL UNTIL OKAY = 0.
IF FRA-NR NOT = 9999999999 PERFORM LAES-FIL.
PERFORM BEHANDL UNTIL FRA-NR = 9999999999.
DISPLAY "PROGRAM SLUT" AT 1230.
WRITE UDLINIE FROM EFTERSKRIFT AFTER ADVANCING 5 LINES.
PERFORM LUK.
STOP RUN.
STYR-UD.
EXIT.
*
*
INIT SECTION.
INIT-IND.
OPEN INPUT INDFIL.
OPEN OUTPUT LISTE.
MOVE 001 TO SIDENR.
DISPLAY SPACE.
DISPLAY "UDSKRIVNING AF INDEX CPR-LISTE." AT 0101.
DISPLAY "INDTAST DATO (MM.DD.AA) " AT 0201.
ACCEPT DATO AT 0225.
MOVE DATO TO MMDDAA.
DISPLAY SPACES.
INIT-UD.
EXIT.
*
*
LAES-INTERVAL SECTION.
L-IND.
DISPLAY "FRA NR: " AT 0301.
DISPLAY "TIL NR: " AT 0401.
DISPLAY " " AT 0309.
DISPLAY " " AT 0409.
ACCEPT FRA-NR AT 0309.
MOVE FRA-NR TO IXPERS-NR.
IF FRA-NR NOT = 9999999999
ACCEPT TIL-NR AT 0409
DISPLAY " " AT 0501.
IF TIL-NR < FRA-NR
\f
* Level II COBOL V2.1 OPG9.CBL Page 0003
*
MOVE 1 TO OKAY.
START INDFIL KEY IS NOT < IXPERS-NR
INVALID KEY MOVE 1 TO OKAY.
IF OKAY = 1 AND FRA-NR NOT = 9999999999 PERFORM FEJL
ELSE
MOVE 0 TO OKAY.
L-UD.
EXIT.
*
*
FEJL SECTION.
F-IND.
DISPLAY "GALT INTERVAL INDTAST NYT:" AT 0501.
DISPLAY " " AT 0309.
DISPLAY " " AT 0409.
MOVE 0 TO FRA-NR.
MOVE 0 TO TIL-NR.
F-UD.
EXIT.
*
*
BEHANDL SECTION.
BEH-IND.
MOVE 2 TO OKAY.
PERFORM BEHANDL2 UNTIL EOF = "SLUT"
OR IXPERS-NR > TIL-NR.
PERFORM SKRIV.
MOVE "TULS" TO EOF.
MOVE 18 TO TAELLER.
MOVE 001 TO SIDENR.
PERFORM LAES-INTERVAL UNTIL OKAY = 0.
IF FRA-NR NOT = 9999999999
PERFORM LAES-FIL.
BEH-UD.
EXIT.
*
*
BEHANDL2 SECTION.
B2-IND.
PERFORM SKRIV.
PERFORM LAES-FIL.
B2-UD.
EXIT.
*
*
LAES-FIL SECTION.
LAES-IND.
READ INDFIL NEXT RECORD
AT END MOVE "SLUT" TO EOF.
LAES-UD.
EXIT.
*
*
FLYT SECTION.
FLYT-IND.
MOVE IXPERS-NR TO PERS-NR1.
MOVE IXPERS-FNVN TO PERS-FNVN1.
MOVE IXPERS-EFNVN TO PERS-EFNVN1.
MOVE IXPERS-GNVN TO PERS-GNVN1.
\f
* Level II COBOL V2.1 OPG9.CBL Page 0004
*
MOVE IXPERS-POSTNR TO PERS-POSTNR1.
MOVE IXPERS-BYNAVN TO PERS-BYNAVN1.
MOVE IXPERS-TLFNR TO PERS-TLFNR1.
FLYT-UD.
EXIT.
*
*
SKRIV SECTION.
SKRIV-IND.
IF TAELLER = 18
PERFORM OVERSKRIFT.
PERFORM FLYT.
WRITE UDLINIE FROM PERSREG1 AFTER ADVANCING 2 LINES.
ADD 1 TO TAELLER.
SKRIV-UD.
EXIT.
*
*
OVERSKRIFT SECTION.
OV-IND.
WRITE UDLINIE FROM OVERSKRIFT0 AFTER ADVANCING PAGE.
WRITE UDLINIE FROM OVERSKRIFT1 AFTER ADVANCING 1 LINE.
WRITE UDLINIE FROM OVERSKRIFT2 AFTER ADVANCING 2 LINES.
ADD 1 TO SIDENR.
MOVE 0 TO TAELLER.
OV-UD.
EXIT.
*
*
LUK SECTION.
LUK-IND.
CLOSE INDFIL, LISTE.
LUK-UD.
EXIT.
* Level II COBOL V2.1 REVISION 9 URN EY/0011/GA
* Compiler Copyright (C) 1983 Micro Focus Ltd
*
* ERRORS=00000 DATA=01792 CODE=01280 DICT=01410:60397/61807 GSA FLAGS = OFF
«eof»