source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCDUE.m@ 1259

Last change on this file since 1259 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 5.6 KB
Line 
1PXRMCDUE ;SLC/PKR - Custom date due calculation routines. ;06/30/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;========================================================
5CDBUILD(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 ;========================================================
31CDUEDATE(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 ;========================================================
54CDKILL(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 ;========================================================
63MAXDATE(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 ;========================================================
70MINDATE(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 ;========================================================
80OUTPUT(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 ;========================================================
91PARSE(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 ;========================================================
108VFREQ(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 ;========================================================
116VCDUE(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 ;========================================================
142XHELP ;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 ;========================================================
152TEXT ;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 TracBrowser for help on using the repository browser.