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

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1PXRMCDUE ;SLC/PKR - Custom date due calculation routines. ;09/05/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
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=$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 ;========================================================
55CDKILL(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 ;========================================================
64MAXDATE(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 ;========================================================
71MINDATE(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 ;========================================================
81OUTPUT(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 ;========================================================
92PARSE(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 ;========================================================
109VFREQ(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 ;========================================================
117VCDUE(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 ;========================================================
143XHELP ;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 ;========================================================
153TEXT ;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 ;
Note: See TracBrowser for help on using the repository browser.