PXRMEXCF	; SLC/PKR - Reminder exchange routines for computed findings. ;06/28/2007
	;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
	;==============================================
EXISTS(ROUTINE)	;Return true if routine ROUTINE exists.
	I ROUTINE="" Q 0
	N RTN
	S RTN="^"_ROUTINE
	Q $S($T(@RTN)'="":1,1:0)
	;
	;==============================================
GETRACT(ATTR,NEWNAME,NAMECHG,RTN,EXISTS)	;Get the action for a routine.
	N ACTION,CHOICES,CSUM,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ECS,IND,MSG
	N PCS,ROUTINE,SAME,TEXT,X,Y
	S NEWNAME=""
	S ROUTINE=ATTR("NAME")
	I EXISTS="" S EXISTS=$$EXISTS^PXRMEXCF(ROUTINE)
	S CHOICES=$S(EXISTS:"COQS",1:"CIQS")
	I EXISTS D
	.;If the routine exists compare the existing routine checksum with the
	.;the checksum of the routine in the packed definition.
	. S CSUM=$$RTNCS^PXRMEXCS(ROUTINE)
	. S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0)
	. S TEXT(1)="Routine "_ROUTINE_" already exists "
	. I SAME D
	.. S TEXT(1)=TEXT(1)_"and the packed routine is identical, skipping."
	.. W !,TEXT(1),! H 2
	.. S ACTION="S"
	. I 'SAME D
	.. S TEXT(1)=TEXT(1)_"but the packed routine is different,"
	.. S TEXT(2)="what do you want to do?"
	.. W !,TEXT(1),!,TEXT(2)
	.. S DIR("B")="O"
	.. S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
	E  D
	. W !!,"Routine "_ROUTINE_" is new, what do you want to do?"
	. S DIR("B")="I"
	. S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
	;
	I (ACTION="Q")!(ACTION="S") Q ACTION
	;
	I ACTION="C" D
	. N CDONE
	. S CDONE=0
	. F  Q:CDONE  D
	.. S NEWNAME=$$GETNAME^PXRMEXIU(ATTR("MIN FIELD LENGTH"),ATTR("FIELD LENGTH"))
	.. I NEWNAME="" S ACTION="S",CDONE=1 Q
	.. S EXISTS=$$EXISTS^PXRMEXCF(NEWNAME)
	.. I EXISTS W !,"Routine ",NEWNAME," already exists, try again."
	.. E  D  Q
	... S CDONE=1
	... S NAMECHG(ATTR("FILE NUMBER"),ROUTINE)=NEWNAME
	;
	I (ACTION="I")&(EXISTS) D
	.;If the action is overwrite double check that overwrite is what the
	.;user really wants to do.
	. K DIR
	. S DIR(0)="Y"_U_"A"
	. S DIR("A")="Are you sure you want to overwrite"
	. S DIR("B")="N"
	. D ^DIR
	. I $D(DIROUT)!$D(DIRUT) S Y=0
	. I $D(DTOUT)!$D(DUOUT) S Y=0
	. I 'Y S ACTION="S"
	. S NAMECHG(ATTR("FILE NUMBER"),ROUTINE)=NEWNAME
	Q ACTION
	;
