|
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: »OPG5.LST«
└─⟦c154ac35e⟧ Bits:30002656 COBOL-programmer til undervisning
└─ ⟦this⟧ »OPG5.LST«
\f
* Level II COBOL V2.1 OPG5.CBL Page 0001
*
* Options:
IDENTIFICATION DIVISION.
PROGRAM-ID. OPG5.
AUTHOR. HOLD 4.
DATE-WRITTEN. 12/9/85.
DATE-COMPILED. 12/9/85.
*
* PROGRAMMET INDLÆSER TRANSAKTION TYPE (1 2 3)
* OG DANNER EN FIL -P-TRANS.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 "P-TRANS.TRA".
*
DATA DIVISION.
FILE SECTION.
FD UDFIL
LABEL RECORD IS STANDARD.
*
01 TRANSREG.
02 TRANS-TYPE PIC 9.
02 TRANS-NR PIC 9(10).
02 TRANS-FNVN PIC X(15).
02 TRANS-EFNVN PIC X(20).
02 TRANS-GNVN PIC X(20).
02 TRANS-POSTNR PIC 9(4).
02 TRANS-BYNAVN PIC X(20).
02 TRANS-TLFNR PIC 9(8).
*
WORKING-STORAGE SECTION.
01 TRANSREG1.
02 TRANS-TYPE1 PIC 9.
02 TRANS-NR1 PIC 9(10).
02 TRANS-FNVN1 PIC X(15).
02 TRANS-EFNVN1 PIC X(20).
02 TRANS-GNVN1 PIC X(20).
02 TRANS-POSTNR1 PIC X(4).
02 R-POSTNR REDEFINES TRANS-POSTNR1 PIC 9(4).
02 TRANS-BYNAVN1 PIC X(20).
02 TRANS-TLFNR1 PIC 9(8).
*
01 AC-NR PIC X(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.
01 FLAG PIC 9.
01 SLET-LINIE PIC X(35) VALUE SPACE.
*
*
PROCEDURE DIVISION.
\f
* Level II COBOL V2.1 OPG5.CBL Page 0002
*
STYRINGS SECTION.
STYR-IND.
PERFORM INIT.
PERFORM BEHANDL1.
PERFORM LUK.
DISPLAY SPACE.
DISPLAY "PROGRAM SLUT" AT 1230.
STOP RUN.
STYR-UD.
EXIT.
*
*
INIT SECTION.
INIT-IND.
OPEN EXTEND UDFIL.
PERFORM CLEAR-FELTER.
PERFORM SKAERM.
INIT-UD.
EXIT.
*
*
BEHANDL1 SECTION.
BEH-IND.
ACCEPT TRANS-TYPE1 AT 0527.
PERFORM TRANS-TYPE-TEST UNTIL
TRANS-TYPE1 > 0 AND TRANS-TYPE1 < 4.
ACCEPT AC-NR AT 0727.
IF AC-NR = " " DISPLAY "NR. SKAL INDTASTES"
AT 0742 ACCEPT AC-NR AT 0727.
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 TRANS-NR1.
IF TRANS-TYPE1 < 3
PERFORM NAVN
ACCEPT TRANS-POSTNR1 AT 1527
IF TRANS-POSTNR1 NOT = " "
PERFORM POST UNTIL R-POSTNR > 1000
AND R-POSTNR < 9999 AND R-POSTNR NUMERIC.
IF TRANS-TYPE1 < 3 PERFORM BY-TLF.
PERFORM SKRIV.
PERFORM CLEAR-FELTER.
ACCEPT TRANS-TYPE1 AT 0527.
PERFORM TRANS-TYPE-TEST UNTIL
TRANS-TYPE1 > 0 AND TRANS-TYPE1 < 4.
ACCEPT AC-NR AT 0727.
IF AC-NR = " " DISPLAY "NR. SKAL INDTASTES"
AT 0742 ACCEPT AC-NR AT 0727.
BEH2-UD.
EXIT.
*
*
SKAERM SECTION.
\f
* Level II COBOL V2.1 OPG5.CBL Page 0003
*
SK-IND.
DISPLAY SPACE.
DISPLAY "INDTAST TRANS TYPE: " AT 0501
DISPLAY "INDTAST PERSONNUMMER: " AT 0701.
DISPLAY "INDTAST FORNAVN: " AT 0901.
DISPLAY "INDTAST EFTERNAVN: " AT 1101.
DISPLAY "INDTAST GADENAVN: " AT 1301.
DISPLAY "INDTAST POSTNUMMER: " AT 1501.
DISPLAY "INDTAST BYNAVN: " AT 1701.
DISPLAY "INDTAST TELEFONNUMMER: " AT 1901.
SK-UD.
EXIT.
*
*
TRANS-TYPE-TEST SECTION.
TR-TY-IND.
IF TRANS-TYPE1 < 1 OR TRANS-TYPE1 > 3 DISPLAY
"GALT TYPE INDTAST NYT: " AT 0534
ACCEPT TRANS-TYPE1 AT 0557.
TR-TY-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).
DIVIDE 11 INTO TAELLER GIVING HELTAL REMAINDER REST.
IF (REST > 0) DISPLAY "GALT NUMMER TAST NYT: "
AT 0742
ACCEPT AC-NR AT 0764.
TST-UD.
EXIT.
*
*
NAVN SECTION.
NAVN-IND.
ACCEPT TRANS-FNVN1 AT 0927.
ACCEPT TRANS-EFNVN1 AT 1127.
ACCEPT TRANS-GNVN1 AT 1327.
NAVN-UD.
EXIT.
*
*
POST SECTION.
POST-IND.
DISPLAY "GALT NUMMER TAST NYT: " AT 1534
ACCEPT TRANS-POSTNR1 AT 1555.
POST-UD.
EXIT.
*
*
BY-TLF SECTION.
BYTLF-IND.
ACCEPT TRANS-BYNAVN1 AT 1727.
ACCEPT TRANS-TLFNR1 AT 1927.
BYTLF-UD.
\f
* Level II COBOL V2.1 OPG5.CBL Page 0004
*
EXIT.
*
*
CLEAR-FELTER SECTION.
CLR-FLT-IND.
MOVE 0 TO FLAG.
MOVE SPACES TO TRANSREG1.
MOVE SPACES TO AC-NR.
DISPLAY TRANS-TYPE1 AT 0527.
DISPLAY SLET-LINIE AT 0534.
DISPLAY TRANS-NR1 AT 0727.
DISPLAY SLET-LINIE AT 0742.
DISPLAY TRANS-FNVN1 AT 0927.
DISPLAY TRANS-EFNVN1 AT 1127.
DISPLAY TRANS-GNVN1 AT 1327.
DISPLAY TRANS-POSTNR1 AT 1527.
DISPLAY SLET-LINIE AT 1534.
DISPLAY TRANS-BYNAVN1 AT 1727.
DISPLAY TRANS-TLFNR1 AT 1927.
CLR-FLT-UD.
EXIT.
*
*
SKRIV SECTION.
SKRIV-IND.
MOVE TRANSREG1 TO TRANSREG.
WRITE TRANSREG.
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=01792 DICT=01247:60560/61807 GSA FLAGS = OFF
«eof»