|
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: 10112 (0x2780)
Types: TextFile
Names: »OPG10.LST«
└─⟦c154ac35e⟧ Bits:30002656 COBOL-programmer til undervisning
└─ ⟦this⟧ »OPG10.LST«
\f
* Level II COBOL V2.1 OPG10.CBL Page 0001
*
* Options: REF
IDENTIFICATION DIVISION. 011E
PROGRAM-ID. OPG10. 0120
AUTHOR. HOLD4. 0120
DATE-WRITTEN. 191185. 0120
DATE-COMPILED. 201185. 0120
*
* PROGRAMMET VALIDERER,INDSÆTTER MÅNEDSNAVN OG
* BEREGNER ÅRETS DAGNUMMER UDFRA EN OPGIVET DATO.
*
*
ENVIRONMENT DIVISION. 0120
CONFIGURATION SECTION. 0120
SOURCE-COMPUTER. PICCOLINE. 0120
SPECIAL-NAMES. CONSOLE IS CRT. 0120
*
*
DATA DIVISION. 0120
*
*
WORKING-STORAGE SECTION. 020C 00
01 DATO-IND PIC 9(6). 020C 00
01 DATO REDEFINES DATO-IND. 020C 00
05 DD PIC 99. 020C 00
05 MM PIC 99. 020E 02
05 AA PIC 99. 0210 04
01 MD-TAB. 0212 06
05 FILLER PIC X(9) VALUE "JANUAR ". 0212 06
05 FILLER PIC X(9) VALUE "FEBRUAR ". 021B 0F
05 FILLER PIC X(9) VALUE "MARTS ". 0224 18
05 FILLER PIC X(9) VALUE "APRIL ". 022D 21
05 FILLER PIC X(9) VALUE "MAJ ". 0236 2A
05 FILLER PIC X(9) VALUE "JUNI ". 023F 33
05 FILLER PIC X(9) VALUE "JULI ". 0248 3C
05 FILLER PIC X(9) VALUE "AUGUST ". 0251 45
05 FILLER PIC X(9) VALUE "SEPTEMBER". 025A 4E
05 FILLER PIC X(9) VALUE "OKTOBER ". 0263 57
05 FILLER PIC X(9) VALUE "NOVEMBER ". 026C 60
05 FILLER PIC X(9) VALUE "DECEMBER ". 0275 69
01 TAB-R REDEFINES MD-TAB. 0212 06
05 MD-NVN PIC X(9) OCCURS 12 TIMES. 0212 06
01 MD-ANTAL. 027E 72
05 FILLER PIC X(24) VALUE 027E 72
"312831303130313130313031". 027E 72
01 TAB-A REDEFINES MD-ANTAL. 027E 72
05 MD-TAL PIC 99 OCCURS 12 TIMES. 027E 72
01 SW PIC 9. 0296 8A
01 RETUR PIC X. 0297 8B
01 TAL PIC 99. 0298 8C
01 RES PIC 999. 029A 8E
01 RES-UD PIC ZZ9. 029D 91
01 MDM PIC X(9). 02A0 94
01 INDEKS PIC 99 COMP. 02A9 9D
*
*
PROCEDURE DIVISION. 0000
STYR SECTION. 001C
ST-IND. 001D
PERFORM INIT. 001E
\f
* Level II COBOL V2.1 OPG10.CBL Page 0002
*
PERFORM BEHANDLE UNTIL DATO = 999999. 0021
PERFORM AFSLUT. 003B
STOP RUN. 003E
ST-UD. 003F
EXIT. 0040
*
*
INIT SECTION. 0044
IN-IND. 0045
DISPLAY SPACES. 0046
DISPLAY "BEREGNING AF ÅRETS DAGNUMMER" AT 0425. 004B
IN-UD. 0071
EXIT. 0072
*
*
BEHANDLE SECTION. 0076
BH-IND. 0077
DISPLAY " " AT 2603. 0078
DISPLAY " " AT 2010. 00A8
DISPLAY " " AT 0638. 00D8
DISPLAY " " AT 1010. 00E8
DISPLAY " " AT 1210. 0106
DISPLAY "INDTAST DATO (DDMMAA)" AT 0615. 0124
ACCEPT DATO AT 0638. 0143
IF DATO = 999999 NEXT SENTENCE 0156
ELSE MOVE ZERO TO SW 0169
PERFORM CHECKDATO UNTIL SW = 1 016A
MOVE ZERO TO TAL RES 016F
SUBTRACT 1 FROM MM 0184
MOVE 1 TO INDEKS 0189
PERFORM BEREGN MM TIMES 018E
ADD 1 TO MM 01A3
ADD DD TO RES 01A3
PERFORM UDSKRIV. 01A8
BH-UD. 01B1
EXIT. 01B2
*
*
CHECKDATO SECTION. 01B6
CK-IND. 01B7
MOVE 1 TO SW. 01B8
IF (DD = 0) OR (DD > 31) 01BD
DISPLAY "FORKERT DAGNR. TAST NYT" AT 2010 01BD
ACCEPT DD AT 2035 01D8
MOVE ZERO TO SW. 01F9
IF (MM = 0) OR (MM > 12) 0206
DISPLAY "FORKERT MÅNEDSNR. TAST NYT" AT 2010 0206
ACCEPT MM AT 2038 0221
MOVE ZERO TO SW. 0245
CK-UD. 0252
EXIT. 0253
*
*
BEREGN SECTION. 0257
BR-IND. 0258
ADD MD-TAL (INDEKS) TO RES. 0259
ADD 1 TO INDEKS. 0265
BR-UD. 0268
EXIT. 0269
\f
* Level II COBOL V2.1 OPG10.CBL Page 0003
*
*
*
UDSKRIV SECTION. 026D
US-IND. 026E
DISPLAY "MDNAVN = " AT 1010. 026F
MOVE MD-NVN (MM) TO MDM. 0282
DISPLAY MDM AT 1019. 028D
DISPLAY "DGNR = " AT 1210. 029A
MOVE RES TO RES-UD. 02AD
DISPLAY RES-UD AT 1219. 02B4
DISPLAY "TRYK (RETUR)" AT 2403. 02C1
ACCEPT RETUR AT 2416. 02D7
US-UD. 02E4
EXIT. 02E5
*
*
AFSLUT SECTION. 02E9
AS-IND. 02EA
DISPLAY SPACES. 02EB
DISPLAY "OPGAVE 10 FÆRDIG" AT 0101. 02F0
AS-UD. 030A
EXIT. 030B
030B
* Level II COBOL V2.1 REVISION 9 URN EY/0011/GA
* Compiler Copyright (C) 1983 Micro Focus Ltd
*
* ERRORS=00000 DATA=00768 CODE=01280 DICT=00829:60978/61807 GSA FLAGS = OFF
«eof»