source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCDUE.m@ 1114

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