source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXIX.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1PXRMEXIX ;SLC/PJH - Reminder Dialog Exchange checks. ;10/10/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 ;=====================================================================
5 ;
6 ;Yes/No Prompts
7 ;--------------
8ASK(YESNO,TEXT,HELP) ;
9 W !
10 N DIR,X,Y
11 K DIROUT,DIRUT,DTOUT,DUOUT
12 S DIR(0)="YA0"
13 M DIR("A")=TEXT
14 S DIR("B")="Y"
15 S DIR("?")="Enter Y or N. For detailed help type ??"
16 S DIR("??")=U_"D HLP^PXRMEXIX(HELP)"
17 D ^DIR K DIR
18 I $D(DIROUT) S DTOUT=1
19 I $D(DTOUT)!($D(DUOUT)) S PXRMDONE=1 Q
20 S YESNO=$E(Y(0))
21 Q
22 ;
23 ;Dialog check - all exist, none exist or some exist
24 ;--------------------------------------------------
25EXIST(ALL,DNAME,DTYP,INAME) ;
26 ;0 - None exist
27 ;1 - All exist
28 ;2 - Some exist
29 ;
30 ;Look for component dialogs in DMAP node from PXRMEXIC
31 N DONE,DOTHER,EXISTS,FILE,MODE
32 S ALL="",DONE=0,MODE="",NAME=""
33 ;
34 I DTYP="reminder dialog" D
35 .F S NAME=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME)) Q:NAME="" D Q:DONE
36 ..;Check if dialog exists
37 ..S EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME)
38 ..;If exists accumulate list of ancestors
39 ..I EXISTS D OTHER(NAME,.DOTHER)
40 ..;Quit if some exist and some don't
41 ..I MODE=1,'EXISTS S MODE=2,DONE=1 Q
42 ..I MODE=0,EXISTS S MODE=2,DONE=1 Q
43 ..;Set all exists flag if dialog found
44 ..I MODE="",EXISTS S MODE=1
45 ..;Set none exists flag if dialog not found
46 ..I MODE="",'EXISTS S MODE=0
47 ;
48 I DTYP'="reminder dialog" D
49 .F S NAME=$O(INAME(NAME)) Q:NAME="" D Q:DONE
50 ..;Treat namechanges as 'done'
51 ..I $D(PXRMNMCH(801.41,NAME)) Q
52 ..;Check if dialog exists
53 ..S EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME)
54 ..;If exists accumulate list of ancestors
55 ..I EXISTS D OTHER(NAME,.DOTHER)
56 ..;Quit if some exist and some don't
57 ..I MODE=1,'EXISTS S MODE=2,DONE=1 Q
58 ..I MODE=0,EXISTS S MODE=2,DONE=1 Q
59 ..;Set all exists flag if dialog found
60 ..I MODE="",EXISTS S MODE=1
61 ..;Set none exists flag if dialog not found
62 ..I MODE="",'EXISTS S MODE=0
63 ;
64 ;If all or none exist give option to install all without prompting
65 N ANS,TEXT
66 I MODE=0 D
67 .S TEXT(1)="All dialog components for "_DNAME_" are new."
68 I MODE=1 D
69 .S TEXT(1)="All dialog components for "_DNAME_" already exist."
70 .S TEXT(2)="",TEXT(4)=""
71 .S TEXT(3)="Components not used by any other dialogs."
72 .;Warn if used by other dialogs
73 .I $D(DOTHER) D
74 ..S TEXT(3)="WARNING - some components already used by:"
75 ..N CNT,DLIT,DNAME,DTYP,FIRST,NAME
76 ..S CNT=4,DNAME="",TEXT(CNT)=""
77 ..F S DNAME=$O(DOTHER(DNAME)) Q:DNAME="" D
78 ...S NAME="",FIRST=1,CNT=CNT+1
79 ...S DTYP=DOTHER(DNAME)
80 ...I DTYP="R" S DTYP="Reminder Dialog"
81 ...I DTYP="G" S DTYP="Dialog Group"
82 ...I DTYP="E" S DTYP="Dialog Element"
83 ...;S CNT=CNT+1,FIRST=0,TEXT(CNT)=DLIT_NAME_" ("_DTYP_")"
84 ...S CNT=CNT+1,FIRST=0,TEXT(CNT)=DNAME_" ("_DTYP_")"
85 ..S CNT=CNT+1,TEXT(CNT)=""
86 S TEXT="Install "_DTYP_" and all components with no further changes: "
87 ;Give option to install all descendents
88 D ASK(.ANS,.TEXT,2) I $G(ANS)="Y" S ALL=1
89 I $G(ANS)="N" S ALL=0
90 Q
91 ;
92 ;Check if used by other dialogs
93 ;------------------------------
94OTHER(NAME,LIST) ;
95 N DDATA,DIEN,DNAME,DTYP,IEN
96 S IEN=$O(^PXRMD(801.41,"B",NAME,0)) Q:'IEN
97 ;Check if used by other dialogs
98 I '$D(^PXRMD(801.41,"AD",IEN)) Q
99 ;Build list of dialogs using this component
100 S DIEN=0
101 F S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:'DIEN D
102 .S DDATA=$G(^PXRMD(801.41,DIEN,0)) Q:DDATA=""
103 .S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) Q:DNAME=""
104 .;Include only dialogs that are not part of this reminder dialog
105 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) Q
106 .S LIST(DNAME)=DTYP
107 Q
108 ;
109 ;General help text routine.
110 ;--------------------------
111HLP(CALL) ;
112 N HTEXT
113 N DIWF,DIWL,DIWR,IC
114 S DIWF="C75",DIWL=0,DIWR=75
115 ;
116 I CALL=1 D
117 .S HTEXT(1)="Enter 'Yes' to install all sub-components or"
118 .S HTEXT(2)="enter 'No' to install only the selected dialog."
119 I CALL=2 D
120 .S HTEXT(1)="Enter 'Yes' to install without changes."
121 .S HTEXT(2)="Enter 'No' to install with changes."
122 I CALL=3 D
123 .S HTEXT(1)="Select IFE to INSTALL reminder or dialog from this exchange"
124 .S HTEXT(2)="entry. Select DFE to DELETE this entry from the exchange file. "
125 .S HTEXT(3)="Select IH to view the installation HISTORY for this entry."
126 K ^UTILITY($J,"W")
127 S IC=""
128 F S IC=$O(HTEXT(IC)) Q:IC="" D
129 . S X=HTEXT(IC)
130 . D ^DIWP
131 W !
132 S IC=0
133 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
134 . W !,^UTILITY($J,"W",0,IC,0)
135 K ^UTILITY($J,"W")
136 W !
137 Q
Note: See TracBrowser for help on using the repository browser.