| 1 | PXRMDATE ; SLC/PKR - Clinical Reminders date utilities. ;01/24/2007
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
|
|---|
| 3 | ;
|
|---|
| 4 | ;==================================================
|
|---|
| 5 | CEFD(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 | ;==================================================
|
|---|
| 18 | COMPARE(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 | ;==================================================
|
|---|
| 38 | COTN(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 | ;==================================================
|
|---|
| 47 | CTFMD(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,ND,X,Y
|
|---|
| 51 | ;Already a FileMan date?
|
|---|
| 52 | S ND=+DATE
|
|---|
| 53 | I (ND'<1000000),(ND'>9991231) Q DATE
|
|---|
| 54 | ;Check for a date FileMan understands.
|
|---|
| 55 | S X=DATE,%DT="ST"
|
|---|
| 56 | D ^%DT
|
|---|
| 57 | ;If it is not a FileMan date check for a symbolic date.
|
|---|
| 58 | I Y=-1 S Y=$$SYMDATE(DATE)
|
|---|
| 59 | ;If it is not a date that is understood by SYMDATE return -1
|
|---|
| 60 | I Y=-1 Q -1
|
|---|
| 61 | I $G(PXRMDATE)'="",$$ISVSYMD(DATE) D
|
|---|
| 62 | . N DIFFS
|
|---|
| 63 | . S DIFFS=-$$FMDIFF^XLFDT(DT,PXRMDATE,2)
|
|---|
| 64 | . S Y=$$FMADD^XLFDT(Y,0,0,0,DIFFS)
|
|---|
| 65 | I DATE["LAD" D
|
|---|
| 66 | . I $G(PXRMLAD)="" S Y=0
|
|---|
| 67 | . E D
|
|---|
| 68 | .. N DIFFS
|
|---|
| 69 | .. S DIFFS=-$$FMDIFF^XLFDT(DT,$G(PXRMLAD),2)
|
|---|
| 70 | .. S Y=$$FMADD^XLFDT(Y,0,0,0,DIFFS)
|
|---|
| 71 | Q Y
|
|---|
| 72 | ;
|
|---|
| 73 | ;=================================================
|
|---|
| 74 | DCHECK(DATE) ;Trap for special characters before calling CTFMD^PXRMDATE.
|
|---|
| 75 | ;Used in DIR("PRE") for date inputs.
|
|---|
| 76 | I $D(DTOUT) Q DATE
|
|---|
| 77 | I DATE="" Q DATE
|
|---|
| 78 | I DATE["^" Q DATE
|
|---|
| 79 | I DATE["?" Q DATE
|
|---|
| 80 | Q $$CTFMD^PXRMDATE(DATE)
|
|---|
| 81 | ;
|
|---|
| 82 | ;==================================================
|
|---|
| 83 | DUE(DEFARR,RESDATE,FREQ,DUE,DUEDATE,FIEVAL) ;Compute the due date.
|
|---|
| 84 | ;This is the date of the resolution finding + the reminder frequency.
|
|---|
| 85 | ;Subtract the due in advance time to see if the reminder should be
|
|---|
| 86 | ;marked as due soon.
|
|---|
| 87 | ;
|
|---|
| 88 | N DATE,DIAT,DIATOK,LDATE,PXRMITEM,TDDUE,TODAY
|
|---|
| 89 | S PXRMITEM=DEFARR("IEN")
|
|---|
| 90 | ;If the final frequency is 0Y then the reminder is not due.
|
|---|
| 91 | I FREQ="0Y" S DUE=0,DUEDATE="" Q
|
|---|
| 92 | ;
|
|---|
| 93 | S DUEDATE=""
|
|---|
| 94 | ;Check for custom date due.
|
|---|
| 95 | I DEFARR(45)'="" S DUEDATE=$$CDUEDATE^PXRMCDUE(.DEFARR,.FIEVAL)
|
|---|
| 96 | I DUEDATE'="",DUEDATE'=-1 G SETDUE
|
|---|
| 97 | ;
|
|---|
| 98 | ;No custom date due, do regular date calculation.
|
|---|
| 99 | I (FREQ="")!(FREQ=-1) D Q
|
|---|
| 100 | . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFREQ")="No reminder frequency - cannot compute due date!"
|
|---|
| 101 | . S (DUE,DUEDATE)="CNBD"
|
|---|
| 102 | ;
|
|---|
| 103 | S LDATE=$S(RESDATE["X":0,1:+RESDATE)
|
|---|
| 104 | I LDATE=0 S (DUE,DUEDATE)="DUE NOW" Q
|
|---|
| 105 | S DATE=$$FULLDATE(LDATE),DUEDATE=$$NEWDATE(DATE,FREQ)
|
|---|
| 106 | ;
|
|---|
| 107 | SETDUE ;If the due date is less than or equal to today's date the reminder
|
|---|
| 108 | ;is due.
|
|---|
| 109 | S TODAY=$$NOW^PXRMDATE
|
|---|
| 110 | I +DUEDATE'>TODAY S DUE="DUE NOW" Q
|
|---|
| 111 | ;
|
|---|
| 112 | S DIAT="-"_$P(DEFARR(0),U,4)
|
|---|
| 113 | I DIAT="-" D
|
|---|
| 114 | . S DIATOK=0
|
|---|
| 115 | . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","DIAT")="Warning no do in advance time"
|
|---|
| 116 | E S DIATOK=1
|
|---|
| 117 | ;
|
|---|
| 118 | S TDDUE=$S(DIATOK=1:$$NEWDATE(DUEDATE,DIAT),1:DUEDATE)
|
|---|
| 119 | S DUE=$S(TDDUE'>TODAY:"DUE SOON",1:"RESOLVED")
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | ;==================================================
|
|---|
| 123 | DURATION(START,STOP) ;Return the number days between the Start Date and
|
|---|
| 124 | ;Stop Date.
|
|---|
| 125 | I +START=0 Q 0
|
|---|
| 126 | N PXRMNOW
|
|---|
| 127 | S PXRMNOW=$$NOW^PXRMDATE
|
|---|
| 128 | I START>PXRMNOW Q 0
|
|---|
| 129 | I (STOP="")!(STOP>PXRMNOW) S STOP=PXRMNOW
|
|---|
| 130 | Q $$FMDIFF^XLFDT(STOP,START)
|
|---|
| 131 | ;
|
|---|
| 132 | ;==================================================
|
|---|
| 133 | EDATE(DATE) ;Check for an historical (event) date, format as appropriate.
|
|---|
| 134 | Q $$FMTE^XLFDT(DATE,"5DZ")
|
|---|
| 135 | ;
|
|---|
| 136 | ;==================================================
|
|---|
| 137 | FULLDATE(DATE) ;See if DATE is a full date, i.e., it has a month and
|
|---|
| 138 | ;a day along with a year. If the month is missing assume Jan. If the
|
|---|
| 139 | ;day is missing assume the first. Issue a warning so the user knows
|
|---|
| 140 | ;what happened. DATE should be in Fileman format.
|
|---|
| 141 | N DAY,MISSING,MONTH,TDATE,YEAR
|
|---|
| 142 | S TDATE=DATE
|
|---|
| 143 | S MISSING=0
|
|---|
| 144 | S DAY=$E(DATE,6,7)
|
|---|
| 145 | S MONTH=$E(DATE,4,5)
|
|---|
| 146 | S YEAR=$E(DATE,1,3)
|
|---|
| 147 | I +DAY=0 D
|
|---|
| 148 | . S DAY=1
|
|---|
| 149 | . S MISSING=1
|
|---|
| 150 | . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO DAY")="Encounter date missing the day, using the first for the date due calculation."
|
|---|
| 151 | I +MONTH=0 D
|
|---|
| 152 | . S MONTH=1
|
|---|
| 153 | . S MISSING=1
|
|---|
| 154 | . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO MONTH")="Encounter date missing the month, using January for the date due calculation."
|
|---|
| 155 | I MISSING D
|
|---|
| 156 | . S TDATE=(YEAR*1E4)+(MONTH*1E2)+DAY
|
|---|
| 157 | . I DATE["E" S TDATE=TDATE_"E"
|
|---|
| 158 | Q TDATE
|
|---|
| 159 | ;
|
|---|
| 160 | ;==================================================
|
|---|
| 161 | FRQINDAY(FREQ) ;Given a frequency in the form ND, NM, or NY where N is a
|
|---|
| 162 | ;number and D stands for days, M for months, and Y for years return
|
|---|
| 163 | ;the value in days.
|
|---|
| 164 | I FREQ="" Q ""
|
|---|
| 165 | N CODE,LEN,MULT,NUM
|
|---|
| 166 | S LEN=$L(FREQ)
|
|---|
| 167 | S NUM=$E(FREQ,1,LEN-1)
|
|---|
| 168 | S CODE=$E(FREQ,LEN,LEN)
|
|---|
| 169 | S MULT=1.0
|
|---|
| 170 | I CODE="M" S MULT=30.42
|
|---|
| 171 | I CODE="Y" S MULT=365.25
|
|---|
| 172 | Q +(MULT*NUM)
|
|---|
| 173 | ;
|
|---|
| 174 | ;==================================================
|
|---|
| 175 | ISVSYMD(DATE) ;Return true if DATE is a valid symbolic date.
|
|---|
| 176 | N P1,P1OK,P2,P2OK,OP,PAT
|
|---|
| 177 | S DATE=$P(DATE,"@",1)
|
|---|
| 178 | S OP=$S(DATE["+":"+",1:"-")
|
|---|
| 179 | S P1=$P(DATE,OP,1),P1OK=0
|
|---|
| 180 | F PAT="T","TODAY","N","NOW" I P1=PAT S P1OK=1 Q:P1OK
|
|---|
| 181 | I PAT=DATE Q 1
|
|---|
| 182 | S P2=$P(DATE,OP,2),P2OK=0
|
|---|
| 183 | F PAT="1N.N","1N.N1""D""","1N.N1""M""","1N.N1""Y""" I P2?@PAT S P2OK=1 Q:P2OK
|
|---|
| 184 | Q P1OK&P2OK
|
|---|
| 185 | ;
|
|---|
| 186 | ;==================================================
|
|---|
| 187 | NEWDATE(FMDATE,OFFSET) ;Given a date in VA Fileman format (FMDATE) and an
|
|---|
| 188 | ;offset of the form NY, NM, ND where N is a number and Y stands for
|
|---|
| 189 | ;years, M for months, and D for days return the new date in VA Fileman
|
|---|
| 190 | ;format.
|
|---|
| 191 | I FMDATE=0 Q 0
|
|---|
| 192 | N LEN,NEWDATE,NUM,UNIT
|
|---|
| 193 | S LEN=$L(OFFSET)
|
|---|
| 194 | S NUM=+$E(OFFSET,1,LEN-1)
|
|---|
| 195 | S UNIT=$E(OFFSET,LEN)
|
|---|
| 196 | I UNIT="D" G DAY
|
|---|
| 197 | I UNIT="M" G MONTH
|
|---|
| 198 | I UNIT="Y" G YEAR
|
|---|
| 199 | ;Unknown unit just return the original date
|
|---|
| 200 | Q FMDATE
|
|---|
| 201 | DAY ;
|
|---|
| 202 | S NEWDATE=+$$FMADD^XLFDT(FMDATE,NUM)
|
|---|
| 203 | Q NEWDATE
|
|---|
| 204 | MONTH ;
|
|---|
| 205 | ;Convert the months to days and then add the days using the DAY code.
|
|---|
| 206 | ;Multiply the number of months by the average number of days in a month.
|
|---|
| 207 | N INT,FRAC
|
|---|
| 208 | S NUM=30.42*NUM
|
|---|
| 209 | ;Round the number of days, FMADD^XLFDT has problems with non-integer
|
|---|
| 210 | ;days.
|
|---|
| 211 | S INT=+$P(NUM,".",1)
|
|---|
| 212 | S FRAC=NUM-INT
|
|---|
| 213 | I FRAC<0.5 S NUM=INT
|
|---|
| 214 | E S NUM=INT+1
|
|---|
| 215 | G DAY
|
|---|
| 216 | Q
|
|---|
| 217 | YEAR ;
|
|---|
| 218 | Q FMDATE+(10000*NUM)
|
|---|
| 219 | ;
|
|---|
| 220 | ;==================================================
|
|---|
| 221 | NOW() ;If the reminder global PXRMDATE is defined return it, otherwise
|
|---|
| 222 | ;return the current date and time.
|
|---|
| 223 | Q $S(+$G(PXRMDATE)>0:PXRMDATE,1:$$NOW^XLFDT)
|
|---|
| 224 | ;
|
|---|
| 225 | ;==================================================
|
|---|
| 226 | SYMDATE(DATE) ;Convert a symbolic date into a FileMan date.
|
|---|
| 227 | N %DT,OPER,PFSTACK,SYM,TIME,X,Y
|
|---|
| 228 | S TIME=$P(DATE,"@",2),DATE=$P(DATE,"@",1)
|
|---|
| 229 | S X=$S(DATE="LAD":$G(PXRMLAD),1:"")
|
|---|
| 230 | I X="" D
|
|---|
| 231 | . S OPER="+-"
|
|---|
| 232 | . D POSTFIX^PXRMSTAC(DATE,OPER,.PFSTACK)
|
|---|
| 233 | I PFSTACK(0)=3 D
|
|---|
| 234 | . S SYM=PFSTACK(1)
|
|---|
| 235 | . S SYM=$S(SYM="LAD":"T",SYM="N":"N",SYM="NOW":"N",SYM="T":"T",SYM="TODAY":"T",1:"")
|
|---|
| 236 | . I SYM="" S Y=-1 Q
|
|---|
| 237 | .;FileMan only handles D, W, or M so convert Y to months.
|
|---|
| 238 | . I PFSTACK(2)["Y" S PFSTACK(2)=+PFSTACK(2)*12_"M"
|
|---|
| 239 | . S X=SYM_PFSTACK(3)_PFSTACK(2)
|
|---|
| 240 | I PFSTACK(0)=1 S X=PFSTACK(1)
|
|---|
| 241 | I TIME'="" S X=X_"@"_TIME
|
|---|
| 242 | S %DT="ST"
|
|---|
| 243 | D ^%DT
|
|---|
| 244 | Q Y
|
|---|
| 245 | ;
|
|---|
| 246 | ;==================================================
|
|---|
| 247 | VDATE(VIEN) ;Given a visit ien return the visit date.
|
|---|
| 248 | N DATE
|
|---|
| 249 | I +VIEN>0 S DATE=$P($G(^AUPNVSIT(VIEN,0)),U,1)
|
|---|
| 250 | E S DATE=0
|
|---|
| 251 | I $L(DATE)=0 S DATE=0
|
|---|
| 252 | ;Check for historical encounter.
|
|---|
| 253 | I $$ISHIST^PXRMVSIT(VIEN) S DATE=DATE_"E"
|
|---|
| 254 | Q DATE
|
|---|
| 255 | ;
|
|---|
