Index: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU4.m
===================================================================
--- WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU4.m	(revision 613)
+++ WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU4.m	(revision 623)
@@ -1,246 +1,215 @@
-PXRMEXU4	; SLC/PJH,PKR - Reminder Exchange #4, dialog changes. ;05/16/2007
-	;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
-	;===============================================
-DLG(FDA,NAMECHG)	;Check the dialog for renamed entries, called by
-	;silent installer. KIDSDONE is newed in INSDLG^PXRMEXSI.
-	N ABBR,ACTION,ALIST,DNAM,IEN,IENS,FILENUM,FINDING,NEWNAM,OFINDING
-	N ORITEM,OORITEM,PT01,RESULT,RRG,SRC,WP
-	S IENS=$O(FDA(801.41,""))
-	;Definition .01
-	S (PT01,DNAM)=FDA(801.41,IENS,.01)
-	I $D(NAMECHG(801.41,PT01)) D
-	.S (FDA(801.41,IENS,.01),DNAM)=NAMECHG(801.41,PT01)
-	;
-	;Build list of finding types
-	D BLDALIST^PXRMVPTR(801.4118,.01,.ALIST)
-	;Plus field 15 files
-	;S ALIST("MH")=601,ALIST("TX")=811.2
-	S ALIST("MH")=601.71,ALIST("TX")=811.2
-	S ALIST("WH")=790.404
-	;Plus field 17 file
-	S ALIST("OI")=101.43
-	;
-	;Process SOURCE REMINDER
-	S SRC=$G(FDA(801.41,IENS,2))
-	I SRC]"" D
-	.S IEN=$$EXISTS^PXRMEXIU(811.9,SRC)
-	.I IEN=0 K FDA(801.41,IENS,2)
-	;
-	;Clear RESULT if not defined
-	S RESULT=$G(FDA(801.41,IENS,55))
-	I RESULT]"" D
-	.S IEN=$$EXISTS^PXRMEXIU(801.41,RESULT)
-	.I IEN=0 K FDA(801.41,IENS,55)
-	;
-	;Process ORDERABLE ITEM
-	S (ORITEM,OORITEM)=$G(FDA(801.41,IENS,17)),ACTION=""
-	I ORITEM'="" D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
-	.S PT01=ORITEM
-	.S ABBR="OI",FILENUM=$P(ALIST(ABBR),U)
-	.I $D(NAMECHG(FILENUM,PT01)) D
-	..S ORITEM=NAMECHG(FILENUM,PT01)
-	..S FDA(801.41,IENS,17)=ORITEM
-	.S IEN=+$$VFIND1^PXRMEXIU(ABBR_"."_ORITEM,.ALIST)
-	.I IEN=0 D
-	..;Get replacement
-	..N DIC,DIR,DUOUT,MSG,X,Y
-	..S MSG(1)=" "
-	..S MSG(2)="ORDERABLE ITEM  entry "_ORITEM_" does not exist."
-	..D MES^XPDUTL(.MSG)
-	..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q"
-	..I ACTION="Q" Q
-	..I ACTION="D" K FDA(801.41,IENS,17) Q
-	..S DIC=FILENUM
-	..S DIC(0)="AEMNQ"
-	..S Y=-1
-	..F  Q:+Y'=-1  D
-	...;If this is being called during a KIDS install we need echoing on.
-	...I $D(XPDNM) X ^%ZOSF("EON")
-	...D ^DIC
-	...I $D(XPDNM) X ^%ZOSF("EOFF")
-	...;If this is being called during a KIDS install we need echoing on.
-	...I $D(DUOUT) S Y="" Q
-	...I Y=-1 D BMES^XPDUTL("You must input a replacement!")
-	..I Y="" S ACTION="Q" Q
-	..S ORITEM=$P(Y,U,2)
-	..S FDA(801.41,IENS,17)=ORITEM
-	.;Save the finding information for the history.
-	.I ORITEM'=OORITEM D
-	.. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),ABBR_"."_OORITEM)=ABBR_"."_ORITEM
-	;
-	;Process FINDING ITEM
-	S (FINDING,OFINDING)=$G(FDA(801.41,IENS,15)),ACTION=""
-	I FINDING'="" D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
-	.S ABBR=$P(FINDING,".",1)
-	.S PT01=$P(FINDING,".",2)
-	.S FILENUM=$P(ALIST(ABBR),U,1)
-	.I $D(NAMECHG(FILENUM,PT01)) D
-	..S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01)
-	..S FDA(801.41,IENS,15)=FINDING
-	.S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST)
-	.I IEN=0 D
-	..;Get replacement
-	..N DIC,DIR,DUOUT,MSG,X,Y
-	..S MSG(1)=" "
-	..S MSG(2)="FINDING entry "_FINDING_" does not exist."
-	..D MES^XPDUTL(.MSG)
-	..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q"
-	..I ACTION="Q" Q
-	..I ACTION="D" K FDA(801.41,IENS,15) Q
-	..S DIC=FILENUM
-	..S DIC(0)="AEMNQ"
-	..S Y=-1
-	..F  Q:+Y'=-1  D
-	...;If this is being called during a KIDS install we need echoing on.
-	...I $D(XPDNM) X ^%ZOSF("EON")
-	...D ^DIC
-	...I $D(XPDNM) X ^%ZOSF("EOFF")
-	...;If this is being called during a KIDS install we need echoing on.
-	...I $D(DUOUT) S Y="" Q
-	...I Y=-1 D BMES^XPDUTL("You must input a replacement!")
-	..I Y="" S ACTION="Q" Q
-	..S FINDING=ABBR_"."_$P(Y,U,2)
-	..S FDA(801.41,IENS,15)=FINDING
-	.;Save the finding information for the history.
-	.I FINDING'=OFINDING D
-	.. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING
-	.;Convert ICD9 codes to `ien format
-	.I $P(FINDING,".")="ICD9" S FDA(801.41,IENS,15)="ICD9."_$$ICD9(FINDING)
-	;
-	;Look for replacements of TIU templates.
-	I $D(NAMECHG(8927.1)) D
-	.S WP=$G(FDA(801.41,IENS,25))
-	.I WP'="" D TIURPL("{FLD:",WP,.NAMECHG,8927.1)
-	.S WP=$G(FDA(801.41,IENS,35))
-	;
-	;Process ADDITIONAL FINDINGS
-	S IENS="",ACTION=""
-	F  S IENS=$O(FDA(801.4118,IENS)) Q:IENS=""  D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
-	. S (FINDING,OFINDING)=FDA(801.4118,IENS,.01)
-	. S ABBR=$P(FINDING,".",1)
-	. S PT01=$P(FINDING,".",2)
-	. S FILENUM=$P(ALIST(ABBR),U,1)
-	. I $D(NAMECHG(FILENUM,PT01)) D
-	.. S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01)
-	.. S FDA(801.4118,IENS,.01)=FINDING
-	. S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST)
-	. I IEN=0 D  Q:ACTION="Q"
-	..;Get replacement
-	.. N DIC,DIR,DUOUT,MSG,X,Y
-	.. S MSG(1)=" "
-	.. S MSG(2)="ADDITIONAL FINDING entry "_FINDING_" does not exist."
-	.. D MES^XPDUTL(.MSG)
-	.. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
-	.. I ACTION="S" S ACTION="Q"
-	.. I ACTION="Q" Q
-	.. I ACTION="D" K FDA(801.4118,IENS) Q
-	.. S DIC=FILENUM
-	.. S DIC(0)="AEMNQ"
-	.. S Y=-1
-	.. F  Q:+Y'=-1  D
-	...;If this is being called during a KIDS install we need echoing on.
-	... I $D(XPDNM) X ^%ZOSF("EON")
-	... D ^DIC
-	... I $D(XPDNM) X ^%ZOSF("EOFF")
-	... I $D(DUOUT) S Y="" Q
-	... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
-	.. I Y="" S ACTION="Q" Q
-	.. S FINDING=ABBR_"."_$P(Y,U,2)
-	.. S FDA(801.4118,IENS,.01)=FINDING
-	. ;Save the finding information for the history.
-	. I FINDING'=OFINDING D
-	.. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING
-	. ;Convert ICD9 codes to `ien format
-	. I $P(FINDING,".")="ICD9" S FDA(801.4118,IENS,.01)=$$ICD9(FINDING)
-	;
-	I ACTION="Q" S (PXRMDONE,KIDSDONE)=1 Q
-	;Process DIALOG COMPONENT
-	S IENS="",ACTION=""
-	F  S IENS=$O(FDA(801.412,IENS)) Q:IENS=""  D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
-	. S PT01=$G(FDA(801.412,IENS,2)) Q:PT01=""
-	. S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01))
-	.I NEWNAM'="" D
-	.. S FDA(801.412,IENS,2)=NEWNAM,PT01=NEWNAM
-	.S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
-	.I IEN=0 D
-	..;Get replacement
-	.. N DIC,DIR,DUOUT,MSG,X,Y
-	.. S MSG(1)=" "
-	.. S MSG(2)="COMPONENT DIALOG entry "_PT01_" does not exist."
-	.. D MES^XPDUTL(.MSG)
-	.. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
-	.. I ACTION="S" S ACTION="Q"
-	.. I ACTION="Q" Q
-	.. I ACTION="D" K FDA(801.412,IENS) Q
-	.. S DIC=FILENUM
-	.. S DIC(0)="AEMNQ"
-	.. S DIC("S")="I ""EG""[$P(^PXRMD(801.41,Y,0),U,4)"
-	.. S Y=-1
-	.. F  Q:+Y'=-1  D
-	...;If this is being called during a KIDS install we need echoing on.
-	... I $D(XPDNM) X ^%ZOSF("EON")
-	... D ^DIC
-	... I $D(XPDNM) X ^%ZOSF("EOFF")
-	... I $D(DUOUT) S Y="" Q
-	... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
-	.. I Y="" S ACTION="Q" Q
-	.. I Y'="" S FDA(801.412,IENS,2)=$P(Y,U,2)
-	;Process Result Groups
-	F  S IENS=$O(FDA(801.41121,IENS)) Q:IENS=""  D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
-	. S PT01=$G(FDA(801.41121,IENS,.01)) Q:PT01=""
-	. S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01))
-	.I NEWNAM'="" D
-	.. S FDA(801.41121,IENS,2)=NEWNAM,PT01=NEWNAM
-	.S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
-	.I IEN=0 D
-	..;Get replacement
-	.. N DIC,DIR,DUOUT,MSG,X,Y
-	.. S MSG(1)=" "
-	.. S MSG(2)="RESULT GROUP entry "_PT01_" does not exist."
-	.. D MES^XPDUTL(.MSG)
-	.. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
-	.. I ACTION="S" S ACTION="Q"
-	.. I ACTION="Q" Q
-	.. I ACTION="D" K FDA(801.41121,IENS) Q
-	.. S DIC=FILENUM
-	.. S DIC(0)="AEMNQ"
-	.. S DIC("S")="I ""S""[$P(^PXRMD(801.41,Y,0),U,4)"
-	.. S Y=-1
-	.. F  Q:+Y'=-1  D
-	...;If this is being called during a KIDS install we need echoing on.
-	... I $D(XPDNM) X ^%ZOSF("EON")
-	... D ^DIC
-	... I $D(XPDNM) X ^%ZOSF("EOFF")
-	... I $D(DUOUT) S Y="" Q
-	... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
-	.. I Y="" S ACTION="Q" Q
-	.. I Y'="" S FDA(801.41121,IENS,.01)=$P(Y,U,2)
-	Q
-	;
-	;===============================================
-	;Convert ICD9 codes to `ien format
-ICD9(CODE)	;
-	N IEN
-	S IEN=$$FIND1^DIC(80,"","AMX",$P(CODE,".",2,99))
-	I 'IEN Q ""
-	Q "`"_IEN
-	;
-	;===============================================
-TIURPL(SRCH,WP,NAMEGHC,FILENUM)	;Replace TIU templates whose names have
-	;changed.
-	N IND,RS,TEXT,TS,TYPE
-	I FILENUM=8927.1 S TYPE="TIU TEMPLATE"
-	E  S TYPE="TIU OBJECT"
-	S IND=1
-	F  S TEXT=$G(@WP@(IND)) Q:TEXT=""  D
-	.I TEXT[SRCH D
-	..S TS=""
-	..F  S TS=$O(NAMECHG(FILENUM,TS)) Q:TS=""  D
-	...S RS=NAMECHG(FILENUM,TS) Q:TEXT'[TS
-	...S @WP@(IND)=$$STRREP^PXRMUTIL(TEXT,TS,RS)
-	...;Save the replacement information for the history.
-	...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS)=RS
-	...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS,DNAM)=""
-	.S IND=IND+1
-	Q
-	;
+PXRMEXU4 ; SLC/PJH,PKR - Reminder Exchange #4, dialog changes. ;01/19/2005
+ ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+ ;===============================================
+DLG(FDA,NAMECHG) ;Check the dialog for renamed entries, called by
+ ;silent installer. KIDSDONE is newed in INSDLG^PXRMEXSI.
+ N ABBR,ACTION,ALIST,DNAM,IEN,IENS,FILENUM,FINDING,NEWNAM,OFINDING
+ N ORITEM,OORITEM,PT01,RESULT,RRG,SRC,WP
+ S IENS=$O(FDA(801.41,""))
+ ;Definition .01
+ S (PT01,DNAM)=FDA(801.41,IENS,.01)
+ I $D(NAMECHG(801.41,PT01)) D
+ .S (FDA(801.41,IENS,.01),DNAM)=NAMECHG(801.41,PT01)
+ ;
+ ;Build list of finding types
+ D BLDALIST^PXRMVPTR(801.4118,.01,.ALIST)
+ ;Plus field 15 files
+ S ALIST("MH")=601,ALIST("TX")=811.2
+ S ALIST("WH")=790.404
+ ;Plus field 17 file
+ S ALIST("OI")=101.43
+ ;
+ ;Process SOURCE REMINDER
+ S SRC=$G(FDA(801.41,IENS,2))
+ I SRC]"" D
+ .S IEN=$$EXISTS^PXRMEXIU(811.9,SRC)
+ .I IEN=0 K FDA(801.41,IENS,2)
+ ;
+ ;Clear RESULT if not defined
+ S RESULT=$G(FDA(801.41,IENS,55))
+ I RESULT]"" D
+ .S IEN=$$EXISTS^PXRMEXIU(801.41,RESULT)
+ .I IEN=0 K FDA(801.41,IENS,55)
+ ;
+ ;Process ORDERABLE ITEM
+ S (ORITEM,OORITEM)=$G(FDA(801.41,IENS,17)),ACTION=""
+ I ORITEM'="" D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
+ .S PT01=ORITEM
+ .S ABBR="OI",FILENUM=$P(ALIST(ABBR),U)
+ .I $D(NAMECHG(FILENUM,PT01)) D
+ ..S ORITEM=NAMECHG(FILENUM,PT01)
+ ..S FDA(801.41,IENS,17)=ORITEM
+ .S IEN=+$$VFIND1^PXRMEXIU(ABBR_"."_ORITEM,.ALIST)
+ .I IEN=0 D
+ ..;Get replacement
+ ..N DIC,DIR,DUOUT,MSG,X,Y
+ ..S MSG(1)=" "
+ ..S MSG(2)="ORDERABLE ITEM  entry "_ORITEM_" does not exist."
+ ..D MES^XPDUTL(.MSG)
+ ..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q"
+ ..I ACTION="Q" Q
+ ..I ACTION="D" K FDA(801.41,IENS,17) Q
+ ..S DIC=FILENUM
+ ..S DIC(0)="AEMNQ"
+ ..S Y=-1
+ ..F  Q:+Y'=-1  D
+ ...;If this is being called during a KIDS install we need echoing on.
+ ...I $D(XPDNM) X ^%ZOSF("EON")
+ ...D ^DIC
+ ...I $D(XPDNM) X ^%ZOSF("EOFF")
+ ...;If this is being called during a KIDS install we need echoing on.
+ ...I $D(DUOUT) S Y="" Q
+ ...I Y=-1 D BMES^XPDUTL("You must input a replacement!")
+ ..I Y="" S ACTION="Q" Q
+ ..S ORITEM=$P(Y,U,2)
+ ..S FDA(801.41,IENS,17)=ORITEM
+ .;Save the finding information for the history.
+ .I ORITEM'=OORITEM D
+ .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),ABBR_"."_OORITEM)=ABBR_"."_ORITEM
+ ;
+ ;Process FINDING ITEM
+ S (FINDING,OFINDING)=$G(FDA(801.41,IENS,15)),ACTION=""
+ I FINDING'="" D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
+ .S ABBR=$P(FINDING,".",1)
+ .S PT01=$P(FINDING,".",2)
+ .S FILENUM=$P(ALIST(ABBR),U,1)
+ .I $D(NAMECHG(FILENUM,PT01)) D
+ ..S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01)
+ ..S FDA(801.41,IENS,15)=FINDING
+ .S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST)
+ .I IEN=0 D
+ ..;Get replacement
+ ..N DIC,DIR,DUOUT,MSG,X,Y
+ ..S MSG(1)=" "
+ ..S MSG(2)="FINDING entry "_FINDING_" does not exist."
+ ..D MES^XPDUTL(.MSG)
+ ..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q"
+ ..I ACTION="Q" Q
+ ..I ACTION="D" K FDA(801.41,IENS,15) Q
+ ..S DIC=FILENUM
+ ..S DIC(0)="AEMNQ"
+ ..S Y=-1
+ ..F  Q:+Y'=-1  D
+ ...;If this is being called during a KIDS install we need echoing on.
+ ...I $D(XPDNM) X ^%ZOSF("EON")
+ ...D ^DIC
+ ...I $D(XPDNM) X ^%ZOSF("EOFF")
+ ...;If this is being called during a KIDS install we need echoing on.
+ ...I $D(DUOUT) S Y="" Q
+ ...I Y=-1 D BMES^XPDUTL("You must input a replacement!")
+ ..I Y="" S ACTION="Q" Q
+ ..S FINDING=ABBR_"."_$P(Y,U,2)
+ ..S FDA(801.41,IENS,15)=FINDING
+ .;Save the finding information for the history.
+ .I FINDING'=OFINDING D
+ .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING
+ .;Convert ICD9 codes to `ien format
+ .I $P(FINDING,".")="ICD9" S FDA(801.41,IENS,15)="ICD9."_$$ICD9(FINDING)
+ ;
+ ;Look for replacements of TIU templates.
+ I $D(NAMECHG(8927.1)) D
+ .S WP=$G(FDA(801.41,IENS,25))
+ .I WP'="" D TIURPL("{FLD:",WP,.NAMECHG,8927.1)
+ .S WP=$G(FDA(801.41,IENS,35))
+ ;
+ ;Process ADDITIONAL FINDINGS
+ S IENS="",ACTION=""
+ F  S IENS=$O(FDA(801.4118,IENS)) Q:IENS=""  D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
+ . S (FINDING,OFINDING)=FDA(801.4118,IENS,.01)
+ . S ABBR=$P(FINDING,".",1)
+ . S PT01=$P(FINDING,".",2)
+ . S FILENUM=$P(ALIST(ABBR),U,1)
+ . I $D(NAMECHG(FILENUM,PT01)) D
+ .. S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01)
+ .. S FDA(801.4118,IENS,.01)=FINDING
+ . S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST)
+ . I IEN=0 D  Q:ACTION="Q"
+ ..;Get replacement
+ .. N DIC,DIR,DUOUT,MSG,X,Y
+ .. S MSG(1)=" "
+ .. S MSG(2)="ADDITIONAL FINDING entry "_FINDING_" does not exist."
+ .. D MES^XPDUTL(.MSG)
+ .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
+ .. I ACTION="S" S ACTION="Q"
+ .. I ACTION="Q" Q
+ .. I ACTION="D" K FDA(801.4118,IENS) Q
+ .. S DIC=FILENUM
+ .. S DIC(0)="AEMNQ"
+ .. S Y=-1
+ .. F  Q:+Y'=-1  D
+ ...;If this is being called during a KIDS install we need echoing on.
+ ... I $D(XPDNM) X ^%ZOSF("EON")
+ ... D ^DIC
+ ... I $D(XPDNM) X ^%ZOSF("EOFF")
+ ... I $D(DUOUT) S Y="" Q
+ ... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
+ .. I Y="" S ACTION="Q" Q
+ .. S FINDING=ABBR_"."_$P(Y,U,2)
+ .. S FDA(801.4118,IENS,.01)=FINDING
+ . ;Save the finding information for the history.
+ . I FINDING'=OFINDING D
+ .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING
+ . ;Convert ICD9 codes to `ien format
+ . I $P(FINDING,".")="ICD9" S FDA(801.4118,IENS,.01)=$$ICD9(FINDING)
+ ;
+ I ACTION="Q" S (PXRMDONE,KIDSDONE)=1 Q
+ ;Process DIALOG COMPONENT
+ S IENS="",ACTION=""
+ F  S IENS=$O(FDA(801.412,IENS)) Q:IENS=""  D  I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
+ . S PT01=$G(FDA(801.412,IENS,2)) Q:PT01=""
+ . S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01))
+ .I NEWNAM'="" D
+ .. S FDA(801.412,IENS,2)=NEWNAM,PT01=NEWNAM
+ .S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
+ .I IEN=0 D
+ ..;Get replacement
+ .. N DIC,DIR,DUOUT,MSG,X,Y
+ .. S MSG(1)=" "
+ .. S MSG(2)="COMPONENT DIALOG entry "_PT01_" does not exist."
+ .. D MES^XPDUTL(.MSG)
+ .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
+ .. I ACTION="S" S ACTION="Q"
+ .. I ACTION="Q" Q
+ .. I ACTION="D" K FDA(801.412,IENS) Q
+ .. S DIC=FILENUM
+ .. S DIC(0)="AEMNQ"
+ .. S DIC("S")="I ""EG""[$P(^PXRMD(801.41,Y,0),U,4)"
+ .. S Y=-1
+ .. F  Q:+Y'=-1  D
+ ...;If this is being called during a KIDS install we need echoing on.
+ ... I $D(XPDNM) X ^%ZOSF("EON")
+ ... D ^DIC
+ ... I $D(XPDNM) X ^%ZOSF("EOFF")
+ ... I $D(DUOUT) S Y="" Q
+ ... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
+ .. I Y="" S ACTION="Q" Q
+ .. I Y'="" S FDA(801.412,IENS,2)=$P(Y,U,2)
+ Q
+ ;
+ ;===============================================
+ ;Convert ICD9 codes to `ien format
+ICD9(CODE) ;
+ N IEN
+ S IEN=$$FIND1^DIC(80,"","AMX",$P(CODE,".",2,99))
+ I 'IEN Q ""
+ Q "`"_IEN
+ ;
+ ;===============================================
+TIURPL(SRCH,WP,NAMEGHC,FILENUM) ;Replace TIU templates whose names have
+ ;changed.
+ N IND,RS,TEXT,TS,TYPE
+ I FILENUM=8927.1 S TYPE="TIU TEMPLATE"
+ E  S TYPE="TIU OBJECT"
+ S IND=1
+ F  S TEXT=$G(@WP@(IND)) Q:TEXT=""  D
+ .I TEXT[SRCH D
+ ..S TS=""
+ ..F  S TS=$O(NAMECHG(FILENUM,TS)) Q:TS=""  D
+ ...S RS=NAMECHG(FILENUM,TS) Q:TEXT'[TS
+ ...S @WP@(IND)=$$STRREP^PXRMUTIL(TEXT,TS,RS)
+ ...;Save the replacement information for the history.
+ ...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS)=RS
+ ...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS,DNAM)=""
+ .S IND=IND+1
+ Q
+ ;
