|
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: 5632 (0x1600)
Types: TextFile
Names: »OPG3.LST«
└─⟦c154ac35e⟧ Bits:30002656 COBOL-programmer til undervisning
└─ ⟦this⟧ »OPG3.LST«
\f
* Level II COBOL V2.1 OPG3.CBL Page 0001
*
* Options:
IDENTIFICATION DIVISION.
PROGRAM-ID. OPG3.
AUTHOR. HOLD 4.
DATE-WRITTEN. 1/10/85.
DATE-COMPILED. 1/10/85.
*
* PROGRAMMET INDLÆSER PERSON DATA FRA SKÆRMEN
* OG DANNER EN FIL -PERSON.TRA-.
* PROGRAMMET STOPPER VED INDTASTNING AF 9(10) I
* PERSON NUMMER FELTET.
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PICCOLINE.
SPECIAL-NAMES. CONSOLE IS CRT.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT UDFIL ASSIGN TO "PERSON.TRA".
*
DATA DIVISION.
FILE SECTION.
FD UDFIL
LABEL RECORD IS STANDARD.
*
01 PERSREG.
02 PERS-NR PIC 9(10).
02 PERS-FNVN PIC X(15).
02 PERS-EFNVN PIC X(20).
02 PERS-GNVN PIC X(20).
02 PERS-POSTNR PIC 9(4).
02 PERS-BYNAVN PIC X(20).
02 PERS-TLFNR PIC 9(8).
*
WORKING-STORAGE SECTION.
01 PERSREG1.
02 PERS-NR1 PIC 9(10).
02 PERS-FNVN1 PIC X(15).
02 PERS-EFNVN1 PIC X(20).
02 PERS-GNVN1 PIC X(20).
02 PERS-POSTNR1 PIC 9(4).
02 PERS-BYNAVN1 PIC X(20).
02 PERS-TLFNR1 PIC 9(8).
*
01 AC-NR PIC 9(10).
01 PERSONNR REDEFINES AC-NR.
02 CIF PIC 9 OCCURS 10 TIMES.
01 TAELLER PIC 999.
01 HELTAL PIC 99.
01 REST PIC 99.
*
*
PROCEDURE DIVISION.
STYRINGS SECTION.
STYR-IND.
PERFORM INIT.
PERFORM BEHANDL1.
PERFORM LUK.
DISPLAY SPACE.
\f
* Level II COBOL V2.1 OPG3.CBL Page 0002
*
DISPLAY "PROGRAM SLUT" AT 1230.
STOP RUN.
STYR-UD.
EXIT.
*
*
INIT SECTION.
INIT-IND.
OPEN EXTEND UDFIL.
PERFORM SKAERM.
INIT-UD.
EXIT.
*
*
BEHANDL1 SECTION.
BEH-IND.
ACCEPT AC-NR AT 0527.
PERFORM BEHANDL2 UNTIL AC-NR = 9999999999.
BEH-UD.
EXIT.
*
*
BEHANDL2 SECTION.
BEH2-IND.
MOVE 1 TO REST.
PERFORM TEST UNTIL REST = 0.
MOVE AC-NR TO PERS-NR1.
PERFORM NAVN.
PERFORM POST UNTIL (PERS-POSTNR1 > 1000)
AND ( PERS-POSTNR1 < 9999 ).
PERFORM BY-TLF.
PERFORM SKRIV.
PERFORM SKAERM.
ACCEPT AC-NR AT 0527.
BEH2-UD.
EXIT.
*
*
SKAERM SECTION.
SK-IND.
DISPLAY SPACE.
MOVE SPACE TO PERSREG1.
DISPLAY "INDTAST PERSONNUMMER: " AT 0501.
DISPLAY "INDTAST FORNAVN: " AT 0701.
DISPLAY "INDTAST EFTERNAVN: " AT 0901.
DISPLAY "INDTAST GADENAVN: " AT 1101.
DISPLAY "INDTAST POSTNUMMER: " AT 1301.
DISPLAY "INDTAST BYNAVN: " AT 1501.
DISPLAY "INDTAST TELEFONNUMMER: " AT 1701.
SK-UD.
EXIT.
*
*
TEST SECTION.
TST-IND.
COMPUTE TAELLER = CIF(1) * 4 + CIF(2) * 3 + CIF(3) * 2
+ CIF(4) * 7 + CIF(5) * 6 + CIF(6) * 5
+ CIF(7) * 4 + CIF(8) * 3 + CIF(9) * 2
+ CIF(10).
\f
* Level II COBOL V2.1 OPG3.CBL Page 0003
*
DIVIDE 11 INTO TAELLER GIVING HELTAL REMAINDER REST.
IF (REST > 0) DISPLAY "GALT NUMMER TAST NYT: "
AT 0542
ACCEPT AC-NR AT 0564.
TST-UD.
EXIT.
*
*
NAVN SECTION.
NAVN-IND.
ACCEPT PERS-FNVN1 AT 0727.
ACCEPT PERS-EFNVN1 AT 0927.
ACCEPT PERS-GNVN1 AT 1127.
NAVN-UD.
EXIT.
*
*
POST SECTION.
POST-IND.
ACCEPT PERS-POSTNR1 AT 1327.
IF (PERS-POSTNR1 < 1000 ) OR (PERS-POSTNR1 > 9998 )
DISPLAY "GALT NUMMER TAST NYT: " AT 1334
ACCEPT PERS-POSTNR1 AT 1355.
POST-UD.
EXIT.
*
*
BY-TLF SECTION.
BYTLF-IND.
ACCEPT PERS-BYNAVN1 AT 1527.
ACCEPT PERS-TLFNR1 AT 1727.
BYTLF-UD.
EXIT.
*
*
SKRIV SECTION.
SKRIV-IND.
MOVE PERSREG1 TO PERSREG.
WRITE PERSREG.
SKRIV-UD.
EXIT.
*
*
LUK SECTION.
LUK-IND.
CLOSE UDFIL.
LUK-UD.
EXIT.
* Level II COBOL V2.1 REVISION 9 URN EY/0011/GA
* Compiler Copyright (C) 1983 Micro Focus Ltd
*
* ERRORS=00000 DATA=01024 CODE=01280 DICT=01019:60788/61807 GSA FLAGS = OFF
«eof»