source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXCF.m@ 952

Last change on this file since 952 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1PXRMEXCF ; SLC/PKR - Reminder exchange routines for computed findings. ;06/28/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;==============================================
4EXISTS(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 ;==============================================
11GETRACT(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 ;
Note: See TracBrowser for help on using the repository browser.