|
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: 6912 (0x1b00)
Types: TextFile
Names: »OPG9PH.CBL«
└─⟦c154ac35e⟧ Bits:30002656 COBOL-programmer til undervisning
└─ ⟦this⟧ »OPG9PH.CBL«
IDENTIFICATION DIVISION.
PROGRAM-ID. OPG9.
AUTHOR. HOLD 4.
DATE-WRITTEN. 18/11/85.
DATE-COMPILED. 18/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 DYNAMIC
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.
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 0.
01 SVAR PIC 9.
*
*
PROCEDURE DIVISION.
STYRINGS SECTION.
STYR-IND.
PERFORM INIT.
PERFORM BEHANDLE UNTIL FRA-NR = 9999999999.
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.
ACCEPT FRA-NR AT 0309.
IF FRA-NR = 9999999999 NEXT SENTENCE
ELSE DISPLAY "TIL NR: " AT 0401.
ACCEPT TIL-NR AT 0409.
L-UD.
EXIT.
*
*
FEJL SECTION.
F-IND.
DISPLAY "GALT INTERVAL INDTAST NYT:" AT 0501
UPON CRT-UNDER.
PERFORM LAES-INTERVAL UNTIL TIL-NR < FRA-NR.
F-UD.
EXIT.
*
*
FOR-STOR SECTION.
FST-IND.
DISPLAY "INGEN PERSONER MED SÅ STORT NR." AT 1515.
PERFORM LAES-INTERVAL.
FST-UD.
EXIT
*
*
BEHANDLE SECTION.
BEHA-IND.
PERFORM BEH.
IF OKAY = 1 PERFORM FOR-STOR.
BEHA-UD.
EXIT.
*
*
BEH SECTION.
B2-IND.
MOVE ZERO TO OKAY.
PERFORM LAES-INTERVAL.
IF FRA-NR = 9999999999 NEXT SENTENCE
ELSE IF FRA-NR > TIL-NR PERFORM FEJL
ELSE MOVE FRA-NR TO IXPERS-NR.
PERFORM INDLAES.
PERFORM SKRIV UNTIL FRA-NR > TIL-NR.
MOVE 18 TO TAELLER.
B2-UD.
EXIT.
*
*
INDLAES SECTION.
LAES-IND.
READ INDFIL NEXT RECORD AT END
MOVE 999999998 TO IXPERS-NR.
MOVE IXPERS-NR TO FRA-NR.
IF SVAR NOT = ZERO MOVE 1 TO OKAY.
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.
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.
«eof»