Index: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXID.m
===================================================================
--- WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXID.m	(revision 613)
+++ WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXID.m	(revision 623)
@@ -1,283 +1,245 @@
-PXRMEXID	;SLC/PJH - Reminder Dialog Exchange Install Routine.;08/16/2007
-	;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
-	;
-	;==================================================
-	;
-	;Install all dialog components in an exchange file entry
-	;------------------------------------------------
-INSALL	N ALL,DIROUT,DIRUT,DTOUT,DUOUT,IND,PXRMDONE
-	;
-	;Set the install date and time.
-	S IND="",PXRMDONE=0
-	;
-	;Go to full screen mode.
-	D FULL^VALM1
-	;
-	;Check if all or none exists - option to install all unchanged
-	N DNAME
-	S DNAME=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAM"))
-	D EXIST^PXRMEXIX(.ALL,DNAME,"reminder dialog","")
-	I ALL=0 D DISP^PXRMEXLD(PXRMMODE) Q
-	;
-	;Lock the entire file
-	Q:'$$LOCK
-	F  S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:(IND="")!(PXRMDONE)  D
-	.D INSCOM(IND,1)
-	;
-	;Clear lock
-	D UNLOCK
-	;
-	;Rebuild display workfile
-	D DISP^PXRMEXLD(PXRMMODE)
-	;
-	K PXRMNMCH
-	Q
-	;
-	;Build list of descendents names
-	;-------------------------------
-INSBLD(NAME,INAME)	;
-	N DNAME,IDATA,ISEQ
-	S ISEQ=0
-	F  S ISEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:'ISEQ  D
-	.S IDATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:IDATA=""
-	.S DNAME=$P(IDATA,U) Q:DNAME=""
-	.;
-	.I $D(^TMP("PXRMEXTMP",$J,"DREPL"))>0 D
-	..S REPL=$$CHKREPL^PXRMEXD1(NAME) I REPL>0 D INSREPL(NAME,REPL,.INAME)
-	.S INAME(DNAME)=""
-	.;Q:$$PXRM(DNAME)  S INAME(DNAME)=""
-	.;Check for descendants
-	.I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D INSBLD(DNAME,.INAME)
-	Q
-	;Build list of replacement names
-	;-------------------------------
-INSREPL(NAME,REPL,INAME)	;
-	N DNAME,IDATA,ISEQ
-	S ISEQ=0
-	S IDATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",REPL,NAME)) Q:IDATA=""
-	S DNAME=$P(IDATA,U) Q:DNAME=""  S INAME(DNAME)=""
-	;S DNAME=$P(IDATA,U) Q:DNAME=""  Q:$$PXRM(DNAME)  S INAME(DNAME)=""
-	;Check for descendants
-	I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D INSBLD(DNAME,.INAME)
-	Q
-	;
-	;Install component IND
-	;---------------------
-INSCOM(IND,SILENT)	;
-	N ACTION,ATTR,CSUM,DTYP,EXIEN,END,EXISTS,FILENUM,IND120,JND120
-	N NEWPT01,PT01,START,REPL,SAME,TEMP
-	S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND),FILENUM=$P(TEMP,U,1)
-	S EXISTS=$P(TEMP,U,4),START=$P(TEMP,U,2),END=$P(TEMP,U,3) Q:START=""
-	S JND120=$P(TEMP,U,6) Q:'JND120
-	S IND120=$P(TEMP,U,5) Q:'IND120
-	S TEMP=^PXD(811.8,PXRMRIEN,100,START,0),PT01=$P(TEMP,"~",2) Q:PT01=""
-	S DTYP=$G(^TMP("PXRMEXTMP",$J,"DTYP",PT01))
-	I DTYP="dialog" S DTYP="reminder dialog"
-	;
-	;Go to full screen mode.
-	D FULL^VALM1
-	;
-	;Check for descendents
-	S REPL=$$CHKREPL^PXRMEXD1(PT01)
-	I 'SILENT&($$INSDSC(PT01)!(REPL>0)) D  Q:PXRMDONE
-	.N ANS,INDS,TEXT
-	.S TEXT(1)=PT01_" ("_DTYP_") contains sub-components."
-	.S TEXT="Install all sub-components with the "_DTYP_": "
-	.;Give option to install all descendents
-	.D ASK^PXRMEXIX(.ANS,.TEXT,1) Q:PXRMDONE
-	.I $G(ANS)="N" S PXRMDONE=1 Q
-	.I $G(ANS)="Y" D
-	..S INDS=IND
-	..N IDATA,INAME,IND
-	..I REPL>0 D INSREPL(PT01,REPL,.INAME)
-	..;Build list of decendents to install
-	..D INSBLD(PT01,.INAME)
-	..;Check if all or none exists - option to install all unchanged
-	..D EXIST^PXRMEXIX(.ALL,PT01,DTYP,.INAME) Q:PXRMDONE
-	..;Start at the end of the list
-	..S IND=""
-	..F  S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:PXRMDONE!(IND=INDS)  D
-	...N PT01,START,TEMP
-	...S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND),START=$P(TEMP,U,2) Q:START=""
-	...S PT01=$P(^PXD(811.8,PXRMRIEN,100,START,0),"~",2) Q:PT01=""
-	...;Ignore namechanges
-	...I $D(PXRMNMCH(801.41,PT01)) Q
-	...;Only install descendents
-	...I $D(INAME(PT01)) D INSCOM(IND,1)
-	;
-SETENTRY	;
-	D SETATTR^PXRMEXFI(.ATTR,FILENUM,PT01)
-	S ACTION=""
-	;Double check that it hasn't been installed
-	S EXIEN=$$EXISTS^PXRMEXIU(801.41,PT01)
-	I EXIEN,'EXISTS S EXISTS=1
-	I EXISTS D
-	. D CHECKSUM^PXRMEXCS(.ATTR,START,END)
-	. S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),EXIEN)
-	. S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0)
-	. I SAME D FEIMSG^PXRMEXFI(SAME,.ATTR) S ACTION="S",(PXRMNMCH,NEWPT01)=""
-	I ACTION="" D
-	.;If all components installed the default is 'Install or Overwrite'
-	. S:ALL ACTION=$S(EXISTS:"O",1:"I"),(PXRMNMCH,NEWPT01)=""
-	. S:'ALL ACTION=$$GETFACT^PXRMEXFI(PT01,.ATTR,.NEWPT01,.PXRMNMCH,EXIEN)
-	;Save what was done for the installation summary.
-	S ^TMP("PXRMEXIAD",$J,IND,ATTR("FILE NAME"),ATTR("PT01"),ACTION)=NEWPT01
-	;Clear heading
-	S VALMHDR(2)=""
-	;If the ACTION is Quit then quit the entire install.
-	I ACTION="Q" S PXRMDONE=1 S VALMHDR(2)="Install not completed" Q
-	;If the ACTION is Skip then skip this component.
-	I ACTION="S" S VALMBCK="R" Q
-	;If the ACTION is Replace then skip this component.
-	I ACTION="P" S VALMBCK="R",VALMHDR(2)=PT01_" replaced with "_NEWPT01 Q
-	;Install this component.
-	D FILE^PXRMEXIC(PXRMRIEN,EXIEN,IND120,JND120,ACTION,.ATTR,.PXRMNMCH)
-	S VALMBCK="R"
-	I PXRMDONE S VALMHDR(2)="Install aborted" Q
-	I NEWPT01="" S VALMHDR(2)=PT01_" ("_DTYP_") installed from exchange file."
-	I NEWPT01'="" S VALMHDR(2)=PT01_" installed as "_NEWPT01_"."
-	;If reminder dialog - disable and give option to link
-	I DTYP="reminder dialog" D
-	.N DNAME
-	.S DNAME=PT01
-	.I NEWPT01'="" S DNAME=NEWPT01
-	.D INSLNK(DNAME)
-	Q
-	;
-	;Check for descendents (either elements or prompts)
-	;--------------------------------------------------
-INSDSC(NAME)	;
-	N DATA,DFOUND,SUB
-	S DFOUND=0,SUB=0
-	F  S SUB=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:'SUB  D  Q:DFOUND
-	.S DATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:DATA=""
-	.S DFOUND=1
-	.;I '$$PXRM($P(DATA,U)) S DFOUND=1
-	Q DFOUND
-	;
-INSREPL1(NAME)	;
-	N DATA,DFOUND,SUB
-	S DFOUND=0,SUB=0
-	F  S SUB=$O(^TMP("PXRMEXTMP",$J,"DREPL",NAME,SUB)) Q:'SUB  D  Q:DFOUND
-	.S DATA=$G(^TMP("PXRMEXTMP",$J,"DREPL",NAME,SUB)) Q:DATA=""
-	.S DFOUND=1
-	Q DFOUND
-	;Option to link dialog to a reminder
-	;-----------------------------------
-INSLNK(DNAME)	;
-	N DIEN,DISABLE,DSRC,RNAME
-	N DA,DIE,DR
-	;Disable
-	S DIEN=$O(^PXRMD(801.41,"B",DNAME,"")) Q:'DIEN
-	;Set dialog as disabled
-	S DISABLE="DISABLED IN EXCHANGE"
-	;Except for National dialogs
-	I $P(^PXRMD(801.41,DIEN,100),U)="N" S DISABLE=""
-	;
-	S DR="3///^S X=DISABLE",DIE="^PXRMD(801.41,",DA=$P(DIEN,U)
-	D ^DIE
-	;
-	;Quit if already linked
-	I $D(^PXD(811.9,"AG",DIEN)) Q
-	;
-	S RNAME=""
-	;If reminder was renamed use as default
-	I $D(PXRMNMCH(811.9)) D
-	.S RNAME=$O(PXRMNMCH(811.9,"")) Q:RNAME=""
-	.S RNAME=$G(PXRMNMCH(811.9,RNAME))
-	;Otherwise use original reminder name as default
-	I RNAME="" D
-	.N DATA,FOUND,RIEN,SUB
-	.;Rebuild ^TMP("PXRMEXLC",$J
-	.D CDISP^PXRMEXLC(PXRMRIEN)
-	.;
-	.S SUB="",FOUND=0
-	.F  S SUB=$O(^TMP("PXRMEXLC",$J,"SEL",SUB),-1) Q:'SUB  Q:FOUND  D
-	..S DATA=$G(^TMP("PXRMEXLC",$J,"SEL",SUB)) Q:$P(DATA,U)'=811.9
-	..S RIEN=$P(DATA,U,4),FOUND=1 Q:'RIEN
-	..S RNAME=$P($G(^PXD(811.9,RIEN,0)),U)
-	;
-TAG	W !!,"Reminder Dialog "_DNAME_" is not linked to a reminder.",!
-	;Select reminder to link
-	S IEN=$$SELECT^PXRMINQ("^PXD(811.9,","Select Reminder to Link: ",RNAME)
-	;Update reminder link in #811.9
-	I $P(IEN,U)'=-1 D
-	.N DA,DIE,DIK,DR
-	.;Set reminder to dialog pointer
-	.S DR="51///^S X=DNAME",DIE="^PXD(811.9,",DA=$P(IEN,U)
-	.D ^DIE
-	.;If source reminder is null replace with linked reminder
-	.S DSRC=$P($G(^PXRMD(801.41,DIEN,0)),U,2) Q:DSRC
-	.S DSRC=$P(IEN,U)
-	.S DR="2///^S X=DSRC",DIE="^PXRMD(801.41,",DA=$P(DIEN,U)
-	.D ^DIE
-	Q
-	;
-	;Install Selected Components
-	;---------------------------
-INSSEL	N ALL,IND,PXRMDONE,VALMY
-	N DIROUT,DIRUT,DTOUT,DUOUT
-	N VALMBG,VALMLST
-	S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXLD",$J,"IDX",""),-1)
-	;Get the list to install.
-	D EN^VALM2(XQORNOD(0))
-	;
-	;Set the install date and time.
-	S ALL="",PXRMDONE=0
-	;
-	;Lock the entire file
-	Q:'$$LOCK
-	;
-	S IND=0
-	F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D INSCOM(IND,0)
-	;
-	;Clear locks
-	D UNLOCK
-	;
-	;Rebuild workfile
-	D DISP^PXRMEXLD(PXRMMODE)
-	Q
-	;
-	;Install the exchange entry PXRMRIEN
-	;-----------------------------------
-INSTALL	N IEN,IND,VALMY
-	;Make sure the component list exists for this entry. PXRMRIEN is
-	;set in INSTALL^PXRMEXLR.
-	I '$D(^PXD(811.8,PXRMRIEN,120)) D CLIST^PXRMEXU1(.PXRMRIEN)
-	I PXRMRIEN=-1 Q
-	;Format the component list for display.
-	D CDISP^PXRMEXLC(PXRMRIEN)
-	S VALMBCK="R",VALMCNT=$O(^TMP("PXRMEXLD",$J,"IDX"),-1)
-	Q
-	;
-PXRM(NAME)	;Validate prompts
-	;
-	;Ignore non-PXRM
-	I $E(NAME,1,4)'="PXRM" Q 0
-	N DIEN,RESULT
-	I $G(PXRMINST)=1 D  Q RESULT
-	.S RESULT=0
-	.S DIEN=$O(^PXRMD(801.41,"B",NAME,"")) I 'DIEN Q
-	.I $P($G(^PXRMD(801.41,DIEN,100)),U)'="N" Q
-	.I ($P($G(^PXRMD(801.41,DIEN,0)),U,4)="P")!($P($G(^PXRMD(801.41,DIEN,0)),U,4)="F") S RESULT=1
-	;
-	;Check if this is a national code
-	S DIEN=$O(^PXRMD(801.41,"B",NAME,""))
-	;If not found abort
-	I 'DIEN Q 0
-	;if result group/element quit
-	I $P($G(^PXRMD(801.41,DIEN,0)),U,4)="S"!($P($G(^PXRMD(801.41,DIEN,0)),U,4)="T") Q 0
-	;Check class
-	I $P($G(^PXRMD(801.41,DIEN,100)),U)="N" Q 1
-	;Otherwise local
-	Q 0
-	;
-	;Lock the dialog file
-LOCK()	;
-	L +^PXRMD(801.41):0 I  Q 1
-	E  W !,"Another user is editing this file, try later" H 2
-	Q 0
-	;
-	;Clear lock
-UNLOCK	L -^PXRMD(801.41)
-	Q
+PXRMEXID ;SLC/PJH - Reminder Dialog Exchange Install Routine.;11/14/2003
+ ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+ ;
+ ;==================================================
+ ;
+ ;Install all dialog components in an exchange file entry
+ ;------------------------------------------------
+INSALL N ALL,DIROUT,DIRUT,DTOUT,DUOUT,IND,PXRMDONE
+ K ^TMP("PXRMEXIA",$J)
+ ;
+ ;Set the install date and time.
+ S IND="",PXRMDONE=0,^TMP("PXRMEXIA",$J,"DT")=$$NOW^XLFDT
+ ;
+ ;Go to full screen mode.
+ D FULL^VALM1
+ ;
+ ;Check if all or none exists - option to install all unchanged
+ N DNAME
+ S DNAME=$G(^TMP("PXRMEXTMP",$J,"PXRMDNAM"))
+ D EXIST^PXRMEXIX(.ALL,DNAME,"reminder dialog","")
+ ;
+ ;Lock the entire file
+ Q:'$$LOCK
+ ;
+ ;Install all components
+ F  S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:(+IND=0)!(PXRMDONE)  D
+ .D INSCOM(IND,1)
+ ;
+ ;Clear lock
+ D UNLOCK
+ ;
+ ;Rebuild display workfile
+ D DISP^PXRMEXLD(PXRMMODE)
+ ;
+ K PXRMNMCH
+ Q
+ ;
+ ;Build list of descendents names
+ ;-------------------------------
+INSBLD(NAME,INAME) ;
+ N DNAME,IDATA,ISEQ
+ S ISEQ=0
+ F  S ISEQ=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:'ISEQ  D
+ .S IDATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,ISEQ)) Q:IDATA=""
+ .S DNAME=$P(IDATA,U) Q:DNAME=""  Q:$$PXRM(DNAME)  S INAME(DNAME)=""
+ .;Check for descendants
+ .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) D INSBLD(DNAME,.INAME)
+ Q
+ ;
+ ;Install component IND
+ ;---------------------
+INSCOM(IND,SILENT) ;
+ N ACTION,ATTR,DTYP,EXIEN,END,EXISTS,FILENUM,IND120,JND120
+ N NEWPT01,PT01,START,TEMP
+ S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND),FILENUM=$P(TEMP,U,1)
+ S EXISTS=$P(TEMP,U,4),START=$P(TEMP,U,2),END=$P(TEMP,U,3) Q:START=""
+ S JND120=$P(TEMP,U,6) Q:'JND120
+ S IND120=$P(TEMP,U,5) Q:'IND120
+ S TEMP=^PXD(811.8,PXRMRIEN,100,START,0),PT01=$P(TEMP,"~",2) Q:PT01=""
+ S DTYP=$G(^TMP("PXRMEXTMP",$J,"DTYP",PT01))
+ I DTYP="dialog" S DTYP="reminder dialog"
+ ;
+ ;Go to full screen mode.
+ D FULL^VALM1
+ ;
+ ;Check for descendents
+ I 'SILENT,$$INSDSC(PT01) D  Q:PXRMDONE
+ .N ANS,INDS,TEXT
+ .S TEXT(1)=PT01_" ("_DTYP_") contains sub-components."
+ .S TEXT="Install all sub-components with the "_DTYP_": "
+ .;Give option to install all descendents
+ .D ASK^PXRMEXIX(.ANS,.TEXT,1) Q:PXRMDONE
+ .I $G(ANS)="Y" D
+ ..S INDS=IND
+ ..N IDATA,INAME,IND
+ ..;Build list of decendents to install
+ ..D INSBLD(PT01,.INAME)
+ ..;Check if all or none exists - option to install all unchanged
+ ..D EXIST^PXRMEXIX(.ALL,PT01,DTYP,.INAME) Q:PXRMDONE
+ ..;Start at the end of the list
+ ..S IND=""
+ ..F  S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:PXRMDONE!(IND=INDS)  D
+ ...N PT01,START,TEMP
+ ...S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND),START=$P(TEMP,U,2) Q:START=""
+ ...S PT01=$P(^PXD(811.8,PXRMRIEN,100,START,0),"~",2) Q:PT01=""
+ ...;Ignore namechanges
+ ...I $D(PXRMNMCH(801.41,PT01)) Q
+ ...;Only install descendents
+ ...I $D(INAME(PT01)) D INSCOM(IND,1)
+ ;
+ D SETATTR^PXRMEXFI(.ATTR,FILENUM)
+ ;Double check that it hasn't been installed
+ S EXIEN=$$EXISTS^PXRMEXIU(801.41,PT01)
+ I EXIEN,'EXISTS S EXISTS=1
+ ;If all components installed the default is 'Install or Overwrite'
+ S:ALL ACTION=$S(EXISTS:"O",1:"I"),(ATTR("NAME"),ATTR("PT01"))=PT01,PXRMNMCH="",NEWPT01=""
+ S:'ALL ACTION=$$GETFACT^PXRMEXFI(PT01,.ATTR,.NEWPT01,.PXRMNMCH,EXISTS)
+ ;Save what was done for the installation summary.
+ S ^TMP("PXRMEXIA",$J,IND,ATTR("FILE NAME"),ATTR("PT01"),ACTION)=NEWPT01
+ ;Clear heading
+ S VALMHDR(2)=""
+ ;If the ACTION is Quit then quit the entire install.
+ I ACTION="Q" S PXRMDONE=1 S VALMHDR(2)="Install not completed" Q
+ ;If the ACTION is Skip then skip this component.
+ I ACTION="S" S VALMBCK="R" Q
+ ;If the ACTION is Replace then skip this component.
+ I ACTION="P" S VALMBCK="R",VALMHDR(2)=PT01_" replaced with "_NEWPT01 Q
+ ;Install this component.
+ D FILE^PXRMEXIC(PXRMRIEN,EXIEN,IND120,JND120,ACTION,.ATTR,.PXRMNMCH)
+ S VALMBCK="R"
+ I PXRMDONE S VALMHDR(2)="Install aborted" Q
+ I NEWPT01="" S VALMHDR(2)=PT01_" ("_DTYP_") installed from exchange file."
+ I NEWPT01'="" S VALMHDR(2)=PT01_" installed as "_NEWPT01_"."
+ ;If reminder dialog - disable and give option to link
+ I DTYP="reminder dialog" D
+ .N DNAME
+ .S DNAME=PT01
+ .I NEWPT01'="" S DNAME=NEWPT01
+ .D INSLNK(DNAME)
+ Q
+ ;
+ ;Check for descendents (either elements or prompts)
+ ;--------------------------------------------------
+INSDSC(NAME) ;
+ N DATA,DFOUND,SUB
+ S DFOUND=0,SUB=0
+ F  S SUB=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:'SUB  D  Q:DFOUND
+ .S DATA=$G(^TMP("PXRMEXTMP",$J,"DMAP",NAME,SUB)) Q:DATA=""
+ .I '$$PXRM($P(DATA,U)) S DFOUND=1
+ Q DFOUND
+ ;
+ ;Option to link dialog to a reminder
+ ;-----------------------------------
+INSLNK(DNAME) ;
+ N DIEN,DISABLE,DSRC,RNAME
+ N DA,DIE,DR
+ ;Disable
+ S DIEN=$O(^PXRMD(801.41,"B",DNAME,"")) Q:'DIEN
+ ;Set dialog as disabled
+ S DISABLE="DISABLED IN EXCHANGE"
+ ;Except for National dialogs
+ I $P(^PXRMD(801.41,DIEN,100),U)="N" S DISABLE=""
+ ;
+ S DR="3///^S X=DISABLE",DIE="^PXRMD(801.41,",DA=$P(DIEN,U)
+ D ^DIE
+ ;
+ ;Quit if already linked
+ I $D(^PXD(811.9,"AG",DIEN)) Q
+ ;
+ S RNAME=""
+ ;If reminder was renamed use as default
+ I $D(PXRMNMCH(811.9)) D
+ .S RNAME=$O(PXRMNMCH(811.9,"")) Q:RNAME=""
+ .S RNAME=$G(PXRMNMCH(811.9,RNAME))
+ ;Otherwise use original reminder name as default
+ I RNAME="" D
+ .N DATA,FOUND,RIEN,SUB
+ .;Rebuild ^TMP("PXRMEXLC",$J
+ .D CDISP^PXRMEXLC(PXRMRIEN)
+ .;
+ .S SUB="",FOUND=0
+ .F  S SUB=$O(^TMP("PXRMEXLC",$J,"SEL",SUB),-1) Q:'SUB  Q:FOUND  D
+ ..S DATA=$G(^TMP("PXRMEXLC",$J,"SEL",SUB)) Q:$P(DATA,U)'=811.9
+ ..S RIEN=$P(DATA,U,4),FOUND=1 Q:'RIEN
+ ..S RNAME=$P($G(^PXD(811.9,RIEN,0)),U)
+ ;
+TAG W !!,"Reminder Dialog "_DNAME_" is not linked to a reminder.",!
+ ;Select reminder to link
+ S IEN=$$SELECT^PXRMINQ("^PXD(811.9,","Select Reminder to Link: ",RNAME)
+ ;Update reminder link in #811.9
+ I $P(IEN,U)'=-1 D
+ .N DA,DIE,DIK,DR
+ .;Set reminder to dialog pointer
+ .S DR="51///^S X=DNAME",DIE="^PXD(811.9,",DA=$P(IEN,U)
+ .D ^DIE
+ .;If source reminder is null replace with linked reminder
+ .S DSRC=$P($G(^PXRMD(801.41,DIEN,0)),U,2) Q:DSRC
+ .S DSRC=$P(IEN,U)
+ .S DR="2///^S X=DSRC",DIE="^PXRMD(801.41,",DA=$P(DIEN,U)
+ .D ^DIE
+ Q
+ ;
+ ;Install Selected Components
+ ;---------------------------
+INSSEL N ALL,IND,PXRMDONE,VALMY
+ N DIROUT,DIRUT,DTOUT,DUOUT
+ N VALMBG,VALMLST
+ S VALMBG=1,VALMLST=+$O(^TMP("PXRMEXLD",$J,"IDX",""),-1)
+ ;Get the list to install.
+ D EN^VALM2(XQORNOD(0))
+ ;
+ K ^TMP("PXRMEXIA",$J)
+ ;Set the install date and time.
+ S ALL="",PXRMDONE=0,^TMP("PXRMEXIA",$J,"DT")=$$NOW^XLFDT
+ ;
+ ;Lock the entire file
+ Q:'$$LOCK
+ ;
+ S IND=0
+ F  S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE)  D
+ .D INSCOM(IND,0)
+ ;
+ ;Clear locks
+ D UNLOCK
+ ;
+ ;Rebuild workfile
+ D DISP^PXRMEXLD(PXRMMODE)
+ Q
+ ;
+ ;Install the exchange entry PXRMRIEN
+ ;-----------------------------------
+INSTALL N IEN,IND,VALMY
+ ;Make sure the component list exists for this entry. PXRMRIEN is
+ ;set in INSTALL^PXRMEXLR.
+ I '$D(^PXD(811.8,PXRMRIEN,120)) D CLIST^PXRMEXU1(.PXRMRIEN)
+ I PXRMRIEN=-1 Q
+ ;Format the component list for display.
+ D CDISP^PXRMEXLC(PXRMRIEN)
+ S VALMBCK="R",VALMCNT=$O(^TMP("PXRMEXLD",$J,"IDX"),-1)
+ Q
+ ;
+PXRM(NAME) ;Validate prompts
+ ;
+ ;Ignore non-PXRM
+ I $E(NAME,1,4)'="PXRM" Q 0
+ ;
+ ;Check if this is a national code
+ N DIEN
+ S DIEN=$O(^PXRMD(801.41,"B",NAME,""))
+ ;If not found abort
+ I 'DIEN Q 0
+ ;Check class
+ I $P($G(^PXRMD(801.41,DIEN,100)),U)="N" Q 1
+ ;Otherwise local
+ Q 0
+ ;
+ ;Lock the dialog file
+LOCK() ;
+ L +^PXRMD(801.41):0 I  Q 1
+ E  W !,"Another user is editing this file, try later" H 2
+ Q 0
+ ;
+ ;Clear lock
+UNLOCK L -^PXRMD(801.41)
+ Q
