|
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: 5888 (0x1700)
Types: TextFile
Names: »OPG5A.CBL«
└─⟦c154ac35e⟧ Bits:30002656 COBOL-programmer til undervisning
└─ ⟦this⟧ »OPG5A.CBL«
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 9(4).
02 TRANS-BYNAVN1 PIC X(20).
02 TRANS-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.
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 TRANS-TYPE1 AT 0527.
IF TRANS-TYPE1 < 1 OR TRANS-TYPE1 > 3
DISPLAY "GALT TYPE INDTAST NYT: " AT 0534
ACCEPT TRANS-TYPE1 AT 0557.
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
PERFORM POST UNTIL ( (TRANS-POSTNR1 > 1000)
AND ( TRANS-POSTNR1 < 9999 ) )
OR TRANS-POSTNR1 = " ".
PERFORM BY-TLF.
PERFORM SKRIV.
PERFORM SKAERM.
ACCEPT TRANS-TYPE1 AT 0527.
IF TRANS-TYPE1 < 1 OR TRANS-TYPE1 > 3
DISPLAY "GALT TYPE INDTAST NYT: " AT 0534
ACCEPT TRANS-TYPE1 AT 0557.
ACCEPT AC-NR AT 0727.
BEH2-UD.
EXIT.
*
*
SKAERM SECTION.
SK-IND.
DISPLAY SPACE.
MOVE SPACE TO TRANSREG1.
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.
*
*
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.
ACCEPT TRANS-POSTNR1 AT 1527.
IF ((TRANS-POSTNR1 < 1000 ) OR (TRANS-POSTNR1 > 9998))
AND TRANS-POSTNR1 NOT = " "
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.
EXIT.
*
*
SKRIV SECTION.
SKRIV-IND.
MOVE TRANSREG1 TO TRANSREG.
WRITE TRANSREG.
SKRIV-UD.
EXIT.
*
*
LUK SECTION.
LUK-IND.
CLOSE UDFIL.
LUK-UD.
EXIT.
«eof»