PXRMDLRP ;SLC/AGP - Dialog reporting routine ;04/02/2012
;;2.0;CLINICAL REMINDERS;**12,18,26**;Feb 04, 2005;Build 404
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
;
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,IEN,NAME,REPIEN,RSCNT,RSIEN,TEXT,TYPE
S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0 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)
.; Disregard Prompts and Forced Values
.I TYPE="P"!(TYPE="F")!(TYPE="") Q
.;Check Replacement Items first
.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 '$D(ARRAY(IEN)) S ARRAY(IEN)=""
I '$D(ARRAY(DIEN)) 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=0
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
;
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 TEXT
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"
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
;
;
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
S CNT=0
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
W !,NAME_" contains the following errors."
S CNT=0 F S CNT=$O(MESS(CNT)) Q:CNT'>0 D
.W !,MESS(CNT)
H 1
Q
;
PXRMDLRP ;SLC/AGP - Dialog reporting routine ;04/02/2012
+1 ;;2.0;CLINICAL REMINDERS;**12,18,26**;Feb 04, 2005;Build 404
+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 ;
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,IEN,NAME,REPIEN,RSCNT,RSIEN,TEXT,TYPE
+4 SET CNT=0
FOR
SET CNT=$ORDER(^PXRMD(801.41,DIEN,10,CNT))
IF CNT'>0
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 ; Disregard Prompts and Forced Values
+14 IF TYPE="P"!(TYPE="F")!(TYPE="")
QUIT
+15 ;Check Replacement Items first
+16 SET REPIEN=$PIECE($GET(^PXRMD(801.41,IEN,49)),U,3)
+17 IF REPIEN>0
DO DITEMAR(REPIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
+18 ;Check for Result Groups second
+19 IF $DATA(^PXRMD(801.41,IEN,51))>0
Begin DoDot:2
+20 SET RSCNT=0
+21 FOR
SET RSCNT=$ORDER(^PXRMD(801.41,IEN,51,RSCNT))
IF RSCNT'>0
QUIT
Begin DoDot:3
+22 SET RSIEN=$GET(^PXRMD(801.41,IEN,51,RSCNT,0))
IF RSIEN'>0
QUIT
+23 DO DITEMAR(RSIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
End DoDot:3
End DoDot:2
+24 ;do subitem third
+25 ;
DO DITEMAR(IEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
+26 IF '$DATA(ARRAY(IEN))
SET ARRAY(IEN)=""
End DoDot:1
+27 IF '$DATA(ARRAY(DIEN))
SET ARRAY(DIEN)=""
+28 QUIT
+29 ;
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=0
+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 ;
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 TEXT
+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 QUIT
+11 ;
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 ;
+37 ;
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
+2 SET CNT=0
+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 WRITE !,NAME_" contains the following errors."
+7 SET CNT=0
FOR
SET CNT=$ORDER(MESS(CNT))
IF CNT'>0
QUIT
Begin DoDot:1
+8 WRITE !,MESS(CNT)
End DoDot:1
+9 HANG 1
+10 QUIT
+11 ;
