| 1 | PXRMEXCF ; SLC/PKR - Reminder exchange routines for computed findings. ;06/28/2007
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
|
|---|
| 3 | ;==============================================
|
|---|
| 4 | EXISTS(ROUTINE) ;Return true if routine ROUTINE exists.
|
|---|
| 5 | I ROUTINE="" Q 0
|
|---|
| 6 | N RTN
|
|---|
| 7 | S RTN="^"_ROUTINE
|
|---|
| 8 | Q $S($T(@RTN)'="":1,1:0)
|
|---|
| 9 | ;
|
|---|
| 10 | ;==============================================
|
|---|
| 11 | GETRACT(ATTR,NEWNAME,NAMECHG,RTN,EXISTS) ;Get the action for a routine.
|
|---|
| 12 | N ACTION,CHOICES,CSUM,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ECS,IND,MSG
|
|---|
| 13 | N PCS,ROUTINE,SAME,TEXT,X,Y
|
|---|
| 14 | S NEWNAME=""
|
|---|
| 15 | S ROUTINE=ATTR("NAME")
|
|---|
| 16 | I EXISTS="" S EXISTS=$$EXISTS^PXRMEXCF(ROUTINE)
|
|---|
| 17 | S CHOICES=$S(EXISTS:"COQS",1:"CIQS")
|
|---|
| 18 | I EXISTS D
|
|---|
| 19 | .;If the routine exists compare the existing routine checksum with the
|
|---|
| 20 | .;the checksum of the routine in the packed definition.
|
|---|
| 21 | . S CSUM=$$RTNCS^PXRMEXCS(ROUTINE)
|
|---|
| 22 | . S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0)
|
|---|
| 23 | . S TEXT(1)="Routine "_ROUTINE_" already exists "
|
|---|
| 24 | . I SAME D
|
|---|
| 25 | .. S TEXT(1)=TEXT(1)_"and the packed routine is identical, skipping."
|
|---|
| 26 | .. W !,TEXT(1),! H 2
|
|---|
| 27 | .. S ACTION="S"
|
|---|
| 28 | . I 'SAME D
|
|---|
| 29 | .. S TEXT(1)=TEXT(1)_"but the packed routine is different,"
|
|---|
| 30 | .. S TEXT(2)="what do you want to do?"
|
|---|
| 31 | .. W !,TEXT(1),!,TEXT(2)
|
|---|
| 32 | .. S DIR("B")="O"
|
|---|
| 33 | .. S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
|
|---|
| 34 | E D
|
|---|
| 35 | . W !!,"Routine "_ROUTINE_" is new, what do you want to do?"
|
|---|
| 36 | . S DIR("B")="I"
|
|---|
| 37 | . S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
|
|---|
| 38 | ;
|
|---|
| 39 | I (ACTION="Q")!(ACTION="S") Q ACTION
|
|---|
| 40 | ;
|
|---|
| 41 | I ACTION="C" D
|
|---|
| 42 | . N CDONE
|
|---|
| 43 | . S CDONE=0
|
|---|
| 44 | . F Q:CDONE D
|
|---|
| 45 | .. S NEWNAME=$$GETNAME^PXRMEXIU(ATTR("MIN FIELD LENGTH"),ATTR("FIELD LENGTH"))
|
|---|
| 46 | .. I NEWNAME="" S ACTION="S",CDONE=1 Q
|
|---|
| 47 | .. S EXISTS=$$EXISTS^PXRMEXCF(NEWNAME)
|
|---|
| 48 | .. I EXISTS W !,"Routine ",NEWNAME," already exists, try again."
|
|---|
| 49 | .. E D Q
|
|---|
| 50 | ... S CDONE=1
|
|---|
| 51 | ... S NAMECHG(ATTR("FILE NUMBER"),ROUTINE)=NEWNAME
|
|---|
| 52 | ;
|
|---|
| 53 | I (ACTION="I")&(EXISTS) D
|
|---|
| 54 | .;If the action is overwrite double check that overwrite is what the
|
|---|
| 55 | .;user really wants to do.
|
|---|
| 56 | . K DIR
|
|---|
| 57 | . S DIR(0)="Y"_U_"A"
|
|---|
| 58 | . S DIR("A")="Are you sure you want to overwrite"
|
|---|
| 59 | . S DIR("B")="N"
|
|---|
| 60 | . D ^DIR
|
|---|
| 61 | . I $D(DIROUT)!$D(DIRUT) S Y=0
|
|---|
| 62 | . I $D(DTOUT)!$D(DUOUT) S Y=0
|
|---|
| 63 | . I 'Y S ACTION="S"
|
|---|
| 64 | . S NAMECHG(ATTR("FILE NUMBER"),ROUTINE)=NEWNAME
|
|---|
| 65 | Q ACTION
|
|---|
| 66 | ;
|
|---|
