- PXRMICHK ;SLC/PKR - Integrity checking routines. ;05/31/2022
- ;;2.0;CLINICAL REMINDERS;**18,24,26,47,45,42,65**;Feb 04, 2005;Build 438
- ;===============
- ADDTEXT(NIN,TEXT,NL,OUTPUT) ;
- N IND,NOUT,TEXTOUT
- D FORMAT^PXRMTEXT(1,80,NIN,.TEXT,.NOUT,.TEXTOUT)
- F IND=1:1:NOUT S NL=NL+1,OUTPUT(NL)=TEXTOUT(IND)
- Q
- ;
- ;===============
- CCRLOGIC(COHOK,FFOK,RESOK,DEFARR,NL,OUTPUT) ;Check cohort and resolution logic.
- N AGE,FIEVAL,FINDING,FF,FLIST,IND,JND,NUM,OCCN,PCLOG
- N RESLOG,RESLSTR,SEX,TEMP,TEST,TEXT
- N PXRMAGE,PXRMDATE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMSEX,PXRMSIG
- S (PXRMAGE,PXRMDATE,PXRMDOB,PXRMDOD,PXRMLAD)=0
- S (PXRMSEX,PXRMSIG)=""
- ;Set all findings false.
- S (FIEVAL("AGE"),FIEVAL("SEX"))=0
- S IND=0
- F S IND=+$O(DEFARR(20,IND)) Q:IND=0 D
- . S FIEVAL(IND)=0
- . S OCCN=$P(DEFARR(20,IND,0),U,14)
- . F JND=1:1:OCCN S FIEVAL(IND,JND)=0
- ;If there were no problems with the function findings evaluate them
- ;with all findings false.
- I FFOK D EVAL^PXRMFF(.DEFARR,.FIEVAL)
- S PCLOG=DEFARR(31)
- I (PCLOG["FF"),('FFOK) S COHOK=0
- I COHOK D
- . S TEMP=DEFARR(32)
- . S NUM=+$P(TEMP,U,1)
- . I NUM=0 Q
- . S FLIST=$P(TEMP,U,2)
- . F IND=1:1:NUM D
- .. S FINDING=$P(FLIST,";",IND)
- .. I FINDING="AGE" S AGE=+$G(FIEVAL("AGE"))
- .. I FINDING="SEX" S SEX=+$G(FIEVAL("SEX"))
- .. I FINDING["FF" S TEMP=$P(FINDING,"FF",2),FF(TEMP)=FIEVAL(FINDING)
- .. E S FI(FINDING)=FIEVAL(FINDING)
- . I @PCLOG
- . S TEST=$T
- . I TEST D
- .. S TEXT(1)="WARNING: Cohort logic is true even when there are no true findings!"
- .. D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- S (RESLOG,RESLSTR)=DEFARR(35)
- I (RESLOG["FF"),('FFOK) S RESOK=0
- I RESOK D
- . S TEMP=DEFARR(36)
- . S NUM=+$P(TEMP,U,1)
- . I NUM=0 Q
- . S (RESLOG,RESLSTR)=DEFARR(35)
- . S FLIST=$P(TEMP,U,2)
- . F IND=1:1:NUM D
- .. S FINDING=$P(FLIST,";",IND)
- .. I FINDING["FF" S TEMP=$P(FINDING,"FF",2),FF(TEMP)=FIEVAL(FINDING)
- .. E S FI(FINDING)=FIEVAL(FINDING)
- . I @RESLOG
- . S TEST=$T
- . I TEST D
- .. S TEXT(1)="WARNING: Resolution logic is true even when there are no true findings!"
- .. D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- Q
- ;
- ;===============
- CFCHK(USAGE,IND,FIEN,DEFARR,TYPE,NL,OUTPUT) ;Check computed findings.
- N CFNAME,CFPAR,CFPREQ,CFTYPE,OK,TEXT
- S OK=1
- ;Is the Computed Finding Parameter required?
- S CFPREQ=$P(^PXRMD(811.4,FIEN,0),U,6)
- S CFNAME=$P(^PXRMD(811.4,FIEN,0),U,1)
- S CFPAR=$P(DEFARR(20,IND,15),U,1)
- I CFPREQ,CFPAR="" D
- . I TYPE="D" S TEXT(1)="FATAL: Finding number "_IND_" uses computed finding "_CFNAME_"."
- . I TYPE="T" S TEXT(1)="FATAL: Term finding number "_IND_" uses computed finding "_CFNAME_"."
- . S TEXT(2)="This computed finding will not work properly unless the"
- . S TEXT(3)="Computed Finding Parameter is defined and in this case it is not."
- . D ADDTEXT(3,.TEXT,.NL,.OUTPUT)
- . S OK=0
- ;If USAGE is 'L' make sure the CF is list type.
- S CFTYPE=$P(^PXRMD(811.4,FIEN,0),U,5)
- I CFTYPE="" S CFTYPE="S"
- I (USAGE["L"),(CFTYPE'="L") D
- . S CFNAME=$P(^PXRMD(811.4,FIEN,0),U,1)
- . K TEXT
- . I TYPE="D" S TEXT(1)="FATAL: Finding number "_IND_" uses computed finding "_CFNAME_"."
- . I TYPE="T" S TEXT(1)="FATAL: Term finding number "_IND_" uses computed finding "_CFNAME_"."
- . S TEXT(2)="Usage is 'L' and this computed finding's Type is "_CFTYPE_";"
- . S TEXT(3)="the Type must be 'L'."
- . D ADDTEXT(3,.TEXT,.NL,.OUTPUT)
- . S OK=0
- ;If the CF is VA-REMINDER DEFINITION do additional checks.
- I (CFNAME="VA-REMINDER DEFINITION") S OK=$$RDCFCHK(CFNAME,CFPAR,IND,TYPE,.NL,.OUTPUT)
- Q OK
- ;
- ;===============
- CHECKALL ;Check all definitions.
- N IEN,NAME,OK,OUTPUT,POP,PXRMDONE,TEXT
- W #!,"Check the integrity of all reminder definitions."
- D ^%ZIS Q:POP
- U IO
- S NAME="",PXRMDONE=0
- F S NAME=$O(^PXD(811.9,"B",NAME)) Q:(NAME="")!(PXRMDONE) D
- . S IEN=$O(^PXD(811.9,"B",NAME,""))
- . W !!,"Checking "_NAME_" (IEN="_IEN_")"
- . K OUTPUT
- . S OK=$$DEF^PXRMICHK(IEN,.OUTPUT,1)
- D ^%ZISC
- Q
- ;
- ;===============
- CHECKONE ;Check selected definitions.
- N DIC,DTOUT,DUOUT,IEN,OK,OUTPUT,Y
- S DIC="^PXD(811.9,"
- S DIC(0)="AEMQ"
- S DIC("A")="Select Reminder Definition: "
- GETDEF ;Get the definition to check.
- W !
- D ^DIC
- I ($D(DTOUT))!($D(DUOUT)) Q
- I Y=-1 Q
- S IEN=$P(Y,U,1)
- W #
- K OUTPUT
- S OK=$$DEF^PXRMICHK(IEN,.OUTPUT,1)
- G GETDEF
- Q
- ;
- ;===============
- DATECHK(FINDING,DATE,TYPE,DEFARR,NL,OUTPUT) ;Check Beginning and Ending
- ;Date/Times if they contain FIEVAL.
- N ARGS,DFI,DTYPE,OCC,OCN,OK,TEXT
- S OK=1
- S ARGS=$E(DATE,$F(DATE,"FIEVAL("),$F(DATE,"""DATE"")")-9)
- I ARGS="" Q OK
- S DFI=$P(ARGS,",",1)
- I '$D(DEFARR(20,DFI)) D
- . S DTYPE=$S(TYPE="BDT":"Beginning Date/Time",TYPE="EDT":"Ending Date/Time")
- . S TEXT(1)="FATAL: "_DTYPE_" for finding number "_FINDING_" uses finding number "_DFI_" which does not exist."
- . D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- . S OK=0
- I OK D
- . S OCN=$P(ARGS,",",2)
- . I OCN="" Q
- . S OCC=+$P(DEFARR(20,DFI,0),U,14)
- . S OCC=$S(OCC=0:1,OCC>0:OCC,1:-OCC)
- . I OCN>OCC D
- .. S DTYPE=$S(TYPE="BDT":"Beginning Date/Time",TYPE="EDT":"Ending Date/Time")
- .. S TEXT(1)="FATAL: "_DTYPE_" for finding number "_FINDING_" uses occurrence "_OCN_" of finding number "_DFI_";"
- .. S TEXT(2)="the Occurrence Count for finding "_DFI_" is "_OCC_"."
- .. D ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- .. S OK=0
- Q OK
- ;
- ;===============
- DEF(IEN,OUTPUT,WRITE) ;Definition integrity check. 0 is returned if the
- ;definition has fatal errors, otherwise 1 is returned.
- ;Warning and error text is stored in the OUTPUT array. If WRITE=1 then
- ;the contents of OUTPUT will be written out.
- N ARGTYPE,BDT,C1,COHOK,DEF,DEFARR,EDT,FFOK
- N FFNUM,FI,FIEN,FLIST,FNUM,FUNCTION,GBL,IND,JND,KND
- N LOGCHK,LOGINTR,LOGSTR,NBFREQ,NFI,NFFREQ,NL
- N OCC,OCN,OK,RESOK
- N TEXT,USAGE,ZNODE
- S NL=0,OK=1
- ;Check usage.
- S ZNODE=^PXD(811.9,IEN,100)
- S USAGE=$P(ZNODE,U,4)
- I $P(ZNODE,U,1)'="N",USAGE["P" D
- . K TEXT
- . S TEXT(1)="WARNING: Usage field contains a ""P"" and this is not a national reminder definition."
- . D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- ;
- D DEF^PXRMLDR(IEN,.DEFARR)
- S DEF=$P(DEFARR(0),U,1)
- ;
- ;Check findings and finding modifiers.
- S IND=0
- F S IND=+$O(DEFARR(20,IND)) Q:IND=0 D
- . S ZNODE=DEFARR(20,IND,0)
- . S FI=$P(ZNODE,U,1)
- . S FIEN=$P(FI,";",1)
- . S GBL=$P(FI,";",2)
- . I (FIEN'=+FIEN)!(GBL="") D Q
- .. K TEXT
- .. S TEXT(1)="FATAL: Finding number "_IND_" is invalid."
- .. D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- .. S OK=0
- . S FNUM=$$GETFNUM^PXRMEXPS(GBL)
- . I '$$FIND1^DIC(FNUM,"","XU","`"_FIEN) D
- .. K TEXT
- .. S TEXT(1)="FATAL: Finding number "_IND_", does not exist! It is entry number "_FIEN_" in file #"_FNUM_"."
- .. D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- .. S OK=0
- . S BDT=$P(ZNODE,U,8)
- . I BDT["FIEVAL",'$$DATECHK(IND,BDT,"BDT",.DEFARR,.NL,.OUTPUT) S OK=0
- . S EDT=$P(ZNODE,U,11)
- . I EDT["FIEVAL",'$$DATECHK(IND,EDT,"EDT",.DEFARR,.NL,.OUTPUT) S OK=0
- .;Check computed findings.
- . I (GBL="PXRMD(811.4,"),'$$CFCHK(USAGE,IND,FIEN,.DEFARR,"D",.NL,.OUTPUT) S OK=0
- .;Check terms.
- . I (GBL="PXRMD(811.5,"),'$$TERMCHK^PXRMICK1(USAGE,FIEN,.NL,.OUTPUT) S OK=0
- ;
- ;Check for recursion.
- I $$RECCHK(IEN,.NL,.OUTPUT) S OK=0
- ;
- ;Check function findings.
- S FFNUM="FF",FFOK=1
- F S FFNUM=$O(DEFARR(25,FFNUM)) Q:FFNUM="" D
- . S IND=$P(FFNUM,"FF",2)
- .;Check for an invalid function string.
- . I $L($G(DEFARR(25,FFNUM,3)))<2 D Q
- .. K TEXT
- .. S TEXT(1)="FATAL: Function finding number "_IND_" has an invalid function string."
- .. D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- .. S (FFOK,OK)=0
- . S JND=0
- . F S JND=+$O(DEFARR(25,FFNUM,5,JND)) Q:JND=0 D
- .. S FUNCTION=$P(DEFARR(25,FFNUM,5,JND,0),U,2)
- .. S FUNCTION=$P(^PXRMD(802.4,FUNCTION,0),U,1)
- .. S KND=0
- .. F S KND=+$O(DEFARR(25,FFNUM,5,JND,20,KND)) Q:KND=0 D
- ... S ARGTYPE=$$ARGTYPE^PXRMFFAT(FUNCTION,KND)
- ... I ARGTYPE="F" D
- .... S FI=DEFARR(25,FFNUM,5,JND,20,KND,0)
- .... S C1=$E(FI,1)
- .... I (C1="C")!(C1="R") S FI=$E(FI,2,15)
- .... I '$D(DEFARR(20,FI,0)) D
- ..... K TEXT
- ..... S TEXT(1)="FATAL: Function finding number "_IND_" depends on finding number "_FI_" which does not exist."
- ..... D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- ..... S (FFOK,OK)=0
- ... I FFOK,ARGTYPE="N" D
- .... S OCN=DEFARR(25,FFNUM,5,JND,20,KND,0)
- .... S OCC=+$P(DEFARR(20,FI,0),U,14)
- .... S OCC=$S(OCC=0:1,OCC>0:OCC,1:-OCC)
- .... ;Ignore Occurrence Count check for contraindication and refusal findings.
- .... I (C1="C")!(C1="R") S OCN=OCC
- .... I OCN>OCC D
- ..... K TEXT
- ..... S TEXT(1)="FATAL: Function finding number "_IND_" uses occurrence number "_OCN
- ..... S TEXT(2)="of finding number "_FI_"."
- ..... S TEXT(3)="The Occurrence Count for finding "_FI_" is "_OCC_"."
- ..... D ADDTEXT(3,.TEXT,.NL,.OUTPUT)
- ..... S (FFOK,OK)=0
- ;
- ;Check custom date due.
- S IND=0
- F S IND=+$O(DEFARR(47,IND)) Q:IND=0 D
- . S FI=$P(DEFARR(47,IND,0),U,1)
- . I '$D(DEFARR(20,FI,0)) D
- .. K TEXT
- .. S TEXT(1)="FATAL: Custom Date Due depends on finding number "_FI_" which does not exist."
- .. D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- .. S OK=0
- ;
- ;Check cohort logic structure and dependencies.
- S LOGSTR=$G(DEFARR(31))
- ;Run the input transform.
- S LOGINTR=$S(LOGSTR'="":$$VALID^PXRMLOG(LOGSTR,IEN,3,512),1:1)
- S NFI=+$P($G(DEFARR(32)),U,1)
- S FLIST=$P($G(DEFARR(32)),U,2)
- S LOGCHK=$$LOGCHECK(NFI,FLIST,LOGSTR,"Patient Cohort",.DEFARR,.NL,.OUTPUT)
- S COHOK=LOGINTR&LOGCHK
- I 'COHOK D
- . S TEXT(1)="FATAL: Definition has invalid cohort logic.\\"
- . S TEXT(2)=" "_LOGSTR
- . D ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- . S OK=0
- ;
- ;If the USAGE is List, check the cohort logic to make sure it
- ;meets the special requirements.
- I USAGE["L",COHOK S COHOK=$$LCOHORTC(.DEFARR,.NL,.OUTPUT)
- I 'COHOK S OK=0
- ;
- ;Check resolution structure and dependencies.
- S LOGSTR=$G(DEFARR(35))
- ;Run the input transform.
- S LOGINTR=$S(LOGSTR'="":$$VALIDR^PXRMLOG(LOGSTR,IEN,5,512),1:1)
- S NFI=+$P($G(DEFARR(36)),U,1)
- S FLIST=$P($G(DEFARR(36)),U,2)
- S LOGCHK=$$LOGCHECK(NFI,FLIST,LOGSTR,"Resolution",.DEFARR,.NL,.OUTPUT)
- S RESOK=LOGINTR&LOGCHK
- I 'RESOK D
- . S TEXT(1)="FATAL: Definition has invalid resolution logic.\\"
- . S TEXT(2)=" "_LOGSTR
- . D ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- . S OK=0
- ;
- ;Make other checks for bad cohort and resolution logic; these are
- ;all just warnings.
- D CCRLOGIC(COHOK,FFOK,RESOK,.DEFARR,.NL,.OUTPUT)
- ;
- ;Check for frequencies, a frequency is required if there is resolution
- ;logic.
- S (IND,NBFREQ,NFFREQ)=0
- F S IND=+$O(DEFARR(7,IND)) Q:IND=0 S NBFREQ=NBFREQ+1
- I NBFREQ=0 D
- . K TEXT
- . S TEXT(1)="WARNING: No baseline frequencies are defined."
- . D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- I NBFREQ=0 D
- . S IND=0
- . F S IND=+$O(DEFARR(20,IND)) Q:IND=0 I $P(DEFARR(20,IND,0),U,4)'="" S NFFREQ=NFFREQ+1
- . S IND="FF"
- . F S IND=$O(DEFARR(25,IND)) Q:IND="" I $P(DEFARR(25,IND,0),U,4)'="" S NFFREQ=NFFREQ+1
- I (NBFREQ=0),(NFFREQ=0),(DEFARR(35)'="") D
- . K TEXT
- . S TEXT(1)="FATAL: Definition has resolution logic but no baseline frequencies."
- . S TEXT(2)="Also there are no findings or function findings that set a frequency."
- . D ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- . S OK=0
- . I (NBFREQ=0),(NFFREQ>0),(DEFARR(35)'="") D
- . K TEXT
- . S TEXT(1)="WARNING: Definition has resolution logic but no baseline frequencies."
- . S TEXT(2)="There are findings that set a frequency but if they are all false there will not be a frequency."
- . D ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- K TEXT
- I OK S TEXT(1)="No fatal reminder definition errors were found."
- E S TEXT(1)="This reminder definition has fatal errors and it will not work!"
- D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- I WRITE=1 D OUTPUT^PXRMICK1(NL,.OUTPUT)
- Q OK
- ;
- ;===============
- LCOHORTC(DEFARR,NL,OUTPUT) ;Check list type reminder cohort logic for special
- ;requirements.
- N IND,MAXAGE,MINAGE,NL,OK,PCLOG,TEXT
- S (OK,NL)=1
- S PCLOG=DEFARR(31)
- ;The cohort logic cannot start with a logical not.
- I $E(PCLOG,1)="'" D
- . S NL=NL+1
- . S TEXT(NL)="The cohort logic cannot start with a logical not.\\"
- . S OK=0
- I PCLOG["!'" D
- . S NL=NL+1
- . S TEXT(NL)="The cohort logic cannot contain !' (OR NOT).\\"
- . S OK=0
- I PCLOG["AGE" D
- .;Make sure a baseline age range is defined.
- . S IND=0 F S IND=$O(DEFARR(7,IND)) Q:(IND="") Q:(DEFARR(7,IND,0)'="")
- . S MINAGE=$S(IND="":0,1:+$P($G(DEFARR(7,IND,0)),U,2))
- . S MAXAGE=$S(IND="":0,1:+$P($G(DEFARR(7,IND,0)),U,3))
- . I (MINAGE=0),(MAXAGE=0) D
- .. S NL=NL+1
- .. S TEXT(NL)="The cohort logic contains AGE but no baseline age range is defined.\\"
- .. S OK=0
- I PCLOG["SEX" D
- . I $P(DEFARR(0),U,9)="" D
- .. S NL=NL+1
- .. S TEXT(NL)="The cohort logic contains SEX but the SEX SPECIFIC field is not defined.\\"
- .. S OK=0
- I PCLOG["SEX" D
- . N PFSTACK
- . D POSTFIX^PXRMSTAC(PCLOG,"!&",.PFSTACK)
- . I PFSTACK(1)'="SEX" Q
- . I (PFSTACK(2)'="AGE")!(PFSTACK(3)'="&") D
- .. S NL=NL+1
- .. S TEXT(NL)="The cohort logic starts with SEX but SEX is not logically ANDED with AGE.\\"
- .. S OK=0
- I 'OK D
- . S TEXT(1)="FATAL: List type definitions have the following restrictions:\\"
- . D ADDTEXT(NL,.TEXT,.NL,.OUTPUT)
- Q OK
- ;
- ;===============
- LOGCHECK(NFI,FLIST,LOGSTR,TYPE,DEFARR,NL,OUTPUT) ;Verify logic strings.
- ;Make sure the findings exist and the syntax is correct.
- N FFNUM,FI,IND,OK,TEXT,X
- S OK=1
- I NFI=0 D Q OK
- . S TEXT(1)="WARNING: There is no "_TYPE_" logic."
- . D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- F IND=1:1:NFI D
- . S FI=$P(FLIST,";",IND)
- . I FI=+FI D
- .. I '$D(DEFARR(20,FI,0)) D
- ... S TEXT(1)="FATAL: "_TYPE_" logic uses finding "_FI_" which does not exist."
- ... D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- ... S OK=0
- . I FI["FF" D
- .. I '$D(DEFARR(25,FI,0)) D
- ... S FFNUM=$P(FI,"FF",2)
- ... S TEXT(1)="Fatal :"_TYPE_" logic uses function finding "_FFNUM_" which does not exist."
- ... D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- ... S OK=0
- S X="S Y="_LOGSTR
- D ^DIM
- I '$D(X) D
- . S TEXT(1)="FATAL: "_TYPE_" logic syntax is invalid."
- . D ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- . S OK=0
- Q OK
- ;
- ;===============
- RDCFCHK(CFNAME,CFPAR,IND,TYPE,NL,OUTPUT) ;Additional checks when the computed
- ;finding is VA-REMINDER DEFINTION.
- ;A blank Computed Finding Parameter has already been checked for.
- I CFPAR="" Q 0
- N NDEFIEN,RECUR,TEXT
- S NDEFIEN=$S(+CFPAR=CFPAR:+CFPAR,1:$O(^PXD(811.9,"B",CFPAR,"")))
- I NDEFIEN="" D Q 0
- . I TYPE="D" S TEXT(1)="FATAL: Finding number "_IND_" uses computed finding "_CFNAME_"."
- . I TYPE="T" S TEXT(1)="FATAL: Term finding number "_IND_" uses computed finding "_CFNAME_"."
- . S TEXT(2)="The Computed Finding Parameter is set to "_CFPAR_", that reminder does not exist."
- . D ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- ;Usage check.
- S USAGE=$P(^PXD(811.9,NDEFIEN,100),U,4)
- I USAGE["L" D Q 0
- . I TYPE="D" S TEXT(1)="FATAL: Finding number "_IND_" uses computed finding "_CFNAME_"."
- . I TYPE="T" S TEXT(1)="FATAL: Term finding number "_IND_" uses computed finding "_CFNAME_"."
- . S TEXT(2)="The Computed Finding Parameter is set to "_CFPAR_", the Usage for that reminder contains L."
- . S TEXT(3)="List type reminders cannot be used with VA-REMINDER DEFINITION."
- . D ADDTEXT(3,.TEXT,.NL,.OUTPUT)
- Q 1
- ;
- ;===============
- RECCHK(DEFIEN,NL,OUTPUT) ;Check for recursion
- N RECUR,P1,P2,P3,TEXT,TYPE
- S RECUR=$$RECCHK^PXRMRCUR(DEFIEN)
- S P1=$P(RECUR,U,1)
- I P1 D
- . N DEFNAME
- . S DEFNAME=$P(^PXD(811.9,DEFIEN,0),U,1)
- . S P2=$P(RECUR,U,2)
- . S P3=$P(RECUR,U,3)
- . S TYPE=$S(P3'="":"T",1:"D")
- . I TYPE="D" D
- .. S TEXT(1)="FATAL: Finding number "_$P(P2,";",3)_" uses CF.VA-REMINDER DEFINITION."
- .. S TEXT(2)="It is recursively calling definition "_DEFNAME_"."
- . I TYPE="T" D
- .. N TNAME
- .. S TNAME=$P(^PXRMD(811.5,$P(P3,";",2),0),U,1)
- .. S TEXT(1)="FATAL: Finding number "_$P(P2,";",3)_" uses term "_TNAME_"."
- .. S TEXT(2)="This term is recursively calling definition "_DEFNAME_"."
- . D ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- Q P1
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMICHK 15862 printed Jan 18, 2025@02:47:20 Page 2
- PXRMICHK ;SLC/PKR - Integrity checking routines. ;05/31/2022
- +1 ;;2.0;CLINICAL REMINDERS;**18,24,26,47,45,42,65**;Feb 04, 2005;Build 438
- +2 ;===============
- ADDTEXT(NIN,TEXT,NL,OUTPUT) ;
- +1 NEW IND,NOUT,TEXTOUT
- +2 DO FORMAT^PXRMTEXT(1,80,NIN,.TEXT,.NOUT,.TEXTOUT)
- +3 FOR IND=1:1:NOUT
- SET NL=NL+1
- SET OUTPUT(NL)=TEXTOUT(IND)
- +4 QUIT
- +5 ;
- +6 ;===============
- CCRLOGIC(COHOK,FFOK,RESOK,DEFARR,NL,OUTPUT) ;Check cohort and resolution logic.
- +1 NEW AGE,FIEVAL,FINDING,FF,FLIST,IND,JND,NUM,OCCN,PCLOG
- +2 NEW RESLOG,RESLSTR,SEX,TEMP,TEST,TEXT
- +3 NEW PXRMAGE,PXRMDATE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMSEX,PXRMSIG
- +4 SET (PXRMAGE,PXRMDATE,PXRMDOB,PXRMDOD,PXRMLAD)=0
- +5 SET (PXRMSEX,PXRMSIG)=""
- +6 ;Set all findings false.
- +7 SET (FIEVAL("AGE"),FIEVAL("SEX"))=0
- +8 SET IND=0
- +9 FOR
- SET IND=+$ORDER(DEFARR(20,IND))
- if IND=0
- QUIT
- Begin DoDot:1
- +10 SET FIEVAL(IND)=0
- +11 SET OCCN=$PIECE(DEFARR(20,IND,0),U,14)
- +12 FOR JND=1:1:OCCN
- SET FIEVAL(IND,JND)=0
- End DoDot:1
- +13 ;If there were no problems with the function findings evaluate them
- +14 ;with all findings false.
- +15 IF FFOK
- DO EVAL^PXRMFF(.DEFARR,.FIEVAL)
- +16 SET PCLOG=DEFARR(31)
- +17 IF (PCLOG["FF")
- IF ('FFOK)
- SET COHOK=0
- +18 IF COHOK
- Begin DoDot:1
- +19 SET TEMP=DEFARR(32)
- +20 SET NUM=+$PIECE(TEMP,U,1)
- +21 IF NUM=0
- QUIT
- +22 SET FLIST=$PIECE(TEMP,U,2)
- +23 FOR IND=1:1:NUM
- Begin DoDot:2
- +24 SET FINDING=$PIECE(FLIST,";",IND)
- +25 IF FINDING="AGE"
- SET AGE=+$GET(FIEVAL("AGE"))
- +26 IF FINDING="SEX"
- SET SEX=+$GET(FIEVAL("SEX"))
- +27 IF FINDING["FF"
- SET TEMP=$PIECE(FINDING,"FF",2)
- SET FF(TEMP)=FIEVAL(FINDING)
- +28 IF '$TEST
- SET FI(FINDING)=FIEVAL(FINDING)
- End DoDot:2
- +29 IF @PCLOG
- +30 SET TEST=$TEST
- +31 IF TEST
- Begin DoDot:2
- +32 SET TEXT(1)="WARNING: Cohort logic is true even when there are no true findings!"
- +33 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- End DoDot:2
- End DoDot:1
- +34 SET (RESLOG,RESLSTR)=DEFARR(35)
- +35 IF (RESLOG["FF")
- IF ('FFOK)
- SET RESOK=0
- +36 IF RESOK
- Begin DoDot:1
- +37 SET TEMP=DEFARR(36)
- +38 SET NUM=+$PIECE(TEMP,U,1)
- +39 IF NUM=0
- QUIT
- +40 SET (RESLOG,RESLSTR)=DEFARR(35)
- +41 SET FLIST=$PIECE(TEMP,U,2)
- +42 FOR IND=1:1:NUM
- Begin DoDot:2
- +43 SET FINDING=$PIECE(FLIST,";",IND)
- +44 IF FINDING["FF"
- SET TEMP=$PIECE(FINDING,"FF",2)
- SET FF(TEMP)=FIEVAL(FINDING)
- +45 IF '$TEST
- SET FI(FINDING)=FIEVAL(FINDING)
- End DoDot:2
- +46 IF @RESLOG
- +47 SET TEST=$TEST
- +48 IF TEST
- Begin DoDot:2
- +49 SET TEXT(1)="WARNING: Resolution logic is true even when there are no true findings!"
- +50 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- End DoDot:2
- End DoDot:1
- +51 QUIT
- +52 ;
- +53 ;===============
- CFCHK(USAGE,IND,FIEN,DEFARR,TYPE,NL,OUTPUT) ;Check computed findings.
- +1 NEW CFNAME,CFPAR,CFPREQ,CFTYPE,OK,TEXT
- +2 SET OK=1
- +3 ;Is the Computed Finding Parameter required?
- +4 SET CFPREQ=$PIECE(^PXRMD(811.4,FIEN,0),U,6)
- +5 SET CFNAME=$PIECE(^PXRMD(811.4,FIEN,0),U,1)
- +6 SET CFPAR=$PIECE(DEFARR(20,IND,15),U,1)
- +7 IF CFPREQ
- IF CFPAR=""
- Begin DoDot:1
- +8 IF TYPE="D"
- SET TEXT(1)="FATAL: Finding number "_IND_" uses computed finding "_CFNAME_"."
- +9 IF TYPE="T"
- SET TEXT(1)="FATAL: Term finding number "_IND_" uses computed finding "_CFNAME_"."
- +10 SET TEXT(2)="This computed finding will not work properly unless the"
- +11 SET TEXT(3)="Computed Finding Parameter is defined and in this case it is not."
- +12 DO ADDTEXT(3,.TEXT,.NL,.OUTPUT)
- +13 SET OK=0
- End DoDot:1
- +14 ;If USAGE is 'L' make sure the CF is list type.
- +15 SET CFTYPE=$PIECE(^PXRMD(811.4,FIEN,0),U,5)
- +16 IF CFTYPE=""
- SET CFTYPE="S"
- +17 IF (USAGE["L")
- IF (CFTYPE'="L")
- Begin DoDot:1
- +18 SET CFNAME=$PIECE(^PXRMD(811.4,FIEN,0),U,1)
- +19 KILL TEXT
- +20 IF TYPE="D"
- SET TEXT(1)="FATAL: Finding number "_IND_" uses computed finding "_CFNAME_"."
- +21 IF TYPE="T"
- SET TEXT(1)="FATAL: Term finding number "_IND_" uses computed finding "_CFNAME_"."
- +22 SET TEXT(2)="Usage is 'L' and this computed finding's Type is "_CFTYPE_";"
- +23 SET TEXT(3)="the Type must be 'L'."
- +24 DO ADDTEXT(3,.TEXT,.NL,.OUTPUT)
- +25 SET OK=0
- End DoDot:1
- +26 ;If the CF is VA-REMINDER DEFINITION do additional checks.
- +27 IF (CFNAME="VA-REMINDER DEFINITION")
- SET OK=$$RDCFCHK(CFNAME,CFPAR,IND,TYPE,.NL,.OUTPUT)
- +28 QUIT OK
- +29 ;
- +30 ;===============
- CHECKALL ;Check all definitions.
- +1 NEW IEN,NAME,OK,OUTPUT,POP,PXRMDONE,TEXT
- +2 WRITE #!,"Check the integrity of all reminder definitions."
- +3 DO ^%ZIS
- if POP
- QUIT
- +4 USE IO
- +5 SET NAME=""
- SET PXRMDONE=0
- +6 FOR
- SET NAME=$ORDER(^PXD(811.9,"B",NAME))
- if (NAME="")!(PXRMDONE)
- QUIT
- Begin DoDot:1
- +7 SET IEN=$ORDER(^PXD(811.9,"B",NAME,""))
- +8 WRITE !!,"Checking "_NAME_" (IEN="_IEN_")"
- +9 KILL OUTPUT
- +10 SET OK=$$DEF^PXRMICHK(IEN,.OUTPUT,1)
- End DoDot:1
- +11 DO ^%ZISC
- +12 QUIT
- +13 ;
- +14 ;===============
- CHECKONE ;Check selected definitions.
- +1 NEW DIC,DTOUT,DUOUT,IEN,OK,OUTPUT,Y
- +2 SET DIC="^PXD(811.9,"
- +3 SET DIC(0)="AEMQ"
- +4 SET DIC("A")="Select Reminder Definition: "
- GETDEF ;Get the definition to check.
- +1 WRITE !
- +2 DO ^DIC
- +3 IF ($DATA(DTOUT))!($DATA(DUOUT))
- QUIT
- +4 IF Y=-1
- QUIT
- +5 SET IEN=$PIECE(Y,U,1)
- +6 WRITE #
- +7 KILL OUTPUT
- +8 SET OK=$$DEF^PXRMICHK(IEN,.OUTPUT,1)
- +9 GOTO GETDEF
- +10 QUIT
- +11 ;
- +12 ;===============
- DATECHK(FINDING,DATE,TYPE,DEFARR,NL,OUTPUT) ;Check Beginning and Ending
- +1 ;Date/Times if they contain FIEVAL.
- +2 NEW ARGS,DFI,DTYPE,OCC,OCN,OK,TEXT
- +3 SET OK=1
- +4 SET ARGS=$EXTRACT(DATE,$FIND(DATE,"FIEVAL("),$FIND(DATE,"""DATE"")")-9)
- +5 IF ARGS=""
- QUIT OK
- +6 SET DFI=$PIECE(ARGS,",",1)
- +7 IF '$DATA(DEFARR(20,DFI))
- Begin DoDot:1
- +8 SET DTYPE=$SELECT(TYPE="BDT":"Beginning Date/Time",TYPE="EDT":"Ending Date/Time")
- +9 SET TEXT(1)="FATAL: "_DTYPE_" for finding number "_FINDING_" uses finding number "_DFI_" which does not exist."
- +10 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +11 SET OK=0
- End DoDot:1
- +12 IF OK
- Begin DoDot:1
- +13 SET OCN=$PIECE(ARGS,",",2)
- +14 IF OCN=""
- QUIT
- +15 SET OCC=+$PIECE(DEFARR(20,DFI,0),U,14)
- +16 SET OCC=$SELECT(OCC=0:1,OCC>0:OCC,1:-OCC)
- +17 IF OCN>OCC
- Begin DoDot:2
- +18 SET DTYPE=$SELECT(TYPE="BDT":"Beginning Date/Time",TYPE="EDT":"Ending Date/Time")
- +19 SET TEXT(1)="FATAL: "_DTYPE_" for finding number "_FINDING_" uses occurrence "_OCN_" of finding number "_DFI_";"
- +20 SET TEXT(2)="the Occurrence Count for finding "_DFI_" is "_OCC_"."
- +21 DO ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- +22 SET OK=0
- End DoDot:2
- End DoDot:1
- +23 QUIT OK
- +24 ;
- +25 ;===============
- DEF(IEN,OUTPUT,WRITE) ;Definition integrity check. 0 is returned if the
- +1 ;definition has fatal errors, otherwise 1 is returned.
- +2 ;Warning and error text is stored in the OUTPUT array. If WRITE=1 then
- +3 ;the contents of OUTPUT will be written out.
- +4 NEW ARGTYPE,BDT,C1,COHOK,DEF,DEFARR,EDT,FFOK
- +5 NEW FFNUM,FI,FIEN,FLIST,FNUM,FUNCTION,GBL,IND,JND,KND
- +6 NEW LOGCHK,LOGINTR,LOGSTR,NBFREQ,NFI,NFFREQ,NL
- +7 NEW OCC,OCN,OK,RESOK
- +8 NEW TEXT,USAGE,ZNODE
- +9 SET NL=0
- SET OK=1
- +10 ;Check usage.
- +11 SET ZNODE=^PXD(811.9,IEN,100)
- +12 SET USAGE=$PIECE(ZNODE,U,4)
- +13 IF $PIECE(ZNODE,U,1)'="N"
- IF USAGE["P"
- Begin DoDot:1
- +14 KILL TEXT
- +15 SET TEXT(1)="WARNING: Usage field contains a ""P"" and this is not a national reminder definition."
- +16 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- End DoDot:1
- +17 ;
- +18 DO DEF^PXRMLDR(IEN,.DEFARR)
- +19 SET DEF=$PIECE(DEFARR(0),U,1)
- +20 ;
- +21 ;Check findings and finding modifiers.
- +22 SET IND=0
- +23 FOR
- SET IND=+$ORDER(DEFARR(20,IND))
- if IND=0
- QUIT
- Begin DoDot:1
- +24 SET ZNODE=DEFARR(20,IND,0)
- +25 SET FI=$PIECE(ZNODE,U,1)
- +26 SET FIEN=$PIECE(FI,";",1)
- +27 SET GBL=$PIECE(FI,";",2)
- +28 IF (FIEN'=+FIEN)!(GBL="")
- Begin DoDot:2
- +29 KILL TEXT
- +30 SET TEXT(1)="FATAL: Finding number "_IND_" is invalid."
- +31 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +32 SET OK=0
- End DoDot:2
- QUIT
- +33 SET FNUM=$$GETFNUM^PXRMEXPS(GBL)
- +34 IF '$$FIND1^DIC(FNUM,"","XU","`"_FIEN)
- Begin DoDot:2
- +35 KILL TEXT
- +36 SET TEXT(1)="FATAL: Finding number "_IND_", does not exist! It is entry number "_FIEN_" in file #"_FNUM_"."
- +37 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +38 SET OK=0
- End DoDot:2
- +39 SET BDT=$PIECE(ZNODE,U,8)
- +40 IF BDT["FIEVAL"
- IF '$$DATECHK(IND,BDT,"BDT",.DEFARR,.NL,.OUTPUT)
- SET OK=0
- +41 SET EDT=$PIECE(ZNODE,U,11)
- +42 IF EDT["FIEVAL"
- IF '$$DATECHK(IND,EDT,"EDT",.DEFARR,.NL,.OUTPUT)
- SET OK=0
- +43 ;Check computed findings.
- +44 IF (GBL="PXRMD(811.4,")
- IF '$$CFCHK(USAGE,IND,FIEN,.DEFARR,"D",.NL,.OUTPUT)
- SET OK=0
- +45 ;Check terms.
- +46 IF (GBL="PXRMD(811.5,")
- IF '$$TERMCHK^PXRMICK1(USAGE,FIEN,.NL,.OUTPUT)
- SET OK=0
- End DoDot:1
- +47 ;
- +48 ;Check for recursion.
- +49 IF $$RECCHK(IEN,.NL,.OUTPUT)
- SET OK=0
- +50 ;
- +51 ;Check function findings.
- +52 SET FFNUM="FF"
- SET FFOK=1
- +53 FOR
- SET FFNUM=$ORDER(DEFARR(25,FFNUM))
- if FFNUM=""
- QUIT
- Begin DoDot:1
- +54 SET IND=$PIECE(FFNUM,"FF",2)
- +55 ;Check for an invalid function string.
- +56 IF $LENGTH($GET(DEFARR(25,FFNUM,3)))<2
- Begin DoDot:2
- +57 KILL TEXT
- +58 SET TEXT(1)="FATAL: Function finding number "_IND_" has an invalid function string."
- +59 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +60 SET (FFOK,OK)=0
- End DoDot:2
- QUIT
- +61 SET JND=0
- +62 FOR
- SET JND=+$ORDER(DEFARR(25,FFNUM,5,JND))
- if JND=0
- QUIT
- Begin DoDot:2
- +63 SET FUNCTION=$PIECE(DEFARR(25,FFNUM,5,JND,0),U,2)
- +64 SET FUNCTION=$PIECE(^PXRMD(802.4,FUNCTION,0),U,1)
- +65 SET KND=0
- +66 FOR
- SET KND=+$ORDER(DEFARR(25,FFNUM,5,JND,20,KND))
- if KND=0
- QUIT
- Begin DoDot:3
- +67 SET ARGTYPE=$$ARGTYPE^PXRMFFAT(FUNCTION,KND)
- +68 IF ARGTYPE="F"
- Begin DoDot:4
- +69 SET FI=DEFARR(25,FFNUM,5,JND,20,KND,0)
- +70 SET C1=$EXTRACT(FI,1)
- +71 IF (C1="C")!(C1="R")
- SET FI=$EXTRACT(FI,2,15)
- +72 IF '$DATA(DEFARR(20,FI,0))
- Begin DoDot:5
- +73 KILL TEXT
- +74 SET TEXT(1)="FATAL: Function finding number "_IND_" depends on finding number "_FI_" which does not exist."
- +75 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +76 SET (FFOK,OK)=0
- End DoDot:5
- End DoDot:4
- +77 IF FFOK
- IF ARGTYPE="N"
- Begin DoDot:4
- +78 SET OCN=DEFARR(25,FFNUM,5,JND,20,KND,0)
- +79 SET OCC=+$PIECE(DEFARR(20,FI,0),U,14)
- +80 SET OCC=$SELECT(OCC=0:1,OCC>0:OCC,1:-OCC)
- +81 ;Ignore Occurrence Count check for contraindication and refusal findings.
- +82 IF (C1="C")!(C1="R")
- SET OCN=OCC
- +83 IF OCN>OCC
- Begin DoDot:5
- +84 KILL TEXT
- +85 SET TEXT(1)="FATAL: Function finding number "_IND_" uses occurrence number "_OCN
- +86 SET TEXT(2)="of finding number "_FI_"."
- +87 SET TEXT(3)="The Occurrence Count for finding "_FI_" is "_OCC_"."
- +88 DO ADDTEXT(3,.TEXT,.NL,.OUTPUT)
- +89 SET (FFOK,OK)=0
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +90 ;
- +91 ;Check custom date due.
- +92 SET IND=0
- +93 FOR
- SET IND=+$ORDER(DEFARR(47,IND))
- if IND=0
- QUIT
- Begin DoDot:1
- +94 SET FI=$PIECE(DEFARR(47,IND,0),U,1)
- +95 IF '$DATA(DEFARR(20,FI,0))
- Begin DoDot:2
- +96 KILL TEXT
- +97 SET TEXT(1)="FATAL: Custom Date Due depends on finding number "_FI_" which does not exist."
- +98 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +99 SET OK=0
- End DoDot:2
- End DoDot:1
- +100 ;
- +101 ;Check cohort logic structure and dependencies.
- +102 SET LOGSTR=$GET(DEFARR(31))
- +103 ;Run the input transform.
- +104 SET LOGINTR=$SELECT(LOGSTR'="":$$VALID^PXRMLOG(LOGSTR,IEN,3,512),1:1)
- +105 SET NFI=+$PIECE($GET(DEFARR(32)),U,1)
- +106 SET FLIST=$PIECE($GET(DEFARR(32)),U,2)
- +107 SET LOGCHK=$$LOGCHECK(NFI,FLIST,LOGSTR,"Patient Cohort",.DEFARR,.NL,.OUTPUT)
- +108 SET COHOK=LOGINTR&LOGCHK
- +109 IF 'COHOK
- Begin DoDot:1
- +110 SET TEXT(1)="FATAL: Definition has invalid cohort logic.\\"
- +111 SET TEXT(2)=" "_LOGSTR
- +112 DO ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- +113 SET OK=0
- End DoDot:1
- +114 ;
- +115 ;If the USAGE is List, check the cohort logic to make sure it
- +116 ;meets the special requirements.
- +117 IF USAGE["L"
- IF COHOK
- SET COHOK=$$LCOHORTC(.DEFARR,.NL,.OUTPUT)
- +118 IF 'COHOK
- SET OK=0
- +119 ;
- +120 ;Check resolution structure and dependencies.
- +121 SET LOGSTR=$GET(DEFARR(35))
- +122 ;Run the input transform.
- +123 SET LOGINTR=$SELECT(LOGSTR'="":$$VALIDR^PXRMLOG(LOGSTR,IEN,5,512),1:1)
- +124 SET NFI=+$PIECE($GET(DEFARR(36)),U,1)
- +125 SET FLIST=$PIECE($GET(DEFARR(36)),U,2)
- +126 SET LOGCHK=$$LOGCHECK(NFI,FLIST,LOGSTR,"Resolution",.DEFARR,.NL,.OUTPUT)
- +127 SET RESOK=LOGINTR&LOGCHK
- +128 IF 'RESOK
- Begin DoDot:1
- +129 SET TEXT(1)="FATAL: Definition has invalid resolution logic.\\"
- +130 SET TEXT(2)=" "_LOGSTR
- +131 DO ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- +132 SET OK=0
- End DoDot:1
- +133 ;
- +134 ;Make other checks for bad cohort and resolution logic; these are
- +135 ;all just warnings.
- +136 DO CCRLOGIC(COHOK,FFOK,RESOK,.DEFARR,.NL,.OUTPUT)
- +137 ;
- +138 ;Check for frequencies, a frequency is required if there is resolution
- +139 ;logic.
- +140 SET (IND,NBFREQ,NFFREQ)=0
- +141 FOR
- SET IND=+$ORDER(DEFARR(7,IND))
- if IND=0
- QUIT
- SET NBFREQ=NBFREQ+1
- +142 IF NBFREQ=0
- Begin DoDot:1
- +143 KILL TEXT
- +144 SET TEXT(1)="WARNING: No baseline frequencies are defined."
- +145 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- End DoDot:1
- +146 IF NBFREQ=0
- Begin DoDot:1
- +147 SET IND=0
- +148 FOR
- SET IND=+$ORDER(DEFARR(20,IND))
- if IND=0
- QUIT
- IF $PIECE(DEFARR(20,IND,0),U,4)'=""
- SET NFFREQ=NFFREQ+1
- +149 SET IND="FF"
- +150 FOR
- SET IND=$ORDER(DEFARR(25,IND))
- if IND=""
- QUIT
- IF $PIECE(DEFARR(25,IND,0),U,4)'=""
- SET NFFREQ=NFFREQ+1
- End DoDot:1
- +151 IF (NBFREQ=0)
- IF (NFFREQ=0)
- IF (DEFARR(35)'="")
- Begin DoDot:1
- +152 KILL TEXT
- +153 SET TEXT(1)="FATAL: Definition has resolution logic but no baseline frequencies."
- +154 SET TEXT(2)="Also there are no findings or function findings that set a frequency."
- +155 DO ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- +156 SET OK=0
- +157 IF (NBFREQ=0)
- IF (NFFREQ>0)
- IF (DEFARR(35)'="")
- Begin DoDot:2
- End DoDot:2
- +158 KILL TEXT
- +159 SET TEXT(1)="WARNING: Definition has resolution logic but no baseline frequencies."
- +160 SET TEXT(2)="There are findings that set a frequency but if they are all false there will not be a frequency."
- +161 DO ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- End DoDot:1
- +162 KILL TEXT
- +163 IF OK
- SET TEXT(1)="No fatal reminder definition errors were found."
- +164 IF '$TEST
- SET TEXT(1)="This reminder definition has fatal errors and it will not work!"
- +165 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +166 IF WRITE=1
- DO OUTPUT^PXRMICK1(NL,.OUTPUT)
- +167 QUIT OK
- +168 ;
- +169 ;===============
- LCOHORTC(DEFARR,NL,OUTPUT) ;Check list type reminder cohort logic for special
- +1 ;requirements.
- +2 NEW IND,MAXAGE,MINAGE,NL,OK,PCLOG,TEXT
- +3 SET (OK,NL)=1
- +4 SET PCLOG=DEFARR(31)
- +5 ;The cohort logic cannot start with a logical not.
- +6 IF $EXTRACT(PCLOG,1)="'"
- Begin DoDot:1
- +7 SET NL=NL+1
- +8 SET TEXT(NL)="The cohort logic cannot start with a logical not.\\"
- +9 SET OK=0
- End DoDot:1
- +10 IF PCLOG["!'"
- Begin DoDot:1
- +11 SET NL=NL+1
- +12 SET TEXT(NL)="The cohort logic cannot contain !' (OR NOT).\\"
- +13 SET OK=0
- End DoDot:1
- +14 IF PCLOG["AGE"
- Begin DoDot:1
- +15 ;Make sure a baseline age range is defined.
- +16 SET IND=0
- FOR
- SET IND=$ORDER(DEFARR(7,IND))
- if (IND="")
- QUIT
- if (DEFARR(7,IND,0)'="")
- QUIT
- +17 SET MINAGE=$SELECT(IND="":0,1:+$PIECE($GET(DEFARR(7,IND,0)),U,2))
- +18 SET MAXAGE=$SELECT(IND="":0,1:+$PIECE($GET(DEFARR(7,IND,0)),U,3))
- +19 IF (MINAGE=0)
- IF (MAXAGE=0)
- Begin DoDot:2
- +20 SET NL=NL+1
- +21 SET TEXT(NL)="The cohort logic contains AGE but no baseline age range is defined.\\"
- +22 SET OK=0
- End DoDot:2
- End DoDot:1
- +23 IF PCLOG["SEX"
- Begin DoDot:1
- +24 IF $PIECE(DEFARR(0),U,9)=""
- Begin DoDot:2
- +25 SET NL=NL+1
- +26 SET TEXT(NL)="The cohort logic contains SEX but the SEX SPECIFIC field is not defined.\\"
- +27 SET OK=0
- End DoDot:2
- End DoDot:1
- +28 IF PCLOG["SEX"
- Begin DoDot:1
- +29 NEW PFSTACK
- +30 DO POSTFIX^PXRMSTAC(PCLOG,"!&",.PFSTACK)
- +31 IF PFSTACK(1)'="SEX"
- QUIT
- +32 IF (PFSTACK(2)'="AGE")!(PFSTACK(3)'="&")
- Begin DoDot:2
- +33 SET NL=NL+1
- +34 SET TEXT(NL)="The cohort logic starts with SEX but SEX is not logically ANDED with AGE.\\"
- +35 SET OK=0
- End DoDot:2
- End DoDot:1
- +36 IF 'OK
- Begin DoDot:1
- +37 SET TEXT(1)="FATAL: List type definitions have the following restrictions:\\"
- +38 DO ADDTEXT(NL,.TEXT,.NL,.OUTPUT)
- End DoDot:1
- +39 QUIT OK
- +40 ;
- +41 ;===============
- LOGCHECK(NFI,FLIST,LOGSTR,TYPE,DEFARR,NL,OUTPUT) ;Verify logic strings.
- +1 ;Make sure the findings exist and the syntax is correct.
- +2 NEW FFNUM,FI,IND,OK,TEXT,X
- +3 SET OK=1
- +4 IF NFI=0
- Begin DoDot:1
- +5 SET TEXT(1)="WARNING: There is no "_TYPE_" logic."
- +6 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- End DoDot:1
- QUIT OK
- +7 FOR IND=1:1:NFI
- Begin DoDot:1
- +8 SET FI=$PIECE(FLIST,";",IND)
- +9 IF FI=+FI
- Begin DoDot:2
- +10 IF '$DATA(DEFARR(20,FI,0))
- Begin DoDot:3
- +11 SET TEXT(1)="FATAL: "_TYPE_" logic uses finding "_FI_" which does not exist."
- +12 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +13 SET OK=0
- End DoDot:3
- End DoDot:2
- +14 IF FI["FF"
- Begin DoDot:2
- +15 IF '$DATA(DEFARR(25,FI,0))
- Begin DoDot:3
- +16 SET FFNUM=$PIECE(FI,"FF",2)
- +17 SET TEXT(1)="Fatal :"_TYPE_" logic uses function finding "_FFNUM_" which does not exist."
- +18 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +19 SET OK=0
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +20 SET X="S Y="_LOGSTR
- +21 DO ^DIM
- +22 IF '$DATA(X)
- Begin DoDot:1
- +23 SET TEXT(1)="FATAL: "_TYPE_" logic syntax is invalid."
- +24 DO ADDTEXT(1,.TEXT,.NL,.OUTPUT)
- +25 SET OK=0
- End DoDot:1
- +26 QUIT OK
- +27 ;
- +28 ;===============
- RDCFCHK(CFNAME,CFPAR,IND,TYPE,NL,OUTPUT) ;Additional checks when the computed
- +1 ;finding is VA-REMINDER DEFINTION.
- +2 ;A blank Computed Finding Parameter has already been checked for.
- +3 IF CFPAR=""
- QUIT 0
- +4 NEW NDEFIEN,RECUR,TEXT
- +5 SET NDEFIEN=$SELECT(+CFPAR=CFPAR:+CFPAR,1:$ORDER(^PXD(811.9,"B",CFPAR,"")))
- +6 IF NDEFIEN=""
- Begin DoDot:1
- +7 IF TYPE="D"
- SET TEXT(1)="FATAL: Finding number "_IND_" uses computed finding "_CFNAME_"."
- +8 IF TYPE="T"
- SET TEXT(1)="FATAL: Term finding number "_IND_" uses computed finding "_CFNAME_"."
- +9 SET TEXT(2)="The Computed Finding Parameter is set to "_CFPAR_", that reminder does not exist."
- +10 DO ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- End DoDot:1
- QUIT 0
- +11 ;Usage check.
- +12 SET USAGE=$PIECE(^PXD(811.9,NDEFIEN,100),U,4)
- +13 IF USAGE["L"
- Begin DoDot:1
- +14 IF TYPE="D"
- SET TEXT(1)="FATAL: Finding number "_IND_" uses computed finding "_CFNAME_"."
- +15 IF TYPE="T"
- SET TEXT(1)="FATAL: Term finding number "_IND_" uses computed finding "_CFNAME_"."
- +16 SET TEXT(2)="The Computed Finding Parameter is set to "_CFPAR_", the Usage for that reminder contains L."
- +17 SET TEXT(3)="List type reminders cannot be used with VA-REMINDER DEFINITION."
- +18 DO ADDTEXT(3,.TEXT,.NL,.OUTPUT)
- End DoDot:1
- QUIT 0
- +19 QUIT 1
- +20 ;
- +21 ;===============
- RECCHK(DEFIEN,NL,OUTPUT) ;Check for recursion
- +1 NEW RECUR,P1,P2,P3,TEXT,TYPE
- +2 SET RECUR=$$RECCHK^PXRMRCUR(DEFIEN)
- +3 SET P1=$PIECE(RECUR,U,1)
- +4 IF P1
- Begin DoDot:1
- +5 NEW DEFNAME
- +6 SET DEFNAME=$PIECE(^PXD(811.9,DEFIEN,0),U,1)
- +7 SET P2=$PIECE(RECUR,U,2)
- +8 SET P3=$PIECE(RECUR,U,3)
- +9 SET TYPE=$SELECT(P3'="":"T",1:"D")
- +10 IF TYPE="D"
- Begin DoDot:2
- +11 SET TEXT(1)="FATAL: Finding number "_$PIECE(P2,";",3)_" uses CF.VA-REMINDER DEFINITION."
- +12 SET TEXT(2)="It is recursively calling definition "_DEFNAME_"."
- End DoDot:2
- +13 IF TYPE="T"
- Begin DoDot:2
- +14 NEW TNAME
- +15 SET TNAME=$PIECE(^PXRMD(811.5,$PIECE(P3,";",2),0),U,1)
- +16 SET TEXT(1)="FATAL: Finding number "_$PIECE(P2,";",3)_" uses term "_TNAME_"."
- +17 SET TEXT(2)="This term is recursively calling definition "_DEFNAME_"."
- End DoDot:2
- +18 DO ADDTEXT(2,.TEXT,.NL,.OUTPUT)
- End DoDot:1
- +19 QUIT P1
- +20 ;