|
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: 4480 (0x1180)
Types: TextFile
Names: »OPG10.CBL«
└─⟦c154ac35e⟧ Bits:30002656 COBOL-programmer til undervisning
└─ ⟦this⟧ »OPG10.CBL«
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.
05 MM PIC 99.
05 AA PIC 99.
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).
01 INDEKS PIC 99 COMP.
*
*
PROCEDURE DIVISION.
STYR SECTION.
ST-IND.
PERFORM INIT.
PERFORM BEHANDLE UNTIL DATO = 999999.
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
MOVE 1 TO INDEKS
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 MD-TAL (INDEKS) TO RES.
ADD 1 TO INDEKS.
BR-UD.
EXIT.
*
*
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.
«eof»