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

PXRMCDUE.m

Go to the documentation of this file.
  1. PXRMCDUE ;SLC/PKR - Custom date due calculation routines. ;02/04/2011
  1. ;;2.0;CLINICAL REMINDERS;**4,6,12,18**;Feb 04, 2005;Build 152
  1. ;
  1. ;========================================================
  1. CDBUILD(STRING,DA) ;Given a custom date due string build the data
  1. ;structure. This is called by a new-style cross-reference after
  1. ;the date due string has passed the input transform so we don't need
  1. ;to validate the elements.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. N FDA,FILIST,FREQLIST,FUNCTION,IENB,IENS,IND,MSG
  1. N OPLIST,NARGS,PFSTACK
  1. S STRING=$$UP^XLFSTR(STRING)
  1. D PARSE(STRING,.FUNCTION,.NARGS,.FILIST,.FREQLIST,.OPLIST)
  1. S IENS=DA_","
  1. S FDA(811.9,IENS,46)=FUNCTION,FDA(811.9,IENS,47)=NARGS
  1. S IENB=DA
  1. F IND=1:1:NARGS D
  1. . S IENB=IENB+1
  1. . S IENS="+"_IENB_","_DA_","
  1. . S FDA(811.948,IENS,.01)=FILIST(IND)
  1. . S FDA(811.948,IENS,.02)=FREQLIST(IND)
  1. . S FDA(811.948,IENS,.03)=OPLIST(IND)
  1. D UPDATE^DIE("","FDA","","MSG")
  1. I $D(MSG) D
  1. . W !,"The Custom Date Due update failed, UPDATE^DIE returned the following error message:"
  1. . D AWRITE^PXRMUTIL("MSG")
  1. Q
  1. ;
  1. ;========================================================
  1. CDUEDATE(DEFARR,FIEVAL) ;Do the custom date due calculation and return
  1. ;the due date.
  1. N DATE,DDUE,DLIST,FI,FREQ,FUNCTION,IND,PM,NARGS,TEMP
  1. S FUNCTION=$P(DEFARR(46),U,1)
  1. S NARGS=$P(DEFARR(46),U,2)
  1. F IND=1:1:NARGS D
  1. . S TEMP=DEFARR(47,IND,0)
  1. . S FI=$P(TEMP,U,1)
  1. . S FREQ=$P(TEMP,U,2)
  1. . S PM=$P(TEMP,U,3)
  1. . S DATE=$S(FIEVAL(FI):+FIEVAL(FI,"DATE"),1:0)
  1. . I DATE>0 S DATE=$$FULLDATE^PXRMDATE(DATE)
  1. . S DLIST(IND)=$$NEWDATE^PXRMDATE(DATE,PM,FREQ)
  1. S TEMP=$S(FUNCTION="MAX_DATE":$$MAXDATE(NARGS,.DLIST),FUNCTION="MIN_DATE":$$MINDATE(NARGS,.DLIST),FUNCTION="RANK_DATE":$$RANKDATE(NARGS,.DLIST),1:0)
  1. S DDUE=$P(TEMP,U,1)
  1. I DDUE=0 Q -1
  1. S IND=$P(TEMP,U,2)
  1. S TEMP=DEFARR(47,IND,0)
  1. S FI=$P(TEMP,U,1)
  1. S FREQ=$P(TEMP,U,2)
  1. S PM=$P(TEMP,U,3)
  1. S DATE=+$G(FIEVAL(FI,"DATE"))
  1. S ^TMP(PXRMPID,$J,PXRMITEM,"zCDUE")=FI_U_FREQ_U_PM_U_DATE
  1. Q DDUE
  1. ;
  1. ;========================================================
  1. CDKILL(X,DA) ;
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q
  1. K ^PXD(811.9,DA,46),^PXD(811.9,DA,47)
  1. Q
  1. ;
  1. ;========================================================
  1. MAXDATE(NARGS,DLIST) ;Return the maximum date from a list of dates in DLIST.
  1. N IND,INDS,MAXDATE
  1. S (INDS,MAXDATE)=0
  1. F IND=1:1:NARGS I DLIST(IND)>MAXDATE S MAXDATE=DLIST(IND),INDS=IND
  1. Q MAXDATE_U_INDS
  1. ;
  1. ;========================================================
  1. MINDATE(NARGS,DLIST) ;Return the minimum date from a list of dates in DLIST.
  1. ;Only return 0 if there is no "real" date in the list.
  1. N DATE,IND,INDS,MINDATE
  1. S INDS=0
  1. S MINDATE=9991231
  1. F IND=1:1:NARGS S DATE=DLIST(IND) I DATE<MINDATE,DATE'=0 S MINDATE=DATE,INDS=IND
  1. I MINDATE=9991231 S MINDATE=0
  1. Q MINDATE_U_INDS
  1. ;
  1. ;========================================================
  1. OUTPUT(CDUEDATA,DEFARR) ;Build the custom date due output text.
  1. N CDUEFI,ENTRY,FINAME,PM,TEXT,VPTR
  1. S CDUEFI=$P(CDUEDATA,U,1)
  1. S PM=$P(CDUEDATA,U,3)
  1. S VPTR=$P(^PXD(811.9,DEFARR("IEN"),20,CDUEFI,0),U,1)
  1. S ENTRY="^"_$P(VPTR,";",2)_$P(VPTR,";",1)_",0)"
  1. S FINAME=$P(@ENTRY,U,1)
  1. S TEXT="Custom date due based on date of finding "_CDUEFI_" ("_FINAME_")"
  1. S TEXT=TEXT_" "_PM_" frequency of "_$P(CDUEDATA,U,2)_"."
  1. Q TEXT
  1. ;
  1. ;========================================================
  1. PARSE(STRING,FUNCTION,NARGS,FILIST,FREQLIST,OPLIST) ;Parse a custom date due
  1. ;string and return the function, number of arguments, finding list,
  1. ;frequency list, and operator list. An argument has the form M+NU or
  1. ;M-NU where M is a finding number, N is an integer, and U is H, D, W,
  1. ;M, or Y.
  1. N IND,OPER,PFSTACK,PM
  1. S OPER=","
  1. D POSTFIX^PXRMSTAC(STRING,OPER,.PFSTACK)
  1. S FUNCTION=$$UP^XLFSTR(PFSTACK(1))
  1. S NARGS=0
  1. F IND=2:1:PFSTACK(0) D
  1. . I PFSTACK(IND)=OPER Q
  1. . S NARGS=NARGS+1
  1. . S PM=$S(PFSTACK(IND)["+":"+",PFSTACK(IND)["-":"-",1:"?")
  1. . S FILIST(NARGS)=$P(PFSTACK(IND),PM,1)
  1. . S FREQLIST(NARGS)=$P(PFSTACK(IND),PM,2)
  1. . S OPLIST(NARGS)=PM
  1. Q
  1. ;
  1. ;========================================================
  1. RANKDATE(NARGS,DLIST) ;Return the first non-zero date from the list of dates
  1. ;in DLIST. Return 0 if DLIST is all zeroes.
  1. N DATE,IND,INDS
  1. S (DATE,INDS)=0
  1. F IND=1:1:NARGS I DLIST(IND)>0 S DATE=DLIST(IND),INDS=IND Q
  1. Q DATE_U_INDS
  1. ;
  1. ;========================================================
  1. VCDUE(STRING,DA) ;Make sure a custom date due string is valid.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q 1
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q 1
  1. I '$D(DA) Q 1
  1. I $L(STRING)>245 Q 0
  1. N FILIST,FREQLIST,FUNCTION,IND,OPLIST,NARGS,TEXT,VALID
  1. D PARSE(STRING,.FUNCTION,.NARGS,.FILIST,.FREQLIST,.OPLIST)
  1. S VALID=$$VFUN(FUNCTION)
  1. I 'VALID D
  1. . S TEXT=FUNCTION_" is not a valid custom date due function."
  1. . D EN^DDIOL(TEXT)
  1. F IND=1:1:NARGS D
  1. . I '$D(^PXD(811.9,DA,20,FILIST(IND),0)) D
  1. .. S TEXT="Finding number "_FILIST(IND)_" is not a valid reminder finding"
  1. .. D EN^DDIOL(TEXT)
  1. .. S VALID=0
  1. . I OPLIST(IND)="?" D
  1. .. S TEXT="'+' and '-' are the only valid operators."
  1. .. D EN^DDIOL(TEXT)
  1. .. S VALID=0
  1. . I '$$VFREQ^PXRMINTR(FREQLIST(IND)) D
  1. .. S TEXT=FREQLIST(IND)_" is not a valid frequency."
  1. .. D EN^DDIOL(TEXT)
  1. .. S VALID=0
  1. Q VALID
  1. ;
  1. ;========================================================
  1. VFUN(FUNCTION) ;Make sure FUNCTION is a valid function.
  1. I FUNCTION="MIN_DATE" Q 1
  1. I FUNCTION="MAX_DATE" Q 1
  1. I FUNCTION="RANK_DATE" Q 1
  1. Q 0
  1. ;
  1. ;========================================================
  1. XHELP ;Executable help for custom date due.
  1. N DONE,IND,TEXT
  1. S DONE=0
  1. F IND=1:1 Q:DONE D
  1. . S TEXT=$P($T(TEXT+IND),";",3)
  1. . I TEXT="**End Text**" S DONE=1 Q
  1. . W !,TEXT
  1. Q
  1. ;
  1. ;========================================================
  1. TEXT ;Custom Date Due help text.
  1. ;;The general form for a Custom Date Due string is:
  1. ;; FUNCTION(ARG1,ARG2,...,ARGN)
  1. ;;
  1. ;;FUNCTION can be one of the following:
  1. ;; MAX_DATE - return the maximum date from the argument list
  1. ;; MIN_DATE - return the minimum date from the argument list
  1. ;; RANK_DATE - going from left to right return the first non-zero date
  1. ;; from the argument list
  1. ;;
  1. ;;The arguments have the form:
  1. ;; F+IU or F-IU where F is a finding number, I is a integer, and U
  1. ;; is one of the following units: H (hours), D (days), W (weeks),
  1. ;; M (months), or Y (years). Each argument is converted to a date
  1. ;; by adding or subtracting I*U with the date of the finding.
  1. ;;
  1. ;;Here is an example: MAX_DATE(1+6M,3-1W)
  1. ;;This will take the date of finding 1 and add 6 months, the date of finding 3
  1. ;;and subtract 1 week and set the date due to the maximum of those two dates.
  1. ;;
  1. ;;**End Text**
  1. Q
  1. ;