Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCDUE.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCDUE.m
r613 r623 1 PXRMCDUE ;SLC/PKR - Custom date due calculation routines. ;09/05/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;======================================================== 5 CDBUILD(STRING,DA) ;Given a custom date due string build the data 6 ;structure. This is called by a new-style cross-reference after 7 ;the date due string has passed the input transform so we don't need 8 ;to validate the elements. 9 ;Do not execute as part of a verify fields. 10 I $G(DIUTIL)="VERIFY FIELDS" Q 11 ;Do not execute as part of exchange. 12 I $G(PXRMEXCH) Q 13 N FDA,FILIST,FREQLIST,FUNCTION,IENB,IENS,IND,MSG,NARGS,PFSTACK 14 S STRING=$$UP^XLFSTR(STRING) 15 D PARSE(STRING,.FUNCTION,.NARGS,.FILIST,.FREQLIST) 16 S IENS=DA_"," 17 S FDA(811.9,IENS,46)=FUNCTION,FDA(811.9,IENS,47)=NARGS 18 S IENB=DA 19 F IND=1:1:NARGS D 20 . S IENB=IENB+1 21 . S IENS="+"_IENB_","_DA_"," 22 . S FDA(811.948,IENS,.01)=FILIST(IND) 23 . S FDA(811.948,IENS,.02)=FREQLIST(IND) 24 D UPDATE^DIE("","FDA","","MSG") 25 I $D(MSG) D 26 . W !,"The update failed, UPDATE^DIE returned the following error message:" 27 . D AWRITE^PXRMUTIL("MSG") 28 Q 29 ; 30 ;======================================================== 31 CDUEDATE(DEFARR,FIEVAL) ;Do the custom date due calculation and return 32 ;the due date. 33 N DATE,DDUE,DLIST,FI,FREQ,FUNCTION,IND,NARGS,TEMP 34 S FUNCTION=$P(DEFARR(46),U,1) 35 S NARGS=$P(DEFARR(46),U,2) 36 F IND=1:1:NARGS D 37 . S TEMP=DEFARR(47,IND,0) 38 . S FI=$P(TEMP,U,1) 39 . S FREQ=$P(TEMP,U,2) 40 . S DATE=$S(FIEVAL(FI):+FIEVAL(FI,"DATE"),1:0) 41 . I DATE>0 S DATE=$$FULLDATE^PXRMDATE(DATE) 42 . S DLIST(IND)=$$NEWDATE^PXRMDATE(DATE,FREQ) 43 S TEMP=$S(FUNCTION="MAX_DATE":$$MAXDATE(NARGS,.DLIST),FUNCTION="MIN_DATE":$$MINDATE(NARGS,.DLIST),1:0) 44 S DDUE=$P(TEMP,U,1) 45 I DDUE=0 Q -1 46 S IND=$P(TEMP,U,2) 47 S TEMP=DEFARR(47,IND,0) 48 S FI=$P(TEMP,U,1) 49 S FREQ=$P(TEMP,U,2) 50 S DATE=+$G(FIEVAL(FI,"DATE")) 51 S ^TMP(PXRMPID,$J,PXRMITEM,"zCDUE")=FI_U_FREQ_U_DATE 52 Q DDUE 53 ; 54 ;======================================================== 55 CDKILL(X,DA) ; 56 ;Do not execute as part of a verify fields. 57 I $G(DIUTIL)="VERIFY FIELDS" Q 58 ;Do not execute as part of exchange. 59 I $G(PXRMEXCH) Q 60 K ^PXD(811.9,DA,46),^PXD(811.9,DA,47) 61 Q 62 ; 63 ;======================================================== 64 MAXDATE(NARGS,DLIST) ;Return the maximum date from a list of dates in DLIST. 65 N IND,INDS,MAXDATE 66 S (INDS,MAXDATE)=0 67 F IND=1:1:NARGS I DLIST(IND)>MAXDATE S MAXDATE=DLIST(IND),INDS=IND 68 Q MAXDATE_U_INDS 69 ; 70 ;======================================================== 71 MINDATE(NARGS,DLIST) ;Return the minimum date from a list of dates in DLIST. 72 ;Only return 0 if there is no "real" date in the list. 73 N DATE,IND,INDS,MINDATE 74 S INDS=0 75 S MINDATE=9991231 76 F IND=1:1:NARGS S DATE=DLIST(IND) I DATE<MINDATE,DATE'=0 S MINDATE=DATE,INDS=IND 77 I MINDATE=9991231 S MINDATE=0 78 Q MINDATE_U_INDS 79 ; 80 ;======================================================== 81 OUTPUT(CDUEDATA,DEFARR) ;Build the custom date due output text. 82 N CDUEFI,ENTRY,FINAME,TEXT,VPTR 83 S CDUEFI=$P(CDUEDATA,U,1) 84 S VPTR=$P(^PXD(811.9,DEFARR("IEN"),20,CDUEFI,0),U,1) 85 S ENTRY="^"_$P(VPTR,";",2)_$P(VPTR,";",1)_",0)" 86 S FINAME=$P(@ENTRY,U,1) 87 S TEXT="Custom date due based on date of finding "_CDUEFI_" ("_FINAME_")" 88 S TEXT=TEXT_" plus frequency of "_$P(CDUEDATA,U,2)_"." 89 Q TEXT 90 ; 91 ;======================================================== 92 PARSE(STRING,FUNCTION,NARGS,FILIST,FREQLIST) ;Parse a custom date due 93 ;string and return the function, number of arguments, finding list, 94 ;and frequency list. An argument has the form M+NF where M is a 95 ;finding number, N is an integer, and F is D, M, or Y. 96 N IND,OPER,PFSTACK 97 S OPER="," 98 D POSTFIX^PXRMSTAC(STRING,OPER,.PFSTACK) 99 S FUNCTION=$$UP^XLFSTR(PFSTACK(1)) 100 S NARGS=0 101 F IND=2:1:PFSTACK(0) D 102 . I PFSTACK(IND)=OPER Q 103 . S NARGS=NARGS+1 104 . S FILIST(NARGS)=$P(PFSTACK(IND),"+",1) 105 . S FREQLIST(NARGS)=$P(PFSTACK(IND),"+",2) 106 Q 107 ; 108 ;======================================================== 109 VFREQ(FREQ) ;Make sure FREQ is a valid frequency. 110 N VALID 111 S VALID=1 112 S FREQ=$$UP^XLFSTR(FREQ) 113 I (FREQ'?1N.N1"D"),(FREQ'?1N.N1"M"),(FREQ'?1N.N1"Y") S VALID=0 114 Q VALID 115 ; 116 ;======================================================== 117 VCDUE(STRING,DA) ;Make sure a custom date due string is valid. 118 ;Do not execute as part of a verify fields. 119 I $G(DIUTIL)="VERIFY FIELDS" Q 1 120 ;Do not execute as part of exchange. 121 I $G(PXRMEXCH) Q 1 122 I '$D(DA) Q 1 123 I $L(STRING)>245 Q 0 124 N FILIST,FREQLIST,FUNCTION,IND,NARGS,TEXT,VALID 125 D PARSE(STRING,.FUNCTION,.NARGS,.FILIST,.FREQLIST) 126 S VALID=1 127 I FUNCTION'="MIN_DATE",FUNCTION'="MAX_DATE" D 128 . S TEXT=FUNCTION_" is not a valid custom date due function" 129 . D EN^DDIOL(TEXT) 130 . S VALID=0 131 F IND=1:1:NARGS D 132 . I '$D(^PXD(811.9,DA,20,FILIST(IND),0)) D 133 .. S TEXT="Finding number "_FILIST(IND)_" is not a valid reminder finding" 134 .. D EN^DDIOL(TEXT) 135 .. S VALID=0 136 . I '$$VFREQ(FREQLIST(IND)) D 137 .. S TEXT=FREQLIST(IND)_" is not a valid frequency" 138 .. D EN^DDIOL(TEXT) 139 .. S VALID=0 140 Q VALID 141 ; 142 ;======================================================== 143 XHELP ;Executable help for custom date due. 144 N DONE,IND,TEXT 145 S DONE=0 146 F IND=1:1 Q:DONE D 147 . S TEXT=$P($T(TEXT+IND),";",3) 148 . I TEXT="**End Text**" S DONE=1 Q 149 . W !,TEXT 150 Q 151 ; 152 ;======================================================== 153 TEXT ;Custom Date Due help text. 154 ;;The general form for a Custom Date Due string is: 155 ;; FUNCTION(ARG1,ARG2,...,ARGN) 156 ;;where FUNCTION is MAX_DATE or MIN_DATE and the arguments have the form 157 ;;M+FREQ where M is a finding number and FREQ is a number followed by 158 ;;D for days, M for months, or Y for years. 159 ;;Here is an example: 160 ;; MAX_DATE(1+6M,3+1Y) 161 ;;This will take the date of finding 1 and add 6 months, the date of finding 3 162 ;;and add 1 year and set the date due to the maximum of those two dates. 163 ;; 164 ;;**End Text** 165 Q 166 ; 1 PXRMCDUE ;SLC/PKR - Custom date due calculation routines. ;06/30/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;======================================================== 5 CDBUILD(STRING,DA) ;Given a custom date due string build the data 6 ;structure. This is called by a new-style cross-reference after 7 ;the date due string has passed the input transform so we don't need 8 ;to validate the elements. 9 ;Do not execute as part of a verify fields. 10 I $G(DIUTIL)="VERIFY FIELDS" Q 11 ;Do not execute as part of exchange. 12 I $G(PXRMEXCH) Q 13 N FDA,FILIST,FREQLIST,FUNCTION,IENB,IENS,IND,MSG,NARGS,PFSTACK 14 S STRING=$$UP^XLFSTR(STRING) 15 D PARSE(STRING,.FUNCTION,.NARGS,.FILIST,.FREQLIST) 16 S IENS=DA_"," 17 S FDA(811.9,IENS,46)=FUNCTION,FDA(811.9,IENS,47)=NARGS 18 S IENB=DA 19 F IND=1:1:NARGS D 20 . S IENB=IENB+1 21 . S IENS="+"_IENB_","_DA_"," 22 . S FDA(811.948,IENS,.01)=FILIST(IND) 23 . S FDA(811.948,IENS,.02)=FREQLIST(IND) 24 D UPDATE^DIE("","FDA","","MSG") 25 I $D(MSG) D 26 . W !,"The update failed, UPDATE^DIE returned the following error message:" 27 . D AWRITE^PXRMUTIL("MSG") 28 Q 29 ; 30 ;======================================================== 31 CDUEDATE(DEFARR,FIEVAL) ;Do the custom date due calculation and return 32 ;the due date. 33 N DATE,DDUE,DLIST,FI,FREQ,FUNCTION,IND,NARGS,TEMP 34 S FUNCTION=$P(DEFARR(46),U,1) 35 S NARGS=$P(DEFARR(46),U,2) 36 F IND=1:1:NARGS D 37 . S TEMP=DEFARR(47,IND,0) 38 . S FI=$P(TEMP,U,1) 39 . S FREQ=$P(TEMP,U,2) 40 . S DATE=+$G(FIEVAL(FI,"DATE")) 41 . S DLIST(IND)=$$NEWDATE^PXRMDATE(DATE,FREQ) 42 S TEMP=$S(FUNCTION="MAX_DATE":$$MAXDATE(NARGS,.DLIST),FUNCTION="MIN_DATE":$$MINDATE(NARGS,.DLIST)) 43 S DDUE=$P(TEMP,U,1) 44 I DDUE=0 Q -1 45 S IND=$P(TEMP,U,2) 46 S TEMP=DEFARR(47,IND,0) 47 S FI=$P(TEMP,U,1) 48 S FREQ=$P(TEMP,U,2) 49 S DATE=+$G(FIEVAL(FI,"DATE")) 50 S ^TMP(PXRMPID,$J,PXRMITEM,"zCDUE")=FI_U_FREQ_U_DATE 51 Q DDUE 52 ; 53 ;======================================================== 54 CDKILL(X,DA) ; 55 ;Do not execute as part of a verify fields. 56 I $G(DIUTIL)="VERIFY FIELDS" Q 57 ;Do not execute as part of exchange. 58 I $G(PXRMEXCH) Q 59 K ^PXD(811.9,DA,46),^PXD(811.9,DA,47) 60 Q 61 ; 62 ;======================================================== 63 MAXDATE(NARGS,DLIST) ;Return the maximum date from a list of dates in DLIST. 64 N IND,INDS,MAXDATE 65 S (INDS,MAXDATE)=0 66 F IND=1:1:NARGS I DLIST(IND)>MAXDATE S MAXDATE=DLIST(IND),INDS=IND 67 Q MAXDATE_U_INDS 68 ; 69 ;======================================================== 70 MINDATE(NARGS,DLIST) ;Return the minimum date from a list of dates in DLIST. 71 ;Only return 0 if there is no "real" date in the list. 72 N DATE,IND,INDS,MINDATE 73 S INDS=0 74 S MINDATE=9991231 75 F IND=1:1:NARGS S DATE=DLIST(IND) I DATE<MINDATE,DATE'=0 S MINDATE=DATE,INDS=IND 76 I MINDATE=9991231 S MINDATE=0 77 Q MINDATE_U_INDS 78 ; 79 ;======================================================== 80 OUTPUT(CDUEDATA,DEFARR) ;Build the custom date due output text. 81 N CDUEFI,ENTRY,FINAME,TEXT,VPTR 82 S CDUEFI=$P(CDUEDATA,U,1) 83 S VPTR=$P(^PXD(811.9,DEFARR("IEN"),20,CDUEFI,0),U,1) 84 S ENTRY="^"_$P(VPTR,";",2)_$P(VPTR,";",1)_",0)" 85 S FINAME=$P(@ENTRY,U,1) 86 S TEXT="Custom date due based on date of finding "_CDUEFI_" ("_FINAME_")" 87 S TEXT=TEXT_" plus frequency of "_$P(CDUEDATA,U,2)_"." 88 Q TEXT 89 ; 90 ;======================================================== 91 PARSE(STRING,FUNCTION,NARGS,FILIST,FREQLIST) ;Parse a custom date due 92 ;string and return the function, number of arguments, finding list, 93 ;and frequency list. An argument has the form M+NF where M is a 94 ;finding number, N is an integer, and F is D, M, or Y. 95 N IND,OPER,PFSTACK 96 S OPER="," 97 D POSTFIX^PXRMSTAC(STRING,OPER,.PFSTACK) 98 S FUNCTION=$$UP^XLFSTR(PFSTACK(1)) 99 S NARGS=0 100 F IND=2:1:PFSTACK(0) D 101 . I PFSTACK(IND)=OPER Q 102 . S NARGS=NARGS+1 103 . S FILIST(NARGS)=$P(PFSTACK(IND),"+",1) 104 . S FREQLIST(NARGS)=$P(PFSTACK(IND),"+",2) 105 Q 106 ; 107 ;======================================================== 108 VFREQ(FREQ) ;Make sure FREQ is a valid frequency. 109 N VALID 110 S VALID=1 111 S FREQ=$$UP^XLFSTR(FREQ) 112 I (FREQ'?1N.N1"D"),(FREQ'?1N.N1"M"),(FREQ'?1N.N1"Y") S VALID=0 113 Q VALID 114 ; 115 ;======================================================== 116 VCDUE(STRING,DA) ;Make sure a custom date due string is valid. 117 ;Do not execute as part of a verify fields. 118 I $G(DIUTIL)="VERIFY FIELDS" Q 1 119 ;Do not execute as part of exchange. 120 I $G(PXRMEXCH) Q 1 121 I '$D(DA) Q 1 122 I $L(STRING)>245 Q 0 123 N FILIST,FREQLIST,FUNCTION,IND,NARGS,TEXT,VALID 124 D PARSE(STRING,.FUNCTION,.NARGS,.FILIST,.FREQLIST) 125 S VALID=1 126 I FUNCTION'="MIN_DATE",FUNCTION'="MAX_DATE" D 127 . S TEXT=FUNCTION_" is not a valid custom date due function" 128 . D EN^DDIOL(TEXT) 129 . S VALID=0 130 F IND=1:1:NARGS D 131 . I '$D(^PXD(811.9,DA,20,FILIST(IND),0)) D 132 .. S TEXT="Finding number "_FILIST(IND)_" is not a valid reminder finding" 133 .. D EN^DDIOL(TEXT) 134 .. S VALID=0 135 . I '$$VFREQ(FREQLIST(IND)) D 136 .. S TEXT=FREQLIST(IND)_" is not a valid frequency" 137 .. D EN^DDIOL(TEXT) 138 .. S VALID=0 139 Q VALID 140 ; 141 ;======================================================== 142 XHELP ;Executable help for custom date due. 143 N DONE,IND,TEXT 144 S DONE=0 145 F IND=1:1 Q:DONE D 146 . S TEXT=$P($T(TEXT+IND),";",3) 147 . I TEXT="**End Text**" S DONE=1 Q 148 . W !,TEXT 149 Q 150 ; 151 ;======================================================== 152 TEXT ;Custom Date Due help text. 153 ;;The general form for a Custom Date Due string is: 154 ;; FUNCTION(ARG1,ARG2,...,ARGN) 155 ;;where FUNCTION is MAX_DATE or MIN_DATE and the arguments have the form 156 ;;M+FREQ where M is a finding number and FREQ is a number followed by 157 ;;D for days, M for months, or Y for years. 158 ;;Here is an example: 159 ;; MAX_DATE(1+6M,3+1Y) 160 ;;This will take the date of finding 1 and add 6 months, the date of finding 3 161 ;;and add 1 year and set the date due to the maximum of those two dates. 162 ;; 163 ;;**End Text** 164 Q 165 ;
Note:
See TracChangeset
for help on using the changeset viewer.
