Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMDATE

PXRMDATE.m

Go to the documentation of this file. 
  1. PXRMDATE ;SLC/PKR - Clinical Reminders date utilities. ;10/23/2013
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,12,17,18,24,26**;Feb 04, 2005;Build 404
  1.  ;
  1.  ;==================================================
  1. CEFD(FDA) ;Called by the Exchange Utility only if the input packed
  1.  ;reminder was packed under v1.5.  Move Effective Date to Beginning Date.
  1.  N IND
  1.  S IND=""
  1.  F  S IND=$O(FDA(811.902,IND)) Q:IND=""  D
  1.  . I '$D(FDA(811.902,IND,12)) Q
  1.  .;If the EFFECTIVE PERIOD exists don't do anything.
  1.  . I $D(FDA(811.902,IND,9)) Q
  1.  . S FDA(811.902,IND,9)=FDA(811.902,IND,12)
  1.  . K FDA(811.902,IND,12)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. COMPARE(X) ;Compare beginning and ending dates, give a warning if
  1.  ;Ending Date comes before Beginning Date. Called by ADATE xref in
  1.  ;definitions and terms.
  1.  ;Do not execute as part of exchange.
  1.  I $G(PXRMEXCH) Q
  1.  N BDT,EDT,TEXT
  1.  ;Dates that are only defined during evaluation, i.e., FIEVAL(2,"DATE")
  1.  ;cannot be checked here.
  1.  S BDT=$S(X(1)'="":$$CTFMD^PXRMDATE(X(1)),1:0)
  1.  I BDT=-1 Q
  1.  S EDT=X(2)
  1.  I EDT="" S EDT="T"
  1.  S EDT=$$CTFMD^PXRMDATE(EDT)
  1.  I EDT=-1 Q
  1.  ;If EDT does not contain a time set it to the end of the day.
  1.  I EDT'["." S EDT=EDT_".235959"
  1.  I EDT<BDT D
  1.  . S BDT=$S(X(1)'="":X(1),1:"")
  1.  . S EDT=$S(X(2)'="":X(2),1:"T@2400")
  1.  . S TEXT="Warning the ending date ("_EDT_") is before the beginning date ("_BDT_")"
  1.  . D EN^DDIOL(TEXT)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. COTN(EFP) ;Convert an Effective Period to the new date/time format.
  1.  ;Possible effective periods are ND, NM, or NY where N is an integer.
  1.  S EFP=$$UP^XLFSTR(EFP)
  1.  I (EFP?1N.N1"D")!(EFP?1N.N1"M")!(EFP?1N.N1"Y") D
  1.  . S NUM=+EFP
  1.  . S EFP=$S(NUM=0:"T",1:"T-"_EFP)
  1.  Q EFP
  1.  ;
  1.  ;==================================================
  1. CTD(MULT,NUM) ;Convert months or years to days.
  1.  N DAYS,INTDAYS,FRAC
  1.  S DAYS=MULT*NUM
  1.  ;Round the number of days.
  1.  S INTDAYS=+$P(DAYS,".",1)
  1.  S FRAC=DAYS-INTDAYS
  1.  S DAYS=$S(FRAC<0.5:INTDAYS,1:INTDAYS+1)
  1.  Q DAYS
  1.  ;
  1.  ;==================================================
  1. CTFMD(DATE) ;Convert DATE which may be in any of the FileMan acceptable
  1.  ;forms with additional CR extensions to an internal FileMan date.
  1.  N FMDATE,OFFSET,OP,SYM,SYMV,TDATE,TIME
  1.  ;Already in internal FileMan date format?
  1.  I DATE?7N Q DATE
  1.  I DATE?7N1"."1.6N Q DATE
  1.  S TDATE=$TR(DATE," ",""),TDATE=$$UP^XLFSTR(TDATE)
  1.  ;Check for T or TODAY with a time.
  1.  I $E(TDATE,1)="T" S TIME=$P(TDATE,"@",2),TDATE=$P(TDATE,"@",1)
  1.  ;Check for dates in the form SYMBOL+IU,or SYMBOL-IU, where I is
  1.  ;an integer and U is a unit.
  1.  S OP=$S(TDATE["+":"+",TDATE["-":"-",1:"")
  1.  S SYM=$S(OP'="":$P(TDATE,OP,1),1:TDATE)
  1.  S OFFSET=$S(OP'="":$P(TDATE,OP,2),1:"")
  1.  ;If the symbolic part is not on the list of valid symbols try FileMan.
  1.  I '$$VSYM(SYM) D DT^DILF("ST",DATE,.FMDATE) Q FMDATE
  1.  ;Check for a valid offset.
  1.  I OFFSET'="",'$$VOFFSET(OFFSET) Q -1
  1.  I ((SYM="T")!(SYM="TODAY")),(OFFSET["H") D  Q -1
  1.  . I $G(PXRMINTR)=1 D EN^DDIOL("Cannot use "_SYM_" with "_OFFSET)
  1.  ;If this is being called by the input transform VDT^PXRMINTR we
  1.  ;are done.
  1.  I $G(PXRMINTR)=1 Q 1
  1.  ;If the symbol is not one of the standard FM symbols then it is
  1.  ;one of the Clinical Reminder symbols.
  1.  S SYMV=$S(SYM="T":$$TODAY,SYM="TODAY":$$TODAY,SYM="N":$$NOW,SYM="NOW":$$NOW,SYM="NOON":$$NOON,SYM="MID":$$MID,1:+$G(@SYM))
  1.  I $G(TIME)'="" D
  1.  . S SYMV=SYMV_"@"_TIME
  1.  . D DT^DILF("ST",SYMV,.FMDATE)
  1.  . S SYMV=FMDATE
  1.  ;If the symbol does not equate to an internal FM date return -1
  1.  I '(SYMV?7N0.1"."0.6N) Q -1
  1.  Q $$NEWDATE(SYMV,OP,OFFSET)
  1.  ;
  1.  ;=================================================
  1. DCHECK(DATE) ;Trap for special characters before calling CTFMD^PXRMDATE.
  1.  ;Used in DIR("PRE") for date inputs.
  1.  I $D(DTOUT) Q DATE
  1.  I DATE="" Q DATE
  1.  I DATE["^" Q DATE
  1.  I DATE["?" Q DATE
  1.  Q $$CTFMD^PXRMDATE(DATE)
  1.  ;
  1.  ;==================================================
  1. DDATE(DATE) ;Check for an historical (event) date, format as appropriate,
  1.  ;withou time.
  1.  I DATE=0 Q "00/00/0000"
  1.  Q $$FMTE^XLFDT(DATE,"5DZ")
  1.  ;
  1.  ;==================================================
  1. DUE(DEFARR,RESDATE,FREQ,DUE,DUEDATE,FIEVAL) ;Compute the due date.
  1.  ;This is the date of the resolution finding + the reminder frequency.
  1.  ;Subtract the due in advance time to see if the reminder should be
  1.  ;marked as due soon.
  1.  ;
  1.  N DATE,DIAT,DIATOK,LDATE,PXRMITEM,TDDUE,TODAY
  1.  S PXRMITEM=DEFARR("IEN")
  1.  ;If the final frequency is 0Y then the reminder is not due.
  1.  I FREQ="0Y" S DUE=0,DUEDATE="" Q
  1.  ;
  1.  S DUEDATE=""
  1.  ;Check for custom date due.
  1.  I DEFARR(45)'="" S DUEDATE=$$CDUEDATE^PXRMCDUE(.DEFARR,.FIEVAL)
  1.  I DUEDATE'="",DUEDATE'=-1 G SETDUE
  1.  ;
  1.  ;If there is no resolution logic then frequency is not required.
  1.  I (FREQ="")!(FREQ=-1)&(DEFARR(35)'="") D  Q
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFREQ")="No reminder frequency - cannot compute due date!"
  1.  . S (DUE,DUEDATE)="CNBD"
  1.  ;
  1.  S LDATE=$S(RESDATE["X":0,1:+RESDATE)
  1.  I LDATE=0 S (DUE,DUEDATE)="DUE NOW" Q
  1.  S DATE=$$FULLDATE(LDATE),DUEDATE=$$NEWDATE(DATE,"+",FREQ)
  1.  ;
  1. SETDUE ;If the due date is less than or equal to today's date the
  1.  ;reminder is due.
  1.  S TODAY=$$TODAY^PXRMDATE
  1.  I +DUEDATE'>TODAY S DUE="DUE NOW"  Q
  1.  ;
  1.  S DIAT=$P(DEFARR(0),U,4)
  1.  I DIAT="" D
  1.  . S DIATOK=0
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","DIAT")="Warning no do in advance time"
  1.  E  S DIATOK=1
  1.  ;
  1.  S TDDUE=$S(DIATOK=1:$$NEWDATE(DUEDATE,"-",DIAT),1:DUEDATE)
  1.  S DUE=$S(TDDUE'>TODAY:"DUE SOON",1:"RESOLVED")
  1.  Q
  1.  ;
  1.  ;==================================================
  1. DURATION(START,STOP) ;Return the number days between the Start Date and
  1.  ;Stop Date.
  1.  I +START=0 Q 0
  1.  N PXRMNOW
  1.  S PXRMNOW=$$NOW^PXRMDATE
  1.  I START>PXRMNOW Q 0
  1.  I (STOP="")!(STOP>PXRMNOW) S STOP=PXRMNOW
  1.  Q $$FMDIFF^XLFDT(STOP,START)
  1.  ;
  1.  ;==================================================
  1. EDATE(DATE) ;Check for an historical (event) date, format as appropriate,
  1.  ;include time.
  1.  I DATE=0 Q "00/00/0000"
  1.  I DATE=-1 Q "None"
  1.  Q $$FMTE^XLFDT(DATE,"5Z")
  1.  ;
  1.  ;==================================================
  1. FMDATE(DFN,TEST,DATE,VALUE,TEXT) ;FileMan date computed finding.
  1.  I TEST="" S TEST=0 Q
  1.  S (DATE,VALUE)=$$CTFMD^PXRMDATE(TEST)
  1.  S TEST=1
  1.  Q
  1.  ;
  1.  ;==================================================
  1. FULLDATE(DATE) ;See if DATE is a full date, i.e., it has a month and
  1.  ;a day along with a year. If the month is missing assume Jan. If the
  1.  ;day is missing assume the first. Issue a warning so the user knows
  1.  ;what happened. DATE should be in Fileman format.
  1.  N DAY,MISSING,MONTH,TDATE,YEAR
  1.  S TDATE=DATE
  1.  S MISSING=0
  1.  S DAY=$E(DATE,6,7)
  1.  S MONTH=$E(DATE,4,5)
  1.  S YEAR=$E(DATE,1,3)
  1.  I +DAY=0 D
  1.  . S DAY=1
  1.  . S MISSING=1
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO DAY")="Encounter date missing the day, using the first for the date due calculation."
  1.  I +MONTH=0 D
  1.  . S MONTH=1
  1.  . S MISSING=1
  1.  . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO MONTH")="Encounter date missing the month, using January for the date due calculation."
  1.  I MISSING D
  1.  . S TDATE=(YEAR*1E4)+(MONTH*1E2)+DAY
  1.  . I DATE["E" S TDATE=TDATE_"E"
  1.  Q TDATE
  1.  ;
  1.  ;==================================================
  1. FRQINDAY(FREQ) ;Given a frequency in the form ND, NM, or NY where N is a
  1.  ;number and D stands for days, M for months, and Y for years return
  1.  ;the value in days. Used for ranking only.
  1.  I FREQ="" Q 0
  1.  N LEN,NUM,UNIT
  1.  S NUM=+FREQ
  1.  S LEN=$L(FREQ)
  1.  S UNIT=$E(FREQ,LEN)
  1.  ;30.42 is average number of days in a month, 365.24 is average number
  1.  ;of days in a year. Unknown unit return 0.
  1.  S NUM=$S(UNIT="D":NUM,UNIT="M":$$CTD(30.42,NUM),UNIT="Y":$$CTD(365.24,NUM),1:0)
  1.  Q NUM
  1.  ;
  1.  ;==================================================
  1. ISLEAP(YEAR) ;Given a 3 digit FileMan year return 1 if it is a leap year,
  1.  ;0 otherwise.
  1.  S YEAR=YEAR+1700
  1.  Q (YEAR#4=0)&'(YEAR#100=0)!(YEAR#400=0)
  1.  ;
  1.  ;==================================================
  1. MCALC(FMDATE,OP,NUM) ;Add or subtract NUM months to FMDATE.
  1.  N DAY,DIM,MONTH,TIME,YEAR
  1.  S YEAR=$E(FMDATE,1,3),MONTH=$E(FMDATE,4,5),DAY=$E(FMDATE,6,7)
  1.  S TIME=$P(FMDATE,".",2)
  1.  I TIME'="" S TIME="."_TIME
  1.  I OP="+" F  Q:'NUM  S NUM=NUM-1,MONTH=MONTH+1 I MONTH=13 S YEAR=YEAR+1,MONTH=1
  1.  I OP="-" F  Q:'NUM  S NUM=NUM-1,MONTH=MONTH-1 I MONTH=0 S YEAR=YEAR-1,MONTH=12
  1.  S DIM="31^"_($$ISLEAP(YEAR)+28)_"^31^30^31^30^31^31^30^31^30^31"
  1.  I DAY>$P(DIM,"^",MONTH) S DAY=$P(DIM,"^",MONTH)
  1.  Q YEAR_"00"+MONTH_"00"+DAY_TIME
  1.  ;
  1.  ;==================================================
  1. MID() ;If the reminder global PXRMDATE is defined return midnight on that day,
  1.  ;otherwise return the current date at midnight.
  1.  Q $S(+$G(PXRMDATE)>0:$E(PXRMDATE,1,7),1:$$DT^XLFDT)_".24"
  1.  ;
  1.  ;==================================================
  1. NEWDATE(FMDATE,OP,OFFSET) ;Given an internal FileMan date, an operator of 
  1.  ;that is + or - ,and an offset of the form I, ID, IW, IM, IY 
  1.  ;where I is a positive integer and H is hours, D is days, W is weeks,
  1.  ;M is months, and Y is years calculate and return the new FM date.
  1.  N DAYS,HOURS,NUM,UNIT
  1.  I FMDATE=0 Q 0
  1.  S NUM=+OFFSET
  1.  I NUM<0 Q -1
  1.  S UNIT=$E(OFFSET,$L(NUM)+1)
  1.  I UNIT="" S UNIT="D"
  1.  I UNIT="H" S HOURS=OP_NUM Q $$FMADD^XLFDT(FMDATE,0,HOURS,0,0)
  1.  I UNIT="D" S DAYS=OP_NUM Q $$FMADD^XLFDT(FMDATE,DAYS,0,0,0)
  1.  I UNIT="W" S DAYS=OP_(NUM*7) Q $$FMADD^XLFDT(FMDATE,DAYS,0,0,0)
  1.  I UNIT="M" Q $$MCALC(FMDATE,OP,NUM)
  1.  I UNIT="Y" Q $$YCALC(FMDATE,OP,NUM)
  1.  Q -1
  1.  ;
  1.  ;==================================================
  1. NOON() ;If the reminder global PXRMDATE is defined return noon on that day,
  1.  ;otherwise return the current date at noon.
  1.  Q $S(+$G(PXRMDATE)>0:$E(PXRMDATE,1,7),1:$$DT^XLFDT)_".12"
  1.  ;
  1.  ;==================================================
  1. NOW() ;If the reminder global PXRMDATE is defined return it, otherwise
  1.  ;return the current date and time.
  1.  I +$G(PXRMDATE)=0 Q $$NOW^XLFDT
  1.  N NOW,TIME
  1.  S TIME=$P(PXRMDATE,".",2)
  1.  I TIME="" S TIME=$P($$NOW^XLFDT,".",2),NOW=PXRMDATE_"."_TIME
  1.  E  S NOW=PXRMDATE
  1.  Q NOW
  1.  ;
  1.  ;==================================================
  1. TODAY() ;If the reminder global PXRMDATE is defined return it, otherwise
  1.  ;return the current date.
  1.  Q $S(+$G(PXRMDATE)>0:$P(PXRMDATE,".",1),1:$$DT^XLFDT)
  1.  ;
  1.  ;==================================================
  1. VDATE(VIEN) ;Given a visit ien return the visit date.
  1.  N DATE
  1.  S DATE=$S(+VIEN>0:$P($G(^AUPNVSIT(VIEN,0)),U,1),1:0)
  1.  I $L(DATE)=0 S DATE=0
  1.  ;Check for historical encounter.
  1.  I $$ISHIST^PXRMVSIT(VIEN) S DATE=DATE_"E"
  1.  Q DATE
  1.  ;
  1.  ;==================================================
  1. VOFFSET(OFFSET) ;Make sure the offset part of a date is valid. It has to
  1.  ;have the form I or IU where I is an integer and U is one of the
  1.  ;following units: H, D, W, M, Y.
  1.  I OFFSET?1.N0.1"H"0.1"D"0.1"W"0.1"M"0.1"Y" Q 1
  1.  Q 0
  1.  ;
  1.  ;==================================================
  1. VSYM(SYM) ;Make sure the symbolic part of a date is valid.
  1.  ;Already in FileMan internal form.
  1.  I SYM?7N Q 1
  1.  I SYM?7N1"."1.6N Q 1
  1.  ;Check for FileMan symbols.
  1.  I (SYM="T")!(SYM="TODAY") Q 1
  1.  I (SYM="N")!(SYM="NOW") Q 1
  1.  I (SYM="NOON") Q 1
  1.  I (SYM="MID") Q 1
  1.  ;Check for Clinical Reminder symbols.
  1.  I SYM="PXRMLAD" Q 1
  1.  I SYM="PXRMDOB" Q 1
  1.  I SYM="PXRMDOD" Q 1
  1.  I SYM?1"FIEVAL("1.N1","0.1(1.N1",")1"""DATE"")" Q 1
  1.  Q 0
  1.  ;
  1.  ;==================================================
  1. YCALC(FMDATE,OP,NUM) ;Add or subtract NUM years to FMDATE.
  1.  N DAY,MONTH,TIME,YEAR
  1.  S YEAR=$E(FMDATE,1,3),MONTH=$E(FMDATE,4,5),DAY=$E(FMDATE,6,7)
  1.  S TIME=$P(FMDATE,".",2)
  1.  I TIME'="" S TIME="."_TIME
  1.  I OP="+" F  Q:'NUM  S NUM=NUM-1,YEAR=YEAR+1
  1.  I OP="-" F  Q:'NUM  S NUM=NUM-1,YEAR=YEAR-1
  1.  ;Handle leap year.
  1.  I MONTH="02",DAY>27,'$$ISLEAP(YEAR) S DAY=28
  1.  Q YEAR_"00"+MONTH_"00"+DAY_TIME
  1.  ;