source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXIX.m@ 1806

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

revised back to 6/30/08 version

File size: 4.2 KB
Line 
1PXRMEXIX ;SLC/PJH - Reminder Dialog Exchange checks. ;12/22/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
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 Q
90 ;
91 ;Check if used by other dialogs
92 ;------------------------------
93OTHER(NAME,LIST) ;
94 N DDATA,DIEN,DNAME,DTYP,IEN
95 S IEN=$O(^PXRMD(801.41,"B",NAME,0)) Q:'IEN
96 ;Check if used by other dialogs
97 I '$D(^PXRMD(801.41,"AD",IEN)) Q
98 ;Build list of dialogs using this component
99 S DIEN=0
100 F S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:'DIEN D
101 .S DDATA=$G(^PXRMD(801.41,DIEN,0)) Q:DDATA=""
102 .S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) Q:DNAME=""
103 .;Include only dialogs that are not part of this reminder dialog
104 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) Q
105 .S LIST(DNAME)=DTYP
106 Q
107 ;
108 ;General help text routine.
109 ;--------------------------
110HLP(CALL) ;
111 N HTEXT
112 N DIWF,DIWL,DIWR,IC
113 S DIWF="C75",DIWL=0,DIWR=75
114 ;
115 I CALL=1 D
116 .S HTEXT(1)="Enter 'Yes' to if you are installing all sub-components or"
117 .S HTEXT(2)="enter 'No' to install only the selected dialog."
118 I CALL=2 D
119 .S HTEXT(1)="Enter 'Yes' to if you are installing without changes."
120 .S HTEXT(2)="enter 'No' to install with changes."
121 I CALL=3 D
122 .S HTEXT(1)="Select IFE to INSTALL reminder or dialog from this exchange"
123 .S HTEXT(2)="entry. Select DFE to DELETE this entry from the exchange file. "
124 .S HTEXT(3)="Select IH to view the installation HISTORY for this entry."
125 K ^UTILITY($J,"W")
126 S IC=""
127 F S IC=$O(HTEXT(IC)) Q:IC="" D
128 . S X=HTEXT(IC)
129 . D ^DIWP
130 W !
131 S IC=0
132 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
133 . W !,^UTILITY($J,"W",0,IC,0)
134 K ^UTILITY($J,"W")
135 W !
136 Q
Note: See TracBrowser for help on using the repository browser.