source: IHS-VA_UTILITIES-XB/trunk/XBDT.m@ 1303

Last change on this file since 1303 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.1 KB
Line 
1XBDT ;IHS/HQW/JDH - date/time utilities ;[ 06/19/1998 11:11 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ;FISCAL
5 ; usage: S %=$$FISCAL^XBDT(XBDT,XBFYMTH,XBADJ)
6 ;
7 ; Input: (all parameters are optional)
8 ; XBDT Date in either fileman of horlog format. If not defined,
9 ; default is today.
10 ; XBFYMT Month beginning fiscal year. The definition of this
11 ; variable can be assigned in the parameter list. If it
12 ; is not and Beginning fiscal year month field in the
13 ; PCC MASTER CONTROL file is valued for the current locaton,
14 ; its value is used. The default is 10.
15 ; XBADJ The value of this variable allows the adjustment of the
16 ; FY value
17 ;
18 ; Output: current fiscal year^star date of FY^end date of FY
19 ;
20 ;LEAP
21 ; input: (optional) date in Fileman, yyyy or horlog
22 ; output: boolean 1=yes 0=no
23 ; uses algorithm defined for leap year in the RPMS Y2000 Compliance Plan
24 ;
25FISCAL(XBDT,XBFYMTH,XBADJ) ; return current fiscal year
26 ;
27 N %,T,T1,T2,XBFY,XBFYBEG,XBFYEND
28 S XBADJ=$G(XBADJ) ; adjustment variable
29 S:'$G(XBDT) XBDT=$$NOW^XLFDT
30 S:XBDT["," XBDT=$$HTFM^XLFDT(XBDT) ; horolog to fileman
31 S T=$P($G(^APCCCTRL(DUZ(2),0)),U,8) ; beg, FY month for location from PCC MASTER CONTROL file
32 S:'$G(XBFYMTH) XBFYMTH=$S(T:T,1:10) ; use month entered, as in MSTR file or 10
33 S XBFYMTH=$E("0",XBFYMTH<10)_XBFYMTH ; if month is less then 10 make it two digits
34 S T1=XBFYMTH-1<$E(XBDT,4,5) ; boolean. month before or after FY start month
35 S T2=XBDT\10000-'T1 ; current year in FM 3 digit year format plus 1 or 0 determined by T1 calculation
36 S XBFY=XBDT\10000+T1 ; fiscal Year in external 4 digit format
37 S XBFYBEG=T2_XBFYMTH_"01" ; beginning of fiscal year
38 S %=T2+1_XBFYMTH_"01"
39 S XBFYEND=$$FMADD^XLFDT(%,-1) ;get the beginning date of the fiscal year
40 Q XBFY+1700+XBADJ_U_XBFYBEG_U_XBFYEND
41 ;
42 ;
43 ;
44LEAP(XBDT) ; is the year a leap year?
45 ;
46 S:'$G(XBDT) XBDT=$$NOW^XLFDT
47 S:XBDT["," XBDT=$$HTFM^XLFDT(XBDT) ; horolog to fileman
48 S:$L(XBDT)>4 XBDT=XBDT\10000+1700 ; 4 digit date
49 Q '(XBDT#4)&(XBDT#100)!('(XBDT#100)&'(XBDT#400)) ; leap year algorithm
50 ;
Note: See TracBrowser for help on using the repository browser.