From:	SMTP%"RELAY-INFO-VAX@CRVAX.SRI.COM" 25-AUG-1993 13:16:37.30
To:	EVERHART
CC:	
Subj:	Re: LIB$DAY in DCL?

X-Newsgroups: comp.os.vms
From: mueller@avalon.physik.unizh.ch (Eric Mueller)
Subject: Re: LIB$DAY in DCL?
Message-ID: <1993Aug25.070342.25749@ifi.unizh.ch>
Sender: news@ifi.unizh.ch (USENET News Admin)
Nntp-Posting-Host: avalon
Organization: University of Zurich, Department of Computer Science
X-Newsreader: TIN [version 1.2 PL0]
Date: Wed, 25 Aug 1993 07:03:42 GMT
Lines: 116
To: Info-VAX@KL.SRI.COM
X-Gateway-Source-Info: USENET


Here comes one I've wrote in Fortran. It's in german but I can
translate it for you if you wish it. You can use it as a DCL-command.
The date will be returned in a global variable where you can use it
in other DCL-procedures. You can also easy modify it to write the date
to the screen.

OSTER.FOR:

C
C     Funktionalitaet:
C
C       Datumsberechnung des Osterfestes nach der Gaussschen Formel 
C     in einem als Parameter uebergebenen Jahr.
C
C
C     Uebergabeparameter:
C
C       Jahreszahl in der Form YYYY.
C
C
C     Verwendete Datensaetze:
C
C       Keine.
C
C
C     Variablenliste:
C
C       Siehe Programmbeginn.
C
C
C     Rueckgabeparameter:
C
C       Osterdatum im Format DD-MMM-YYYY, wobei DD und YYYY Ganzzahlwerte
C     und MMM eine Stringliteralkonstante darstellt.
C
C
C     Anmerkungen:
C
C       Der Gueltigkeitsbereich der Berechnung wurde auf ein Datum zwischen
C     den Jahren 1700 bis 2199 gelegt. Dies sollte fuer die meisten An-
C     wendungen genuegen.
C
C
C
      IMPLICIT NONE
      INTEGER jahr1, a, b, c, d, e, m, n, tag
      CHARACTER osterdatum * 11, monat * 3, delimiter
      CHARACTER tag1 * 2, jahr * 4
      INTRINSIC JMOD
C
      delimiter = '-'
      CALL CLI$GET_VALUE('JAHR',jahr)
      READ (jahr, '(I4)') jahr1
      IF (jahr1.GE.1700.AND.jahr1.LE.1799) THEN 
        m = 23
        n =  3
      ELSE IF (jahr1.GE.1800.AND.jahr1.LE.1899) THEN
        m = 23
        n =  4
      ELSE IF (jahr1.GE.1900.AND.jahr1.LE.2099) THEN
        m = 24
        n =  5
      ELSE IF (jahr1.GE.2100.AND.jahr1.LE.2199) THEN
        m = 24
        n =  6
      ELSE
        CALL Fehlermeldung('001')
      END IF
      a = JMOD(jahr1,19)
      b = JMOD(jahr1,4)
      c = JMOD(jahr1,7)
      d = JMOD((19*a+m),30)
      e = JMOD((2*b+4*c+6*d+n),7)
      tag = 22 + d + e
      IF (tag.GT.31) THEN
        tag = d + e - 9
        monat = 'APR'
      ELSE
        monat = 'MAR'
      END IF
      IF ((tag.EQ.26).AND.(monat.EQ.'APR')) THEN
        tag = 19
      ELSE IF ((tag.EQ.25).AND.(monat.EQ.'APR').AND.(d.EQ.28)
     &.AND.(a.GT.10)) THEN
        tag = 18
      END IF
      WRITE (tag1, '(I2)') tag
      osterdatum = tag1 // delimiter // monat // delimiter // jahr
      CALL LIB$SET_SYMBOL('OSTERDATUM',osterdatum,2)
      END
C
C
      SUBROUTINE Fehlermeldung (fehler)
C
C     Ausgabe einer formatierten Fehlermeldung auf den/m Bildschirm
C     und gegebenenfalls Abbruch des Programmes.
C
      CHARACTER fehler * 3, description * 80
      IF (fehler .EQ. '001') THEN
        description = 'Jahr ausserhalb der Grenzen 1700 - 2199'
      END IF
      PRINT *, 'Error: ',description
      STOP
      END

And now OSTER.CLD:

DEFINE VERB OSTER
       IMAGE "DISK1:[RZ.MUELLERE.PROGRAMME.SOURCE]OSTER.EXE"
       PARAMETER P1, LABEL=JAHR, PROMPT="Jahr", VALUE(REQUIRED, TYPE=$NUMBER)


Use it as SET COMMAND OSTER.
--
eric.mueller@rz.id.ethz.ch

