Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMLOG

PXRMLOG.m

Go to the documentation of this file.
  1. PXRMLOG ;SLC/PKR - Clinical Reminders logic routines. ;03/31/2022
  1. ;;2.0;CLINICAL REMINDERS;**4,6,12,17,18,26,47,42,65**;Feb 04, 2005;Build 438
  1. ;==========================================================
  1. CRSTATUS(DEFARR,FIEVAL) ;Determine the contraindicated/refused status.
  1. N CONTRALOGIC,CONTRASTRING,CRSTATUS,DCONTRALOGIC,IND,FF,FI,FINDING,FLIST,NUM,TEMP,TEST
  1. ;If there is contraindicated logic, evaluate it.
  1. S CRSTATUS=""
  1. S TEMP=DEFARR(81)
  1. S NUM=+$P(TEMP,U,1)
  1. I NUM>0 D
  1. . S (CONTRALOGIC,CONTRASTRING)=DEFARR(80)
  1. . S FLIST=$P(TEMP,U,2)
  1. . F IND=1:1:NUM D
  1. .. S FINDING=$P(FLIST,";",IND)
  1. .. I FINDING["FF" S TEMP=$P(FINDING,"FF",2),FF(TEMP)=FIEVAL(FINDING)
  1. .. E S FI(FINDING)=FIEVAL(FINDING)
  1. . I @CONTRALOGIC S CRSTATUS="CONTRA"
  1. . S TEST=$T
  1. . I $G(PXRMDEBG) D
  1. .. S DCONTRALOGIC=CONTRALOGIC
  1. .. F IND=1:1:NUM D
  1. ... S FINDING=$P(FLIST,";",IND)
  1. ... S TEMP=$S(FINDING["FF":"FF("_$P(FINDING,"FF",2)_")",1:"FI("_FINDING_")")
  1. ... S DCONTRALOGIC=$$STRREP^PXRMUTIL(DCONTRALOGIC,TEMP,FIEVAL(FINDING))
  1. . S ^TMP(PXRMPID,$J,PXRMITEM,"CONTRAINDICATED LOGIC")=TEST_U_CONTRASTRING_U_$G(DCONTRALOGIC)
  1. I CRSTATUS="CONTRA" Q CRSTATUS
  1. ;
  1. ;If CRSTATUS is not "CONTRA" and there is resolution logic evaluate it.
  1. N DREFUSEDLOGIC,REFUSEDLOGIC,REFUSEDSTRING
  1. S TEMP=DEFARR(91)
  1. S NUM=+$P(TEMP,U,1)
  1. I NUM>0 D
  1. . S (REFUSEDLOGIC,REFUSEDSTRING)=DEFARR(90)
  1. . S FLIST=$P(TEMP,U,2)
  1. . F IND=1:1:NUM D
  1. .. S FINDING=$P(FLIST,";",IND)
  1. .. I FINDING["FF" S TEMP=$P(FINDING,"FF",2),FF(TEMP)=FIEVAL(FINDING)
  1. .. E S FI(FINDING)=FIEVAL(FINDING)
  1. . I @REFUSEDLOGIC S CRSTATUS="REFUSED"
  1. . S TEST=$T
  1. . I $G(PXRMDEBG) D
  1. .. S DREFUSEDLOGIC=REFUSEDLOGIC
  1. .. F IND=1:1:NUM D
  1. ... S FINDING=$P(FLIST,";",IND)
  1. ... S TEMP=$S(FINDING["FF":"FF("_$P(FINDING,"FF",2)_")",1:"FI("_FINDING_")")
  1. ... S DREFUSEDLOGIC=$$STRREP^PXRMUTIL(DREFUSEDLOGIC,TEMP,FIEVAL(FINDING))
  1. . S ^TMP(PXRMPID,$J,PXRMITEM,"REFUSED LOGIC")=TEST_U_REFUSEDSTRING_U_$G(DREFUSEDLOGIC)
  1. Q CRSTATUS
  1. ;
  1. ;==========================================================
  1. EVALPCL(DEFARR,PXRMPDEM,FREQ,PCLOGIC,FIEVAL) ;Evaluate the Patient Cohort
  1. ;Logic.
  1. ;Determine the applicable frequency age range set; get the baseline.
  1. N AGEFI,IND,FINDING,FIFREQ,FLIST,FREQDAY,MAXAGE,MINAGE,NODE,NUMAFI
  1. N PCLOG,PCLSTR,RANKAR,RANK,RANKFI,TEMP,TEST
  1. D MMF^PXRMAGE(.DEFARR,.PXRMPDEM,.MINAGE,.MAXAGE,.FREQ,.FIEVAL)
  1. S FIFREQ="Baseline"
  1. ;If there is no match with any of the baseline values FREQ=-1.
  1. ;If there was no frequency in the definition then FREQ="".
  1. ;See if any findings override the baseline.
  1. S TEMP=DEFARR(40)
  1. S NUMAFI=+$P(TEMP,U,1)
  1. ;If there are no age findings use the baseline.
  1. I NUMAFI=0 G ACHK
  1. S FLIST=$P(TEMP,U,2)
  1. F IND=1:1:NUMAFI D
  1. . S FINDING=$P(FLIST,";",IND)
  1. . I FIEVAL(FINDING) D
  1. .. S NODE=$S(FINDING["FF":25,1:20)
  1. .. S TEMP=DEFARR(NODE,FINDING,0)
  1. .. S RANK=+$P(TEMP,U,5)
  1. .. I RANK=0 S RANK=9999
  1. .. S FREQDAY=$$FRQINDAY^PXRMDATE($P(TEMP,U,4))
  1. ..;If there is no frequency with this rank ignore it.
  1. .. I FREQDAY]"" S RANKAR(RANK,FREQDAY,FINDING)=""
  1. ;If there was a ranking use it otherwise use the greatest frequency.
  1. I '$D(RANKAR) G ACHK
  1. S RANK=0
  1. S RANK=+$O(RANKAR(RANK))
  1. S FREQDAY=+$O(RANKAR(RANK,""))
  1. S FINDING=$O(RANKAR(RANK,FREQDAY,""))
  1. I FINDING'="" D
  1. . S NODE=$S(FINDING["FF":25,1:20)
  1. . S TEMP=DEFARR(NODE,FINDING,0)
  1. . S FREQ=$P(TEMP,U,4)
  1. . S MINAGE=$P(TEMP,U,2)
  1. . S MAXAGE=$P(TEMP,U,3)
  1. . S FIFREQ="Finding "_FINDING
  1. .;Remove the baseline age findings since they have been overridden.
  1. . K FIEVAL("AGE")
  1. ACHK ;
  1. I FREQ="" D
  1. . S AGEFI=0
  1. .;If there is no resolution logic then frequency is not required.
  1. . I DEFARR(35)="" S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NOFREQ")="There is no reminder frequency!"
  1. . I DEFARR(35)'="" S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","NOFREQ")="There is resolution logic but no reminder frequency!"
  1. E D
  1. .;Save the final frequency and age range for display.
  1. .;Use the z so this will be the last of the info text.
  1. . S ^TMP(PXRMPID,$J,PXRMITEM,"zFREQARNG")=FREQ_U_MINAGE_U_MAXAGE_U_FIFREQ
  1. . S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM,"FREQ")=FREQ
  1. . S AGEFI=$S(FREQ=-1:0,1:$$AGECHECK^PXRMAGE(PXRMPDEM("AGE"),MINAGE,MAXAGE))
  1. S FIEVAL("AGE")=AGEFI
  1. ;
  1. EVAL ;Evaluate the patient cohort logic.
  1. N AGE,DPCLOG,FI,FF,FUN,FUNCTION,FUNLIST,NUM,SEX,VAR
  1. S TEMP=DEFARR(32)
  1. S NUM=+$P(TEMP,U,1)
  1. S (PCLOG,PCLSTR)=DEFARR(31)
  1. S FLIST=$P(TEMP,U,2)
  1. F IND=1:1:NUM D
  1. . S FINDING=$P(FLIST,";",IND)
  1. . I FINDING="AGE" S AGE=+$G(FIEVAL("AGE"))
  1. . I FINDING="SEX" S SEX=+$G(FIEVAL("SEX"))
  1. . I FINDING["FF" S TEMP=$P(FINDING,"FF",2),FF(TEMP)=FIEVAL(FINDING)
  1. . E S FI(FINDING)=FIEVAL(FINDING)
  1. I @PCLOG
  1. S TEST=$T
  1. I 'AGEFI,PCLSTR["AGE" D
  1. . S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","AGE")=""
  1. . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","AGE")="Patient does not meet any age criteria!"
  1. ;Reminders are always N/A for dead patients unless PXRMIDOD is true in which case
  1. ;the regular cohort logic applies.
  1. I '$G(PXRMIDOD),PXRMPDEM("DOD")'="" S TEST=0
  1. S PCLOGIC=TEST_U_PCLSTR
  1. I 'TEST S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","COHORT")=""
  1. I $G(PXRMDEBG) D
  1. . S DPCLOG=PCLOG
  1. . F IND=1:1:NUM D
  1. .. S FINDING=$P(FLIST,";",IND)
  1. .. I FINDING="AGE" S DPCLOG=$$STRREP^PXRMUTIL(DPCLOG,"AGE",+$G(FIEVAL(FINDING))) Q
  1. .. I FINDING="SEX" S DPCLOG=$$STRREP^PXRMUTIL(DPCLOG,"SEX",+$G(FIEVAL(FINDING))) Q
  1. .. S TEMP=$S(FINDING["FF":"FF("_$P(FINDING,"FF",2)_")",1:"FI("_FINDING_")")
  1. .. S DPCLOG=$$STRREP^PXRMUTIL(DPCLOG,TEMP,FIEVAL(FINDING))
  1. S PCLOGIC=PCLOGIC_U_$G(DPCLOG)
  1. I $G(PXRMDEBG) S ^TMP(PXRMPID,$J,PXRMITEM,"PATIENT COHORT LOGIC")=PCLOGIC
  1. Q
  1. ;
  1. ;==========================================================
  1. EVALRESL(DEFARR,RESDATE,RESLOGIC,FIEVAL) ;Evaluate the
  1. ;Resolution Logic.
  1. N DRESLOG,IND,FF,FI,FINDING,FLIST,NUM,RESLOG,RESLSTR,TEMP,TEST
  1. S TEMP=DEFARR(36)
  1. S NUM=+$P(TEMP,U,1)
  1. I NUM=0 Q
  1. S (RESLOG,RESLSTR)=DEFARR(35)
  1. S FLIST=$P(TEMP,U,2)
  1. F IND=1:1:NUM D
  1. . S FINDING=$P(FLIST,";",IND)
  1. . I FINDING["FF" S TEMP=$P(FINDING,"FF",2),FF(TEMP)=FIEVAL(FINDING)
  1. . E S FI(FINDING)=FIEVAL(FINDING)
  1. I @RESLOG
  1. S TEST=$T
  1. I $G(PXRMDEBG) D
  1. . S DRESLOG=RESLOG
  1. . F IND=1:1:NUM D
  1. .. S FINDING=$P(FLIST,";",IND)
  1. .. S TEMP=$S(FINDING["FF":"FF("_$P(FINDING,"FF",2)_")",1:"FI("_FINDING_")")
  1. .. S DRESLOG=$$STRREP^PXRMUTIL(DRESLOG,TEMP,FIEVAL(FINDING))
  1. S RESLOGIC=TEST_U_RESLSTR_U_$G(DRESLOG)
  1. I $G(PXRMDEBG) S ^TMP(PXRMPID,$J,PXRMITEM,"RESOLUTION LOGIC")=RESLOGIC
  1. S RESDATE=$S(TEST=1:$$RESDATE(RESLSTR,.FIEVAL),1:0)
  1. Q
  1. ;
  1. ;==========================================================
  1. LOGOP(DT1,DT2,LOP) ;Given two dates return the most recent if the logical
  1. ;operator is ! and the oldest if it is &. 'FIs and FFs which don't
  1. ;have a date are flagged with date of -1.
  1. I DT1=0,DT2=0 Q 0
  1. I DT1=-1,DT2=-1 Q -1
  1. N VALUE
  1. I LOP="&" D Q VALUE
  1. . I (DT1=0)!(DT2=0) S VALUE=0 Q
  1. . I (DT1=-1) S VALUE=DT2 Q
  1. . I (DT2=-1) S VALUE=DT1 Q
  1. . S VALUE=$S(DT1>DT2:DT2,1:DT1)
  1. I LOP'="!" Q 0
  1. I DT1=-1 Q $S(DT2>0:DT2,1:-1)
  1. I DT2=-1 Q $S(DT1>0:DT1,1:-1)
  1. Q $S(DT1>DT2:DT1,1:DT2)
  1. ;
  1. ;==========================================================
  1. RESDATE(RESLSTR,FIEVAL) ;Return the resolution date based on the following
  1. ;rules:
  1. ;Dates that are ORed use the most recent.
  1. ;Dates that are ANDed use the oldest.
  1. ;This is routine is called only if the resolution logic is true.
  1. N DATE,DT1,DT2,DT3,FINUM,IND,JND,OPER,PFSTACK,STACK,T1,T2
  1. ;Remove leading (n) entries.
  1. I ($E(RESLSTR,1,4)="(0)!")!($E(RESLSTR,1,4)="(1)&") S $E(RESLSTR,1,4)=""
  1. S OPER="!&'U"
  1. D POSTFIX^PXRMSTAC(RESLSTR,OPER,.PFSTACK)
  1. S (IND,JND)=0
  1. F D Q:(IND'<PFSTACK(0))
  1. . S IND=IND+1,T1=PFSTACK(IND)
  1. . I T1="FI" D Q
  1. .. S IND=IND+1,FINUM=PFSTACK(IND)
  1. ..;Replace true findings with their dates.
  1. .. S DATE=$S(FIEVAL(FINUM)=1:FIEVAL(FINUM,"DATE"),1:0)
  1. .. S JND=JND+1,STACK(JND)=DATE
  1. . I T1="FF" D Q
  1. ..;FFs do not have dates, flag them all with -1.
  1. .. S IND=IND+1,JND=JND+1,STACK(JND)=-1
  1. . I OPER[T1 S JND=JND+1,STACK(JND)=T1
  1. S STACK(0)=JND
  1. K PFSTACK
  1. S PFSTACK(0)=0
  1. F IND=1:1:STACK(0) D
  1. . S T1=STACK(IND)
  1. . I OPER'[T1 D PUSH^PXRMSTAC(.PFSTACK,T1) Q
  1. .;For unary NOT replace the top of the stack with -1.
  1. . I T1="'U" S DT1=$$POP^PXRMSTAC(.PFSTACK) D PUSH^PXRMSTAC(.PFSTACK,-1) Q
  1. .;Pop the top two elements on the stack and do the operation.
  1. . S DT1=$$POP^PXRMSTAC(.PFSTACK)
  1. . S DT2=$$POP^PXRMSTAC(.PFSTACK)
  1. . S DT3=$$LOGOP(DT1,DT2,T1)
  1. .;Save the result back on the stack
  1. . D PUSH^PXRMSTAC(.PFSTACK,DT3)
  1. ;The result is the only thing left on the stack.
  1. Q $$POP^PXRMSTAC(.PFSTACK)
  1. ;
  1. ;==========================================================
  1. SEX(DEFARR,SEX) ;Return FALSE (0) if the patient is the wrong sex for
  1. ; the reminder, TRUE (1) is the patient is the right sex.
  1. N REMSEX
  1. S REMSEX=$P(DEFARR(0),U,9)
  1. I REMSEX="" Q 1
  1. I SEX=REMSEX Q 1
  1. S ^TMP(PXRMPID,$J,PXRMITEM,"N/A","SEX")=""
  1. S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","SEX")="Patient is the wrong sex!"
  1. Q 0
  1. ;
  1. ;==========================================================
  1. VALID(LOGSTR,DA,MINLEN,MAXLEN) ;Make sure that LOGSTR is a valid logic string.
  1. ;This is called by the input transform for PATIENT COHORT LOGIC and
  1. ;RESOLUTION LOGIC. Return 1 if LOGSTR is ok.
  1. ;Don't do this if this is being called as a result of an install
  1. ;through the Exchange Utility.
  1. I $G(PXRMEXCH) Q 1
  1. I LOGSTR="" Q 0
  1. ;
  1. ;Check the length.
  1. N LEN
  1. S LEN=$L(LOGSTR)
  1. I LEN<MINLEN D Q 0
  1. . D EN^DDIOL("Logic string is too short")
  1. I LEN>MAXLEN D Q 0
  1. . D EN^DDIOL("Logic string is too long")
  1. ;
  1. ;Use the FileMan code validator to check the code.
  1. N X
  1. S X="S Y="_$TR(LOGSTR,";","")
  1. D ^DIM
  1. I $D(X)=0 D Q 0
  1. . N TEXT
  1. . S TEXT(1)="LOGIC string: "_LOGSTR
  1. . S TEXT(2)="contains invalid MUMPS code!"
  1. . D EN^DDIOL(.TEXT)
  1. ;
  1. N ELE1,ELE2,MNUM,SEP,STACK,TEXT,TSTSTR,VALID
  1. ;Make sure the entries in LOGSTR are valid elements or functions.
  1. S TSTSTR=LOGSTR
  1. S TSTSTR=$TR(TSTSTR,"'","")
  1. S TSTSTR=$TR(TSTSTR,"&",U)
  1. S TSTSTR=$TR(TSTSTR,"!",U)
  1. ;Set the allowable logic separators.
  1. S SEP="^,<>="
  1. ;Convert the string to postfix form for evaluation.
  1. D POSTFIX^PXRMSTAC(TSTSTR,SEP,.STACK)
  1. S (ELE1,VALID)=1
  1. F Q:(ELE1="")!(VALID=0) D
  1. . S ELE1=$$POP^PXRMSTAC(.STACK)
  1. . I '$$VELEM(ELE1) S VALID=0 Q
  1. . I SEP[ELE1 Q
  1. .;If the element is FI or FF then the next element should be a number.
  1. . S MNUM=$S(ELE1="FI":20,ELE1="FF":25,1:"")
  1. . I MNUM'="" D
  1. .. S ELE2=$$POP^PXRMSTAC(.STACK)
  1. .. I ELE2'=+ELE2 S VALID=0
  1. .. I VALID S VALID=$D(^PXD(811.9,DA,MNUM,ELE2))
  1. .. I 'VALID D
  1. ... S TEXT=ELE1_"("_ELE2_") is not in this definition!"
  1. ... D EN^DDIOL(TEXT)
  1. Q VALID
  1. ;
  1. ;==========================================================
  1. VALIDR(LOGSTR,DA,MINLEN,MAXLEN) ;Make sure that LOGSTR is a valid resolution
  1. ;logic string. This is called by the input transform for RESOLUTION
  1. ;LOGIC. Return 1 if LOGSTR is ok.
  1. ;Don't do this if this is being called as a result of an install
  1. ;through the Exchange Utility.
  1. I $G(PXRMEXCH) Q 1
  1. I LOGSTR="" Q 0
  1. N TEXT
  1. ;The resolution logic cannot contain SEX or AGE.
  1. I LOGSTR["AGE" D Q 0
  1. . S TEXT="The resolution logic cannot contain AGE!"
  1. . D EN^DDIOL(TEXT)
  1. I LOGSTR["SEX" D Q 0
  1. . S TEXT="The resolution logic cannot contain SEX!"
  1. . D EN^DDIOL(TEXT)
  1. ;Now call the regular logic string validator.
  1. Q $$VALID(LOGSTR,DA,MINLEN,MAXLEN)
  1. ;
  1. ;==========================================================
  1. VELEM(ELEMENT) ;Make sure that the element is valid.
  1. I ELEMENT="AGE" Q 1
  1. I ELEMENT="FI" Q 1
  1. I ELEMENT="FF" Q 1
  1. I ELEMENT="SEX" Q 1
  1. I ELEMENT="^" Q 1
  1. I ELEMENT?.N Q 1
  1. D EN^DDIOL(ELEMENT_" is not a valid logic element.")
  1. Q 0
  1. ;