source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLGZ.m@ 1489

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

revised back to 6/30/08 version

File size: 6.2 KB
Line 
1PXRMDLGZ ; SLC/PJH - Link reminder to dialog. ;05/31/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Called by option PXRM DIALOG/COMPONENT EDIT
5 ;
6START N BY,DATA,DDES,DHD,DIC,DNAM,DTYP,FLDS,FR,L,LOGIC,NOW,PNAM,TO,Y
7 N PXRMBG,PXRMHD,PXRMDIEN,PXRMGTYP,PXRMDTYP,PXRMITEM,PXRMMODE,PXRMNAME
8 N PXRMTEMP,PXRMTITL,PXRMVIEW
9 ;Refresh on return
10 S VALMBCK="R"
11 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
12 ;Default is display dialog elements
13 S PXRMDTYP="R",PXRMGTYP="DLGR",PXRMVIEW="AN"
14 ;Select dialog for display
15 F D Q:'PXRMTEMP
16 .S PXRMTEMP=""
17 .D START^PXRMSEL(.PXRMHD,.PXRMGTYP,"PXRMTEMP") Q:'PXRMTEMP
18 .N X S X="IORESET"
19 .D ENDR^%ZISS,@(PXRMGTYP_"("_PXRMTEMP_")")
20END Q
21 ;
22 ;Reminder View
23 ;-------------
24DLGR(PXRMITEM) ;
25 N PXRMDIEN,PXRMCS1,PXRMCS2
26 ;Format headings to include reminder and name
27 S DATA=$G(^PXD(811.9,PXRMITEM,0)),RNAM=$P(DATA,U),PNAM=$P(DATA,U,3)
28 S PXRMHD="REMINDER NAME: "_RNAM
29 ;
30 ;Dialog History
31 F D Q:'PXRMDIEN
32 .D START^PXRMDLGH(PXRMITEM,.PXRMDIEN,"PXRMDIEN") Q:'PXRMDIEN
33 .N PXRMHD,VALMBCK,VALMBG,VALMSG,VIEW,X,XMZ
34 .S DNAM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U)
35 .I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,3)]"" S DNAM=DNAM_" (DISABLED)"
36 .S PXRMHD="REMINDER DIALOG NAME: "_DNAM
37 .S PXRMCS1=$$FILE^PXRMEXCS(801.41,PXRMDIEN)
38 .S X="IORESET"
39 .D ENDR^%ZISS,EN^VALM("PXRM DIALOG LIST")
40 .I PXRMDIEN,$D(^PXRMD(801.41,PXRMDIEN,0)) D
41 ..S PXRMCS2=$$FILE^PXRMEXCS(801.41,PXRMDIEN) Q:+PXRMCS2=0
42 ..Q:PXRMCS1=PXRMCS2
43 ..D SEHIST^PXRMUTIL(801.41,"^PXRMD(801,41,",PXRMDIEN)
44 .W IORESET
45 .D KILL^%ZISS
46 Q
47 ;
48 ;Edit element/prompt/group
49 ;-------------------------
50DLGE(PXRMDIEN) ;
51 N LOCK,LFIND
52 ;Check for Uneditable flag
53 S LOCK=$P($G(^PXRMD(801.41,PXRMTEMP,100)),U,4)
54 S LFIND=$P($G(^PXRMD(801.41,PXRMTEMP,1)),U,5)
55 I LOCK=1,$G(LFIND)'="",$G(LFIND)'["ORD",'$G(PXRMINST) D Q
56 .W !,"This item can not be edited" H 2
57 ;
58 S PXRMHD="Dialog Name: ",PXRMDIEN=PXRMTEMP
59 ;Format headings to include dialog name
60 S DATA=$G(^PXRMD(801.41,PXRMDIEN,0)),DDES=$P(DATA,U),DTYP=$P(DATA,U,4)
61 ;Test
62 I DTYP="G" D DLG(PXRMDIEN) Q
63 ;
64 S PXRMHD=PXRMHD_" "_DDES W PXRMHD,!
65 ;Edit selected dialog
66 D EDIT^PXRMDEDT(DTYP,PXRMDIEN,0)
67 Q
68 ;
69 ;Reminder dialog view
70 ;--------------------
71DLG(PXRMDIEN) ;
72 S PXRMDIEN=PXRMTEMP
73 S PXRMNAME=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U)
74 S PXRMITEM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U,2)
75 ;Format headings to include dialog name
76 S PXRMHD=PXRMHD_PXRMNAME
77 ;Check if the set is disable and add to header if disabled
78 I $P(^PXRMD(801.41,PXRMDIEN,0),U,3)]"" S PXRMHD=PXRMHD_" (DISABLED)"
79 ;Listman option
80 D EN^VALM("PXRM DIALOG LIST")
81 W IORESET
82 D KILL^%ZISS
83 Q
84 ;
85 ;Other subroutines
86 ;
87 ;Ask update or no
88 ;----------------
89ASK(YESNO) ;
90 N X,Y,TEXT,DIR
91 K DIROUT,DIRUT,DTOUT,DUOUT
92 S DIR(0)="YA0"
93 S DIR("A")="LINK THIS REMINDER TO DIALOG - "_$P(PXRMHD,": ",2)_": "
94 S DIR("B")="Y"
95 S DIR("?")="Enter Y or N. For detailed help type ??"
96 S DIR("??")=U_"D HLP^PXRMDLGY(1)"
97 D ^DIR K DIR
98 I $D(DIROUT) S DTOUT=1
99 I $D(DTOUT)!($D(DUOUT)) Q
100 S YESNO=$E(Y(0))
101 Q
102 ;
103 ;Display dialogs autogenerated from this reminder
104 ;------------------------------------------------
105DISP(RIEN) ;
106 N ARRAY,DSUB,FIRST
107 ;Get OTHER dialogs
108 S FIRST=1,DSUB=""
109 F S DSUB=$O(^PXRMD(801.41,"AG",RIEN,DSUB)) Q:'DSUB D
110 .W !
111 .D:FIRST
112 ..W "DIALOGS ALREADY GENERATED FROM THIS REMINDER:",!! S FIRST=0
113 .W ?20,$P($G(^PXRMD(801.41,DSUB,0)),U)
114 ;
115 I 'FIRST W !
116 ;
117 Q
118 ;
119 ;Display linked reminders
120 ;------------------------
121DISPL(DIEN) ;
122 N ARRAY,DLG,RSUB,FIRST,RNAM
123 S RSUB=$P($G(^PXRMD(801.41,DIEN,0)),U,2)
124 I RSUB W !!,"SOURCE REMINDER: "_$P($G(^PXD(811.9,RSUB,0)),U)
125 ;Linked reminders
126 S FIRST=1,RNAM=""
127 F S RNAM=$O(^PXD(811.9,"B",RNAM)) Q:RNAM="" D
128 .S RSUB=$O(^PXD(811.9,"B",RNAM,"")) Q:'RSUB
129 .S DLG=$P($G(^PXD(811.9,RSUB,51)),U) Q:DLG'=DIEN
130 .W ! I FIRST W !,"REMINDERS ALREADY LINKED TO THIS DIALOG:",!! S FIRST=0
131 .W ?18,$P($G(^PXD(811.9,RSUB,0)),U)
132 Q
133 ;
134 ;Link a dialog (called by protocol PXRM DIALOG/REMINDER LINK)
135 ;-------------
136LINK(DIEN) ;
137 F D Q:$D(DTOUT)!$D(DUOUT)
138 .W IORESET
139 .S VALMBCK="R"
140 .;Display linked reminders
141 .D DISPL(DIEN)
142 .;
143 .N ANS,DIC,DIR,DLG,LIT1,PNAME,PXRMREM,REM
144 .S DIC("A")="SELECT A REMINDER TO LINK OR CHANGE: "
145 .S LIT1="You must select a reminder!"
146 .D SEL(811.9,"AEQMZ",.PXRMREM)
147 .Q:$D(DTOUT)!$D(DUOUT)
148 .S REM=$P(PXRMREM(1),U),PNAME=$P(PXRMREM(1),U,3)
149 .I PNAME]"" W !!,"REMINDER PRINT NAME: "_PNAME,!
150 .;Display related dialogs
151 .D DISP(REM)
152 .;Check if already linked
153 .S DLG=$P($G(^PXD(811.9,REM,51)),U)
154 .;Reconfirm to link reminder
155 .I 'DLG S ANS="" D ASK(.ANS) Q:ANS'="Y"
156 .;
157 .N DA,DR,DIE
158 .;Edit selected reminder
159 .S DA=REM
160 .;Settup local variables
161 .S DIE="^PXD(811.9,",DR=51
162 .;If no link force entry
163 .I 'DLG S DR=DR_"///"_PXRMNAME
164 .D ^DIE
165 Q
166 ;
167 ;Link a Reminder (called by protocol PXRM DIALOG LINK)
168 ;---------------
169RLINK(REM) ;
170 N DLG
171 ;Re-display reminder name
172 W IORESET
173 W !,PXRMHD
174 ;
175 N DA,DR,DIE
176 ;Edit selected reminder
177 S DA=REM
178 ;Settup local variables
179 S DIE="^PXD(811.9,",DR=51
180 ;If no link force entry
181 D ^DIE
182 Q
183 ;
184 ;General help text routine.
185 ;--------------------------
186HLP(CALL) ;
187 N HTEXT
188 N DIWF,DIWL,DIWR,IC
189 S DIWF="C75",DIWL=0,DIWR=75
190 ;
191 I CALL=1 D
192 .S HTEXT(1)="Enter Yes to link reminder to this dialog."
193 I CALL=2 D
194 .S HTEXT(1)="Enter Yes to link reminder to this dialog."
195 K ^UTILITY($J,"W")
196 S IC=""
197 F S IC=$O(HTEXT(IC)) Q:IC="" D
198 . S X=HTEXT(IC)
199 . D ^DIWP
200 W !
201 S IC=0
202 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
203 . W !,^UTILITY($J,"W",0,IC,0)
204 K ^UTILITY($J,"W")
205 W !
206 Q
207 ;
208 ;Reminder selection
209 ;------------------
210SEL(FILE,MODE,ARRAY) ;
211 N X,Y,CNT
212 K DIROUT,DIRUT,DTOUT,DUOUT
213 S CNT=0
214 W !
215 F D Q:$D(DTOUT) Q:$D(DUOUT) Q:CNT>0 Q:(Y=-1)&(CNT>0)
216 .S DIC=FILE,DIC(0)=MODE
217 .D ^DIC
218 .I X=(U_U) S DTOUT=1
219 .I '$D(DTOUT),('$D(DUOUT)) D
220 ..I +Y'=-1 D Q
221 ...S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
222 ..W:CNT=0 !,LIT1
223 .K DIC
224 Q
225 ;
226 ;Input transform for FINDING ITEM in 801.41
227XINP(X) ;Taxonomy findings are not allowed for dialog groups
228 I $P(X,";",2)="PXD(811.2,",$P($G(^PXRMD(801.41,DA,0)),U,4)="G" D Q 0
229 .W $C(7),!,"A taxonomy cannot be entered as the finding item for a group"
230 ;Only applies to MH
231 I $P(X,";",2)'="YTT(601," Q 1
232 ;GAF
233 I $P($G(^YTT(601,$P(X,";"),0)),U)="GAF" Q 1
234 ;Check if a VALID GUI test
235 I $P($G(^YTT(601.6,$P(X,";"),0)),U,4)="Y" Q 1
236 ;else
237 W *7,!,"This test is not appropriate for the GUI",!
238 Q 0
Note: See TracBrowser for help on using the repository browser.