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

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

initial load of WorldVistAEHR

File size: 7.3 KB
Line 
1PXRMDBLD ; SLC/PJH - Reminder Dialog Generation. ;04/07/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Called from PXRMGEDT
5 ;
6START N ANS,DIC,DNAME,LIT,LIT1,MSG,NAME,REDO,REM,RLNK,RNAME,ORY
7 N PXRMENAB,PXRMLINK,PXRMREPL,PXRMREM
8 ;Prompt for auto or manual addition
9 S ANS="" D ASK(.ANS) Q:$D(DUOUT)!$D(DTOUT)
10 ;Auto
11 I ANS="Y" D AUTO Q
12 ;Manual
13 I ANS'="Y" D ADD^PXRMDEDT
14END Q
15 ;
16 ;Called by protocol PXRM DIALOG ADD
17 ;----------------------------------
18ADD(PXRMITEM) ;
19 N ANS,DNAME,DTOUT,DUOUT
20 S VALMBCK="R"
21 W IORESET
22 W !,PXRMHD
23 S DNAME=""
24 D ASK^PXRMDBLD(.ANS) Q:$D(DTOUT)!$D(DUOUT)
25 I ANS="Y" D AUTOP(PXRMITEM) Q
26 Q
27 ;
28 ;Ask autogenerate/manual
29 ;-----------------------
30ASK(YESNO) ;
31 N X,Y,TEXT,DIR
32 K DIROUT,DIRUT,DTOUT,DUOUT
33 S DIR(0)="YA0"
34 S DIR("A")="GENERATE DIALOG AUTOMATICALLY: "
35 S DIR("B")="N"
36 S DIR("?")="Enter Y or N. For detailed help type ??"
37 S DIR("??")=U_"D HELP^PXRMDBLD(1)"
38 D ^DIR K DIR
39 I $D(DIROUT) S DTOUT=1
40 I $D(DTOUT)!($D(DUOUT)) Q
41 S YESNO=$E(Y(0))
42 Q
43 ;
44 ;Source reminder for auto-generate
45 ;---------------------------------
46AUTO S DIC("A")="SELECT REMINDER TO GENERATE DIALOG FROM: "
47 S LIT1="You must select a reminder!"
48 D SEL(811.9,"AEQMZ",.PXRMREM)
49 Q:$D(DTOUT)!$D(DUOUT)
50 S REM=$P(PXRMREM(1),U),DNAME=""
51 ;Display related dialogs
52 D DISP(REM)
53 ;Promt for type of generate
54 D AUTOP(REM)
55 Q
56 ;
57 ;Autogenerate prompts
58 ;--------------------
59AUTOP(REM) ;
60 S RNAME=$P($G(^PXD(811.9,REM,0)),U)
61 F D Q:$D(DUOUT)!$D(DTOUT)!(DNAME]"")
62 .N CONFIRM,X,Y,DIR,DA
63 .K DIROUT,DIRUT,DTOUT,DUOUT
64 .S DIR(0)="F"_U_"3:40"_U_"K:(X?.N)!'(X'?1P.E) X"
65 .S DIR("A")="ENTER A UNIQUE DIALOG NAME"
66 .S DIR("B")=RNAME
67 .S DIR("?")="Select a unique name for the generated dialog."
68 .S DIR("??")=U_"D HELP^PXRMDBLD(6)"
69 .D ^DIR K DIR
70 .I $D(DIROUT) S DTOUT=1
71 .I $D(DTOUT)!($D(DUOUT)) Q
72 .I Y["""" D EN^DDIOL(" name cannot contain quotes!") Q
73 .I $D(^PXRMD(801.41,"B",Y)) D Q:$G(DTOUT)=1
74 ..D CONFIRM(.CONFIRM,Y) I CONFIRM="Y" D Q:$G(DTOUT)=1
75 ...S DA=$O(^PXRMD(801.41,"B",Y,""))
76 ...I $P($G(^PXRMD(801.41,DA,0)),U,3)="" D Q:$G(DTOUT)=1
77 ....W !!,"THE CURRENT DIALOG IS ENABLED PLEASE DISABLE IT BEFORE "
78 ....W "CONTINING." H 2 S DTOUT=1 Q
79 ..I '$$OVER(Y) S DTOUT=1 Q
80 ..S Y=$$NAME^PXRMDCPY(DA,Y)
81 ..;If this is the linked reminder clear it
82 ..I $P($G(^PXD(811.9,REM,51)),U)=$G(DA) S $P(^PXD(811.9,REM,51),U)=""
83 .;Option to LINK DIALOG to REMINDER if reminder is not linked already
84 .S RLNK=$P($G(^PXD(811.9,REM,51)),U),PXRMLINK=0
85 .I 'RLNK D LINK(.PXRMLINK) Q:$D(DTOUT)!$D(DUOUT)
86 .;Option to enable dialog
87 .D ENABLE(.PXRMENAB) Q:$D(DTOUT)!$D(DUOUT)
88 .;Option to replace existing dialog elements
89 .D REPL(.PXRMREPL) Q:$D(DTOUT)!$D(DUOUT)
90 .;Use name entered
91 .S DNAME=Y
92 ;
93 Q:$D(DUOUT)!$D(DTOUT)
94 ;Build dialog
95 N CHECK D BUILD^PXRMDBL1(REM,DNAME,.CHECK)
96 Q
97 ;
98 ;Display dialogs autogenerated from this reminder
99 ;------------------------------------------------
100DISP(RIEN) ;
101 N ARRAY,DSUB,FIRST
102 ;Get Autogenerated dialogs
103 S FIRST=1,DSUB=""
104 F S DSUB=$O(^PXRMD(801.41,"AG",RIEN,DSUB)) Q:'DSUB D
105 .I FIRST W !!,"Associated Dialogs:" S FIRST=0
106 .W ?25,$P($G(^PXRMD(801.41,DSUB,0)),U),!
107 Q
108 ;
109 ;Disable generated dialog
110 ;------------------------
111ENABLE(YESNO) ;
112 N X,Y,TEXT,DIR
113 K DIROUT,DIRUT,DTOUT,DUOUT
114 S DIR(0)="YA0"
115 S DIR("A")="ENABLE DIALOG: "
116 S DIR("B")="NO"
117 S DIR("?")="Enter Y or N. For detailed help type ??"
118 S DIR("??")=U_"D HELP^PXRMDBLD(4)"
119 D ^DIR K DIR
120 I $D(DIROUT) S DTOUT=1
121 I $D(DTOUT)!($D(DUOUT)) Q
122 S YESNO=$E(Y(0))
123 Q
124 ;
125 ;Link dialog to reminder
126 ;-----------------------
127LINK(YESNO) ;
128 N X,Y,TEXT,DIR
129 K DIROUT,DIRUT,DTOUT,DUOUT
130 S DIR(0)="YA0"
131 S DIR("A")="LINK DIALOG TO REMINDER: "
132 S DIR("B")="YES"
133 S DIR("?")="Enter Y or N. For detailed help type ??"
134 S DIR("??")=U_"D HELP^PXRMDBLD(5)"
135 D ^DIR K DIR
136 I $D(DIROUT) S DTOUT=1
137 I $D(DTOUT)!($D(DUOUT)) Q
138 S YESNO=$E(Y(0))
139 Q
140 ;
141 ;Option to override existing dialog
142 ;----------------------------------
143OVER(DNAME) ;
144 N DIR,X,Y
145 S DIR(0)="Y",DIR("B")="NO"
146 S DIR("A")="OVERWRITE EXISTING REMINDER DIALOG "
147 S DIR("?")="Enter Y or N. For detailed help type ??"
148 S DIR("??")=U_"D HELP^PXRMDBLD(2)"
149 D ^DIR K DIR
150 I $D(DIROUT) S DTOUT=1
151 I $D(DTOUT)!($D(DUOUT)) Q 0
152 Q $S(Y(0)="YES":1,1:0)
153 ;
154 ;Option to replace existing dialog elements
155 ;------------------------------------------
156REPL(INP) ;
157 N DIR,X,Y
158 S DIR(0)="Y",DIR("B")="NO"
159 S DIR("A")="REPLACE ANY EXISTING DIALOG ELEMENTS"
160 S DIR("?")="Enter Y or N. For detailed help type ??"
161 S DIR("??")=U_"D HELP^PXRMDBLD(3)"
162 D ^DIR K DIR
163 I $D(DIROUT) S DTOUT=1
164 I $D(DTOUT)!($D(DUOUT)) Q
165 S INP=$S(Y(0)="YES":1,1:0)
166 Q
167 ;
168 ;Reminder selection
169 ;------------------
170SEL(FILE,MODE,ARRAY) ;
171 N X,Y,CNT
172 K DIROUT,DIRUT,DTOUT,DUOUT
173 S CNT=0
174 W !
175 F D Q:$D(DTOUT) Q:$D(DUOUT) Q:CNT>0 Q:(Y=-1)&(CNT>0)
176 .S DIC=FILE,DIC(0)=MODE
177 .D ^DIC
178 .I X=(U_U) S DTOUT=1
179 .I '$D(DTOUT),('$D(DUOUT)) D
180 ..I +Y'=-1 D Q
181 ...S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
182 ..W:CNT=0 !,LIT1
183 .K DIC
184 Q
185 ;
186CONFIRM(YESNO,NAME) ;
187 N X,Y,TEXT,DIR
188 K DIROUT,DIRUT,DTOUT,DUOUT
189 S DIR(0)="YA0"
190 S DIR("A")="YOU ARE ABOUT TO OVERWRITE THE EXISTING DIALOG "_NAME_" CONTINUE? "
191 S DIR("B")="N"
192 S DIR("?")="Enter Y or N. For detailed help type ??"
193 S DIR("??")=U_"D HELP^PXRMDBLD(1)"
194 D ^DIR K DIR
195 I $D(DIROUT) S DTOUT=1
196 I $D(DTOUT)!($D(DUOUT)) Q
197 S YESNO=$E(Y(0))
198 Q
199 ;
200 ;General help text routine.
201 ;--------------------------
202HELP(CALL) ;
203 N HTEXT
204 N DIWF,DIWL,DIWR,IC
205 S DIWF="C75",DIWL=0,DIWR=75
206 ;
207 I CALL=1 D
208 .S HTEXT(1)="Enter Yes to generate reminder dialog automatically for a"
209 .S HTEXT(2)="selected reminder. Enter No to create a reminder dialog"
210 .S HTEXT(3)="using the standard fileman edit."
211 I CALL=2 D
212 .S HTEXT(1)="Enter Yes to replace the existing reminder dialog."
213 .S HTEXT(2)="Enter No to return and enter an alternative dialog name."
214 I CALL=3 D
215 .S HTEXT(1)="For each FINDING ITEM on the reminder a dialog element"
216 .S HTEXT(2)="will be created. A separate DIALOG ELEMENT is created for"
217 .S HTEXT(3)="each enabled RESOLUTION STATUS in the FINDING TYPE"
218 .S HTEXT(4)="PARAMETERS for this finding type. The dialog element is"
219 .S HTEXT(5)="unique for finding type, finding item name and resolution"
220 .S HTEXT(6)="status name."
221 .S HTEXT(7)="e.g. VM WEIGHT DONE will be generated for the finding item"
222 .S HTEXT(8)=" vitals measurement/weight."
223 .S HTEXT(9)=""
224 .S HTEXT(10)="Enter Yes to rebuild all dialog elements used by this"
225 .S HTEXT(11)="reminder overwriting any existing modifications."
226 .S HTEXT(12)=""
227 .S HTEXT(13)="Enter No to use existing dialog elements if they exist."
228 .S HTEXT(14)="New dialog elements will be created if they don't already"
229 .S HTEXT(15)="exist."
230 I CALL=4 D
231 .S HTEXT(1)="Enter Yes to create a dialog enabled for use in CPRS."
232 .S HTEXT(2)="Enter No to create a dialog disabled for CPRS."
233 I CALL=5 D
234 .S HTEXT(1)="If the source reminder is not linked to any other dialog"
235 .S HTEXT(2)="enter Yes to link the reminder to the generated dialog."
236 .S HTEXT(3)="Enter No if no link should be made."
237 I CALL=6 D
238 .S HTEXT(1)="Enter the name of the dialog. The default is the reminder"
239 .S HTEXT(2)="name. If the name of an existing dialog is specified the"
240 .S HTEXT(3)="option to override the existing dialog will be given."
241 K ^UTILITY($J,"W")
242 S IC=""
243 F S IC=$O(HTEXT(IC)) Q:IC="" D
244 . S X=HTEXT(IC)
245 . D ^DIWP
246 W !
247 S IC=0
248 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
249 . W !,^UTILITY($J,"W",0,IC,0)
250 K ^UTILITY($J,"W")
251 W !
252 Q
Note: See TracBrowser for help on using the repository browser.