source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXCF.m@ 1259

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

revised back to 6/30/08 version

File size: 2.4 KB
Line 
1PXRMEXCF ; SLC/PKR - Reminder exchange routines for computed findings. ;12/22/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
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,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ECS,IND,MSG
13 N PCS,ROUTINE,SAME,TEXT,X,Y
14 S NEWNAME=""
15 ;If the routine exists compare the existing routine checksum with the
16 ;the checksum of the routine in the packed definition.
17 S ROUTINE=ATTR("NAME")
18 I EXISTS="" S EXISTS=$$EXISTS^PXRMEXCF(ROUTINE)
19 S CHOICES=$S(EXISTS:"COQS",1:"CIQS")
20 I EXISTS D
21 . S SAME=$$SAME(.ATTR,.RTN)
22 . S TEXT(1)="Routine "_ROUTINE_" already exists "
23 . I SAME S TEXT(1)=TEXT(1)_"and the packed routine is identical,"
24 . I 'SAME S TEXT(1)=TEXT(1)_"but the packed routine is different,"
25 . S TEXT(2)="what do you want to do?"
26 . D EN^DDIOL(.TEXT)
27 . S DIR("B")="S"
28 . S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
29 E D
30 . W !!,"Routine "_ROUTINE_" is NEW, what do you want to do?"
31 . S DIR("B")="I"
32 . S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR)
33 ;
34 I ACTION="Q" Q ACTION
35 ;
36 I ACTION="C" D
37 . N CDONE
38 . S CDONE=0
39 . F Q:CDONE D
40 .. S NEWNAME=$$GETNAME^PXRMEXIU(ATTR("MIN FIELD LENGTH"),ATTR("FIELD LENGTH"))
41 .. I NEWNAME="" S ACTION="S",CDONE=1 Q
42 .. S EXISTS=$$EXISTS^PXRMEXCF(NEWNAME)
43 .. I EXISTS W !,"Routine ",NEWNAME," already exists, try again."
44 .. E D Q
45 ... S CDONE=1
46 ... S NAMECHG(ATTR("FILE NUMBER"),ROUTINE)=NEWNAME
47 ;
48 I (ACTION="I")&(EXISTS) D
49 .;If the action is overwrite double check that overwrite is what the
50 .;user really wants to do.
51 . K DIR
52 . S DIR(0)="Y"_U_"A"
53 . S DIR("A")="Are you sure you want to overwrite"
54 . S DIR("B")="N"
55 . D ^DIR
56 . I $D(DIROUT)!$D(DIRUT) S Y=0
57 . I $D(DTOUT)!$D(DUOUT) S Y=0
58 . I 'Y S ACTION="S"
59 . S NAMECHG(ATTR("FILE NUMBER"),ROUTINE)=NEWNAME
60 Q ACTION
61 ;
62 ;==============================================
63SAME(ATTR,RTN) ;Compare the existing routine and the new version
64 ;in RTN to see if they are the same.
65 N ECS,DIF,NEWCS,RT,SAME,X,XCNP
66 ;Load the existing routine into RT.
67 S XCNP=0
68 S DIF="RT("
69 S X=ATTR("NAME")
70 X ^%ZOSF("LOAD")
71 S ECS=$$ROUTINE^PXRMEXCS(.RT)
72 K RT
73 S NEWCS=$$ROUTINE^PXRMEXCS(.RTN)
74 S SAME=$S(ECS=NEWCS:1,1:0)
75 Q SAME
76 ;
Note: See TracBrowser for help on using the repository browser.