/usr/lib/x86_64-linux-gnu/fis-gtm/V6.3-000A_x86_64/_DATE.m is in fis-gtm-6.3-000a 6.3-000A-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
; Copyright 1987, 2003 Sanchez Computer Associates, Inc. ;
; ;
; This source code contains the intellectual property ;
; of its copyright holder(s), and is made available ;
; under a license. If you do not know the terms of ;
; the license, please stop and do not read further. ;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
%DATE ;GT.M %DATE utility - returns $H format date in %DN
;invoke at INT with %DS to by pass interactive prompt
;formats accepted include:
; days as 1 or 2 digits
; months as 1 or 2 digits or as unique alpha prefixes
; years as 2 or 4 digits
; "T" or "t" for today with an optional +/- offset
; except for the +/- offset any non alphameric character(s)
; are accepted as delimiters
; numeric months must precede days
; alpha months may precede or follow days
; a missing year is defaulted to this year
; null input is defaulted to today
;
n %DS
f r !,"Date: ",%DS s %DN=$$FUNC(%DS) q:%DN'="" w " - invalid date"
q
INT s %DN=$$FUNC($g(%DS))
q
FUNC(dt)
n cp,dd,dir,ilen,mm,tok,tp,yy,dh,zd
i $g(dt)="" q +$H
s ilen=$l(dt)+1,cp=1 d advance
i $e("TODAY",1,$l(tok))=$tr(tok,"today","TODAY") q $$incr(+$H)
i $e("TOMORROW",1,$l(tok))=$tr(tok,"tomrw","TOMRW") q $$incr($H+1)
i $e("YESTERDAY",1,$l(tok))=$tr(tok,"yestrday","YESTRDAY") q $$incr($H-1)
i dir?1A s mm=$$amon(tok) q:mm=0 "" d advance s dd=tok q $$date
i tok<1 q ""
s mm=tok d advance
i dir?1A s dd=mm,mm=$$amon(tok) q:mm=0 "" q $$date
i mm<13 s dd=tok q $$date
q ""
;
advance f cp=cp:1:ilen q:$e(dt,cp)?1AN
s dir=$e(dt,cp)
i dir?1A f tp=cp+1:1:ilen q:$e(dt,tp)'?1A
e i dir?1N f tp=cp+1:1:ilen q:$e(dt,tp)'?1N
e s tok="" q
s tok=$e(dt,cp,tp-1)
s cp=tp
q
incr(h)
f cp=cp:1:ilen q:"+-"[$e(dt,cp)
i cp'=ilen s dd=$e(dt,cp) d advance i dir?.1N,cp=ilen q h+(dd_tok)
q h
;
amon(mm)
s mm=$tr(mm,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
i $l(mm)<3,"AJM"[tok,"JAPAU"'[mm q 0
n mon
s mon="\JANUARY \FEBRUARY \MARCH \APRIL \MAY \JUNE \JULY \AUGUST \SEPTEMBER\OCTOBER \NOVEMBER \DECEMBER"
q $f(mon,("\"_mm))+8\10
;
date()
i dd<1 q ""
d advance
i dir'?.1N q ""
s zd=$ZDATEFORM
s yy=tok
i yy="" s yy=$zd($h,"YEAR")
i cp'=ilen q ""
i $l(yy)<3 d
. s dh=$H
. s yy=yy+(100*$S('zd:19,(zd>1840)&($L(zd)=4):($E(zd,1,2)+$S($E(zd,3,4)'>yy:0,1:1)),1:$E($ZDATE(dh,"YEAR"),1,2)))
; 20th rolling current century
i dd>$s(+mm'=2:$e(303232332323,mm)+28,yy#4:28,yy#100:29,yy#400:28,1:29) q ""
n cc,dat
s dat=yy-1841,mm=mm-1,cc=1
i dat<0 s dd=dd-1,cc=-1
s dat=dat\4*1461+(dat#4-$s(dat'<0:0,1:4)*365)+(mm*30)+$e(10112234455,mm)+dd-(yy-1800\100-(yy-1600\400))
i yy#4,mm>1 s dat=dat-cc
i yy#100=0,mm<2,yy#400 s dat=dat+cc
q dat
|