PXRMDLRP ;SLC/AGP - Dialog reporting routine ;Mar 07, 2019@11:43
;;2.0;CLINICAL REMINDERS;**12,18,26,45**;Feb 04, 2005;Build 566
Q
;
ALL ;
N CNT,FAIL,IEN,MESS
S IEN=0 F S IEN=$O(^PXRMD(801.41,"TYPE","R",IEN)) Q:IEN'>0 D
.I +$P($G(^PXRMD(801.41,IEN,0)),U,3)>0 Q
.K MESS
.S FAIL=$$RETARR(IEN,.MESS)
.I $D(MESS) D
..W !
..S CNT=0 F S CNT=$O(MESS(CNT)) Q:CNT'>0 D
...W !,MESS(CNT)
W !!,"**DONE**"
Q
;
BLCHK(NAME,TYPE,IEN,REPIEN,ERRCNT,ERRMSG,FAIL) ;
I $$RECCHK^PXRMDBL(IEN,REPIEN)=1 S FAIL="F"
I FAIL="",$$REPCHK^PXRMDBL(REPIEN,IEN)=1 S FAIL="F"
I FAIL=""!(FAIL="W") Q
S ERRCNT=ERRCNT+1
;S NAME=$P($G(^PXRMD(801.41,IEN,0)),U),TYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,REPIEN,0)),U,4))
S TEXT(1)="Error in branching logic "_TYPE_" "_NAME_" can cause recursive failure or other errors."
D BUILDMSG(.TEXT,.ERRCNT,.ERRMSG,1)
Q
;
BUILDMSG(TEXTIN,CNT,MESS,NIN) ;
N LINE,NOUT,TEXTOUT
D FORMAT^PXRMTEXT(1,75,NIN,.TEXTIN,.NOUT,.TEXTOUT)
S CNT=CNT+1,MESS(CNT)=""
F LINE=1:1:NOUT D
.S CNT=CNT+1,MESS(CNT)=TEXTOUT(LINE)
Q
;
DITEMAR(DIEN,ARRAY,ERRCNT,ERRMSG,FAIL) ;
;DIEN is the IEN of the dialog top level
;Array contains the dialog elements and groups within the dialog.
N CNT,IDX,EIEN,ETYPE,ITEM,NAME,REPIEN,RSCNT,RSIEN,SEQ,TEMPARR,TEXT,TYPE
S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0!(FAIL="F") D
.S IEN=$P($G(^PXRMD(801.41,DIEN,10,CNT,0)),U,2) I IEN'>0 D Q
..S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
..S TYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,DIEN,0)),U,4))
..S TEXT(1)="The "_TYPE_" "_NAME_" contains an incomplete sequence"
..D BUILDMSG(.TEXT,.ERRCNT,.ERRMSG,1)
..S FAIL="F"
.;
.S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
.S ETYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,IEN,0)),U,4))
.S NAME=$P($G(^PXRMD(801.41,IEN,0)),U)
.; Disregard Prompts and Forced Values
.I TYPE="P"!(TYPE="F")!(TYPE="") Q
.;I TYPE="G",$P($G(^PXRMD(801.41,DIEN,0)),U,4)="G" D VALIDGP(IEN,.ERRCNT,.ERRMSG,.FAIL) I FAIL="F" Q
.I TYPE="G",$P($G(^PXRMD(801.41,DIEN,0)),U,4)="G" D VALIDGP1(NAME,ETYPE,IEN,DIEN,.ERRCNT,.ERRMSG,.FAIL) I FAIL="F" Q
.;Check Replacement Items first
.I $D(^PXRMD(801.41,IEN,"BL")) D
..S SEQ=0 F S SEQ=$O(^PXRMD(801.41,IEN,"BL","B",SEQ)) Q:SEQ'>0!(FAIL="F") D
...S IDX=$O(^PXRMD(801.41,IEN,"BL","B",SEQ,"")) Q:IDX'>0!(FAIL="F")
...S ITEM=$P($G(^PXRMD(801.41,IEN,"BL",IDX,0)),U,2) D VALIDREM(NAME,ETYPE,ITEM,.ERRCNT,.ERRMSG,.FAIL) I FAIL="F" Q
...S REPIEN=$P($G(^PXRMD(801.41,IEN,"BL",IDX,0)),U,5)
...I REPIEN>0 D
....I +$G(IEN)>0 Q
....D BLCHK(NAME,ETYPE,IEN,REPIEN,.ERRCNT,.ERRMSG,.FAIL)
....;K TEMPARR
....;D GETDIAL(IEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
....;D VALIDBL(IEN,REPIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
....I FAIL="F" Q
....D DITEMAR(REPIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
.I FAIL="F" Q
.;S REPIEN=$P($G(^PXRMD(801.41,IEN,49)),U,3)
.;I REPIEN>0 D DITEMAR(REPIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
.;Check for Result Groups second
.I $D(^PXRMD(801.41,IEN,51))>0 D
..S RSCNT=0
..F S RSCNT=$O(^PXRMD(801.41,IEN,51,RSCNT)) Q:RSCNT'>0 D
...S RSIEN=$G(^PXRMD(801.41,IEN,51,RSCNT,0)) Q:RSIEN'>0
...D DITEMAR(RSIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
.;do subitem third
.D DITEMAR(IEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL) ;
.I FAIL="F" Q
.I '$D(ARRAY(IEN)) S ARRAY(IEN)=""
I '$D(ARRAY(DIEN)) D
.S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
.S ETYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,DIEN,0)),U,4))
.I $D(^PXRMD(801.41,DIEN,"BL")) D
..S SEQ=0 F S SEQ=$O(^PXRMD(801.41,DIEN,"BL","B",SEQ)) Q:SEQ'>0!(FAIL="F") D
...S IDX=$O(^PXRMD(801.41,DIEN,"BL","B",SEQ,"")) Q:IDX'>0!(FAIL="F")
...S ITEM=$P($G(^PXRMD(801.41,DIEN,"BL",IDX,0)),U,2) D VALIDREM(NAME,ETYPE,ITEM,.ERRCNT,.ERRMSG,.FAIL) I FAIL="F" Q
...S REPIEN=$P($G(^PXRMD(801.41,DIEN,"BL",IDX,0)),U,5)
...I REPIEN>0 D
....D BLCHK(NAME,ETYPE,DIEN,REPIEN,.ERRCNT,.ERRMSG,.FAIL)
....I FAIL="F" Q
....D DITEMAR(REPIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
.S ARRAY(DIEN)=""
Q
;
EN(DIEN,NAME,CNT,MESS,FAIL) ;
; entry point that loops through the dialog array and calls each
;validation line tag
;
N DLGARR,DNAME,EXT,IEN,TYPE,UP
D DITEMAR(DIEN,.DLGARR,.CNT,.MESS,.FAIL)
S IEN="" F S IEN=$O(DLGARR(IEN)) Q:IEN'>0 D
.S DNAME=$P($G(^PXRMD(801.41,IEN,0)),U)
.S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
.S EXT=$$EXTERNAL^DILFD(801.41,4,"",TYPE)
.;validate dialog item exist on the system
. D VALIDITM(IEN,DNAME,EXT,.CNT,.MESS,.FAIL)
.;validate findings data exist on the system
. D VALIDFND(IEN,DNAME,EXT,TYPE,.CNT,.MESS,.FAIL)
.;validate TIU Objects and Template Fields found in word processing
.;fields exist on the system
. D VALIDTXT(IEN,DNAME,EXT,TYPE,.CNT,.MESS,.FAIL)
Q
;
ODDPIPES(DIEN,NAME,EXT,TYPE,CNT,MESS,FAIL) ;
;this line tag returns true/false and it builds an error message
;if the dialog text/alter PN text contains an odd number of pipes
;
N AMOUNT,FLDNAM,NODE,NUM,PIPECNT,RESULT,TEXT
S RESULT=0
F NODE=25,35 D
.K TEXT
.S PIPECNT=0,NUM=0
.F S NUM=$O(^PXRMD(801.41,DIEN,NODE,NUM)) Q:NUM'>0 D
..S AMOUNT=$L(^PXRMD(801.41,DIEN,NODE,NUM,0),"|") I AMOUNT=1 Q
..S PIPECNT=PIPECNT+(AMOUNT-1)
.I PIPECNT=0 Q
.I PIPECNT#2=0 Q
.S RESULT=1
.S FLDNAM=$S(NODE=25:"Dialog/Progress Note Text",1:"Alternate Progress Note Text")
.S TEXT(1)="The "_EXT_" "_DNAME_" contains an odd number of pipes (|) in the "_FLDNAM_" field. TIU Objects cannot be evaluated."
.D BUILDMSG(.TEXT,.CNT,.MESS,1)
.S FAIL="F"
Q RESULT
;
RETARR(DIEN,MESS) ;
;This entry point is used by reminder exchange this returns an array
;for use in selecting a reminder dialog
N CNT,FAIL,NAME,TYPE
S CNT=0,FAIL=""
S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
D EN(DIEN,NAME,.CNT,.MESS,.FAIL)
I '$D(MESS) Q FAIL
S MESS(1)=NAME_" contains the following errors."
Q FAIL
;
SCREEN(DIEN) ;
N NODE
S NODE=$G(^PXRMD(801.41,DIEN,0))
I $P(NODE,U,4)="P" Q 0
I $P(NODE,U,4)="F" Q 0
Q 1
;
SELECT ;
;this entry point is used from the option on the reminder dialog menu
N DIC,Y
S DIC="^PXRMD(801.41,"
S DIC(0)="AEMQ"
S DIC("A")="Select Dialog Definition: "
S DIC("S")="I $$SCREEN^PXRMDLRP(Y)=1"
;Current dialog type only
D ^DIC
I Y>0 D WRITE(+Y)
Q
;
GETDIAL(IEN,TEMPARR,ERRCNT,ERRMSG,FAIL) ; recurrsive function that follows up the AD cross-references
;until either the item is not used or a dialog is reached
N CNT,NODE,DIEN,OIEN
S NODE=$G(^PXRMD(801.41,IEN,0))
;S CNT=$O(PATH(""),-1) S CNT=CNT+1,PATH(CNT)=NODE
I $P($G(NODE),U,4)="R" Q
S TEMPARR(IEN)=""
I $P($G(NODE),U,4)="S" D Q
.S DIEN=0 F S DIEN=$O(^PXRMD(801.41,"RG",IEN,DIEN)) Q:DIEN'>0 D
..;checked for result group attached to a dialog. This should not happened. Just a safety check
..S NODE=$G(^PXRMD(801.41,DIEN,0))
..I $P($G(NODE),U,4)="R" Q
..D GETDIAL(DIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
;search everything else
S DIEN=0,OIEN=0 F S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:DIEN'>0!(FAIL="F") D
.S NODE=$G(^PXRMD(801.41,DIEN,0))
.I $P(NODE,U,4)="G" D VALIDGP(DIEN,.ERRCNT,.ERRMSG,.FAIL) I FAIL="F" Q
.I $P($G(NODE),U,4)="R" Q
.D GETDIAL(DIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
Q
;
VALIDBL(IEN,REPIEN,TEMPARR,ERRCNT,ERRMSG,FAIL) ;
N IDX,NAME,SEQ,TYPE,RIEN,TEXT
I FAIL="F" Q
D GETDIAL(REPIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
I $D(^PXRMD(801.41,REPIEN,"BL")) D
.S SEQ=0 F S SEQ=$O(^PXRMD(801.41,REPIEN,"BL","B",SEQ)) Q:SEQ'>0!(FAIL'="") D
..S IDX=$O(^PXRMD(801.41,REPIEN,"BL","B",SEQ,"")) Q:IDX'>0!(FAIL'="")
..S RIEN=$P($G(^PXRMD(801.41,REPIEN,"BL",IDX,0)),U,5) I RIEN="" Q
..I $D(TEMPARR(RIEN)) D Q
...S ERRCNT=ERRCNT+1
...S FAIL="F"
...S NAME=$P($G(^PXRMD(801.41,REPIEN,0)),U),TYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,REPIEN,0)),U,4))
...S TEXT(1)="Recursive failure "_TYPE_" "_NAME_" branching logic sequence "_SEQ_" calls a parent group."
...D BUILDMSG(.TEXT,.ERRCNT,.ERRMSG,1)
..D VALIDBL(REPIEN,RIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
Q
;
VALIDGP(DIEN,ERRCNT,ERRMSG,FAIL) ;
N NAME1,SUB,TYPE1
S SUB=0
F S SUB=$O(^PXRMD(801.41,"AD",DIEN,SUB)) Q:'SUB!(FAIL="F") D
.;Ignore reminder dialogs
.I $P($G(^PXRMD(801.41,SUB,0)),U,4)'="G" Q
.;Repeat check on other parents
.S NAME1=$P($G(^PXRMD(801.41,SUB,0)),U),TYPE1=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,SUB,0)),U,4))
.D VALIDGP1(NAME1,TYPE1,DIEN,SUB,.ERRCNT,.ERRMSG,.FAIL)
Q
;
VALIDGP1(NAME,TYPE,IEN,DIEN,ERRCNT,ERRMSG,FAIL) ;check for recursive dialog groups
N NAME1,TEXT,TYPE1
;End search if already found
I FAIL="F" Q
;Check if dialog being added is a parent at this level
I $D(^PXRMD(801.41,"AD",DIEN,IEN)) D Q
.S FAIL="F"
.;S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U),TYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,DIEN,0)),U,4))
.S TEXT(1)="Recursive failure dialog group "_NAME_" point to a parent group."
.D BUILDMSG(.TEXT,.ERRCNT,.ERRMSG,1)
;
;If not look at other parents
N SUB
S SUB=0
F S SUB=$O(^PXRMD(801.41,"AD",DIEN,SUB)) Q:'SUB!(FAIL="F") D
.;Ignore reminder dialogs
.I $P($G(^PXRMD(801.41,SUB,0)),U,4)'="G" Q
.;Repeat check on other parents
.S NAME1=$P($G(^PXRMD(801.41,SUB,0)),U),TYPE1=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,SUB,0)),U,4))
.D VALIDGP1(NAME1,TYPE1,IEN,SUB,.ERRCNT,.ERRMSG,.FAIL)
Q
;
VALIDFND(IEN,DNAME,EXT,TYPE,CNT,MESS,FAIL) ;
N FIND,NIN,NODE,MHTEST,OUTPUT,TEXT
;S DNAME=$P($G(^PXRMD(801.41,IEN,0)),U)
;
;disregard Reminder Dialogs and Result Elements
I TYPE="R"!(TYPE="T") Q
;
;Result Groups only need to be check for MH Data
I TYPE="S" D Q
.S NODE=$G(^PXRMD(801.41,IEN,50))
.I +$P(NODE,U)'>0 D
..S TEXT(1)="The result group "_DNAME_" does not contain a valid MH Test."
..D BUILDMSG(.TEXT,.CNT,.MESS,1)
..S FAIL="F"
.I +$P(NODE,U,2)'>0 D
..S TEXT(1)="The result group "_DNAME_" does not contain a valid MH Scale."
..D BUILDMSG(.TEXT,.CNT,.MESS,1)
..S FAIL="F"
.I +$P(NODE,U)>0,$$VALIDENT($P(NODE,U)_";YTT(601.71,")=0 D
..S TEXT(1)="The result group "_DNAME_" does not contain a valid MH Test."
..D BUILDMSG(.TEXT,.CNT,.MESS,1)
..S FAIL="F"
;
S NODE=$G(^PXRMD(801.41,IEN,1))
;check Orderable items
I +$P(NODE,U,7)>0,$$VALIDENT(+$P(NODE,U,7)_";ORD(101.43,")=0 D
.S TEXT(1)="The "_EXT_" "_DNAME_" contains a pointer to an Orderable Item that does not exist on the system."
.D BUILDMSG(.TEXT,.CNT,.MESS,1)
.S FAIL="F"
;
;check finding item
I $P(NODE,U,5)'="" D
.S FIND=$P(NODE,U,5)
.I $$VALIDENT(FIND)=0 D Q
..S TEXT(1)="The "_EXT_" "_DNAME_" contains an a pointer to the finding item that does not exist on the system."
..D BUILDMSG(.TEXT,.CNT,.MESS,1)
..S FAIL="F"
.I FIND[811.2 S FAIL=$$CHECKER^PXRMDTAX(IEN,+FIND,"F",.OUTPUT) I $D(OUTPUT) S NIN=$O(OUTPUT(""),-1) D BUILDMSG(.OUTPUT,.CNT,.MESS,NIN)
;
;check additional findings
S FIND=0 F S FIND=$O(^PXRMD(801.41,IEN,3,"B",FIND)) Q:FIND="" D
.I $$VALIDENT(FIND)=0 D Q
..S TEXT(1)="The "_EXT_" "_DNAME_" contains a pointer to an additional finding item that does not exist on the system."
..D BUILDMSG(.TEXT,.CNT,.MESS,1)
..S FAIL="F"
.I FIND[811.2 S FAIL=$$CHECKER^PXRMDTAX(IEN,+FIND,"A",.OUTPUT) I $D(OUTPUT) S NIN=$O(OUTPUT(""),-1) D BUILDMSG(.OUTPUT,.CNT,.MESS,NIN)
Q
;
VALIDENT(FIND) ;
N FILENUM,IEN
S FILENUM=$$FNFR^PXRMUTIL(U_$P(FIND,";",2))
Q $$FIND1^DIC(FILENUM,"","QU","`"_$P(FIND,";"))
;
VALIDITM(IEN,NAME,EXT,CNT,MESS,FAIL) ;
N BLVALID,REPIEN,NODE,SEQ,TEXT,X
I '$D(^PXRMD(801.41,IEN)) D Q
.S TEXT(1)=NAME_" contains a pointer to an invalid dialog item."
.D BUILDMSG(.TEXT,.CNT,.MESS,1)
.S FAIL="F"
I +$P(^PXRMD(801.41,IEN,0),U,3)>0 D
.S TEXT(1)="The "_EXT_" "_NAME_" is disabled."
.D BUILDMSG(.TEXT,.CNT,.MESS,1)
.I $G(FAIL)'="F" S FAIL="W"
I $D(^PXRMD(801.41,IEN,"BL")) D CHECK1^PXRMDBL(IEN,NAME,EXT,.CNT,.MESS,.FAIL)
;S REPIEN=0 F S REPIEN=$O(^PXRMD(801.41,IEN,"BL",REPIEN)) Q:REPIEN'>0 D
;.S NODE=$G(^PXRMD(801.41,IEN,"BL",REPIEN,0))
;.S SEQ=$P(NODE,U)
;.F X=1:1:4 D
;..I $P(NODE,U,X)="" S FAIL="F",MESS(1)="Branching Logic sequence "_SEQ_" has missing fields."
;.I FAIL="F" Q
;.I $P(NODE,U,4)="R",+$P(NODE,U,5)=0 S FAIL="F",MESS(1)="Branching Logic sequence "_SEQ_" is missing a Replacement Item."
Q
;
VALIDNAM(DIEN,DNAME,FIELD,EXT,TYPE,CNT,MESS,OLIST,TLIST,RETFAIL) ;
N ARRAY,FAIL,FLDNAM,NAME,TCNT,TEXT
;determine field object/tiu template is in
S FLDNAM=$S(FIELD=25:"Dialog Text",1:"Alternate Progress Note Text")
S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
;
I $D(OLIST)>0 D
.S TCNT=0 F S TCNT=$O(OLIST(TCNT)) Q:TCNT'>0 D
..S NAME=OLIST(TCNT)
..;do not check result element objects called SCORE
..I TYPE="T",NAME="SCORE" Q
..;dbia 5447
..S FAIL=$$OBJSTAT^TIUCHECK(NAME)
..I FAIL=-1 D Q
...S TEXT(1)="The "_EXT_" "_DNAME_" contains a reference to a TIU Object "_NAME_" in the "_FLDNAM_" field. This TIU Object does not exist on the system."
...D BUILDMSG(.TEXT,.CNT,.MESS,1)
...S RETFAIL="F"
..I FAIL=0 D Q
...S TEXT(1)="The "_EXT_" "_DNAME_" contains a reference to a TIU Object "_NAME_" in the "_FLDNAM_" field. This TIU Object is inactive."
...D BUILDMSG(.TEXT,.CNT,.MESS,1)
...I $G(RETFAIL)'="F" S RETFAIL="W"
;
I $D(TLIST)>0 D
.S TCNT=0 F S TCNT=$O(TLIST(TCNT)) Q:TCNT'>0 D
..S NAME=TLIST(TCNT)
..;dbia 5447
..S FAIL=$$TEMPSTAT^TIUCHECK(NAME)
..I FAIL=-1 D Q
...S TEXT(1)="The "_EXT_" "_DNAME_" contains a reference to a TIU Template field "_NAME_" in the "_FLDNAM_" field. This TIU Template field does not exist on the system."
...D BUILDMSG(.TEXT,.CNT,.MESS,1)
...S RETFAIL="F"
..I FAIL=0 D Q
...S TEXT(1)="The "_EXT_" "_DNAME_" contains a reference to a TIU Template field "_NAME_" in the "_FLDNAM_" field. This TIU Template field is inactive."
...D BUILDMSG(.TEXT,.CNT,.MESS,1)
...I $G(RETFAIL)'="F" S RETFAIL="W"
Q
;
VALIDREM(NAME,TYPE,ITEM,ERRCNT,ERRMSG,FAIL) ;
N DEFARR,GBL,IEN,TEXT,PXRMDLRP
S PXRMDLRP=1
S GBL=$P(ITEM,";",2)
S IEN=+ITEM
I IEN'>0 D Q
.S TEXT(1)="The "_TYPE_" "_NAME_" branching logic contains a reference to "_ITEM_" that does not exist on the system."
.D BUILDMSG(.TEXT,.ERRCNT,.MESS,1)
.S FAIL="F"
I GBL["811.5",'$D(^PXRMD(811.5,IEN)) D Q
.S TEXT(1)="The "_TYPE_" "_NAME_" branching logic contains a reference to a Reminder Term "_ITEM_" that does not exist on the system."
.D BUILDMSG(.TEXT,.ERRCNT,.MESS,1)
.S FAIL="F"
I GBL["811.9",'$D(^PXD(811.9,IEN)) D
.S TEXT(1)="The "_TYPE_" "_NAME_" branching logic contains a reference to a Reminder Definition "_ITEM_" that does not exist on the system."
.D BUILDMSG(.TEXT,.ERRCNT,.MESS,1)
.S FAIL="F"
Q
;
VALIDTXT(DIEN,NAME,EXT,TYPE,CNT,MESS,FAIL) ;
N OBJLIST,TEXT,TLIST
I $$ODDPIPES(IEN,NAME,EXT,TYPE,.CNT,.MESS,.FAIL)=1 Q
;check dialog/progress note text
D TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,25,.OBJLIST,.TLIST)
I $D(OBJLIST)>0!($D(TLIST)>0) D VALIDNAM(IEN,NAME,25,EXT,TYPE,.CNT,.MESS,.OBJLIST,.TLIST,.FAIL)
K OBJLIST,TLIST
;Check alternate progress note text
D TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,35,.OBJLIST,.TLIST)
I $D(OBJLIST)>0!($D(TLIST)>0) D VALIDNAM(IEN,NAME,35,EXT,TYPE,.CNT,.MESS,.OBJLIST,.TLIST,.FAIL)
Q
;
TIUSRCH(DIEN) ;
N CNT,DLGARR,DNAME,EXT,FAIL,IEN,MESS,NAME,OCNT,OBJLIST,OLIST,TLIST,TYPE
S CNT=0,OCNT=0
S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
D DITEMAR(DIEN,.DLGARR,.CNT,.MESS,.FAIL)
S IEN="" F S IEN=$O(DLGARR(IEN)) Q:IEN'>0 D
.S DNAME=$P($G(^PXRMD(801.41,IEN,0)),U)
.S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
.S EXT=$$EXTERNAL^DILFD(801.41,4,"",TYPE)
.I $$ODDPIPES(IEN,NAME,EXT,TYPE,.CNT,.MESS,.FAIL)=1 Q
.;check dialog/progress note text
.D TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,25,.OBJLIST,.TLIST)
.I $D(OBJLIST)>0 D
..D VALIDNAM(IEN,NAME,25,EXT,TYPE,.CNT,.MESS,.OBJLIST,.TLIST,.FAIL)
Q
;
WRITE(DIEN) ;
N CNT,FAIL,MESS,NAME,NOUT,TEXT
S CNT=0,FAIL=""
S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
D EN(DIEN,NAME,.CNT,.MESS,.FAIL)
I '$D(MESS) W !,"NO ERRORS FOUND" H 1 Q
;D FORMAT^PXRMTEXT(0,74,CNT,.MESS,.NOUT,.TEXT)
;W !,NAME_" contains the following errors."
;F CNT=1:1:NOUT W !,TEXT(CNT)
S CNT=0 F S CNT=$O(MESS(CNT)) Q:CNT'>0 D
.W !,MESS(CNT)
H 3
Q
;
WRITE1(DIEN) ;
W IORESET
D WRITE(DIEN)
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLRP 16295 printed Apr 09, 2024@20:54:12 Page 2
PXRMDLRP ;SLC/AGP - Dialog reporting routine ;Mar 07, 2019@11:43
+1 ;;2.0;CLINICAL REMINDERS;**12,18,26,45**;Feb 04, 2005;Build 566
+2 QUIT
+3 ;
ALL ;
+1 NEW CNT,FAIL,IEN,MESS
+2 SET IEN=0
FOR
SET IEN=$ORDER(^PXRMD(801.41,"TYPE","R",IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 IF +$PIECE($GET(^PXRMD(801.41,IEN,0)),U,3)>0
QUIT
+4 KILL MESS
+5 SET FAIL=$$RETARR(IEN,.MESS)
+6 IF $DATA(MESS)
Begin DoDot:2
+7 WRITE !
+8 SET CNT=0
FOR
SET CNT=$ORDER(MESS(CNT))
if CNT'>0
QUIT
Begin DoDot:3
+9 WRITE !,MESS(CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+10 WRITE !!,"**DONE**"
+11 QUIT
+12 ;
BLCHK(NAME,TYPE,IEN,REPIEN,ERRCNT,ERRMSG,FAIL) ;
+1 IF $$RECCHK^PXRMDBL(IEN,REPIEN)=1
SET FAIL="F"
+2 IF FAIL=""
IF $$REPCHK^PXRMDBL(REPIEN,IEN)=1
SET FAIL="F"
+3 IF FAIL=""!(FAIL="W")
QUIT
+4 SET ERRCNT=ERRCNT+1
+5 ;S NAME=$P($G(^PXRMD(801.41,IEN,0)),U),TYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,REPIEN,0)),U,4))
+6 SET TEXT(1)="Error in branching logic "_TYPE_" "_NAME_" can cause recursive failure or other errors."
+7 DO BUILDMSG(.TEXT,.ERRCNT,.ERRMSG,1)
+8 QUIT
+9 ;
BUILDMSG(TEXTIN,CNT,MESS,NIN) ;
+1 NEW LINE,NOUT,TEXTOUT
+2 DO FORMAT^PXRMTEXT(1,75,NIN,.TEXTIN,.NOUT,.TEXTOUT)
+3 SET CNT=CNT+1
SET MESS(CNT)=""
+4 FOR LINE=1:1:NOUT
Begin DoDot:1
+5 SET CNT=CNT+1
SET MESS(CNT)=TEXTOUT(LINE)
End DoDot:1
+6 QUIT
+7 ;
DITEMAR(DIEN,ARRAY,ERRCNT,ERRMSG,FAIL) ;
+1 ;DIEN is the IEN of the dialog top level
+2 ;Array contains the dialog elements and groups within the dialog.
+3 NEW CNT,IDX,EIEN,ETYPE,ITEM,NAME,REPIEN,RSCNT,RSIEN,SEQ,TEMPARR,TEXT,TYPE
+4 SET CNT=0
FOR
SET CNT=$ORDER(^PXRMD(801.41,DIEN,10,CNT))
if CNT'>0!(FAIL="F")
QUIT
Begin DoDot:1
+5 SET IEN=$PIECE($GET(^PXRMD(801.41,DIEN,10,CNT,0)),U,2)
IF IEN'>0
Begin DoDot:2
+6 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+7 SET TYPE=$$EXTERNAL^DILFD(801.41,4,"",$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4))
+8 SET TEXT(1)="The "_TYPE_" "_NAME_" contains an incomplete sequence"
+9 DO BUILDMSG(.TEXT,.ERRCNT,.ERRMSG,1)
+10 SET FAIL="F"
End DoDot:2
QUIT
+11 ;
+12 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+13 SET ETYPE=$$EXTERNAL^DILFD(801.41,4,"",$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4))
+14 SET NAME=$PIECE($GET(^PXRMD(801.41,IEN,0)),U)
+15 ; Disregard Prompts and Forced Values
+16 IF TYPE="P"!(TYPE="F")!(TYPE="")
QUIT
+17 ;I TYPE="G",$P($G(^PXRMD(801.41,DIEN,0)),U,4)="G" D VALIDGP(IEN,.ERRCNT,.ERRMSG,.FAIL) I FAIL="F" Q
+18 IF TYPE="G"
IF $PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)="G"
DO VALIDGP1(NAME,ETYPE,IEN,DIEN,.ERRCNT,.ERRMSG,.FAIL)
IF FAIL="F"
QUIT
+19 ;Check Replacement Items first
+20 IF $DATA(^PXRMD(801.41,IEN,"BL"))
Begin DoDot:2
+21 SET SEQ=0
FOR
SET SEQ=$ORDER(^PXRMD(801.41,IEN,"BL","B",SEQ))
if SEQ'>0!(FAIL="F")
QUIT
Begin DoDot:3
+22 SET IDX=$ORDER(^PXRMD(801.41,IEN,"BL","B",SEQ,""))
if IDX'>0!(FAIL="F")
QUIT
+23 SET ITEM=$PIECE($GET(^PXRMD(801.41,IEN,"BL",IDX,0)),U,2)
DO VALIDREM(NAME,ETYPE,ITEM,.ERRCNT,.ERRMSG,.FAIL)
IF FAIL="F"
QUIT
+24 SET REPIEN=$PIECE($GET(^PXRMD(801.41,IEN,"BL",IDX,0)),U,5)
+25 IF REPIEN>0
Begin DoDot:4
+26 IF +$GET(IEN)>0
QUIT
+27 DO BLCHK(NAME,ETYPE,IEN,REPIEN,.ERRCNT,.ERRMSG,.FAIL)
+28 ;K TEMPARR
+29 ;D GETDIAL(IEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
+30 ;D VALIDBL(IEN,REPIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
+31 IF FAIL="F"
QUIT
+32 DO DITEMAR(REPIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
End DoDot:4
End DoDot:3
End DoDot:2
+33 IF FAIL="F"
QUIT
+34 ;S REPIEN=$P($G(^PXRMD(801.41,IEN,49)),U,3)
+35 ;I REPIEN>0 D DITEMAR(REPIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
+36 ;Check for Result Groups second
+37 IF $DATA(^PXRMD(801.41,IEN,51))>0
Begin DoDot:2
+38 SET RSCNT=0
+39 FOR
SET RSCNT=$ORDER(^PXRMD(801.41,IEN,51,RSCNT))
if RSCNT'>0
QUIT
Begin DoDot:3
+40 SET RSIEN=$GET(^PXRMD(801.41,IEN,51,RSCNT,0))
if RSIEN'>0
QUIT
+41 DO DITEMAR(RSIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
End DoDot:3
End DoDot:2
+42 ;do subitem third
+43 ;
DO DITEMAR(IEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
+44 IF FAIL="F"
QUIT
+45 IF '$DATA(ARRAY(IEN))
SET ARRAY(IEN)=""
End DoDot:1
+46 IF '$DATA(ARRAY(DIEN))
Begin DoDot:1
+47 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+48 SET ETYPE=$$EXTERNAL^DILFD(801.41,4,"",$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4))
+49 IF $DATA(^PXRMD(801.41,DIEN,"BL"))
Begin DoDot:2
+50 SET SEQ=0
FOR
SET SEQ=$ORDER(^PXRMD(801.41,DIEN,"BL","B",SEQ))
if SEQ'>0!(FAIL="F")
QUIT
Begin DoDot:3
+51 SET IDX=$ORDER(^PXRMD(801.41,DIEN,"BL","B",SEQ,""))
if IDX'>0!(FAIL="F")
QUIT
+52 SET ITEM=$PIECE($GET(^PXRMD(801.41,DIEN,"BL",IDX,0)),U,2)
DO VALIDREM(NAME,ETYPE,ITEM,.ERRCNT,.ERRMSG,.FAIL)
IF FAIL="F"
QUIT
+53 SET REPIEN=$PIECE($GET(^PXRMD(801.41,DIEN,"BL",IDX,0)),U,5)
+54 IF REPIEN>0
Begin DoDot:4
+55 DO BLCHK(NAME,ETYPE,DIEN,REPIEN,.ERRCNT,.ERRMSG,.FAIL)
+56 IF FAIL="F"
QUIT
+57 DO DITEMAR(REPIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
End DoDot:4
End DoDot:3
End DoDot:2
+58 SET ARRAY(DIEN)=""
End DoDot:1
+59 QUIT
+60 ;
EN(DIEN,NAME,CNT,MESS,FAIL) ;
+1 ; entry point that loops through the dialog array and calls each
+2 ;validation line tag
+3 ;
+4 NEW DLGARR,DNAME,EXT,IEN,TYPE,UP
+5 DO DITEMAR(DIEN,.DLGARR,.CNT,.MESS,.FAIL)
+6 SET IEN=""
FOR
SET IEN=$ORDER(DLGARR(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+7 SET DNAME=$PIECE($GET(^PXRMD(801.41,IEN,0)),U)
+8 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+9 SET EXT=$$EXTERNAL^DILFD(801.41,4,"",TYPE)
+10 ;validate dialog item exist on the system
+11 DO VALIDITM(IEN,DNAME,EXT,.CNT,.MESS,.FAIL)
+12 ;validate findings data exist on the system
+13 DO VALIDFND(IEN,DNAME,EXT,TYPE,.CNT,.MESS,.FAIL)
+14 ;validate TIU Objects and Template Fields found in word processing
+15 ;fields exist on the system
+16 DO VALIDTXT(IEN,DNAME,EXT,TYPE,.CNT,.MESS,.FAIL)
End DoDot:1
+17 QUIT
+18 ;
ODDPIPES(DIEN,NAME,EXT,TYPE,CNT,MESS,FAIL) ;
+1 ;this line tag returns true/false and it builds an error message
+2 ;if the dialog text/alter PN text contains an odd number of pipes
+3 ;
+4 NEW AMOUNT,FLDNAM,NODE,NUM,PIPECNT,RESULT,TEXT
+5 SET RESULT=0
+6 FOR NODE=25,35
Begin DoDot:1
+7 KILL TEXT
+8 SET PIPECNT=0
SET NUM=0
+9 FOR
SET NUM=$ORDER(^PXRMD(801.41,DIEN,NODE,NUM))
if NUM'>0
QUIT
Begin DoDot:2
+10 SET AMOUNT=$LENGTH(^PXRMD(801.41,DIEN,NODE,NUM,0),"|")
IF AMOUNT=1
QUIT
+11 SET PIPECNT=PIPECNT+(AMOUNT-1)
End DoDot:2
+12 IF PIPECNT=0
QUIT
+13 IF PIPECNT#2=0
QUIT
+14 SET RESULT=1
+15 SET FLDNAM=$SELECT(NODE=25:"Dialog/Progress Note Text",1:"Alternate Progress Note Text")
+16 SET TEXT(1)="The "_EXT_" "_DNAME_" contains an odd number of pipes (|) in the "_FLDNAM_" field. TIU Objects cannot be evaluated."
+17 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+18 SET FAIL="F"
End DoDot:1
+19 QUIT RESULT
+20 ;
RETARR(DIEN,MESS) ;
+1 ;This entry point is used by reminder exchange this returns an array
+2 ;for use in selecting a reminder dialog
+3 NEW CNT,FAIL,NAME,TYPE
+4 SET CNT=0
SET FAIL=""
+5 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+6 DO EN(DIEN,NAME,.CNT,.MESS,.FAIL)
+7 IF '$DATA(MESS)
QUIT FAIL
+8 SET MESS(1)=NAME_" contains the following errors."
+9 QUIT FAIL
+10 ;
SCREEN(DIEN) ;
+1 NEW NODE
+2 SET NODE=$GET(^PXRMD(801.41,DIEN,0))
+3 IF $PIECE(NODE,U,4)="P"
QUIT 0
+4 IF $PIECE(NODE,U,4)="F"
QUIT 0
+5 QUIT 1
+6 ;
SELECT ;
+1 ;this entry point is used from the option on the reminder dialog menu
+2 NEW DIC,Y
+3 SET DIC="^PXRMD(801.41,"
+4 SET DIC(0)="AEMQ"
+5 SET DIC("A")="Select Dialog Definition: "
+6 SET DIC("S")="I $$SCREEN^PXRMDLRP(Y)=1"
+7 ;Current dialog type only
+8 DO ^DIC
+9 IF Y>0
DO WRITE(+Y)
+10 QUIT
+11 ;
GETDIAL(IEN,TEMPARR,ERRCNT,ERRMSG,FAIL) ; recurrsive function that follows up the AD cross-references
+1 ;until either the item is not used or a dialog is reached
+2 NEW CNT,NODE,DIEN,OIEN
+3 SET NODE=$GET(^PXRMD(801.41,IEN,0))
+4 ;S CNT=$O(PATH(""),-1) S CNT=CNT+1,PATH(CNT)=NODE
+5 IF $PIECE($GET(NODE),U,4)="R"
QUIT
+6 SET TEMPARR(IEN)=""
+7 IF $PIECE($GET(NODE),U,4)="S"
Begin DoDot:1
+8 SET DIEN=0
FOR
SET DIEN=$ORDER(^PXRMD(801.41,"RG",IEN,DIEN))
if DIEN'>0
QUIT
Begin DoDot:2
+9 ;checked for result group attached to a dialog. This should not happened. Just a safety check
+10 SET NODE=$GET(^PXRMD(801.41,DIEN,0))
+11 IF $PIECE($GET(NODE),U,4)="R"
QUIT
+12 DO GETDIAL(DIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
End DoDot:2
End DoDot:1
QUIT
+13 ;search everything else
+14 SET DIEN=0
SET OIEN=0
FOR
SET DIEN=$ORDER(^PXRMD(801.41,"AD",IEN,DIEN))
if DIEN'>0!(FAIL="F")
QUIT
Begin DoDot:1
+15 SET NODE=$GET(^PXRMD(801.41,DIEN,0))
+16 IF $PIECE(NODE,U,4)="G"
DO VALIDGP(DIEN,.ERRCNT,.ERRMSG,.FAIL)
IF FAIL="F"
QUIT
+17 IF $PIECE($GET(NODE),U,4)="R"
QUIT
+18 DO GETDIAL(DIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
End DoDot:1
+19 QUIT
+20 ;
VALIDBL(IEN,REPIEN,TEMPARR,ERRCNT,ERRMSG,FAIL) ;
+1 NEW IDX,NAME,SEQ,TYPE,RIEN,TEXT
+2 IF FAIL="F"
QUIT
+3 DO GETDIAL(REPIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
+4 IF $DATA(^PXRMD(801.41,REPIEN,"BL"))
Begin DoDot:1
+5 SET SEQ=0
FOR
SET SEQ=$ORDER(^PXRMD(801.41,REPIEN,"BL","B",SEQ))
if SEQ'>0!(FAIL'="")
QUIT
Begin DoDot:2
+6 SET IDX=$ORDER(^PXRMD(801.41,REPIEN,"BL","B",SEQ,""))
if IDX'>0!(FAIL'="")
QUIT
+7 SET RIEN=$PIECE($GET(^PXRMD(801.41,REPIEN,"BL",IDX,0)),U,5)
IF RIEN=""
QUIT
+8 IF $DATA(TEMPARR(RIEN))
Begin DoDot:3
+9 SET ERRCNT=ERRCNT+1
+10 SET FAIL="F"
+11 SET NAME=$PIECE($GET(^PXRMD(801.41,REPIEN,0)),U)
SET TYPE=$$EXTERNAL^DILFD(801.41,4,"",$PIECE($GET(^PXRMD(801.41,REPIEN,0)),U,4))
+12 SET TEXT(1)="Recursive failure "_TYPE_" "_NAME_" branching logic sequence "_SEQ_" calls a parent group."
+13 DO BUILDMSG(.TEXT,.ERRCNT,.ERRMSG,1)
End DoDot:3
QUIT
+14 DO VALIDBL(REPIEN,RIEN,.TEMPARR,.ERRCNT,.ERRMSG,.FAIL)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
VALIDGP(DIEN,ERRCNT,ERRMSG,FAIL) ;
+1 NEW NAME1,SUB,TYPE1
+2 SET SUB=0
+3 FOR
SET SUB=$ORDER(^PXRMD(801.41,"AD",DIEN,SUB))
if 'SUB!(FAIL="F")
QUIT
Begin DoDot:1
+4 ;Ignore reminder dialogs
+5 IF $PIECE($GET(^PXRMD(801.41,SUB,0)),U,4)'="G"
QUIT
+6 ;Repeat check on other parents
+7 SET NAME1=$PIECE($GET(^PXRMD(801.41,SUB,0)),U)
SET TYPE1=$$EXTERNAL^DILFD(801.41,4,"",$PIECE($GET(^PXRMD(801.41,SUB,0)),U,4))
+8 DO VALIDGP1(NAME1,TYPE1,DIEN,SUB,.ERRCNT,.ERRMSG,.FAIL)
End DoDot:1
+9 QUIT
+10 ;
VALIDGP1(NAME,TYPE,IEN,DIEN,ERRCNT,ERRMSG,FAIL) ;check for recursive dialog groups
+1 NEW NAME1,TEXT,TYPE1
+2 ;End search if already found
+3 IF FAIL="F"
QUIT
+4 ;Check if dialog being added is a parent at this level
+5 IF $DATA(^PXRMD(801.41,"AD",DIEN,IEN))
Begin DoDot:1
+6 SET FAIL="F"
+7 ;S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U),TYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,DIEN,0)),U,4))
+8 SET TEXT(1)="Recursive failure dialog group "_NAME_" point to a parent group."
+9 DO BUILDMSG(.TEXT,.ERRCNT,.ERRMSG,1)
End DoDot:1
QUIT
+10 ;
+11 ;If not look at other parents
+12 NEW SUB
+13 SET SUB=0
+14 FOR
SET SUB=$ORDER(^PXRMD(801.41,"AD",DIEN,SUB))
if 'SUB!(FAIL="F")
QUIT
Begin DoDot:1
+15 ;Ignore reminder dialogs
+16 IF $PIECE($GET(^PXRMD(801.41,SUB,0)),U,4)'="G"
QUIT
+17 ;Repeat check on other parents
+18 SET NAME1=$PIECE($GET(^PXRMD(801.41,SUB,0)),U)
SET TYPE1=$$EXTERNAL^DILFD(801.41,4,"",$PIECE($GET(^PXRMD(801.41,SUB,0)),U,4))
+19 DO VALIDGP1(NAME1,TYPE1,IEN,SUB,.ERRCNT,.ERRMSG,.FAIL)
End DoDot:1
+20 QUIT
+21 ;
VALIDFND(IEN,DNAME,EXT,TYPE,CNT,MESS,FAIL) ;
+1 NEW FIND,NIN,NODE,MHTEST,OUTPUT,TEXT
+2 ;S DNAME=$P($G(^PXRMD(801.41,IEN,0)),U)
+3 ;
+4 ;disregard Reminder Dialogs and Result Elements
+5 IF TYPE="R"!(TYPE="T")
QUIT
+6 ;
+7 ;Result Groups only need to be check for MH Data
+8 IF TYPE="S"
Begin DoDot:1
+9 SET NODE=$GET(^PXRMD(801.41,IEN,50))
+10 IF +$PIECE(NODE,U)'>0
Begin DoDot:2
+11 SET TEXT(1)="The result group "_DNAME_" does not contain a valid MH Test."
+12 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+13 SET FAIL="F"
End DoDot:2
+14 IF +$PIECE(NODE,U,2)'>0
Begin DoDot:2
+15 SET TEXT(1)="The result group "_DNAME_" does not contain a valid MH Scale."
+16 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+17 SET FAIL="F"
End DoDot:2
+18 IF +$PIECE(NODE,U)>0
IF $$VALIDENT($PIECE(NODE,U)_";YTT(601.71,")=0
Begin DoDot:2
+19 SET TEXT(1)="The result group "_DNAME_" does not contain a valid MH Test."
+20 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+21 SET FAIL="F"
End DoDot:2
End DoDot:1
QUIT
+22 ;
+23 SET NODE=$GET(^PXRMD(801.41,IEN,1))
+24 ;check Orderable items
+25 IF +$PIECE(NODE,U,7)>0
IF $$VALIDENT(+$PIECE(NODE,U,7)_";ORD(101.43,")=0
Begin DoDot:1
+26 SET TEXT(1)="The "_EXT_" "_DNAME_" contains a pointer to an Orderable Item that does not exist on the system."
+27 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+28 SET FAIL="F"
End DoDot:1
+29 ;
+30 ;check finding item
+31 IF $PIECE(NODE,U,5)'=""
Begin DoDot:1
+32 SET FIND=$PIECE(NODE,U,5)
+33 IF $$VALIDENT(FIND)=0
Begin DoDot:2
+34 SET TEXT(1)="The "_EXT_" "_DNAME_" contains an a pointer to the finding item that does not exist on the system."
+35 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+36 SET FAIL="F"
End DoDot:2
QUIT
+37 IF FIND[811.2
SET FAIL=$$CHECKER^PXRMDTAX(IEN,+FIND,"F",.OUTPUT)
IF $DATA(OUTPUT)
SET NIN=$ORDER(OUTPUT(""),-1)
DO BUILDMSG(.OUTPUT,.CNT,.MESS,NIN)
End DoDot:1
+38 ;
+39 ;check additional findings
+40 SET FIND=0
FOR
SET FIND=$ORDER(^PXRMD(801.41,IEN,3,"B",FIND))
if FIND=""
QUIT
Begin DoDot:1
+41 IF $$VALIDENT(FIND)=0
Begin DoDot:2
+42 SET TEXT(1)="The "_EXT_" "_DNAME_" contains a pointer to an additional finding item that does not exist on the system."
+43 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+44 SET FAIL="F"
End DoDot:2
QUIT
+45 IF FIND[811.2
SET FAIL=$$CHECKER^PXRMDTAX(IEN,+FIND,"A",.OUTPUT)
IF $DATA(OUTPUT)
SET NIN=$ORDER(OUTPUT(""),-1)
DO BUILDMSG(.OUTPUT,.CNT,.MESS,NIN)
End DoDot:1
+46 QUIT
+47 ;
VALIDENT(FIND) ;
+1 NEW FILENUM,IEN
+2 SET FILENUM=$$FNFR^PXRMUTIL(U_$PIECE(FIND,";",2))
+3 QUIT $$FIND1^DIC(FILENUM,"","QU","`"_$PIECE(FIND,";"))
+4 ;
VALIDITM(IEN,NAME,EXT,CNT,MESS,FAIL) ;
+1 NEW BLVALID,REPIEN,NODE,SEQ,TEXT,X
+2 IF '$DATA(^PXRMD(801.41,IEN))
Begin DoDot:1
+3 SET TEXT(1)=NAME_" contains a pointer to an invalid dialog item."
+4 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+5 SET FAIL="F"
End DoDot:1
QUIT
+6 IF +$PIECE(^PXRMD(801.41,IEN,0),U,3)>0
Begin DoDot:1
+7 SET TEXT(1)="The "_EXT_" "_NAME_" is disabled."
+8 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+9 IF $GET(FAIL)'="F"
SET FAIL="W"
End DoDot:1
+10 IF $DATA(^PXRMD(801.41,IEN,"BL"))
DO CHECK1^PXRMDBL(IEN,NAME,EXT,.CNT,.MESS,.FAIL)
+11 ;S REPIEN=0 F S REPIEN=$O(^PXRMD(801.41,IEN,"BL",REPIEN)) Q:REPIEN'>0 D
+12 ;.S NODE=$G(^PXRMD(801.41,IEN,"BL",REPIEN,0))
+13 ;.S SEQ=$P(NODE,U)
+14 ;.F X=1:1:4 D
+15 ;..I $P(NODE,U,X)="" S FAIL="F",MESS(1)="Branching Logic sequence "_SEQ_" has missing fields."
+16 ;.I FAIL="F" Q
+17 ;.I $P(NODE,U,4)="R",+$P(NODE,U,5)=0 S FAIL="F",MESS(1)="Branching Logic sequence "_SEQ_" is missing a Replacement Item."
+18 QUIT
+19 ;
VALIDNAM(DIEN,DNAME,FIELD,EXT,TYPE,CNT,MESS,OLIST,TLIST,RETFAIL) ;
+1 NEW ARRAY,FAIL,FLDNAM,NAME,TCNT,TEXT
+2 ;determine field object/tiu template is in
+3 SET FLDNAM=$SELECT(FIELD=25:"Dialog Text",1:"Alternate Progress Note Text")
+4 SET DNAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+5 ;
+6 IF $DATA(OLIST)>0
Begin DoDot:1
+7 SET TCNT=0
FOR
SET TCNT=$ORDER(OLIST(TCNT))
if TCNT'>0
QUIT
Begin DoDot:2
+8 SET NAME=OLIST(TCNT)
+9 ;do not check result element objects called SCORE
+10 IF TYPE="T"
IF NAME="SCORE"
QUIT
+11 ;dbia 5447
+12 SET FAIL=$$OBJSTAT^TIUCHECK(NAME)
+13 IF FAIL=-1
Begin DoDot:3
+14 SET TEXT(1)="The "_EXT_" "_DNAME_" contains a reference to a TIU Object "_NAME_" in the "_FLDNAM_" field. This TIU Object does not exist on the system."
+15 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+16 SET RETFAIL="F"
End DoDot:3
QUIT
+17 IF FAIL=0
Begin DoDot:3
+18 SET TEXT(1)="The "_EXT_" "_DNAME_" contains a reference to a TIU Object "_NAME_" in the "_FLDNAM_" field. This TIU Object is inactive."
+19 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+20 IF $GET(RETFAIL)'="F"
SET RETFAIL="W"
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+21 ;
+22 IF $DATA(TLIST)>0
Begin DoDot:1
+23 SET TCNT=0
FOR
SET TCNT=$ORDER(TLIST(TCNT))
if TCNT'>0
QUIT
Begin DoDot:2
+24 SET NAME=TLIST(TCNT)
+25 ;dbia 5447
+26 SET FAIL=$$TEMPSTAT^TIUCHECK(NAME)
+27 IF FAIL=-1
Begin DoDot:3
+28 SET TEXT(1)="The "_EXT_" "_DNAME_" contains a reference to a TIU Template field "_NAME_" in the "_FLDNAM_" field. This TIU Template field does not exist on the system."
+29 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+30 SET RETFAIL="F"
End DoDot:3
QUIT
+31 IF FAIL=0
Begin DoDot:3
+32 SET TEXT(1)="The "_EXT_" "_DNAME_" contains a reference to a TIU Template field "_NAME_" in the "_FLDNAM_" field. This TIU Template field is inactive."
+33 DO BUILDMSG(.TEXT,.CNT,.MESS,1)
+34 IF $GET(RETFAIL)'="F"
SET RETFAIL="W"
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
VALIDREM(NAME,TYPE,ITEM,ERRCNT,ERRMSG,FAIL) ;
+1 NEW DEFARR,GBL,IEN,TEXT,PXRMDLRP
+2 SET PXRMDLRP=1
+3 SET GBL=$PIECE(ITEM,";",2)
+4 SET IEN=+ITEM
+5 IF IEN'>0
Begin DoDot:1
+6 SET TEXT(1)="The "_TYPE_" "_NAME_" branching logic contains a reference to "_ITEM_" that does not exist on the system."
+7 DO BUILDMSG(.TEXT,.ERRCNT,.MESS,1)
+8 SET FAIL="F"
End DoDot:1
QUIT
+9 IF GBL["811.5"
IF '$DATA(^PXRMD(811.5,IEN))
Begin DoDot:1
+10 SET TEXT(1)="The "_TYPE_" "_NAME_" branching logic contains a reference to a Reminder Term "_ITEM_" that does not exist on the system."
+11 DO BUILDMSG(.TEXT,.ERRCNT,.MESS,1)
+12 SET FAIL="F"
End DoDot:1
QUIT
+13 IF GBL["811.9"
IF '$DATA(^PXD(811.9,IEN))
Begin DoDot:1
+14 SET TEXT(1)="The "_TYPE_" "_NAME_" branching logic contains a reference to a Reminder Definition "_ITEM_" that does not exist on the system."
+15 DO BUILDMSG(.TEXT,.ERRCNT,.MESS,1)
+16 SET FAIL="F"
End DoDot:1
+17 QUIT
+18 ;
VALIDTXT(DIEN,NAME,EXT,TYPE,CNT,MESS,FAIL) ;
+1 NEW OBJLIST,TEXT,TLIST
+2 IF $$ODDPIPES(IEN,NAME,EXT,TYPE,.CNT,.MESS,.FAIL)=1
QUIT
+3 ;check dialog/progress note text
+4 DO TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,25,.OBJLIST,.TLIST)
+5 IF $DATA(OBJLIST)>0!($DATA(TLIST)>0)
DO VALIDNAM(IEN,NAME,25,EXT,TYPE,.CNT,.MESS,.OBJLIST,.TLIST,.FAIL)
+6 KILL OBJLIST,TLIST
+7 ;Check alternate progress note text
+8 DO TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,35,.OBJLIST,.TLIST)
+9 IF $DATA(OBJLIST)>0!($DATA(TLIST)>0)
DO VALIDNAM(IEN,NAME,35,EXT,TYPE,.CNT,.MESS,.OBJLIST,.TLIST,.FAIL)
+10 QUIT
+11 ;
TIUSRCH(DIEN) ;
+1 NEW CNT,DLGARR,DNAME,EXT,FAIL,IEN,MESS,NAME,OCNT,OBJLIST,OLIST,TLIST,TYPE
+2 SET CNT=0
SET OCNT=0
+3 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+4 DO DITEMAR(DIEN,.DLGARR,.CNT,.MESS,.FAIL)
+5 SET IEN=""
FOR
SET IEN=$ORDER(DLGARR(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+6 SET DNAME=$PIECE($GET(^PXRMD(801.41,IEN,0)),U)
+7 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+8 SET EXT=$$EXTERNAL^DILFD(801.41,4,"",TYPE)
+9 IF $$ODDPIPES(IEN,NAME,EXT,TYPE,.CNT,.MESS,.FAIL)=1
QUIT
+10 ;check dialog/progress note text
+11 DO TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,25,.OBJLIST,.TLIST)
+12 IF $DATA(OBJLIST)>0
Begin DoDot:2
+13 DO VALIDNAM(IEN,NAME,25,EXT,TYPE,.CNT,.MESS,.OBJLIST,.TLIST,.FAIL)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
WRITE(DIEN) ;
+1 NEW CNT,FAIL,MESS,NAME,NOUT,TEXT
+2 SET CNT=0
SET FAIL=""
+3 SET NAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+4 DO EN(DIEN,NAME,.CNT,.MESS,.FAIL)
+5 IF '$DATA(MESS)
WRITE !,"NO ERRORS FOUND"
HANG 1
QUIT
+6 ;D FORMAT^PXRMTEXT(0,74,CNT,.MESS,.NOUT,.TEXT)
+7 ;W !,NAME_" contains the following errors."
+8 ;F CNT=1:1:NOUT W !,TEXT(CNT)
+9 SET CNT=0
FOR
SET CNT=$ORDER(MESS(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+10 WRITE !,MESS(CNT)
End DoDot:1
+11 HANG 3
+12 QUIT
+13 ;
WRITE1(DIEN) ;
+1 WRITE IORESET
+2 DO WRITE(DIEN)
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
