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 Apr 09, 2024@20:48:46 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 ;
