source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDATE.m@ 1806

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

revised back to 6/30/08 version

File size: 8.0 KB
Line 
1PXRMDATE ; SLC/PKR - Clinical Reminders date utilities. ;06/20/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;==================================================
5CEFD(FDA) ;Called by the Exchange Utility only if the input packed
6 ;reminder was packed under v1.5 Move Effective Date to Beginning Date.
7 N IND
8 S IND=""
9 F S IND=$O(FDA(811.902,IND)) Q:IND="" D
10 . I '$D(FDA(811.902,IND,12)) Q
11 .;If the EFFECTIVE PERIOD exists don't do anything.
12 . I $D(FDA(811.902,IND,9)) Q
13 . S FDA(811.902,IND,9)=FDA(811.902,IND,12)
14 . K FDA(811.902,IND,12)
15 Q
16 ;
17 ;==================================================
18COMPARE(X) ;Compare beginning and ending dates, give a warning if
19 ;Ending Date comes before Beginning Date. Called by ADATE xref in
20 ;definitions and terms.
21 ;Do not execute as part of exchange.
22 I $G(PXRMEXCH) Q
23 N BDT,EDT
24 S BDT=$S(X(1)'="":$$CTFMD^PXRMDATE(X(1)),1:0)
25 S EDT=X(2)
26 I EDT="" S EDT="T"
27 S EDT=$$CTFMD^PXRMDATE(EDT)
28 ;If EDT does not contain a time set it to the end of the day.
29 I EDT'["." S EDT=EDT_".235959"
30 I EDT<BDT D
31 . S BDT=$S(X(1)'="":X(1),1:"")
32 . S EDT=$S(X(2)'="":X(2),1:"T@2400")
33 . S TEXT="Warning the ending date ("_EDT_") is before the beginning date ("_BDT_")"
34 . D EN^DDIOL(TEXT)
35 Q
36 ;
37 ;==================================================
38COTN(EFP) ;Convert an Effective Period to the new date/time format.
39 ;Possible effective periods are ND, NM, or NY where N is an integer.
40 S EFP=$$UP^XLFSTR(EFP)
41 I (EFP?1N.N1"D")!(EFP?1N.N1"M")!(EFP?1N.N1"Y") D
42 . S NUM=+EFP
43 . S EFP=$S(NUM=0:"T",1:"T-"_EFP)
44 Q EFP
45 ;
46 ;==================================================
47CTFMD(DATE) ;Convert DATE which may be in any of the FileMan acceptable
48 ;forms as well as T-NY to a FileMan date. Also understands LAD for
49 ;Last Admission Date.
50 N %DT,X,Y
51 ;Check for a date FileMan understands.
52 S X=DATE,%DT="ST"
53 D ^%DT
54 ;If it is not a FileMan date check for a symbolic date.
55 I Y=-1 S Y=$$SYMDATE(DATE)
56 ;If it is not a date that is understood by SYMDATE return -1
57 I Y=-1 Q -1
58 I $G(PXRMDATE)'="",$$ISVSYMD(DATE) D
59 . N DIFFS
60 . S DIFFS=-$$FMDIFF^XLFDT(DT,PXRMDATE,2)
61 . S Y=$$FMADD^XLFDT(Y,0,0,0,DIFFS)
62 I DATE["LAD" D
63 . I $G(PXRMLAD)="" S Y=0
64 . E D
65 .. N DIFFS
66 .. S DIFFS=-$$FMDIFF^XLFDT(DT,$G(PXRMLAD),2)
67 .. S Y=$$FMADD^XLFDT(Y,0,0,0,DIFFS)
68 Q Y
69 ;
70 ;=================================================
71DCHECK(DATE) ;Trap for special characters before calling CTFMD^PXRMDATE.
72 ;Used in DIR("PRE") for date inputs.
73 I $D(DTOUT) Q DATE
74 I DATE="" Q DATE
75 I DATE["^" Q DATE
76 I DATE["?" Q DATE
77 Q $$CTFMD^PXRMDATE(DATE)
78 ;
79 ;==================================================
80DUE(DEFARR,RESDATE,FREQ,DUE,DUEDATE,FIEVAL) ;Compute the due date.
81 ;This is the date of the resolution finding + the reminder frequency.
82 ;Subtract the due in advance time to see if the reminder should be
83 ;marked as due soon.
84 ;
85 N DATE,DIAT,DIATOK,LDATE,PXRMITEM,TDDUE,TODAY
86 S PXRMITEM=DEFARR("IEN")
87 ;If the final frequency is 0Y then the reminder is not due.
88 I FREQ="0Y" S DUE=0,DUEDATE="" Q
89 ;
90 S DUEDATE=""
91 ;Check for custom date due.
92 I DEFARR(45)'="" S DUEDATE=$$CDUEDATE^PXRMCDUE(.DEFARR,.FIEVAL)
93 I DUEDATE'="",DUEDATE'=-1 G SETDUE
94 ;
95 ;No custom date due, do regular date calculation.
96 I (FREQ="")!(FREQ=-1) D Q
97 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFREQ")="No reminder frequency - cannot compute due date!"
98 . S (DUE,DUEDATE)="CNBD"
99 ;
100 S LDATE=$S(RESDATE["X":0,1:+RESDATE)
101 I LDATE=0 S (DUE,DUEDATE)="DUE NOW" Q
102 S DATE=$$FULLDATE(LDATE),DUEDATE=$$NEWDATE(DATE,FREQ)
103 ;
104SETDUE ;If the due date is less than or equal to today's date the reminder
105 ;is due.
106 S TODAY=$$NOW^PXRMDATE
107 I +DUEDATE'>TODAY S DUE="DUE NOW" Q
108 ;
109 S DIAT="-"_$P(DEFARR(0),U,4)
110 I DIAT="-" D
111 . S DIATOK=0
112 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","DIAT")="Warning no do in advance time"
113 E S DIATOK=1
114 ;
115 S TDDUE=$S(DIATOK=1:$$NEWDATE(DUEDATE,DIAT),1:DUEDATE)
116 S DUE=$S(TDDUE'>TODAY:"DUE SOON",1:"RESOLVED")
117 Q
118 ;
119 ;==================================================
120DURATION(START,STOP) ;Return the number days between the Start Date and
121 ;Stop Date.
122 I +START=0 Q 0
123 N PXRMNOW
124 S PXRMNOW=$$NOW^PXRMDATE
125 I START>PXRMNOW Q 0
126 I (STOP="")!(STOP>PXRMNOW) S STOP=PXRMNOW
127 Q $$FMDIFF^XLFDT(STOP,START)
128 ;
129 ;==================================================
130EDATE(DATE) ;Check for an historical (event) date, format as appropriate.
131 Q $$FMTE^XLFDT(DATE,"5DZ")
132 ;
133 ;==================================================
134FULLDATE(DATE) ;See if DATE is a full date, i.e., it has a month and
135 ;a day along with a year. If the month is missing assume Jan. If the
136 ;day is missing assume the first. Issue a warning so the user knows
137 ;what happened. DATE should be in Fileman format.
138 N DAY,MISSING,MONTH,TDATE,YEAR
139 S TDATE=DATE
140 S MISSING=0
141 S DAY=$E(DATE,6,7)
142 S MONTH=$E(DATE,4,5)
143 S YEAR=$E(DATE,1,3)
144 I +DAY=0 D
145 . S DAY=1
146 . S MISSING=1
147 . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO DAY")="Encounter date missing the day, using the first for the date due calculation."
148 I +MONTH=0 D
149 . S MONTH=1
150 . S MISSING=1
151 . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO MONTH")="Encounter date missing the month, using January for the date due calculation."
152 I MISSING D
153 . S TDATE=(YEAR*1E4)+(MONTH*1E2)+DAY
154 . I DATE["E" S TDATE=TDATE_"E"
155 Q TDATE
156 ;
157 ;==================================================
158FRQINDAY(FREQ) ;Given a frequency in the form ND, NM, or NY where N is a
159 ;number and D stands for days, M for months, and Y for years return
160 ;the value in days.
161 I FREQ="" Q ""
162 N CODE,LEN,MULT,NUM
163 S LEN=$L(FREQ)
164 S NUM=$E(FREQ,1,LEN-1)
165 S CODE=$E(FREQ,LEN,LEN)
166 S MULT=1.0
167 I CODE="M" S MULT=30.42
168 I CODE="Y" S MULT=365.25
169 Q +(MULT*NUM)
170 ;
171 ;==================================================
172ISVSYMD(DATE) ;Return true if DATE is a valid symbolic date.
173 N P1,P1OK,P2,P2OK,OP,PAT
174 S DATE=$P(DATE,"@",1)
175 S OP=$S(DATE["+":"+",1:"-")
176 S P1=$P(DATE,OP,1),P1OK=0
177 F PAT="T","TODAY","N","NOW" I P1=PAT S P1OK=1 Q:P1OK
178 I PAT=DATE Q 1
179 S P2=$P(DATE,OP,2),P2OK=0
180 F PAT="1N.N","1N.N1""D""","1N.N1""M""","1N.N1""Y""" I P2?@PAT S P2OK=1 Q:P2OK
181 Q P1OK&P2OK
182 ;
183 ;==================================================
184NEWDATE(FMDATE,OFFSET) ;Given a date in VA Fileman format (FMDATE) and an
185 ;offset of the form NY, NM, ND where N is a number and Y stands for
186 ;years, M for months, and D for days return the new date in VA Fileman
187 ;format.
188 I FMDATE=0 Q 0
189 N LEN,NEWDATE,NUM,UNIT
190 S LEN=$L(OFFSET)
191 S NUM=+$E(OFFSET,1,LEN-1)
192 S UNIT=$E(OFFSET,LEN)
193 I UNIT="D" G DAY
194 I UNIT="M" G MONTH
195 I UNIT="Y" G YEAR
196 ;Unknown unit just return the original date
197 Q FMDATE
198DAY ;
199 S NEWDATE=+$$FMADD^XLFDT(FMDATE,NUM)
200 Q NEWDATE
201MONTH ;
202 ;Convert the months to days and then add the days using the DAY code.
203 ;Multiply the number of months by the average number of days in a month.
204 N INT,FRAC
205 S NUM=30.42*NUM
206 ;Round the number of days, FMADD^XLFDT has problems with non-integer
207 ;days.
208 S INT=+$P(NUM,".",1)
209 S FRAC=NUM-INT
210 I FRAC<0.5 S NUM=INT
211 E S NUM=INT+1
212 G DAY
213 Q
214YEAR ;
215 Q FMDATE+(10000*NUM)
216 ;
217 ;==================================================
218NOW() ;If the reminder global PXRMDATE is defined return it, otherwise
219 ;return the current date and time.
220 Q $S(+$G(PXRMDATE)>0:PXRMDATE,1:$$NOW^XLFDT)
221 ;
222 ;==================================================
223SYMDATE(DATE) ;Convert a symbolic date into a FileMan date.
224 N %DT,OPER,PFSTACK,SYM,TIME,X,Y
225 S TIME=$P(DATE,"@",2),DATE=$P(DATE,"@",1)
226 S X=$S(DATE="LAD":$G(PXRMLAD),1:"")
227 I X="" D
228 . S OPER="+-"
229 . D POSTFIX^PXRMSTAC(DATE,OPER,.PFSTACK)
230 I PFSTACK(0)=3 D
231 . S SYM=PFSTACK(1)
232 . S SYM=$S(SYM="LAD":"T",SYM="N":"N",SYM="NOW":"N",SYM="T":"T",SYM="TODAY":"T",1:"")
233 . I SYM="" S Y=-1 Q
234 .;FileMan only handles D, W, or M so convert Y to months.
235 . I PFSTACK(2)["Y" S PFSTACK(2)=+PFSTACK(2)*12_"M"
236 . S X=SYM_PFSTACK(3)_PFSTACK(2)
237 I PFSTACK(0)=1 S X=PFSTACK(1)
238 I TIME'="" S X=X_"@"_TIME
239 S %DT="ST"
240 D ^%DT
241 Q Y
242 ;
243 ;==================================================
244VDATE(VIEN) ;Given a visit ien return the visit date.
245 N DATE
246 I +VIEN>0 S DATE=$P($G(^AUPNVSIT(VIEN,0)),U,1)
247 E S DATE=0
248 I $L(DATE)=0 S DATE=0
249 ;Check for historical encounter.
250 I $$ISHIST^PXRMVSIT(VIEN) S DATE=DATE_"E"
251 Q DATE
252 ;
Note: See TracBrowser for help on using the repository browser.