[613] | 1 | PXRMLOG ; SLC/PKR - Clinical Reminders logic routines. ;06/12/2006
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
---|
| 3 | ;==========================================================
|
---|
| 4 | EVALPCL(DEFARR,PXRMPDEM,FREQ,PCLOGIC,FIEVAL) ;Evaluate the Patient Cohort
|
---|
| 5 | ;Logic.
|
---|
| 6 | ;Determine the applicable frequency age range set; get the baseline.
|
---|
| 7 | N AGEFI,IND,FINDING,FLIST,FREQDAY,MAXAGE,MINAGE,NODE,NUMAFI
|
---|
| 8 | N PCLOG,PCLSTR,RANKAR,RANK,RANKFI,TEMP,TEST
|
---|
| 9 | D MMF^PXRMAGE(.DEFARR,.PXRMPDEM,.MINAGE,.MAXAGE,.FREQ,.FIEVAL)
|
---|
| 10 | ;If there is no match with any of the baseline values FREQ=-1.
|
---|
| 11 | ;If there was no frequency in the definition then FREQ="".
|
---|
| 12 | ;See if any findings override the baseline.
|
---|
| 13 | S TEMP=DEFARR(40)
|
---|
| 14 | S NUMAFI=+$P(TEMP,U,1)
|
---|
| 15 | ;If there are no age findings use the baseline.
|
---|
| 16 | I NUMAFI=0 G ACHK
|
---|
| 17 | S FLIST=$P(TEMP,U,2)
|
---|
| 18 | F IND=1:1:NUMAFI D
|
---|
| 19 | . S FINDING=$P(FLIST,";",IND)
|
---|
| 20 | . I FIEVAL(FINDING) D
|
---|
| 21 | .. S NODE=$S(FINDING["FF":25,1:20)
|
---|
| 22 | .. S TEMP=DEFARR(NODE,FINDING,0)
|
---|
| 23 | .. S RANK=+$P(TEMP,U,5)
|
---|
| 24 | .. I RANK=0 S RANK=9999
|
---|
| 25 | .. S FREQDAY=$$FRQINDAY^PXRMDATE($P(TEMP,U,4))
|
---|
| 26 | ..;If there is no frequency with this rank ignore it.
|
---|
| 27 | .. I FREQDAY]"" S RANKAR(RANK,FREQDAY,FINDING)=""
|
---|
| 28 | ;If there was a ranking use it otherwise use the greatest frequency.
|
---|
| 29 | I '$D(RANKAR) G ACHK
|
---|
| 30 | S RANK=0
|
---|
| 31 | S RANK=+$O(RANKAR(RANK))
|
---|
| 32 | S FREQDAY=+$O(RANKAR(RANK,""))
|
---|
| 33 | S FINDING=$O(RANKAR(RANK,FREQDAY,""))
|
---|
| 34 | I FINDING'="" D
|
---|
| 35 | . S NODE=$S(FINDING["FF":25,1:20)
|
---|
| 36 | . S TEMP=DEFARR(NODE,FINDING,0)
|
---|
| 37 | . S FREQ=$P(TEMP,U,4)
|
---|
| 38 | . S MINAGE=$P(TEMP,U,2)
|
---|
| 39 | . S MAXAGE=$P(TEMP,U,3)
|
---|
| 40 | .;Remove the baseline age findings since they have been overridden.
|
---|
| 41 | . K FIEVAL("AGE")
|
---|
| 42 | ACHK ;
|
---|
| 43 | I FREQ="" D
|
---|
| 44 | . S AGEFI=0
|
---|
| 45 | . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NOFREQ")="There is no reminder frequency!"
|
---|
| 46 | E D
|
---|
| 47 | .;Save the final frequency and age range for display.
|
---|
| 48 | .;Use the z so this will be the last of the info text.
|
---|
| 49 | . S ^TMP(PXRMPID,$J,PXRMITEM,"zFREQARNG")=FREQ_U_MINAGE_U_MAXAGE
|
---|
| 50 | . S AGEFI=$S(FREQ=-1:0,1:$$AGECHECK^PXRMAGE(PXRMPDEM("AGE"),MINAGE,MAXAGE))
|
---|
| 51 | S FIEVAL("AGE")=AGEFI
|
---|
| 52 | ;
|
---|
| 53 | ;Evaluate the patient cohort logic
|
---|
| 54 | EVAL ;
|
---|
| 55 | N AGE,DPCLOG,FI,FF,FUN,FUNCTION,FUNLIST,NUM,SEX,VAR
|
---|
| 56 | S TEMP=DEFARR(32)
|
---|
| 57 | S NUM=+$P(TEMP,U,1)
|
---|
| 58 | S (PCLOG,PCLSTR)=DEFARR(31)
|
---|
| 59 | S FLIST=$P(TEMP,U,2)
|
---|
| 60 | F IND=1:1:NUM D
|
---|
| 61 | . S FINDING=$P(FLIST,";",IND)
|
---|
| 62 | . I FINDING="AGE" S AGE=+$G(FIEVAL("AGE"))
|
---|
| 63 | . I FINDING="SEX" S SEX=+$G(FIEVAL("SEX"))
|
---|
| 64 | . I FINDING["FF" S TEMP=$P(FINDING,"FF",2),FF(TEMP)=FIEVAL(FINDING)
|
---|
| 65 | . E S FI(FINDING)=FIEVAL(FINDING)
|
---|
| 66 | I @PCLOG
|
---|
| 67 | S TEST=$T
|
---|
| 68 | I 'AGEFI,PCLSTR["AGE" D
|
---|
| 69 | . S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","AGE")=""
|
---|
| 70 | . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","AGE")="Patient does not meet any age criteria!"
|
---|
| 71 | ;Reminders are always N/A for dead patients unless PXRMIDOD is true in which case
|
---|
| 72 | ;the regular cohort logic applies.
|
---|
| 73 | I '$G(PXRMIDOD),PXRMPDEM("DOD")'="" S TEST=0
|
---|
| 74 | S PCLOGIC=TEST_U_PCLSTR
|
---|
| 75 | I 'TEST S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","COHORT")=""
|
---|
| 76 | I $G(PXRMDEBG) D
|
---|
| 77 | . S DPCLOG=PCLOG
|
---|
| 78 | . F IND=1:1:NUM D
|
---|
| 79 | .. S FINDING=$P(FLIST,";",IND)
|
---|
| 80 | .. I FINDING="AGE" S DPCLOG=$$STRREP^PXRMUTIL(DPCLOG,"AGE",+$G(FIEVAL(FINDING))) Q
|
---|
| 81 | .. I FINDING="SEX" S DPCLOG=$$STRREP^PXRMUTIL(DPCLOG,"SEX",+$G(FIEVAL(FINDING))) Q
|
---|
| 82 | .. S TEMP=$S(FINDING["FF":"FF("_$P(FINDING,"FF",2)_")",1:"FI("_FINDING_")")
|
---|
| 83 | .. S DPCLOG=$$STRREP^PXRMUTIL(DPCLOG,TEMP,FIEVAL(FINDING))
|
---|
| 84 | S PCLOGIC=PCLOGIC_U_$G(DPCLOG)
|
---|
| 85 | I $G(PXRMDEBG) S ^TMP(PXRMPID,$J,PXRMITEM,"PATIENT COHORT LOGIC")=PCLOGIC
|
---|
| 86 | Q
|
---|
| 87 | ;
|
---|
| 88 | ;==========================================================
|
---|
| 89 | EVALRESL(DEFARR,RESDATE,RESLOGIC,FIEVAL) ;Evaluate the
|
---|
| 90 | ;Resolution Logic.
|
---|
| 91 | N DRESLOG,IND,FF,FI,FINDING,FLIST,NUM,RESLOG,RESLSTR,TEMP,TEST
|
---|
| 92 | S TEMP=DEFARR(36)
|
---|
| 93 | S NUM=+$P(TEMP,U,1)
|
---|
| 94 | I NUM=0 Q
|
---|
| 95 | S (RESLOG,RESLSTR)=DEFARR(35)
|
---|
| 96 | S FLIST=$P(TEMP,U,2)
|
---|
| 97 | F IND=1:1:NUM D
|
---|
| 98 | . S FINDING=$P(FLIST,";",IND)
|
---|
| 99 | .;Check for contraindicated in a resolution finding
|
---|
| 100 | . I $G(FIEVAL(FINDING,"CONTRAINDICATED")) S FIEVAL("CONTRAINDICATED")=1
|
---|
| 101 | . I FINDING["FF" S TEMP=$P(FINDING,"FF",2),FF(TEMP)=FIEVAL(FINDING)
|
---|
| 102 | . E S FI(FINDING)=FIEVAL(FINDING)
|
---|
| 103 | I @RESLOG
|
---|
| 104 | S TEST=$T
|
---|
| 105 | I $G(PXRMDEBG) D
|
---|
| 106 | . S DRESLOG=RESLOG
|
---|
| 107 | . F IND=1:1:NUM D
|
---|
| 108 | .. S FINDING=$P(FLIST,";",IND)
|
---|
| 109 | .. S TEMP=$S(FINDING["FF":"FF("_$P(FINDING,"FF",2)_")",1:"FI("_FINDING_")")
|
---|
| 110 | .. S DRESLOG=$$STRREP^PXRMUTIL(DRESLOG,TEMP,FIEVAL(FINDING))
|
---|
| 111 | S RESLOGIC=TEST_U_RESLSTR_U_$G(DRESLOG)
|
---|
| 112 | I $G(PXRMDEBG) S ^TMP(PXRMPID,$J,PXRMITEM,"RESOLUTION LOGIC")=RESLOGIC
|
---|
| 113 | S RESDATE=$S(TEST=1:$$RESDATE(RESLSTR,.FIEVAL),1:0)
|
---|
| 114 | Q
|
---|
| 115 | ;
|
---|
| 116 | ;==========================================================
|
---|
| 117 | LOGOP(DT1,DT2,LOP) ;Given two dates return the most recent if the logical
|
---|
| 118 | ;operator is ! and the oldest if it is &. True FFs which don't have
|
---|
| 119 | ;a date are flagged with date of -1.
|
---|
| 120 | I DT1=0,DT2=0 Q 0
|
---|
| 121 | I DT1=-1,DT2=-1 Q -1
|
---|
| 122 | N VALUE
|
---|
| 123 | I LOP="&" D Q VALUE
|
---|
| 124 | . I DT1=-1 S VALUE=DT2 Q
|
---|
| 125 | . I DT2=-1 S VALUE=DT1 Q
|
---|
| 126 | . I DT1=0 S VALUE=DT2 Q
|
---|
| 127 | . I DT2=0 S VALUE=DT1 Q
|
---|
| 128 | . S VALUE=$S(DT1>DT2:DT2,1:DT1)
|
---|
| 129 | I LOP'="!" Q 0
|
---|
| 130 | I DT1=-1 Q $S(DT2>0:DT2,1:-1)
|
---|
| 131 | I DT2=-1 Q $S(DT1>0:DT1,1:-1)
|
---|
| 132 | Q $S(DT1>DT2:DT1,1:DT2)
|
---|
| 133 | ;
|
---|
| 134 | ;==========================================================
|
---|
| 135 | RESDATE(RESLSTR,FIEVAL) ;Return the resolution date based on the following
|
---|
| 136 | ;rules:
|
---|
| 137 | ; Dates that are ORed use the most recent.
|
---|
| 138 | ; Dates that are ANDed use the oldest.
|
---|
| 139 | ;This is only evaluated if the resolution logic is true.
|
---|
| 140 | N DATE,DSTRING,DT1,DT2,DT3,FFI,IND,INDEX,JND
|
---|
| 141 | N OPER,PFSTACK,STACK,TEMP
|
---|
| 142 | ;Remove leading (n) entries.
|
---|
| 143 | I ($E(RESLSTR,1,4)="(0)!")!($E(RESLSTR,1,4)="(1)&") S $E(RESLSTR,1,4)=""
|
---|
| 144 | ;The NOT operator is not relevant for the date calculation so remove
|
---|
| 145 | ;any NOTs.
|
---|
| 146 | S DSTRING=$TR(RESLSTR,"'","")
|
---|
| 147 | ;Replace true findings with their dates. This includes false findings
|
---|
| 148 | ;that are notted in the logic.
|
---|
| 149 | S OPER="!&"
|
---|
| 150 | D POSTFIX^PXRMSTAC(DSTRING,OPER,.PFSTACK)
|
---|
| 151 | S JND=0
|
---|
| 152 | F IND=1:1:PFSTACK(0) D
|
---|
| 153 | . S TEMP=PFSTACK(IND)
|
---|
| 154 | . I TEMP="FI" D Q
|
---|
| 155 | .. S IND=IND+1,INDEX=PFSTACK(IND)
|
---|
| 156 | .. S DATE=$S(FIEVAL(INDEX)=1:FIEVAL(INDEX,"DATE"),1:0)
|
---|
| 157 | .. S JND=JND+1,STACK(JND)=DATE
|
---|
| 158 | . I TEMP="FF" D Q
|
---|
| 159 | .. S IND=IND+1,INDEX=PFSTACK(IND)
|
---|
| 160 | .. S FFI="FF"_INDEX
|
---|
| 161 | ..;FFs do not have dates, flag with -1.
|
---|
| 162 | .. S DATE=-1
|
---|
| 163 | .. S JND=JND+1,STACK(JND)=DATE
|
---|
| 164 | . I OPER[TEMP S JND=JND+1,STACK(JND)=TEMP
|
---|
| 165 | S STACK(0)=JND
|
---|
| 166 | K PFSTACK
|
---|
| 167 | S PFSTACK(0)=0
|
---|
| 168 | F IND=1:1:STACK(0) D
|
---|
| 169 | . S TEMP=STACK(IND)
|
---|
| 170 | . I OPER[TEMP D
|
---|
| 171 | ..;Pop the top two elements on the stack and do the operation.
|
---|
| 172 | .. S DT1=$$POP^PXRMSTAC(.PFSTACK)
|
---|
| 173 | .. S DT2=$$POP^PXRMSTAC(.PFSTACK)
|
---|
| 174 | .. S DT3=$$LOGOP(DT1,DT2,TEMP)
|
---|
| 175 | ..;Save the result back on the stack
|
---|
| 176 | .. D PUSH^PXRMSTAC(.PFSTACK,DT3)
|
---|
| 177 | . E D PUSH^PXRMSTAC(.PFSTACK,TEMP)
|
---|
| 178 | ;The result is the only thing left on the stack.
|
---|
| 179 | Q $$POP^PXRMSTAC(.PFSTACK)
|
---|
| 180 | ;
|
---|
| 181 | ;==========================================================
|
---|
| 182 | SEX(DEFARR,SEX) ;Return FALSE (0) if the patient is the wrong sex for
|
---|
| 183 | ; the reminder, TRUE (1) is the patient is the right sex.
|
---|
| 184 | N REMSEX
|
---|
| 185 | S REMSEX=$P(DEFARR(0),U,9)
|
---|
| 186 | I REMSEX="" Q 1
|
---|
| 187 | I SEX=REMSEX Q 1
|
---|
| 188 | S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","SEX")=""
|
---|
| 189 | S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","SEX")="Patient is the wrong sex!"
|
---|
| 190 | Q 0
|
---|
| 191 | ;
|
---|
| 192 | ;==========================================================
|
---|
| 193 | VALID(LOGSTR,DA,MINLEN,MAXLEN) ;Make sure that LOGSTR is a valid logic string.
|
---|
| 194 | ;This is called by the input transform for PATIENT COHORT LOGIC and
|
---|
| 195 | ;RESOLUTION LOGIC. Return 1 if LOGSTR is ok.
|
---|
| 196 | ;Don't do this if this is being called as a result of an install
|
---|
| 197 | ;through the Exchange Utility.
|
---|
| 198 | I $G(PXRMEXCH) Q 1
|
---|
| 199 | I LOGSTR="" Q 0
|
---|
| 200 | ;
|
---|
| 201 | ;Check the length.
|
---|
| 202 | N LEN
|
---|
| 203 | S LEN=$L(LOGSTR)
|
---|
| 204 | I (LEN<MINLEN)!(LEN>MAXLEN) Q 0
|
---|
| 205 | ;
|
---|
| 206 | ;Use the FileMan code validator to check the code.
|
---|
| 207 | N TEST,X
|
---|
| 208 | S X="S Y="_$TR(LOGSTR,";","")
|
---|
| 209 | D ^DIM
|
---|
| 210 | I $D(X)=0 D Q 0
|
---|
| 211 | . S TEXT(1)="LOGIC string: "_LOGSTR
|
---|
| 212 | . S TEXT(2)="contains invalid MUMPS code!"
|
---|
| 213 | . D EN^DDIOL(.TEXT)
|
---|
| 214 | ;
|
---|
| 215 | N ELE1,ELE2,MNUM,SEP,STACK,TEXT,TSTSTR,VALID
|
---|
| 216 | ;Make sure the entries in LOGSTR are valid elements or functions.
|
---|
| 217 | S TSTSTR=LOGSTR
|
---|
| 218 | S TSTSTR=$TR(TSTSTR,"'","")
|
---|
| 219 | S TSTSTR=$TR(TSTSTR,"&",U)
|
---|
| 220 | S TSTSTR=$TR(TSTSTR,"!",U)
|
---|
| 221 | ;Set the allowable logic separators.
|
---|
| 222 | S SEP="^,<>="
|
---|
| 223 | ;Convert the string to postfix form for evaluation.
|
---|
| 224 | D POSTFIX^PXRMSTAC(TSTSTR,SEP,.STACK)
|
---|
| 225 | S (ELE1,VALID)=1
|
---|
| 226 | F Q:(ELE1="")!(VALID=0) D
|
---|
| 227 | . S ELE1=$$POP^PXRMSTAC(.STACK)
|
---|
| 228 | . I SEP[ELE1 Q
|
---|
| 229 | .;If the element is FI or FF then the next element should be a number.
|
---|
| 230 | . S MNUM=$S(ELE1="FI":20,ELE1="FF":25,1:"")
|
---|
| 231 | . I MNUM'="" D
|
---|
| 232 | .. S ELE2=$$POP^PXRMSTAC(.STACK)
|
---|
| 233 | .. I ELE2'=+ELE2 S VALID=0
|
---|
| 234 | .. I VALID S VALID=$D(^PXD(811.9,DA,MNUM,ELE2))
|
---|
| 235 | .. I 'VALID D
|
---|
| 236 | ... S TEXT=ELE1_"("_ELE2_") is not in this definition!"
|
---|
| 237 | ... D EN^DDIOL(TEXT)
|
---|
| 238 | Q VALID
|
---|
| 239 | ;
|
---|
| 240 | ;==========================================================
|
---|
| 241 | VALIDR(LOGSTR,DA,MINLEN,MAXLEN) ;Make sure that LOGSTR is a valid resolution
|
---|
| 242 | ;logic string. This is called by the input transform for RESOLUTION
|
---|
| 243 | ;LOGIC. Return 1 if LOGSTR is ok.
|
---|
| 244 | ;Don't do this if this is being called as a result of an install
|
---|
| 245 | ;through the Exchange Utility.
|
---|
| 246 | I $G(PXRMEXCH) Q 1
|
---|
| 247 | I LOGSTR="" Q 0
|
---|
| 248 | N TEXT
|
---|
| 249 | ;The resolution logic cannot contain SEX or AGE.
|
---|
| 250 | I LOGSTR["AGE" D Q 0
|
---|
| 251 | . S TEXT="The resolution logic cannot contain AGE!"
|
---|
| 252 | . D EN^DDIOL(TEXT)
|
---|
| 253 | I LOGSTR["SEX" D Q 0
|
---|
| 254 | . S TEXT="The resolution logic cannot contain SEX!"
|
---|
| 255 | . D EN^DDIOL(TEXT)
|
---|
| 256 | ;Now call the regular logic string validator.
|
---|
| 257 | Q $$VALID(LOGSTR,DA,MINLEN,MAXLEN)
|
---|
| 258 | ;
|
---|