source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINTR.m@ 701

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

initial load of WorldVistAEHR

File size: 7.9 KB
Line 
1PXRMINTR ; SLC/PKR/PJH - Input transforms for Clinical Reminders.;04/17/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;=======================================================
4VASP(DA,X) ;Check for valid associate sponsor in file 811.6.
5 ;Do not execute as part of a verify fields.
6 I $G(DIUTIL)="VERIFY FIELDS" Q 1
7 ;Do not execute as part of exchange.
8 I $G(PXRMEXCH) Q 1
9 ;Make sure that an associated sponsor does not point to itself.
10 I X=DA D Q 0
11 . D EN^DDIOL("An associated sponsor cannot point to itself.")
12 ;A sponsor cannot be an associated sponsor if it contains associated
13 ;sponsors.
14 I $D(^PXRMD(811.6,X,2,"B")) D Q 0
15 . D EN^DDIOL("A sponsor cannot be selected as an associated sponsor if it contains associated sponsors.")
16 ;The class of an associated sponsor must match that of the sponsor.
17 N ASCLASS,SCLASS
18 S SCLASS=$P(^PXRMD(811.6,DA,0),U,2)
19 S ASCLASS=$P(^PXRMD(811.6,X,0),U,2)
20 I ASCLASS'=SCLASS D Q 0
21 . N TEXT
22 . S TEXT="The associated sponsor's class is "_ASCLASS_", it does not match the sponsor's class which is "_SCLASS_". They must match."
23 . D EN^DDIOL(TEXT)
24 Q 1
25 ;
26 ;=======================================================
27VCLASS(X) ;Check for valid CLASS field, ordinary users cannot create
28 ;National classes.
29 ;Do not execute as part of a verify fields.
30 I $G(DIUTIL)="VERIFY FIELDS" Q 1
31 ;Do not execute as part of exchange.
32 I $G(PXRMEXCH) Q 1
33 I (X["N"),(($G(PXRMINST)'=1)!(DUZ(0)'="@")) D Q 0
34 . D EN^DDIOL("You are not allowed to create a NATIONAL class")
35 E Q 1
36 ;
37 ;=======================================================
38VDT(X) ;Check for a valid date/time. Input transform on
39 ;beginning date/time and ending date/time fields.
40 N FMDATE,VALID
41 S FMDATE=$$CTFMD^PXRMDATE(X)
42 S VALID=$S(FMDATE=-1:0,1:1)
43 I 'VALID D
44 . N TEXT
45 . S TEXT=X_" is not a valid date/time"
46 . D EN^DDIOL(TEXT)
47 Q VALID
48 ;
49 ;=======================================================
50VFINDING(X) ;Check X to see if it is a valid finding. This is the input
51 ;transform on the .01 field of the reminder findings multiple. Data
52 ;element 811.902,.01.
53 ;Include stubs for all possible finding types in case we need input
54 ;transforms on them.
55 ;I X["AUTTEDT(" Q 1
56 ;I X["AUTTEXAM(" Q 1
57 I X["AUTTHF(" Q $$VHF(X)
58 ;I X["AUTTIMM(" Q 1
59 ;I X["AUTTSK(" Q 1
60 ;I X["GMRD(120.51," Q 1
61 I X["LAB(60," Q $$VLAB(X)
62 ;I X["ORD(101.43," Q 1
63 I X["PXD(811.2," Q $$VTAX(X)
64 ;I X["PXRMD(811.4," Q 1
65 ;I X["PXRMD(811.5," Q 1
66 ;I X["PS(50.605," Q 1
67 ;I X["PSDRUG(" Q 1
68 ;I X["PSNDF(50.6," Q 1
69 ;I X["RAMIS(71," Q 1
70 I X["YTT(601," Q $$VMH(X)
71 Q 1
72 ;
73 ;=======================================================
74VHF(X) ;Check for valid health factor findings. It must be a factor, not
75 ;a category.
76 N CAT,IEN,TEMP,TYPE
77 S IEN=$P(X,";",1)
78 S TEMP=$G(^AUTTHF(IEN,0))
79 S TYPE=$P(TEMP,U,10)
80 I TYPE="C" D Q 0
81 . D EN^DDIOL("Category health factors cannot be used in reminder definitions!")
82 I TYPE'="F" D Q 0
83 . D EN^DDIOL("Only factor health factors can be used in reminder definitions!")
84 ;Make sure that the health factor has a category.
85 S CAT=$P(TEMP,U,3)
86 I CAT="" D Q 0
87 . D EN^DDIOL("Factor health factors must have a category!")
88 Q 1
89 ;
90 ;=======================================================
91VIGNAC(X) ;Check X to see if it contains valid IGNORE ON N/A codes.
92 ;This is part of the input transform for this field. The length of the
93 ;IGNORE ON N/A field is 8 characters. The valid codes are:
94 ; A - age
95 ; I - inactive
96 ; R - race
97 ; S - sex
98 ; * - wildcard matches anything.
99 N LEN
100 S LEN=$L(X)
101 I (LEN>8)!(LEN<1) Q 0
102 ;
103 N TEMP,TEXT
104 S TEMP=X
105 S TEMP=$TR(TEMP,"A","")
106 S TEMP=$TR(TEMP,"I","")
107 S TEMP=$TR(TEMP,"R","")
108 S TEMP=$TR(TEMP,"S","")
109 S TEMP=$TR(TEMP,"*","")
110 ;At this point TEMP should be NULL,if it is not then there are
111 ;bad codes.
112 S LEN=$L(TEMP)
113 I LEN=1 D Q 0
114 . S TEXT=TEMP_" is not a valid IGNORE ON N/A code!"
115 . D EN^DDIOL(TEXT)
116 I LEN>1 D Q 0
117 . S TEXT=TEMP_" are not valid IGNORE ON N/A codes!"
118 . D EN^DDIOL(TEXT)
119 Q 1
120 ;
121 ;=======================================================
122VLAB(X) ;Check for valid lab findings. Everything but a panel is ok.
123 I X'["LAB(60" Q 1
124 N DATANAME,LAB0,LABTEST,SUB,TEST,TEXT
125 S LABTEST=$P(X,";",1)
126 ;DBIA #91-A
127 S LAB0=^LAB(60,LABTEST,0)
128 S SUB=$P(LAB0,U,4)
129 ;BB and WK not allowed
130 I (SUB="BB")!(SUB="WK") D Q 0
131 . S TEXT=SUB_" tests cannot be used as reminder findings."
132 . D EN^DDIOL(.TEXT)
133 ;The concept of lab panel only applies to CH tests.
134 I SUB'["CH" Q 1
135 S DATANAME=$P(LAB0,U,5)
136 ;If DATA NAME is null then it is a panel.
137 I DATANAME="" D Q 0
138 . S TEXT(1)=$P(LAB0,U,1)_" is a lab panel, cannot be used for a reminder!"
139 . S TEXT(2)="Contact your Lab ADPAC for help"
140 . D EN^DDIOL(.TEXT)
141 Q 1
142 ;
143 ;=======================================================
144VMH(X) ;The site must have the routine YTAPI installed in order to use
145 ;mental health instrument findings.
146 N EXISTS
147 S EXISTS=$$EXISTS^PXRMEXCF("YTAPI")
148 I EXISTS Q 1
149 N TEXT
150 S TEXT(1)="Your site does not have the routine YTAPI installed."
151 S TEXT(2)="It is required in order to use Mental Instrument findings."
152 S TEXT(3)="The routine was originally released in patch YS*5.01*53."
153 S TEXT(4)=" "
154 D EN^DDIOL(.TEXT)
155 Q 0
156 ;
157 ;=======================================================
158VNAME(NAME,FILE) ;Check for valid .01 value.
159 ;For files 801.41, 811.2, 811.4 and 811.9 the name cannot start with VA-
160 ;unless this is a national reminder.
161 ;Do not execute as part of a verify fields.
162 I $G(DIUTIL)="VERIFY FIELDS" Q 1
163 ;Do not execute as part of exchange.
164 I $G(PXRMEXCH) Q 1
165 N STEXT,TEXT,VALID
166 S VALID=1
167 I (FILE=811.2)!(FILE=811.4)!(FILE=811.9)!(FILE=801.41) D
168 . S STEXT=$E(NAME,1,3)
169 . I (STEXT="VA-"),(($G(PXRMINST)'=1)!(DUZ(0)'="@")) D
170 .. S TEXT=NAME_" cannot start with ""VA-"", reserved for national distribution!"
171 .. D EN^DDIOL(TEXT)
172 .. H 2
173 .. S VALID=0
174 Q VALID
175 ;
176 ;=======================================================
177VSPONSOR(X) ;Make sure file Class and Sponsor Class match.
178 ;If there is no sponsor don't do the check.
179 I X="" Q 1
180 ;Do not execute as part of a verify fields.
181 I $G(DIUTIL)="VERIFY FIELDS" Q 1
182 ;Do not execute as part of exchange.
183 I $G(PXRMEXCH) Q 1
184 N FCLASS,FILENUM,SCLASS,TEXT,VALID
185 S VALID=1
186 I $G(X)="" Q VALID
187 I $G(DIC)="" Q 0
188 S FILENUM=+$P(@(DIC_"0)"),U,2)
189 S FCLASS=$P(@(DIC_DA_",100)"),U,1)
190 S SCLASS=$P(^PXRMD(811.6,X,100),U,1)
191 I SCLASS'=FCLASS D
192 . S FCLASS=$$EXTERNAL^DILFD(FILENUM,100,"",FCLASS)
193 . S SCLASS=$$EXTERNAL^DILFD(811.6,100,"",SCLASS)
194 . S TEXT="Sponsor Class is "_SCLASS_", File Class is "_FCLASS_" they must match!"
195 . D EN^DDIOL(TEXT)
196 . S VALID=0
197 Q VALID
198 ;
199 ;=======================================================
200VTAX(X) ;Make sure the taxonomy is active.
201 N IEN,INACTIVE
202 S IEN=$P(X,";",1)
203 S INACTIVE=$P(^PXD(811.2,IEN,0),U,6)
204 I INACTIVE D Q 0
205 . D EN^DDIOL("This taxonomy is inactive and cannot be selected.")
206 E Q 1
207 ;
208 ;=======================================================
209VTPER(X) ;Check for valid time period. They must be of the form NS,
210 ; where N is a number and S is D for days, M for months, or Y for years.
211 N LEN
212 S X=$$UP^XLFSTR(X)
213 S LEN=$L(X)
214 I (LEN>5)!(LEN<2) Q 0
215 I ((X'?1N.N1"D")&(X'?1N.N1"M")&(X'?1N.N1"Y")) Q 0
216 Q 1
217 ;
218 ;=======================================================
219VUSAGE(X) ;Check X to see if it contains valid USAGE codes.
220 ;This is part of the input transform for this field. The length of the
221 ;USAGE field is 10 characters. The valid codes are:
222 ; C - CPRS
223 ; L - Reminder Patient List
224 ; P - Patient
225 ; R - Reports
226 ; X - Extracts
227 ; * - Wildcard matches anything, except P.
228 N LEN
229 S LEN=$L(X)
230 I (LEN>10)!(LEN<1) Q 0
231 ;
232 N TEMP,TEXT
233 S TEMP=$$UP^XLFSTR(X)
234 S TEMP=$TR(TEMP,"C","")
235 S TEMP=$TR(TEMP,"L","")
236 S TEMP=$TR(TEMP,"P","")
237 S TEMP=$TR(TEMP,"R","")
238 S TEMP=$TR(TEMP,"X","")
239 S TEMP=$TR(TEMP,"*","")
240 ;At this point TEMP should be NULL,if it is not then there are
241 ;bad codes.
242 S LEN=$L(TEMP)
243 I LEN=1 D Q 0
244 . S TEXT=TEMP_" is not a valid USAGE code!"
245 . D EN^DDIOL(TEXT)
246 I LEN>1 D Q 0
247 . S TEXT=TEMP_" are not valid USAGE codes!"
248 . D EN^DDIOL(TEXT)
249 Q 1
Note: See TracBrowser for help on using the repository browser.