|
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: 4864 (0x1300)
Types: TextFile
Names: »OPG10PH.LST«
└─⟦c154ac35e⟧ Bits:30002656 COBOL-programmer til undervisning
└─ ⟦this⟧ »OPG10PH.LST«
\f
* Level II COBOL V2.1 OPG10PH.CBL Page 0001
*
* Options:
IDENTIFICATION DIVISION.
PROGRAM-ID. OPG10.
AUTHOR. HOLD4.
DATE-WRITTEN. 191185.
DATE-COMPILED. 201185.
*
* PROGRAMMET VALIDERER,INDSÆTTER MÅNEDSNAVN OG
* BEREGNER ÅRETS DAGNUMMER UDFRA EN OPGIVET DATO.
*
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PICCOLINE.
SPECIAL-NAMES. CONSOLE IS CRT.
*
*
DATA DIVISION.
*
*
WORKING-STORAGE SECTION.
01 DATO-IND PIC 9(6).
01 DATO REDEFINES DATO-IND.
05 DD PIC 99 COMP.
05 MM PIC 99 COMP.
05 AA PIC 99 COMP.
01 MD-TAB.
05 FILLER PIC X(9) VALUE "JANUAR ".
05 FILLER PIC X(9) VALUE "FEBRUAR ".
05 FILLER PIC X(9) VALUE "MARTS ".
05 FILLER PIC X(9) VALUE "APRIL ".
05 FILLER PIC X(9) VALUE "MAJ ".
05 FILLER PIC X(9) VALUE "JUNI ".
05 FILLER PIC X(9) VALUE "JULI ".
05 FILLER PIC X(9) VALUE "AUGUST ".
05 FILLER PIC X(9) VALUE "SEPTEMBER".
05 FILLER PIC X(9) VALUE "OKTOBER ".
05 FILLER PIC X(9) VALUE "NOVEMBER ".
05 FILLER PIC X(9) VALUE "DECEMBER ".
01 TAB-R REDEFINES MD-TAB.
05 MD-NVN PIC X(9) OCCURS 12 TIMES.
01 MD-ANTAL.
05 FILLER PIC X(24) VALUE
"312831303130313130313031".
01 TAB-A REDEFINES MD-ANTAL.
05 MD-TAL PIC 99 OCCURS 12 TIMES.
01 SW PIC 9.
01 RETUR PIC X.
01 TAL PIC 99.
01 RES PIC 999.
01 RES-UD PIC ZZ9.
01 MDM PIC X(9).
*
*
PROCEDURE DIVISION.
STYR SECTION.
ST-IND.
PERFORM INIT.
PERFORM BEHANDLE UNTIL DATO = 999999.
\f
* Level II COBOL V2.1 OPG10PH.CBL Page 0002
*
PERFORM AFSLUT.
STOP RUN.
ST-UD.
EXIT.
*
*
INIT SECTION.
IN-IND.
DISPLAY SPACES.
DISPLAY "BEREGNING AF ÅRETS DAGNUMMER" AT 0425.
IN-UD.
EXIT.
*
*
BEHANDLE SECTION.
BH-IND.
DISPLAY " " AT 2603.
DISPLAY " " AT 2010.
DISPLAY " " AT 0638.
DISPLAY " " AT 1010.
DISPLAY " " AT 1210.
DISPLAY "INDTAST DATO (DDMMAA)" AT 0615.
ACCEPT DATO AT 0638.
IF DATO = 999999 NEXT SENTENCE
ELSE MOVE ZERO TO SW
PERFORM CHECKDATO UNTIL SW = 1
MOVE ZERO TO TAL RES
SUBTRACT 1 FROM MM
PERFORM BEREGN MM TIMES
ADD 1 TO MM
ADD DD TO RES
PERFORM UDSKRIV.
BH-UD.
EXIT.
*
*
CHECKDATO SECTION.
CK-IND.
MOVE 1 TO SW.
IF (DD = 0) OR (DD > 31)
DISPLAY "FORKERT DAGNR. TAST NYT" AT 2010
ACCEPT DD AT 2035
MOVE ZERO TO SW.
IF (MM = 0) OR (MM > 12)
DISPLAY "FORKERT MÅNEDSNR. TAST NYT" AT 2010
ACCEPT MM AT 2038
MOVE ZERO TO SW.
CK-UD.
EXIT.
*
*
BEREGN SECTION.
BR-IND.
ADD 1 TO TAL.
ADD MD-TAL(TAL) TO RES.
BR-UD.
EXIT.
*
*
\f
* Level II COBOL V2.1 OPG10PH.CBL Page 0003
*
UDSKRIV SECTION.
US-IND.
DISPLAY "MDNAVN = " AT 1010.
MOVE MD-NVN (MM) TO MDM.
DISPLAY MDM AT 1019.
DISPLAY "DGNR = " AT 1210.
MOVE RES TO RES-UD.
DISPLAY RES-UD AT 1219.
DISPLAY "TRYK (RETUR)" AT 2403.
ACCEPT RETUR AT 2416.
US-UD.
EXIT.
*
*
AFSLUT SECTION.
AS-IND.
DISPLAY SPACES.
DISPLAY "OPGAVE 10 FÆRDIG" AT 0101.
AS-UD.
EXIT.
* Level II COBOL V2.1 REVISION 9 URN EY/0011/GA
* Compiler Copyright (C) 1983 Micro Focus Ltd
*
* ERRORS=00000 DATA=00768 CODE=01024 DICT=00807:61000/61807 GSA FLAGS = OFF
«eof»