Index: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXIU.m
===================================================================
--- WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXIU.m	(revision 613)
+++ WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXIU.m	(revision 623)
@@ -1,252 +1,262 @@
-PXRMEXIU	; SLC/PKR/PJH - Utilities for installing repository entries. ;07/27/2007
-	;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
-	;===============================================
-DEF(FDA,NAMECHG)	;Check the reminder definition to make sure the related
-	;reminder exists and all the findings exist.
-	N ABBR,ALIST,IEN,IENS,FILENUM,FINDING,LRD,OFINDING,PT01
-	N RRG,SPONSOR,TEXT,VERSN
-	S IENS=$O(FDA(811.9,""))
-	;
-	;Related reminder guideline field 1.4.
-	I $D(FDA(811.9,IENS,1.4)) D
-	. S RRG=FDA(811.9,IENS,1.4)
-	. S IEN=$$EXISTS^PXRMEXIU(811.9,RRG)
-	. I IEN=0 D
-	..;Get replacement.
-	.. N DIC,X,Y
-	.. S TEXT(1)=" "
-	.. S TEXT(2)="The Related Reminder Guideline does not exist on your system!"
-	.. S TEXT(3)="It is "_RRG_" input a replacement or ^ to leave it empty."
-	.. D MES^XPDUTL(.TEXT)
-	..;If this is being called during a KIDS install we need echoing on.
-	.. I $D(XPDNM) X ^%ZOSF("EON")
-	.. S DIC=811.9,DIC(0)="AEMQ"
-	.. D ^DIC
-	.. I $D(XPDNM) X ^%ZOSF("EOFF")
-	.. I Y=-1 K FDA(811.9,IENS,1.4)
-	.. E  S FDA(811.9,IENS,1.4)=$P(Y,U,2)
-	;
-	;Sponsor field 101.
-	I $D(FDA(811.9,IENS,101)) D
-	. S SPONSOR=FDA(811.9,IENS,101)
-	. S IEN=$$FIND1^DIC(811.6,"","",SPONSOR)
-	. I IEN=0 D
-	..;Get replacement.
-	.. N DIC,X,Y
-	.. S TEXT(1)=" "
-	.. S TEXT(2)="The Sponsor does not exist on your system!"
-	.. S TEXT(3)="It is "_SPONSOR_" input a replacement or ^ to leave it empty."
-	.. D MES^XPDUTL(.TEXT)
-	..;If this is being called during a KIDS install we need echoing on.
-	.. I $D(XPDNM) X ^%ZOSF("EON")
-	.. S DIC=811.6,DIC(0)="AEMQ"
-	.. D ^DIC
-	.. I $D(XPDNM) X ^%ZOSF("EOFF")
-	.. I Y=-1 K FDA(811.9,IENS,101)
-	.. E  S FDA(811.9,IENS,101)=$P(Y,U,2)
-	;
-	;Linked reminder dialog field 51.
-	S LRD=$G(FDA(811.9,IENS,51))
-	S IEN=$S(LRD="":0,1:+$O(^PXRMD(801.41,"B",LRD,"")))
-	I IEN=0 K FDA(811.9,IENS,51)
-	;
-	;Search the finding multiple for replacements and missing findings.
-	D BLDALIST^PXRMVPTR(811.902,.01,.ALIST)
-	S IENS=""
-	F  S IENS=$O(FDA(811.902,IENS)) Q:IENS=""  D
-	. S (FINDING,OFINDING)=FDA(811.902,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(811.902,IENS,.01)=FINDING
-	. S IEN=+$$VFIND1(FINDING,.ALIST)
-	. I IEN>0 S FDA(811.902,IENS,.01)=ABBR_".`"_IEN
-	. I IEN=0 D
-	..;Get replacement
-	.. N DIC,DUOUT,TEXT,X,Y
-	.. S TEXT="Finding "_FINDING_" does not exist; input a replacement or ^ to quit the install."
-	.. W !,TEXT
-	.. S DIC=FILENUM
-	.. I DIC="60" S DIC("S")="I $$LABPANEL^PXRMEXIU(Y)"
-	.. 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="" K FDA
-	.. I Y="" Q
-	.. S FINDING=ABBR_"."_$P(Y,U,2),FDA(811.902,IENS,.01)=FINDING
-	.;Save the finding information for the history.
-	. S ^TMP("PXRMEXIA",$J,"DEFF",$P(IENS,",",1),OFINDING)=FINDING
-	.;Save changes to Orderable items for dialog
-	. I FILENUM=101.43,OFINDING'=FINDING
-	. S NAMECHG(FILENUM,$P(OFINDING,".",2))=$P(FINDING,".",2)
-	S VERSN=$$GETTAGV^PXRMEXU3(^PXD(811.8,PXRMRIEN,100,3,0),"<PACKAGE_VERSION>")
-	I VERSN=1.5 D CEFD^PXRMDATE(.FDA)
-	Q
-	;
-	;===============================================
-EXISTS(FILENUM,NAME,FLAG)	;Check for existence of an entry with the
-	;same name. Return 0 for null name
-	I NAME="" Q 0
-	;Return the ien if it does, 0 otherwise.
-	N IEN
-	I FILENUM=0 S IEN=$$EXISTS^PXRMEXCF(NAME) Q
-	N FLAGS,RESULT
-	S RESULT=NAME
-	;Special lookup for files 80 and 80.1, they do not have a standard "B"
-	;cross-reference.
-	I (FILENUM=80)!(FILENUM=80.1) D
-	.;Name may or may not have the necessary space appended, make sure
-	.;it does.
-	. S RESULT=$S($E(NAME,$L(NAME))'=" ":NAME_" ",1:NAME)
-	. S FLAGS="MX"
-	E  S FLAGS="BX"
-	I FILENUM=811.6 S FLAGS=FLAGS_"U"
-	;File 8927.1 only allows upper case .01s.
-	I FILENUM=8927.1 S RESULT=$$UP^XLFSTR(NAME)
-	S IEN=$$FIND1^DIC(FILENUM,"",FLAGS,RESULT)
-	I +IEN>0 Q IEN
-	;If IEN is null then there was an error try FIND^DIC.
-	N FILENAME,LIST,MSG,NFOUND,TEXT
-	D FIND^DIC(FILENUM,"","",FLAGS,NAME,"","","","","LIST","MSG")
-	S NFOUND=+$P(LIST("DILIST",0),U,1)
-	I NFOUND=0 Q 0
-	I NFOUND=1 Q LIST("DILIST",2,1)
-	;Multiple entries with the same name found.
-	S FILENAME=$$GET1^DID(FILENUM,"","","NAME")
-	S TEXT(1)="Warning there are "_NFOUND_" "_FILENAME_" entries with the name "_NAME_"!"
-	S TEXT(2)="If this is used as a finding, and it is not resolved by FileMan during"
-	S TEXT(3)="installation, any component using this finding will not install."
-	D EN^DDIOL(.TEXT)
-	I $G(FLAG)="W" H 3 Q LIST("DILIST",2,1)
-	I NFOUND>1 S IEN=$$GETIEN^PXRMEXU0(NFOUND,.LIST)
-	Q IEN
-	;
-	;===============================================
-GETACT(CHOICES,DIR)	;Get the action
-	;If CHOICES is empty the only action is skip.
-	I CHOICES="" Q "S"
-	N DIROUT,DIRUT,DTOUT,DUOUT,X,Y
-	S DIR(0)="S"_U
-	I CHOICES["C" S DIR(0)=DIR(0)_"C:Create a new entry by copying to a new name"
-	I CHOICES["D" S DIR(0)=DIR(0)_";D:Delete (from the reminder/dialog)"
-	I CHOICES["I" S DIR(0)=DIR(0)_";I:Install"
-	I CHOICES["M" S DIR(0)=DIR(0)_";M:Merge findings"
-	I CHOICES["O" S DIR(0)=DIR(0)_";O:Overwrite the current entry"
-	I CHOICES["P" S DIR(0)=DIR(0)_";P:Replace (in the reminder/dialog) with an existing entry"
-	I CHOICES["Q" S DIR(0)=DIR(0)_";Q:Quit the install"
-	I CHOICES["R" S DIR(0)=DIR(0)_";R:Restart"
-	I CHOICES["S" S DIR(0)=DIR(0)_";S:Skip, do not install this entry"
-	;If this is being called during a KIDS install we need echoing on.
-	I $D(XPDNM) X ^%ZOSF("EON")
-	D ^DIR
-	I $D(XPDNM) X ^%ZOSF("EOFF")
-	I $D(DIROUT)!$D(DIRUT) S Y="S"
-	I $D(DTOUT)!($D(DUOUT)) S Y="S"
-	Q Y
-	;
-	;===============================================
-GETNAME(MIN,MAX)	;Get a name to use.
-	N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
-	S DIR(0)="FAOU"_U_MIN_":"_MAX
-	S DIR("A")="Input the new name: "
-	D ^DIR
-	I $D(DIROUT)!$D(DIRUT) Q ""
-	I $D(DTOUT)!$D(DUOUT) Q ""
-	Q Y
-	;
-	;===============================================
-GETUNAME(ATTR)	;Get a unique name to use, ATTR holds the attributes.
-	N IEN,NEWPT01,TEXT
-GNEW	S NEWPT01=$$GETNAME(ATTR("MIN FIELD LENGTH"),ATTR("FIELD LENGTH"))
-	S IEN=+$$EXISTS(ATTR("FILE NUMBER"),NEWPT01)
-	I IEN>0 D  G GNEW
-	. S TEXT=ATTR("FILE NAME")_" entry "_NEWPT01_" already exists, what do you want to do?"
-	. D EN^DDIOL(TEXT)
-	E  S ATTR("NAME")=NEWPT01
-	Q NEWPT01
-	;
-	;===============================================
-HF(FDA,NAMECHG)	;Check the health factor to make sure a category does not
-	;have a category.
-	N IENS
-	S IENS=$O(FDA(9999999.64,""))
-	I IENS="" Q
-	I FDA(9999999.64,IENS,.1)="CATEGORY" K FDA(9999999.64,IENS,.03)
-	Q
-	;
-	;===============================================
-LABPANEL(IEN)	;
-	N NODE
-	S NODE=^LAB(60,IEN,0)
-	I $P(NODE,U,4)'["CH" Q 1
-	I $P(NODE,U,5)="" Q 0
-	Q 1
-	;
-	;===============================================
-REXISTS(NAME,DATEP)	;See if this Exchange File entry already exists.
-	N IEN,LUVALUE
-	S LUVALUE(1)=NAME
-	S LUVALUE(2)=DATEP
-	S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
-	Q IEN
-	;
-	;===============================================
-TERM(FDA,NAMECHG)	;Check the reminder term to make sure all the
-	;findings exist.
-	N ABBR,ALIST,IEN,IENS,FILENUM,FINDING,OFINDING,PT01
-	;Search the finding multiple for replacements and missing findings.
-	D BLDALIST^PXRMVPTR(811.52,.01,.ALIST)
-	S IENS=""
-	F  S IENS=$O(FDA(811.52,IENS)) Q:IENS=""  D
-	. S (FINDING,OFINDING)=FDA(811.52,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(811.52,IENS,.01)=FINDING
-	. S IEN=+$$VFIND1(FINDING,.ALIST)
-	. I IEN>0 S FDA(811.52,IENS,.01)=ABBR_".`"_IEN
-	. I IEN=0 D
-	..;Get replacement
-	.. N DIC,DUOUT,TEXT,X,Y
-	.. S TEXT="Finding "_FINDING_" does not exist; input a replacement or ^ to quit the install."
-	.. D BMES^XPDUTL(TEXT)
-	.. S DIC=FILENUM
-	.. I DIC="60" S DIC("S")="I $$LABPANEL^PXRMEXIU(Y)"
-	.. 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) D
-	.... S Y=""
-	.... K FDA
-	.. I Y="" K FDA(811.52,IENS)
-	.. E  D
-	... S FINDING=ABBR_"."_$P(Y,U,2)
-	... S FDA(811.52,IENS,.01)=FINDING
-	.;Save the finding information for the history.
-	. S ^TMP("PXRMEXIA",$J,"TRMF",$P(IENS,",",1),OFINDING)=FINDING
-	Q
-	;
-	;===============================================
-VFIND1(VPTR,ALIST)	;Given a variable pointer of the form ABBR.NAME
-	;and ALIST which contains the link between abbreviations and files
-	;return the IEN if it exists and 0 if no match if found.
-	N ABBR,IEN,FILENUM,PT01,RESULT
-	S IEN=0
-	S ABBR=$P(VPTR,".",1)
-	S PT01=$P(VPTR,".",2,99)
-	S FILENUM=$P(ALIST(ABBR),U,1)
-	S IEN=$$EXISTS(FILENUM,PT01)
-	Q IEN
-	;
+PXRMEXIU ; SLC/PKR/PJH - Utilities for installing repository entries. ;06/23/2005
+ ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
+ ;===============================================
+DEF(FDA,NAMECHG) ;Check the reminder definition to make sure the related
+ ;reminder exists and all the findings exist.
+ N ABBR,ALIST,IEN,IENS,FILENUM,FINDING,LRD,OFINDING,PT01
+ N RRG,SPONSOR,TEXT,VERSN
+ S IENS=$O(FDA(811.9,""))
+ ;
+ ;Related reminder guideline field 1.4.
+ I $D(FDA(811.9,IENS,1.4)) D
+ . S RRG=FDA(811.9,IENS,1.4)
+ . S IEN=$$EXISTS^PXRMEXIU(811.9,RRG)
+ . I IEN=0 D
+ ..;Get replacement.
+ .. N DIC,X,Y
+ .. S TEXT(1)=" "
+ .. S TEXT(2)="The Related Reminder Guideline does not exist on your system!"
+ .. S TEXT(3)="It is "_RRG_" input a replacement or ^ to leave it empty."
+ .. D MES^XPDUTL(.TEXT)
+ ..;If this is being called during a KIDS install we need echoing on.
+ .. I $D(XPDNM) X ^%ZOSF("EON")
+ .. S DIC=811.9,DIC(0)="AEMQ"
+ .. D ^DIC
+ .. I $D(XPDNM) X ^%ZOSF("EOFF")
+ .. I Y=-1 K FDA(811.9,IENS,1.4)
+ .. E  S FDA(811.9,IENS,1.4)=$P(Y,U,2)
+ ;
+ ;Sponsor field 101.
+ I $D(FDA(811.9,IENS,101)) D
+ . S SPONSOR=FDA(811.9,IENS,101)
+ . S IEN=$$FIND1^DIC(811.6,"","",SPONSOR)
+ . I IEN=0 D
+ ..;Get replacement.
+ .. N DIC,X,Y
+ .. S TEXT(1)=" "
+ .. S TEXT(2)="The Sponsor does not exist on your system!"
+ .. S TEXT(3)="It is "_SPONSOR_" input a replacement or ^ to leave it empty."
+ .. D MES^XPDUTL(.TEXT)
+ ..;If this is being called during a KIDS install we need echoing on.
+ .. I $D(XPDNM) X ^%ZOSF("EON")
+ .. S DIC=811.6,DIC(0)="AEMQ"
+ .. D ^DIC
+ .. I $D(XPDNM) X ^%ZOSF("EOFF")
+ .. I Y=-1 K FDA(811.9,IENS,101)
+ .. E  S FDA(811.9,IENS,101)=$P(Y,U,2)
+ ;
+ ;Linked reminder dialog field 51.
+ S LRD=+$G(FDA(811.9,IENS,51))
+ S IEN=$$EXISTS^PXRMEXIU(801.41,LRD)
+ I IEN=0 K FDA(811.9,IENS,51)
+ ;
+ ;Search the finding multiple for replacements and missing findings.
+ D BLDALIST^PXRMVPTR(811.902,.01,.ALIST)
+ S IENS=""
+ F  S IENS=$O(FDA(811.902,IENS)) Q:IENS=""  D
+ . S (FINDING,OFINDING)=FDA(811.902,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(811.902,IENS,.01)=FINDING
+ . S IEN=+$$VFIND1(FINDING,.ALIST)
+ . I IEN>0 S FDA(811.902,IENS,.01)=ABBR_".`"_IEN
+ . I IEN=0 D
+ ..;Get replacement
+ .. N DIC,DUOUT,TEXT,X,Y
+ .. S TEXT="Finding "_FINDING_" does not exist; input a replacement or ^ to quit the install."
+ .. W !,TEXT
+ .. S DIC=FILENUM
+ .. I DIC="60" S DIC("S")="I $$LABPANEL^PXRMEXIU(Y)"
+ .. 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="" K FDA
+ .. I Y="" Q
+ .. S FINDING=ABBR_"."_$P(Y,U,2),FDA(811.902,IENS,.01)=FINDING
+ .;Save the finding information for the history.
+ . S ^TMP("PXRMEXIA",$J,"DEFF",$P(IENS,",",1),OFINDING)=FINDING
+ .;Save changes to Orderable items for dialog
+ . I FILENUM=101.43,OFINDING'=FINDING
+ . S NAMECHG(FILENUM,$P(OFINDING,".",2))=$P(FINDING,".",2)
+ S VERSN=$$GETTAGV^PXRMEXU3(^PXD(811.8,PXRMRIEN,100,3,0),"<PACKAGE_VERSION>")
+ I VERSN=1.5 D CEFD^PXRMDATE(.FDA)
+ Q
+ ;
+ ;===============================================
+EXISTS(FILENUM,NAME,FLAG) ;Check for existence of an entry with the
+ ;same name. Return 0 for null name
+ I NAME="" Q 0
+ ;Return the ien if it does, 0 otherwise.
+ N IEN
+ I FILENUM=0 S IEN=$$EXISTS^PXRMEXCF(NAME) Q
+ N FLAGS,RESULT
+ S RESULT=NAME
+ ;Special lookup for files 80 and 80.1, they do not have a standard "B"
+ ;cross-reference.
+ I (FILENUM=80)!(FILENUM=80.1) D
+ .;Name may or may not have the necessary space appended, make sure
+ .;it does.
+ . S RESULT=$S($E(NAME,$L(NAME))'=" ":NAME_" ",1:NAME)
+ . S FLAGS="MX"
+ E  S FLAGS="BX"
+ I FILENUM=811.6 S FLAGS=FLAGS_"U"
+ ;File 8927.1 only allows upper case .01s.
+ I FILENUM=8927.1 S RESULT=$$UP^XLFSTR(NAME)
+ S IEN=$$FIND1^DIC(FILENUM,"",FLAGS,RESULT)
+ I +IEN>0 Q IEN
+ ;If IEN is null then there was an error try FIND^DIC.
+ N FILENAME,LIST,MSG,NFOUND,TEXT
+ D FIND^DIC(FILENUM,"","",FLAGS,NAME,"","","","","LIST","MSG")
+ S NFOUND=+$P(LIST("DILIST",0),U,1)
+ I NFOUND=0 Q 0
+ I NFOUND=1 Q LIST("DILIST",2,1)
+ ;Multiple entries with the same name found.
+ S FILENAME=$$GET1^DID(FILENUM,"","","NAME")
+ S TEXT(1)="Warning there are "_NFOUND_" "_FILENAME_" entries with the name "_NAME_"!"
+ S TEXT(2)="If this is used as a finding, and it is not resolved by FileMan during"
+ S TEXT(3)="installation, any component using this finding will not install."
+ D EN^DDIOL(.TEXT)
+ I $G(FLAG)="W" H 3 Q LIST("DILIST",2,1)
+ I NFOUND>1 S IEN=$$GETIEN^PXRMEXU0(NFOUND,.LIST)
+ Q IEN
+ ;
+ ;===============================================
+GETACT(CHOICES,DIR) ;Get the action
+ ;If CHOICES is empty the only action is skip.
+ I CHOICES="" Q "S"
+ N DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+ S DIR(0)="S"_U
+ I CHOICES["C" S DIR(0)=DIR(0)_"C:Create a new entry by copying to a new name"
+ I CHOICES["D" S DIR(0)=DIR(0)_";D:Delete (from the reminder/dialog)"
+ I CHOICES["I" S DIR(0)=DIR(0)_";I:Install"
+ I CHOICES["M" S DIR(0)=DIR(0)_";M:Merge findings"
+ I CHOICES["O" S DIR(0)=DIR(0)_";O:Overwrite the current entry"
+ I CHOICES["P" S DIR(0)=DIR(0)_";P:Replace (in the reminder/dialog) with an existing entry"
+ I CHOICES["Q" S DIR(0)=DIR(0)_";Q:Quit the install"
+ I CHOICES["R" S DIR(0)=DIR(0)_";R:Restart"
+ I CHOICES["S" S DIR(0)=DIR(0)_";S:Skip, do not install this entry"
+ ;If this is being called during a KIDS install we need echoing on.
+ I $D(XPDNM) X ^%ZOSF("EON")
+ D ^DIR
+ I $D(XPDNM) X ^%ZOSF("EOFF")
+ I $D(DIROUT)!$D(DIRUT) S Y="S"
+ I $D(DTOUT)!($D(DUOUT)) S Y="S"
+ Q Y
+ ;
+ ;===============================================
+GETNAME(MIN,MAX) ;Get a name to use.
+ N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+ S DIR(0)="FAOU"_U_MIN_":"_MAX
+ S DIR("A")="Input the new name: "
+ D ^DIR
+ I $D(DIROUT)!$D(DIRUT) Q ""
+ I $D(DTOUT)!$D(DUOUT) Q ""
+ Q Y
+ ;
+ ;===============================================
+GETUNAME(ATTR) ;Get a unique name to use, ATTR holds the attributes.
+ N IEN,NEWPT01,TEXT
+GNEW S NEWPT01=$$GETNAME(ATTR("MIN FIELD LENGTH"),ATTR("FIELD LENGTH"))
+ S IEN=+$$EXISTS(ATTR("FILE NUMBER"),NEWPT01)
+ I IEN>0 D  G GNEW
+ . S TEXT=ATTR("FILE NAME")_" entry "_NEWPT01_" already exists, what do you want to do?"
+ . D EN^DDIOL(TEXT)
+ E  S ATTR("NAME")=NEWPT01
+ Q NEWPT01
+ ;
+ ;===============================================
+HF(FDA,NAMECHG) ;Check the health factor to make sure a category does not
+ ;have a category.
+ N IENS
+ S IENS=$O(FDA(9999999.64,""))
+ I IENS="" Q
+ I FDA(9999999.64,IENS,.1)="CATEGORY" K FDA(9999999.64,IENS,.03)
+ Q
+ ;
+ ;===============================================
+LABPANEL(IEN) ;
+ N NODE
+ S NODE=^LAB(60,IEN,0)
+ I $P(NODE,U,4)'["CH" Q 1
+ I $P(NODE,U,5)="" Q 0
+ Q 1
+ ;
+ ;===============================================
+REXISTS(NAME,DATEP) ;See if this Exchange File entry already exists.
+ N IEN,LUVALUE
+ S LUVALUE(1)=NAME
+ S LUVALUE(2)=DATEP
+ S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
+ Q IEN
+ ;
+ ;===============================================
+SAME(ATTR,TA,NAME) ;Check existing entry and entry in packed reminder
+ ;definition to see if they are identical.
+ ;Present version only works for computed finding routines, other
+ ;types of entries can be added later.
+ N SAME
+ I ATTR("FILE NAME")="COMPUTED FINDING ROUTINE" S SAME=$$SAME^PXRMEXCF(.ATTR,.TA,NAME)
+ E  S SAME=1
+ Q SAME
+ ;
+ ;===============================================
+TERM(FDA,NAMECHG) ;Check the reminder term to make sure all the
+ ;findings exist.
+ N ABBR,ALIST,IEN,IENS,FILENUM,FINDING,OFINDING,PT01
+ ;Search the finding multiple for replacements and missing findings.
+ D BLDALIST^PXRMVPTR(811.52,.01,.ALIST)
+ S IENS=""
+ F  S IENS=$O(FDA(811.52,IENS)) Q:IENS=""  D
+ . S (FINDING,OFINDING)=FDA(811.52,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(811.52,IENS,.01)=FINDING
+ . S IEN=+$$VFIND1(FINDING,.ALIST)
+ . I IEN>0 S FDA(811.52,IENS,.01)=ABBR_".`"_IEN
+ . I IEN=0 D
+ ..;Get replacement
+ .. N DIC,DUOUT,TEXT,X,Y
+ .. S TEXT="Finding "_FINDING_" does not exist; input a replacement or ^ to quit the install."
+ .. D BMES^XPDUTL(TEXT)
+ .. S DIC=FILENUM
+ .. I DIC="60" S DIC("S")="I $$LABPANEL^PXRMEXIU(Y)"
+ .. 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) D
+ .... S Y=""
+ .... K FDA
+ .. I Y="" K FDA(811.52,IENS)
+ .. E  D
+ ... S FINDING=ABBR_"."_$P(Y,U,2)
+ ... S FDA(811.52,IENS,.01)=FINDING
+ .;Save the finding information for the history.
+ . S ^TMP("PXRMEXIA",$J,"TRMF",$P(IENS,",",1),OFINDING)=FINDING
+ Q
+ ;
+ ;===============================================
+VFIND1(VPTR,ALIST) ;Given a variable pointer of the form ABBR.NAME
+ ;and ALIST which contains the link between abbreviations and files
+ ;return the IEN if it exists and 0 if no match if found.
+ N ABBR,IEN,FILENUM,PT01,RESULT
+ S IEN=0
+ S ABBR=$P(VPTR,".",1)
+ S PT01=$P(VPTR,".",2,99)
+ S FILENUM=$P(ALIST(ABBR),U,1)
+ S IEN=$$EXISTS(FILENUM,PT01)
+ Q IEN
+ ;
