source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCDXPRGD.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.5 KB
Line 
1SCDXPRGD ;ALB/JRP - DATE UTILITIES FOR ACRP PURGING;04-SEP-97
2 ;;5.3;Scheduling;**128**;AUG 13, 1993
3 ;
4FY4DT(DATE) ;Return fiscal year given date falls within
5 ;
6 ;Input : DATE - Date (FileMan) (Defaults to TODAY)
7 ;Output : YYYY - Fiscal year date falls within (ex: 1997)
8 ;
9 ;Check input
10 S DATE=+$P($G(DATE),".",1)
11 S:(DATE'?7N) DATE=$$DT^XLFDT()
12 ;Declare variables
13 N YEAR,MONTH
14 ;Pull year from given date
15 S YEAR=$E(DATE,1,3)
16 ;Pull month from given date
17 S MONTH=+$E(DATE,4,5)
18 ;Fiscal year begins in October (add one to year for Oct, Nov, and Dec)
19 S:(MONTH>9) YEAR=YEAR+1
20 ;Convert year to external format
21 S YEAR=YEAR+1700
22 ;Done
23 Q YEAR
24 ;
25PREVFY(DATE) ;Return previous fiscal year from given date
26 ;
27 ;Input : DATE - Date (FileMan) (Defaults to TODAY)
28 ;Output : YYYY - Previous fiscal year from given date (ex: 1996)
29 ;
30 ;Check input
31 S DATE=+$P($G(DATE),".",1)
32 S:(DATE'?7N) DATE=$$DT^XLFDT()
33 ;Declare variables
34 N YEAR
35 ;Convert date to same date of previous year
36 S YEAR=+$E(DATE,1,3)
37 S YEAR=YEAR-1
38 S DATE=YEAR_$E(DATE,4,7)
39 ;Return fiscal year for date in last year (done)
40 Q $$FY4DT(DATE)
41 ;
42DR4FY(FISCAL) ;Return date range for a given fiscal year
43 ;
44 ;Input : FISCAL - Year (external) (Default to current year)
45 ;Ouput : Begin ^ End - Beginning and ending dates (FileMan)
46 ;
47 ;Check input
48 S FISCAL=+$G(FISCAL)
49 S:(FISCAL'?4N) FISCAL=1700+$E($$DT^XLFDT(),1,3)
50 ;Declare variables
51 N BEGIN,END
52 ;Fiscal year begins in October of previous year
53 S BEGIN=((FISCAL-1)-1700)_"1001"
54 ;Fiscal year ends in September of given year
55 S END=(FISCAL-1700)_"0930"
56 ;Done
57 Q (BEGIN_"^"_END)
58 ;
59LASTDBCO(DATE) ;Return last NPCD database close-out from given date
60 ;
61 ;Input : DATE - Date (FileMan) (Defaults to TODAY)
62 ;Output : Date - Date that NPCD was last closed for database credit
63 ;Notes : If the database close-out date for the input date can not
64 ; be determined, the first day of the fiscal year will be
65 ; returned. The same holds true if the database close-out
66 ; date for a previous month can not be determined.
67 ;
68 ;Check input
69 S DATE=+$P($G(DATE),".",1)
70 S:(DATE'?7N) DATE=$$DT^XLFDT()
71 ;Declare variables
72 N MONTH,YEAR,CLOSEOUT,DBCLOSE,TMP
73 ;Get current database close-out date
74 S DBCLOSE=+$$CLOSEOUT^SCDXFU04(DATE)
75 ;Error - return first day of fiscal year
76 I (DBCLOSE<0) S YEAR=$$FY4DT(DATE) Q +$$DR4FY(YEAR)
77 S CLOSEOUT=DBCLOSE
78 ;Break year & month off of given date
79 S YEAR=$E(DATE,1,3)
80 S MONTH=$E(DATE,4,5)
81 ;Go backwards, one month at a time, from given month
82 ; Stop when database close-out date is prior to current close-out date
83 F S MONTH=MONTH-1 D Q:(CLOSEOUT<DBCLOSE)
84 .;Account for jump from Jan to Dec
85 .I ('MONTH) S MONTH=12,YEAR=YEAR-1
86 .;Create FileMan date out of year/month
87 .S MONTH="00"_MONTH
88 .S TMP=$L(MONTH)
89 .S MONTH=$E(MONTH,(TMP-1),TMP)
90 .S TMP=YEAR_MONTH_"01"
91 .;Get database close-out date
92 .S CLOSEOUT=+$$CLOSEOUT^SCDXFU04(TMP)
93 ;Error - return first day of fiscal year
94 I (CLOSEOUT<0) S YEAR=$$FY4DT(DATE) Q +$$DR4FY(YEAR)
95 ;Done
96 Q CLOSEOUT
97 ;
98PREVMNTH(DATE) ;Return first day of previous month
99 ;
100 ;Input : DATE - Month/year to return previous month from (FileMan)
101 ; Defaults to TODAY
102 ;Output : Date - First day of previous month (FileMan)
103 ;
104 ;Check input
105 S DATE=+$P($G(DATE),".",1)
106 S:(DATE'?7N) DATE=$$DT^XLFDT()
107 ;Declare variables
108 N MONTH,YEAR,TMP
109 ;Break year & month off of given date
110 S YEAR=$E(DATE,1,3)
111 S MONTH=$E(DATE,4,5)
112 ;Decrement month by 1
113 S MONTH=MONTH-1
114 ;Account for jump from Jan to Dec
115 I ('MONTH) S MONTH=12,YEAR=YEAR-1
116 ;Re-build FileMan date
117 S MONTH="00"_MONTH
118 S TMP=$L(MONTH)
119 S MONTH=$E(MONTH,(TMP-1),TMP)
120 S TMP=YEAR_MONTH_"01"
121 ; Done - Return first day of previous month
122 Q TMP
123 ;
124LASTDAY(DATE) ;Return last day of specified month
125 ;
126 ;Input : DATE - Month/year to return last day of (FileMan)
127 ; Defaults to TODAY
128 ;Output : Date - Last day of month (FileMan)
129 ;Notes : This call does not return the number of days in the month
130 ;
131 ;Check input
132 S DATE=+$P($G(DATE),".",1)
133 S:(DATE'?7N) DATE=$$DT^XLFDT()
134 ;Declare variables
135 N MONTH,YEAR,TMP
136 ;Break year & month off of given date
137 S YEAR=$E(DATE,1,3)
138 S MONTH=$E(DATE,4,5)
139 ;Last day of month is day before first day of next month
140 ; Increment month by 1
141 S MONTH=MONTH+1
142 ; Account for jump from Dec to Jan
143 I (MONTH=13) S MONTH=1,YEAR=YEAR+1
144 ; Build FileMan date denoting first day of next month
145 S MONTH="00"_MONTH
146 S TMP=$L(MONTH)
147 S MONTH=$E(MONTH,(TMP-1),TMP)
148 S TMP=YEAR_MONTH_"01"
149 ; Done - Return day prior to first day of next month
150 Q $$FMADD^XLFDT(TMP,-1,0,0,0)
Note: See TracBrowser for help on using the repository browser.