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

PXRMDLRP.m

Go to the documentation of this file. 
  1. PXRMDLRP ;SLC/AGP - Dialog reporting routine ;04/02/2012
  1.  ;;2.0;CLINICAL REMINDERS;**12,18,26**;Feb 04, 2005;Build 404
  1.  Q
  1.  ;
  1. ALL ;
  1.  N CNT,FAIL,IEN,MESS
  1.  S IEN=0 F  S IEN=$O(^PXRMD(801.41,"TYPE","R",IEN)) Q:IEN'>0  D
  1.  .I +$P($G(^PXRMD(801.41,IEN,0)),U,3)>0 Q
  1.  .K MESS
  1.  .S FAIL=$$RETARR(IEN,.MESS)
  1.  .I $D(MESS) D
  1.  ..W !
  1.  ..S CNT=0 F  S CNT=$O(MESS(CNT)) Q:CNT'>0  D
  1.  ...W !,MESS(CNT)
  1.  W !!,"**DONE**"
  1.  Q
  1.  ;
  1. BUILDMSG(TEXTIN,CNT,MESS,NIN) ;
  1.  N LINE,NOUT,TEXTOUT
  1.  D FORMAT^PXRMTEXT(1,75,NIN,.TEXTIN,.NOUT,.TEXTOUT)
  1.  S CNT=CNT+1,MESS(CNT)=""
  1.  F LINE=1:1:NOUT D
  1.  .S CNT=CNT+1,MESS(CNT)=TEXTOUT(LINE)
  1.  Q
  1.  ;
  1. DITEMAR(DIEN,ARRAY,ERRCNT,ERRMSG,FAIL) ;
  1.  ;DIEN is the IEN of the dialog top level
  1.  ;Array contains the dialog elements and groups within the dialog.
  1.  N CNT,IEN,NAME,REPIEN,RSCNT,RSIEN,TEXT,TYPE
  1.  S CNT=0 F  S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0  D
  1.  .S IEN=$P($G(^PXRMD(801.41,DIEN,10,CNT,0)),U,2) I IEN'>0 D  Q
  1.  ..S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
  1.  ..S TYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,DIEN,0)),U,4))
  1.  ..S TEXT(1)="The "_TYPE_" "_NAME_" contains an incomplete sequence"
  1.  ..D BUILDMSG(.TEXT,.ERRCNT,.ERRMSG,1)
  1.  ..S FAIL="F"
  1.  .;
  1.  .S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
  1.  .; Disregard Prompts and Forced Values
  1.  .I TYPE="P"!(TYPE="F")!(TYPE="") Q
  1.  .;Check Replacement Items first
  1.  .S REPIEN=$P($G(^PXRMD(801.41,IEN,49)),U,3)
  1.  .I REPIEN>0 D DITEMAR(REPIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
  1.  .;Check for Result Groups second
  1.  .I $D(^PXRMD(801.41,IEN,51))>0 D
  1.  ..S RSCNT=0
  1.  ..F  S RSCNT=$O(^PXRMD(801.41,IEN,51,RSCNT)) Q:RSCNT'>0  D
  1.  ...S RSIEN=$G(^PXRMD(801.41,IEN,51,RSCNT,0)) Q:RSIEN'>0
  1.  ...D DITEMAR(RSIEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL)
  1.  .;do subitem third
  1.  .D DITEMAR(IEN,.ARRAY,.ERRCNT,.ERRMSG,.FAIL) ;
  1.  .I '$D(ARRAY(IEN)) S ARRAY(IEN)=""
  1.  I '$D(ARRAY(DIEN)) S ARRAY(DIEN)=""
  1.  Q
  1.  ;
  1. EN(DIEN,NAME,CNT,MESS,FAIL) ;
  1.  ; entry point that loops through the dialog array and calls each
  1.  ;validation line tag
  1.  ;
  1.  N DLGARR,DNAME,EXT,IEN,TYPE,UP
  1.  D DITEMAR(DIEN,.DLGARR,.CNT,.MESS,.FAIL)
  1.  S IEN="" F  S IEN=$O(DLGARR(IEN)) Q:IEN'>0  D
  1.  .S DNAME=$P($G(^PXRMD(801.41,IEN,0)),U)
  1.  .S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
  1.  .S EXT=$$EXTERNAL^DILFD(801.41,4,"",TYPE)
  1.  .;validate dialog item exist on the system
  1.  . D VALIDITM(IEN,DNAME,EXT,.CNT,.MESS,.FAIL)
  1.  .;validate findings data exist on the system
  1.  . D VALIDFND(IEN,DNAME,EXT,TYPE,.CNT,.MESS,.FAIL)
  1.  .;validate TIU Objects and Template Fields found in word processing
  1.  .;fields exist on the system
  1.  . D VALIDTXT(IEN,DNAME,EXT,TYPE,.CNT,.MESS,.FAIL)
  1.  Q
  1.  ;
  1. ODDPIPES(DIEN,NAME,EXT,TYPE,CNT,MESS,FAIL) ;
  1.  ;this line tag returns true/false and it builds an error message
  1.  ;if the dialog text/alter PN text contains an odd number of pipes
  1.  ;
  1.  N AMOUNT,FLDNAM,NODE,NUM,PIPECNT,RESULT,TEXT
  1.  S RESULT=0
  1.  F NODE=25,35 D
  1.  .K TEXT
  1.  .S PIPECNT=0,NUM=0
  1.  .F  S NUM=$O(^PXRMD(801.41,DIEN,NODE,NUM)) Q:NUM'>0  D
  1.  ..S AMOUNT=$L(^PXRMD(801.41,DIEN,NODE,NUM,0),"|") I AMOUNT=1 Q
  1.  ..S PIPECNT=PIPECNT+(AMOUNT-1)
  1.  .I PIPECNT=0 Q
  1.  .I PIPECNT#2=0 Q
  1.  .S RESULT=1
  1.  .S FLDNAM=$S(NODE=25:"Dialog/Progress Note Text",1:"Alternate Progress Note Text")
  1.  .S TEXT(1)="The "_EXT_" "_DNAME_" contains an odd number of pipes (|) in the "_FLDNAM_" field. TIU Objects cannot be evaluated."
  1.  .D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  .S FAIL="F"
  1.  Q RESULT
  1.  ;
  1. RETARR(DIEN,MESS) ;
  1.  ;This entry point is used by reminder exchange this returns an array
  1.  ;for use in selecting a reminder dialog
  1.  N CNT,FAIL,NAME,TYPE
  1.  S CNT=0,FAIL=0
  1.  S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
  1.  D EN(DIEN,NAME,.CNT,.MESS,.FAIL)
  1.  I '$D(MESS) Q FAIL
  1.  S MESS(1)=NAME_" contains the following errors."
  1.  Q FAIL
  1.  ;
  1. SCREEN(DIEN) ;
  1.  N NODE
  1.  S NODE=$G(^PXRMD(801.41,DIEN,0))
  1.  I $P(NODE,U,4)="P" Q 0
  1.  I $P(NODE,U,4)="F" Q 0
  1.  Q 1
  1.  ;
  1. SELECT ;
  1.  ;this entry point is used from the option on the reminder dialog menu
  1.  N DIC,Y
  1.  S DIC="^PXRMD(801.41,"
  1.  S DIC(0)="AEMQ"
  1.  S DIC("A")="Select Dialog Definition: "
  1.  S DIC("S")="I $$SCREEN^PXRMDLRP(Y)=1"
  1.  ;Current dialog type only
  1.  D ^DIC
  1.  I Y>0 D WRITE(+Y)
  1.  Q
  1.  ;
  1. VALIDFND(IEN,DNAME,EXT,TYPE,CNT,MESS,FAIL) ;
  1.  N FIND,NIN,NODE,MHTEST,OUTPUT,TEXT
  1.  ;S DNAME=$P($G(^PXRMD(801.41,IEN,0)),U)
  1.  ;
  1.  ;disregard Reminder Dialogs and Result Elements
  1.  I TYPE="R"!(TYPE="T") Q
  1.  ;
  1.  ;Result Groups only need to be check for MH Data
  1.  I TYPE="S" D  Q
  1.  .S NODE=$G(^PXRMD(801.41,IEN,50))
  1.  .I +$P(NODE,U)'>0 D
  1.  ..S TEXT(1)="The result group "_DNAME_" does not contain a valid MH Test."
  1.  ..D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  ..S FAIL="F"
  1.  .I +$P(NODE,U,2)'>0 D
  1.  ..S TEXT(1)="The result group "_DNAME_" does not contain a valid MH Scale."
  1.  ..D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  ..S FAIL="F"
  1.  .I +$P(NODE,U)>0,$$VALIDENT($P(NODE,U)_";YTT(601.71,")=0 D
  1.  ..S TEXT(1)="The result group "_DNAME_" does not contain a valid MH Test."
  1.  ..D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  ..S FAIL="F"
  1.  ;
  1.  S NODE=$G(^PXRMD(801.41,IEN,1))
  1.  ;check Orderable items
  1.  I +$P(NODE,U,7)>0,$$VALIDENT(+$P(NODE,U,7)_";ORD(101.43,")=0 D
  1.  .S TEXT(1)="The "_EXT_" "_DNAME_" contains a pointer to an Orderable Item that does not exist on the system."
  1.  .D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  .S FAIL="F"
  1.  ;
  1.  ;check finding item
  1.  I $P(NODE,U,5)'="" D
  1.  .S FIND=$P(NODE,U,5)
  1.  .I $$VALIDENT(FIND)=0 D  Q
  1.  ..S TEXT(1)="The "_EXT_" "_DNAME_" contains an a pointer to the finding item that does not exist on the system."
  1.  ..D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  ..S FAIL="F"
  1.  .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)
  1.  ;
  1.  ;check additional findings
  1.  S FIND=0 F  S FIND=$O(^PXRMD(801.41,IEN,3,"B",FIND)) Q:FIND=""  D
  1.  .I $$VALIDENT(FIND)=0 D  Q
  1.  ..S TEXT(1)="The "_EXT_" "_DNAME_" contains a pointer to an additional finding item that does not exist on the system."
  1.  ..D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  ..S FAIL="F"
  1.  .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)
  1.  Q
  1.  ;
  1. VALIDENT(FIND) ;
  1.  N FILENUM,IEN
  1.  S FILENUM=$$FNFR^PXRMUTIL(U_$P(FIND,";",2))
  1.  Q $$FIND1^DIC(FILENUM,"","QU","`"_$P(FIND,";"))
  1.  ;
  1. VALIDITM(IEN,NAME,EXT,CNT,MESS,FAIL) ;
  1.  N TEXT
  1.  I '$D(^PXRMD(801.41,IEN)) D  Q
  1.  .S TEXT(1)=NAME_" contains a pointer to an invalid dialog item."
  1.  .D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  .S FAIL="F"
  1.  I +$P(^PXRMD(801.41,IEN,0),U,3)>0 D
  1.  .S TEXT(1)="The "_EXT_" "_NAME_" is disabled."
  1.  .D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  .I $G(FAIL)'="F" S FAIL="W"
  1.  Q
  1.  ;
  1. VALIDNAM(DIEN,DNAME,FIELD,EXT,TYPE,CNT,MESS,OLIST,TLIST,RETFAIL) ;
  1.  N ARRAY,FAIL,FLDNAM,NAME,TCNT,TEXT
  1.  ;determine field object/tiu template is in
  1.  S FLDNAM=$S(FIELD=25:"Dialog Text",1:"Alternate Progress Note Text")
  1.  S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
  1.  ;
  1.  I $D(OLIST)>0 D
  1.  .S TCNT=0 F  S TCNT=$O(OLIST(TCNT)) Q:TCNT'>0  D
  1.  ..S NAME=OLIST(TCNT)
  1.  ..;do not check result element objects called SCORE
  1.  ..I TYPE="T",NAME="SCORE" Q
  1.  ..;dbia 5447
  1.  ..S FAIL=$$OBJSTAT^TIUCHECK(NAME)
  1.  ..I FAIL=-1 D  Q
  1.  ...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."
  1.  ...D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  ...S RETFAIL="F"
  1.  ..I FAIL=0 D  Q
  1.  ...S TEXT(1)="The "_EXT_" "_DNAME_" contains a reference to a TIU Object "_NAME_" in the "_FLDNAM_" field. This TIU Object is inactive."
  1.  ...D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  ...I $G(RETFAIL)'="F" S RETFAIL="W"
  1.  ;
  1.  I $D(TLIST)>0 D
  1.  .S TCNT=0 F  S TCNT=$O(TLIST(TCNT)) Q:TCNT'>0  D
  1.  ..S NAME=TLIST(TCNT)
  1.  ..;dbia 5447
  1.  ..S FAIL=$$TEMPSTAT^TIUCHECK(NAME)
  1.  ..I FAIL=-1 D  Q
  1.  ...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."
  1.  ...D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  ...S RETFAIL="F"
  1.  ..I FAIL=0 D  Q
  1.  ...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."
  1.  ...D BUILDMSG(.TEXT,.CNT,.MESS,1)
  1.  ...I $G(RETFAIL)'="F" S RETFAIL="W"
  1.  Q
  1.  ;
  1.  ;
  1. VALIDTXT(DIEN,NAME,EXT,TYPE,CNT,MESS,FAIL) ;
  1.  N OBJLIST,TEXT,TLIST
  1.  I $$ODDPIPES(IEN,NAME,EXT,TYPE,.CNT,.MESS,.FAIL)=1 Q
  1.  ;check dialog/progress note text
  1.  D TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,25,.OBJLIST,.TLIST)
  1.  I $D(OBJLIST)>0!($D(TLIST)>0) D VALIDNAM(IEN,NAME,25,EXT,TYPE,.CNT,.MESS,.OBJLIST,.TLIST,.FAIL)
  1.  K OBJLIST,TLIST
  1.  ;Check alternate progress note text
  1.  D TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,35,.OBJLIST,.TLIST)
  1.  I $D(OBJLIST)>0!($D(TLIST)>0) D VALIDNAM(IEN,NAME,35,EXT,TYPE,.CNT,.MESS,.OBJLIST,.TLIST,.FAIL)
  1.  Q
  1.  ;
  1. TIUSRCH(DIEN) ;
  1.  N CNT,DLGARR,DNAME,EXT,FAIL,IEN,MESS,NAME,OCNT,OBJLIST,OLIST,TLIST,TYPE
  1.  S CNT=0,OCNT=0
  1.  S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
  1.  D DITEMAR(DIEN,.DLGARR,.CNT,.MESS,.FAIL)
  1.  S IEN="" F  S IEN=$O(DLGARR(IEN)) Q:IEN'>0  D
  1.  .S DNAME=$P($G(^PXRMD(801.41,IEN,0)),U)
  1.  .S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
  1.  .S EXT=$$EXTERNAL^DILFD(801.41,4,"",TYPE)
  1.  .I $$ODDPIPES(IEN,NAME,EXT,TYPE,.CNT,.MESS,.FAIL)=1 Q
  1.  .;check dialog/progress note text
  1.  .D TIUSRCH^PXRMEXU1("^PXRMD(801.41,",DIEN,25,.OBJLIST,.TLIST)
  1.  .I $D(OBJLIST)>0 D
  1.  ..D VALIDNAM(IEN,NAME,25,EXT,TYPE,.CNT,.MESS,.OBJLIST,.TLIST,.FAIL)
  1.  Q
  1.  ;
  1. WRITE(DIEN) ;
  1.  N CNT,FAIL,MESS,NAME
  1.  S CNT=0
  1.  S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
  1.  D EN(DIEN,NAME,.CNT,.MESS,.FAIL)
  1.  I '$D(MESS) W !,"NO ERRORS FOUND" H 1 Q
  1.  W !,NAME_" contains the following errors."
  1.  S CNT=0 F  S CNT=$O(MESS(CNT)) Q:CNT'>0  D
  1.  .W !,MESS(CNT)
  1.  H 1
  1.  Q
  1.  ;