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

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

initial load of WorldVistAEHR

File size: 6.6 KB
Line 
1PXRMVLST ; SLC/PKR - Validate a reminder definition for building a patient list. ;06/16/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;==================================================
4CCF(FINDING) ;Check a computed finding to see if it can be used for building
5 ;a list.
6 N IEN,TEMP,TEXT,TYPE,VALID
7 S VALID=1
8 S IEN=$P(FINDING,";",1)
9 S TEMP=$G(^PXRMD(811.4,IEN,0))
10 I TEMP="" D Q 0
11 . S TEXT="Trying to use computed finding number "_IEN_" it does not exist!"
12 . D EN^DDIOL(TEXT)
13 S TYPE=$P(TEMP,U,5)
14 I TYPE="" S TYPE="S"
15 I TYPE'="L" D
16 . S VALID=0
17 . S TEXT(1)="Computed finding "_$P(TEMP,U,1)_" is type "_TYPE_"."
18 . S TEXT(2)="It cannot be used for building patient lists!"
19 . D EN^DDIOL(.TEXT)
20 Q VALID
21 ;
22 ;==================================================
23CTERM(DEFARR,FINUM,FINDING) ;Check terms for computed findings and
24 ;health factors to see if they are valid for building a list.
25 N IEN,IND,TEXT,VALID,WCR
26 S IEN=$P(FINDING,";",1)
27 I '$D(^PXRMD(811.5,IEN,0)) D Q 0
28 . S TEXT="Trying to use term number "_IEN_" it does not exist!"
29 . D EN^DDIOL(TEXT)
30 S VALID=1
31 I $D(^PXRMD(811.5,IEN,20,"E","PXRMD(811.4,")) D
32 . S IND=0
33 . F S IND=$O(^PXRMD(811.5,IEN,20,"E","PXRMD(811.4,",IND)) Q:IND="" D
34 .. S VALID=$$CCF(IND)
35 .. I 'VALID D
36 ... S TEXT="The computed finding is used in term "_$P(^PXRMD(811.5,IEN,0),U,1)_"."
37 ... D EN^DDIOL(TEXT)
38 Q VALID
39 ;
40 ;==================================================
41HF(DEFARR,FINUM) ;
42 ;If a health factor is used its Within Category Rank must be 0.
43 N WCR,TEXT
44 S WCR=$P(DEFARR(20,FINUM,0),U,10)
45 I WCR=0 Q 1
46 S TEXT="Finding "_FINUM_" is a health factor and its Within Category Rank is not 0!"
47 D EN^DDIOL(TEXT)
48 Q 0
49 ;
50 ;==================================================
51VDEF(RIEN) ;Check a reminder definition and see if it is valid for
52 ;use in creating a patient list.
53 N AGEFI,AGR,DEFARR,FFL,FI,FIL,FILIST,FINDING,FINUM,FREQ,FUNN,IND,OPER
54 N MAXAGE,MINAGE,NUMAFI,PCLOG,PFSTACK
55 N SAAFI,SEXFI,SSTACK,TEMP,TEXT,TYPE,VALID,VF
56 I RIEN="" Q 0
57 I '$D(^PXD(811.9,RIEN)) D Q 0
58 . S TEXT="The reminder does not exist!"
59 . D EN^DDIOL(TEXT)
60 ;
61 ;See if the reminder is inactive.
62 I $P($G(^PXD(811.9,RIEN,0)),U,6) D Q 0
63 . S TEXT="This reminder is inactive!"
64 . D EN^DDIOL(TEXT)
65 ;
66 D DEF^PXRMLDR(RIEN,.DEFARR)
67 S PCLOG=DEFARR(31)
68 I PCLOG="" D Q 0
69 . S TEXT="This reminder does not contain any patient cohort logic!"
70 . D EN^DDIOL(TEXT)
71 ;
72 ;The cohort logic cannot contain the old-style MRD.
73 I $G(^PXD(811.9,RIEN,30))["MRD" D Q 0
74 . S TEXT="The patient cohort logic cannot contain the old-style MRD!"
75 . D EN^DDIOL(TEXT)
76 ;
77 ;The cohort logic cannot start with a not.
78 I $E(PCLOG,1)="'" D Q 0
79 . S TEXT="The patient cohort logic cannot start with a not!"
80 . D EN^DDIOL(TEXT)
81 ;
82 ;The cohort logic cannot contain or not.
83 ;Change any !(' to !' before checking.
84 S TEMP=$TR(PCLOG,"(","")
85 S TEMP=$TR(TEMP,")","")
86 I TEMP["!'" D Q 0
87 . S TEXT="The patient cohort logic cannot contain or not!"
88 . D EN^DDIOL(TEXT)
89 ;
90 S OPER="!&~"
91 S PCLOG=$$STRREP^PXRMUTIL(PCLOG,"&'","~")
92 D POSTFIX^PXRMSTAC(PCLOG,OPER,.PFSTACK)
93 D CFSAA^PXRMPLST(.PFSTACK)
94 M SSTACK=PFSTACK
95 S (AGEFI,SAAFI,SEXFI)=0
96 F IND=1:1:PFSTACK(0) D
97 . S TEMP=$$POP^PXRMSTAC(.PFSTACK)
98 . I TEMP="AGE" S AGEFI=IND
99 . I TEMP="SAA" S SAAFI=IND
100 . I TEMP="SEX" S SEXFI=IND
101 . I TEMP="'SEX" S SEXFI=IND
102 ;
103 ;If AGE is defined then make sure a baseline age range is defined.
104 I (AGEFI)!(SAAFI) D
105 . S (AGR,IND)=0
106 . F S IND=+$O(DEFARR(7,IND)) Q:IND=0 D
107 .. S TEMP=DEFARR(7,IND,0)
108 .. I $P(TEMP,U,2)'="" S AGR=1
109 .. I $P(TEMP,U,3)'="" S AGR=1
110 ;
111 S TEMP=DEFARR(40)
112 S NUMAFI=+$P(TEMP,U,1)
113 S FILIST=$P(TEMP,U,2)
114 I (AGEFI!SAAFI),('AGR&(NUMAFI=0)) D Q 0
115 . S TEXT(1)="Age is used in the cohort logic and neither a baseline age range or any age"
116 . S TEXT(2)="findings have been defined!"
117 . D EN^DDIOL(.TEXT)
118 ;
119 ;SEX cannot be the first element unless it is followed by & AGE.
120 I (SEXFI=1),('SAAFI) D Q 0
121 . S TEXT="SEX must be followed by & AGE when it starts the patient cohort logic!"
122 . D EN^DDIOL(TEXT)
123 ;If SEX is defined and there is not a combined sex & age finding then
124 ;a sex must be defined and the logical operator cannot be an or.
125 S VALID=1
126 I (SEXFI),('SAAFI) D
127 . I $P(^PXD(811.9,RIEN,0),U,9)="" D
128 .. S VALID=0
129 .. S TEXT(1)="Sex is used in the patient cohort logic and no sex is defined in the reminder"
130 .. S TEXT(2)="definition!"
131 .. D EN^DDIOL(.TEXT)
132 . I VALID D
133 .. S TEMP=SSTACK(SEXFI+1)
134 .. I TEMP="!" D
135 ... S VALID=0
136 ... S TEXT="SEX cannot be used in conjunction with the or operator!"
137 ... D EN^DDIOL(TEXT)
138 I 'VALID Q VALID
139 ;
140 ;Check the age findings and see if any of them set the frequency to
141 ;0Y. If they do they cannot have an associated age range.
142 F IND=1:1:NUMAFI D
143 . S FINUM=$P(FILIST,";",IND)
144 . S TEMP=$S(FINUM["FF":DEFARR(25,FINUM,0),1:DEFARR(20,FINUM,0))
145 . S MINAGE=$P(TEMP,U,2)
146 . S MAXAGE=$P(TEMP,U,3)
147 . S FREQ=$P(TEMP,U,4)
148 . I FREQ="0Y",((MINAGE'="")!(MAXAGE'="")) D
149 .. S VALID=0
150 .. S TEXT(1)="Finding "_FINUM_" sets the frequency to 0Y and also sets an age range."
151 .. S TEXT(2)="An age range is not allowed with a frequency of 0Y!"
152 .. D EN^DDIOL(.TEXT)
153 ;
154 ;Build a list of all the findings that affect whether or not the
155 ;patient is in the cohort and check to see if any of them use a
156 ;computed finding. If they use a computed finding then it must be
157 ;a list type. Health factors must have within category rank of 0.
158 F IND=1:1:SSTACK(0) D
159 . I (SSTACK(IND)["FI") D
160 .. S FINUM=$G(SSTACK(IND+1))
161 .. S FIL(FINUM)=""
162 . I (SSTACK(IND)["FF") D
163 .. S FINUM=$G(SSTACK(IND+1))
164 .. S FFL(FINUM)="FF"_FINUM
165 ;Add any age findings to the list.
166 F IND=1:1:NUMAFI D
167 . S TEMP=$P(FILIST,";",IND)
168 . I TEMP=+TEMP S FIL(TEMP)=""
169 . I TEMP["FF" S FFL($P(TEMP,"FF",2))=TEMP
170 ;Add findings used by function findings to the list.
171 S IND=0
172 F S IND=$O(FFL(IND)) Q:IND="" D
173 . S FUNN=0
174 . S FUNN=$O(DEFARR(25,FFL(IND),5,FUNN)) Q:FUNN="" D
175 .. S FI=0
176 .. F S FI=$O(DEFARR(25,FFL(IND),5,FUNN,20,FI)) Q:FI="" D
177 ... S FINUM=DEFARR(25,FFL(IND),5,FUNN,20,FI,0)
178 ... I '$D(DEFARR(20,FINUM)) D Q
179 .... S VALID=0
180 .... S TEXT="Finding "_FINUM_" is used in FF("_IND_") and it does not exist!"
181 .... D EN^DDIOL(TEXT)
182 ... S FIL(FINUM)=""
183 I 'VALID Q VALID
184 S IND=0
185 F S IND=$O(FIL(IND)) Q:IND="" D
186 . S FINDING=$P($G(DEFARR(20,IND,0)),U,1)
187 . I FINDING="" D Q
188 .. S VALID=0
189 .. S TEXT="Finding number "_IND_" does not exist!"
190 .. D EN^DDIOL(TEXT)
191 . S TEMP=$P(FINDING,";",2)
192 . S TYPE=$S(TEMP="AUTTHF(":"HF",TEMP="PXRMD(811.4,":"CF",TEMP="PXRMD(811.5,":"TERM",1:"REG")
193 . I TYPE="REG" Q
194 . I TYPE="CF" S VF=$$CCF(FINDING)
195 . I TYPE="HF" S VF=$$HF(.DEFARR,IND)
196 . I TYPE="TERM" S VF=$$CTERM(.DEFARR,IND,FINDING)
197 . I VF=0 D
198 .. S VALID=0
199 .. S TEXT="Finding number "_IND_" is the problem finding."
200 .. D EN^DDIOL(TEXT)
201 Q VALID
202 ;
Note: See TracBrowser for help on using the repository browser.