source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLG5.m@ 761

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

initial load of FOIAVistA 6/30/08 version

File size: 7.8 KB
Line 
1PXRMDLG5 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;11/08/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4ALT(DIEN,LEV,DSEQ,NODE,VIEW,NLINE,CNT,ALTLEN) ;
5 ;Display branching logic text in dialog summary view
6 N DATA,DNAM,DTYP,IEN,TERM,TNAME,TSTAT,TEMP
7 S DATA=$G(^PXRMD(801.41,DIEN,49))
8 I '+$P(DATA,U)!($P($G(DATA),U,2)="") Q
9 S TNAME=$P($G(^PXRMD(811.5,$P(DATA,U),0)),U)
10 S TSTAT=$S($P(DATA,U,2)="1":"TRUE",1:"FALSE")
11 I +$P(DATA,U,3)>0 D
12 .S IEN=$P(DATA,U,3),DNAM=$P($G(^PXRMD(801.41,IEN,0)),U)
13 .S DTYP=$S($P($G(^PXRMD(801.41,IEN,0)),U,4)="E":"Element",$P($G(^PXRMD(801.41,IEN,0)),U,4)="G":"Group")
14 I $G(DNAM)="" S TEMP="Suppressed if Reminder Term "_TNAME_" evaluates as "_TSTAT
15 I $G(DNAM)'="" S TEMP="Replaced by "_DNAM_" if Reminder Term "_TNAME_" evaluates as "_TSTAT
16 D TEXT(.NLINES,CNT,ALTLEN,TEMP,NODE)
17 Q
18 ;
19ASK(YESNO,PIEN) ;Confirm
20 K DIR,DIROUT,DIRUT,DNAME,DTOUT,DTYP,DUOUT,TEXT,X,Y
21 N DDATA,DNAME,DTYP
22 S DDATA=$G(^PXRMD(801.41,PIEN,0))
23 ;Parent name and type
24 S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4)
25 ;
26 S DIR(0)="YA0"
27 S DIR("A")="Add sequence "_SEQ_" to "
28 I DTYP="G" S DIR("A")=DIR("A")_"group "_DNAME_": "
29 E S DIR("A")=DIR("A")_"reminder dialog ?: "
30 S DIR("B")="N",DIR("?")="Enter Y or N. For detailed help type ??"
31 S DIR("??")=U_"D XHLP^PXRMDLG(1)"
32 D ^DIR K DIR
33 I $D(DIROUT) S DTOUT=1
34 I $D(DTOUT)!($D(DUOUT)) Q
35 S YESNO=$E(Y(0)) I YESNO'="Y" S DUOUT=1
36 S VALMBCK="R"
37 Q
38 ;
39BHELP(VALUE) ;
40 N HTEXT
41 D FULL^VALM1
42 ;Help text for Reminder Dialog Branching logic
43 I VALUE=1 D
44 .;Reminder Term field
45 .S HTEXT(1)="Enter a reminder term that will be used to determine if the reminder"
46 .S HTEXT(2)="element/group should be replaced or suppressed if the reminder term evaluation"
47 .S HTEXT(3)="matches the value in the Reminder Term Status field."
48 I VALUE=2 D
49 .;Reminder Term Status field
50 .S HTEXT(1)="Enter either 1 for true or 0 for false. This value will be used with the"
51 .S HTEXT(2)="reminder term field to determine if this item should be replaced with a"
52 .S HTEXT(3)="different element/group defined in the Replacement Element/Group field, or if"
53 .S HTEXT(4)="this item should be suppressed."
54 I VALUE=3 D
55 .;Replacement Element/Group field
56 .S HTEXT(1)="Enter an element/group that will be used as a replacement to thisitem, or"
57 .S HTEXT(2)="leave this field blank to suppress this item if the term evaluation"
58 .S HTEXT(3)="matches the value defined in the term status field. "
59 I VALUE=4 D
60 .;Patient Specific field
61 .S HTEXT(1)="Enter either 1 for true or 0 for false. This value must be set to true"
62 .S HTEXT(2)="if item in this dialog will be using reminder term to either replace an item"
63 .S HTEXT(3)="or to suppress an item."
64 D HELP^PXRMEUT(.HTEXT)
65 Q
66 ;
67INQ(DIEN) ;INQ Inquiry/Print option
68 ; Used by 801.41 print templates
69 ; [PXRM REMINDER DIALOG]
70 ; [PXRM DIALOG GROUP]
71 ;
72 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
73 N NLINE,NODE,NSEL,SUB
74 S NLINE=0,NODE="PXRMDLG4",NSEL=0
75 K ^TMP(NODE,$J)
76 ;
77 ;Components
78 W !!," Seq. Dialog",!
79 D DETAIL^PXRMDLG4(DIEN,"",4,NODE)
80 ;
81 ;Print lines from workfile
82 S SUB=""
83 F S SUB=$O(^TMP(NODE,$J,SUB)) Q:'SUB W !,^TMP(NODE,$J,SUB,0)
84 K ^TMP(NODE,$J)
85 Q
86 ;
87MH(IEN) ;Allow IEN=109 (HX2) as a place holder for 601 entries that do not
88 ;have a corresponding 601.71 entry.
89 I IEN=109 Q 1
90 I $G(PXRMINST)=1 Q 1
91 N MAXNUM
92 S MAXNUM=+$P($G(^PXRM(800,1,"MH")),U)
93 I MAXNUM=0 S MAXNUM=25
94 Q $$ONECR^YTQPXRM5(IEN,MAXNUM)
95 ;
96MHLICR(IEN) ;Called by input template PXRM EDIT ELEMENT. Preserve Y so template
97 ;branching works.
98 N Y
99 ;DBIA #5042
100 I $$RL^YTQPXRM3(IEN)="Y" D
101 .W !,"This MH test requires a license."
102 .W !,"The question text will not appear in the progress note.",!
103 .H 1
104 Q
105 ;
106MSEL(NUM) ;
107 I NUM=4,'$$PATCH^XPDUTL("OR*3.0*243") D EN^DDIOL("THIS SELECTION IS NOT VALID, UNTIL CPRS 27 IS INSTALLED") Q 0
108 Q 1
109 ;
110MHREQHLP ;
111 N TEXT
112 S TEXT(1)="Select 0, ""Optional open and optional complete (partial complete possible)"","
113 S TEXT(2)="if the user should be able to optionally select/open the MH test in the reminder dialog and optionally complete the MH test before the reminder dialog can be finished."
114 S TEXT(3)=" "
115 S TEXT(4)="Select 1, ""Required open and required complete before finish"","
116 S TEXT(5)="if the user is required to select/open and complete the MH test in the reminder dialog before the reminder dialog can be finished."
117 S TEXT(6)=" "
118 S TEXT(7)="Select 2, ""Optional open and required complete or cancel before finish"","
119 S TEXT(8)="if the user should be able to optionally select/open the MH test in the reminder dialog; however, if the user opens the MH test, then the user is required to complete or cancel the MH test before the reminder dialog can be finished."
120 S TEXT(9)=" "
121 S TEXT(10)="Note: Clicking the cancel button in the MH Test is considered the same as not opening the MH Test."
122 S TEXT(11)="Also, Option 2, ""Optional open and required complete or cancel before finish"", only works with CPRS 27 and"
123 S TEXT(12)="YS_MHA.dll. If Option 2 is selected and the user is using a pre-CPRS 27 version this option will be treated by CPRS as Option 1, ""Required open and required complete before finish""."
124 D HELP^PXRMEUT(.TEXT)
125 Q
126 ;
127NTERM(DA,OTERM,NTERM) ;
128 I +OTERM=0 S OTERM=$P($G(DA),U)
129 I +NTERM=0 K OTERM Q 2
130 I +OTERM=0,+NTERM>0 K OTERM Q 1
131 I +OTERM'=+NTERM K OTERM Q 0
132 K OTERM
133 Q 1
134 ;
135OTERM(DA) ;
136 K OTERM
137 S OTERM=$P($G(^PXRMD(801.41,DA,49)),U)
138 Q
139 ;
140RESCHK(IEN) ;Called by input template PXRM EDIT ELEMENT. Preserve Y so template
141 ;branching works.
142 N CNT,FDA,MSG,RG,RGIEN,VALID,Y
143 S CNT=0
144 F S CNT=$O(^PXRMD(801.41,IEN,51,CNT)) Q:CNT'>0 D
145 .S RGIEN=$P($G(^PXRMD(801.41,IEN,51,CNT,0)),U) I +RGIEN'>0 Q
146 .S RG=$P($G(^PXRMD(801.41,RGIEN,0)),U,1)
147 .I RG="" Q
148 .S VALID=$$RGLSCR(IEN,RG,RGIEN)
149 .I VALID Q
150 .W !,"Deleting the result group ",RG," from the element/group."
151 .S FDA(801.41121,CNT_","_IEN_",",.01)="@"
152 .D FILE^DIE("E","FDA","MSG")
153 .S RGKILL=1
154 .I $D(MSG) D AWRITE^PXRMUTIL("MSG")
155 Q
156 ;
157RSELEDIT(DA) ;
158 N NODE,RESULT
159 ;RESULT=0 EDIT NOTHING
160 ;RESULT=1 EDIT INFORMATIONAL TEXT
161 ;RESULT=2 EDIT EVERYTHING
162 S RESULT=2
163 I $G(PXRMINST)=1,DUZ(0)="@" Q RESULT
164 S NODE=$G(^PXRMD(801.41,DA,100))
165 I $P(NODE,U)="N" S RESULT=0
166 I RESULT=0,+$P(NODE,U,4)=0 S RESULT=1
167 Q RESULT
168 ;
169RGLSCR(DA,X,IEN) ;Input transform/screen for RESULT GROUP LIST
170 I $G(PXRMINST)=1 Q 1
171 I $G(PXRMEXCH)=1 Q 1
172 N HELP,MHTEST,TEXT,VALID,Y
173 S NMATCH=0
174 S MHTEST=$O(^PXRMD(801.41,"B",X),-1)
175 F S MHTEST=$O(^PXRMD(801.41,"B",MHTEST)) Q:(NMATCH>1)!(MHTEST'[X) S NMATCH=NMATCH+1
176 ;If there is an exact match to the user's input turn help on.
177 S HELP=$S($G(DIQUIET):0,NMATCH=1:1,1:0)
178 S VALID=1
179 ;Make sure the TYPE is a result group
180 I '$D(^PXRMD(801.41,"TYPE","S",IEN)) D
181 . I HELP S TEXT(1)="TYPE must be a result group."
182 . S VALID=0
183 ;Make sure the finding item for the element matches the
184 ;MH Test assigned to the Result Group
185 S MHTEST=+$P($G(^PXRMD(801.41,DA,1)),U,5) I MHTEST="" D
186 . I HELP S TEXT(2)="The MH test is missing."
187 . S VALID=0
188 I +$P($G(^PXRMD(801.41,IEN,50)),U)'=MHTEST D
189 . I HELP S TEXT(3)="The finding item does not match the MH Test assigned to the Result Group"
190 . S VALID=0
191 ;Make sure a scale has been defined.
192 I +$P($G(^PXRMD(801.41,IEN,50)),U,2)'>0 D
193 . I HELP S TEXT(4)="An MH Scale must be defined."
194 . S VALID=0
195 ;Make sure it is not disabled.
196 I $P($G(^PXRMD(801.41,IEN,0)),U,3)'="" D
197 . S VALID=0
198 . I HELP D
199 .. N EM,TYPE
200 .. S TYPE=$P(^PXRMD(801.41,IEN,0),U,4)
201 .. S TYPE=$$EXTERNAL^DILFD(801.41,4,"",TYPE,.EM)
202 .. S TEXT(5)="The "_TYPE_" is disabled."
203 I HELP,'VALID D EN^DDIOL(.TEXT)
204 Q VALID
205 ;
206TERMS(DA,X) ;
207 N TERM
208 S TERM=$P($G(^PXRMD(801.41,DA,49)),U)
209 I +TERM=0 D Q 0
210 .W !,"Cannot set Reminder Term Status if the Reminder Term field is blank"
211 .H 2
212 I +TERM>0,$G(X)="" Q 2
213 Q 1
214 ;
215TEXT(NLINES,CNT,ATLEN,TEMP,NODE) ;
216 N CNT1,NOUT,OUTPUT,WIDHT
217 S WIDTH=IOM-(2+(CNT+ATLEN))
218 S CNT1=1 D FORMATS^PXRMTEXT(1,WIDTH,TEMP,.NOUT,.OUTPUT)
219 I NOUT>0 F CNT1=1:1:NOUT D
220 .S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=$J("",2+(CNT+ATLEN))_OUTPUT(CNT1)
221 Q
222 ;
Note: See TracBrowser for help on using the repository browser.