source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU4.m@ 619

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

initial load of WorldVistAEHR
File size: 8.0 KB
Line 
1PXRMEXU4 ; SLC/PJH,PKR - Reminder Exchange #4, dialog changes. ;05/16/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;===============================================
4DLG(FDA,NAMECHG) ;Check the dialog for renamed entries, called by
5 ;silent installer. KIDSDONE is newed in INSDLG^PXRMEXSI.
6 N ABBR,ACTION,ALIST,DNAM,IEN,IENS,FILENUM,FINDING,NEWNAM,OFINDING
7 N ORITEM,OORITEM,PT01,RESULT,RRG,SRC,WP
8 S IENS=$O(FDA(801.41,""))
9 ;Definition .01
10 S (PT01,DNAM)=FDA(801.41,IENS,.01)
11 I $D(NAMECHG(801.41,PT01)) D
12 .S (FDA(801.41,IENS,.01),DNAM)=NAMECHG(801.41,PT01)
13 ;
14 ;Build list of finding types
15 D BLDALIST^PXRMVPTR(801.4118,.01,.ALIST)
16 ;Plus field 15 files
17 ;S ALIST("MH")=601,ALIST("TX")=811.2
18 S ALIST("MH")=601.71,ALIST("TX")=811.2
19 S ALIST("WH")=790.404
20 ;Plus field 17 file
21 S ALIST("OI")=101.43
22 ;
23 ;Process SOURCE REMINDER
24 S SRC=$G(FDA(801.41,IENS,2))
25 I SRC]"" D
26 .S IEN=$$EXISTS^PXRMEXIU(811.9,SRC)
27 .I IEN=0 K FDA(801.41,IENS,2)
28 ;
29 ;Clear RESULT if not defined
30 S RESULT=$G(FDA(801.41,IENS,55))
31 I RESULT]"" D
32 .S IEN=$$EXISTS^PXRMEXIU(801.41,RESULT)
33 .I IEN=0 K FDA(801.41,IENS,55)
34 ;
35 ;Process ORDERABLE ITEM
36 S (ORITEM,OORITEM)=$G(FDA(801.41,IENS,17)),ACTION=""
37 I ORITEM'="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
38 .S PT01=ORITEM
39 .S ABBR="OI",FILENUM=$P(ALIST(ABBR),U)
40 .I $D(NAMECHG(FILENUM,PT01)) D
41 ..S ORITEM=NAMECHG(FILENUM,PT01)
42 ..S FDA(801.41,IENS,17)=ORITEM
43 .S IEN=+$$VFIND1^PXRMEXIU(ABBR_"."_ORITEM,.ALIST)
44 .I IEN=0 D
45 ..;Get replacement
46 ..N DIC,DIR,DUOUT,MSG,X,Y
47 ..S MSG(1)=" "
48 ..S MSG(2)="ORDERABLE ITEM entry "_ORITEM_" does not exist."
49 ..D MES^XPDUTL(.MSG)
50 ..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q"
51 ..I ACTION="Q" Q
52 ..I ACTION="D" K FDA(801.41,IENS,17) Q
53 ..S DIC=FILENUM
54 ..S DIC(0)="AEMNQ"
55 ..S Y=-1
56 ..F Q:+Y'=-1 D
57 ...;If this is being called during a KIDS install we need echoing on.
58 ...I $D(XPDNM) X ^%ZOSF("EON")
59 ...D ^DIC
60 ...I $D(XPDNM) X ^%ZOSF("EOFF")
61 ...;If this is being called during a KIDS install we need echoing on.
62 ...I $D(DUOUT) S Y="" Q
63 ...I Y=-1 D BMES^XPDUTL("You must input a replacement!")
64 ..I Y="" S ACTION="Q" Q
65 ..S ORITEM=$P(Y,U,2)
66 ..S FDA(801.41,IENS,17)=ORITEM
67 .;Save the finding information for the history.
68 .I ORITEM'=OORITEM D
69 .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),ABBR_"."_OORITEM)=ABBR_"."_ORITEM
70 ;
71 ;Process FINDING ITEM
72 S (FINDING,OFINDING)=$G(FDA(801.41,IENS,15)),ACTION=""
73 I FINDING'="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
74 .S ABBR=$P(FINDING,".",1)
75 .S PT01=$P(FINDING,".",2)
76 .S FILENUM=$P(ALIST(ABBR),U,1)
77 .I $D(NAMECHG(FILENUM,PT01)) D
78 ..S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01)
79 ..S FDA(801.41,IENS,15)=FINDING
80 .S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST)
81 .I IEN=0 D
82 ..;Get replacement
83 ..N DIC,DIR,DUOUT,MSG,X,Y
84 ..S MSG(1)=" "
85 ..S MSG(2)="FINDING entry "_FINDING_" does not exist."
86 ..D MES^XPDUTL(.MSG)
87 ..S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR) I ACTION="S" S ACTION="Q"
88 ..I ACTION="Q" Q
89 ..I ACTION="D" K FDA(801.41,IENS,15) Q
90 ..S DIC=FILENUM
91 ..S DIC(0)="AEMNQ"
92 ..S Y=-1
93 ..F Q:+Y'=-1 D
94 ...;If this is being called during a KIDS install we need echoing on.
95 ...I $D(XPDNM) X ^%ZOSF("EON")
96 ...D ^DIC
97 ...I $D(XPDNM) X ^%ZOSF("EOFF")
98 ...;If this is being called during a KIDS install we need echoing on.
99 ...I $D(DUOUT) S Y="" Q
100 ...I Y=-1 D BMES^XPDUTL("You must input a replacement!")
101 ..I Y="" S ACTION="Q" Q
102 ..S FINDING=ABBR_"."_$P(Y,U,2)
103 ..S FDA(801.41,IENS,15)=FINDING
104 .;Save the finding information for the history.
105 .I FINDING'=OFINDING D
106 .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING
107 .;Convert ICD9 codes to `ien format
108 .I $P(FINDING,".")="ICD9" S FDA(801.41,IENS,15)="ICD9."_$$ICD9(FINDING)
109 ;
110 ;Look for replacements of TIU templates.
111 I $D(NAMECHG(8927.1)) D
112 .S WP=$G(FDA(801.41,IENS,25))
113 .I WP'="" D TIURPL("{FLD:",WP,.NAMECHG,8927.1)
114 .S WP=$G(FDA(801.41,IENS,35))
115 ;
116 ;Process ADDITIONAL FINDINGS
117 S IENS="",ACTION=""
118 F S IENS=$O(FDA(801.4118,IENS)) Q:IENS="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
119 . S (FINDING,OFINDING)=FDA(801.4118,IENS,.01)
120 . S ABBR=$P(FINDING,".",1)
121 . S PT01=$P(FINDING,".",2)
122 . S FILENUM=$P(ALIST(ABBR),U,1)
123 . I $D(NAMECHG(FILENUM,PT01)) D
124 .. S FINDING=ABBR_"."_NAMECHG(FILENUM,PT01)
125 .. S FDA(801.4118,IENS,.01)=FINDING
126 . S IEN=+$$VFIND1^PXRMEXIU(FINDING,.ALIST)
127 . I IEN=0 D Q:ACTION="Q"
128 ..;Get replacement
129 .. N DIC,DIR,DUOUT,MSG,X,Y
130 .. S MSG(1)=" "
131 .. S MSG(2)="ADDITIONAL FINDING entry "_FINDING_" does not exist."
132 .. D MES^XPDUTL(.MSG)
133 .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
134 .. I ACTION="S" S ACTION="Q"
135 .. I ACTION="Q" Q
136 .. I ACTION="D" K FDA(801.4118,IENS) Q
137 .. S DIC=FILENUM
138 .. S DIC(0)="AEMNQ"
139 .. S Y=-1
140 .. F Q:+Y'=-1 D
141 ...;If this is being called during a KIDS install we need echoing on.
142 ... I $D(XPDNM) X ^%ZOSF("EON")
143 ... D ^DIC
144 ... I $D(XPDNM) X ^%ZOSF("EOFF")
145 ... I $D(DUOUT) S Y="" Q
146 ... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
147 .. I Y="" S ACTION="Q" Q
148 .. S FINDING=ABBR_"."_$P(Y,U,2)
149 .. S FDA(801.4118,IENS,.01)=FINDING
150 . ;Save the finding information for the history.
151 . I FINDING'=OFINDING D
152 .. S ^TMP("PXRMEXIA",$J,"DIAF",$P(IENS,",",1),OFINDING)=FINDING
153 . ;Convert ICD9 codes to `ien format
154 . I $P(FINDING,".")="ICD9" S FDA(801.4118,IENS,.01)=$$ICD9(FINDING)
155 ;
156 I ACTION="Q" S (PXRMDONE,KIDSDONE)=1 Q
157 ;Process DIALOG COMPONENT
158 S IENS="",ACTION=""
159 F S IENS=$O(FDA(801.412,IENS)) Q:IENS="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
160 . S PT01=$G(FDA(801.412,IENS,2)) Q:PT01=""
161 . S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01))
162 .I NEWNAM'="" D
163 .. S FDA(801.412,IENS,2)=NEWNAM,PT01=NEWNAM
164 .S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
165 .I IEN=0 D
166 ..;Get replacement
167 .. N DIC,DIR,DUOUT,MSG,X,Y
168 .. S MSG(1)=" "
169 .. S MSG(2)="COMPONENT DIALOG entry "_PT01_" does not exist."
170 .. D MES^XPDUTL(.MSG)
171 .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
172 .. I ACTION="S" S ACTION="Q"
173 .. I ACTION="Q" Q
174 .. I ACTION="D" K FDA(801.412,IENS) Q
175 .. S DIC=FILENUM
176 .. S DIC(0)="AEMNQ"
177 .. S DIC("S")="I ""EG""[$P(^PXRMD(801.41,Y,0),U,4)"
178 .. S Y=-1
179 .. F Q:+Y'=-1 D
180 ...;If this is being called during a KIDS install we need echoing on.
181 ... I $D(XPDNM) X ^%ZOSF("EON")
182 ... D ^DIC
183 ... I $D(XPDNM) X ^%ZOSF("EOFF")
184 ... I $D(DUOUT) S Y="" Q
185 ... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
186 .. I Y="" S ACTION="Q" Q
187 .. I Y'="" S FDA(801.412,IENS,2)=$P(Y,U,2)
188 ;Process Result Groups
189 F S IENS=$O(FDA(801.41121,IENS)) Q:IENS="" D I ACTION="Q" K FDA S (PXRMDONE,KIDSDONE)=1 Q
190 . S PT01=$G(FDA(801.41121,IENS,.01)) Q:PT01=""
191 . S FILENUM=801.41,NEWNAM=$G(NAMECHG(FILENUM,PT01))
192 .I NEWNAM'="" D
193 .. S FDA(801.41121,IENS,2)=NEWNAM,PT01=NEWNAM
194 .S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01)
195 .I IEN=0 D
196 ..;Get replacement
197 .. N DIC,DIR,DUOUT,MSG,X,Y
198 .. S MSG(1)=" "
199 .. S MSG(2)="RESULT GROUP entry "_PT01_" does not exist."
200 .. D MES^XPDUTL(.MSG)
201 .. S ACTION=$$GETACT^PXRMEXIU("DPQ",.DIR)
202 .. I ACTION="S" S ACTION="Q"
203 .. I ACTION="Q" Q
204 .. I ACTION="D" K FDA(801.41121,IENS) Q
205 .. S DIC=FILENUM
206 .. S DIC(0)="AEMNQ"
207 .. S DIC("S")="I ""S""[$P(^PXRMD(801.41,Y,0),U,4)"
208 .. S Y=-1
209 .. F Q:+Y'=-1 D
210 ...;If this is being called during a KIDS install we need echoing on.
211 ... I $D(XPDNM) X ^%ZOSF("EON")
212 ... D ^DIC
213 ... I $D(XPDNM) X ^%ZOSF("EOFF")
214 ... I $D(DUOUT) S Y="" Q
215 ... I Y=-1 D BMES^XPDUTL("You must input a replacement!")
216 .. I Y="" S ACTION="Q" Q
217 .. I Y'="" S FDA(801.41121,IENS,.01)=$P(Y,U,2)
218 Q
219 ;
220 ;===============================================
221 ;Convert ICD9 codes to `ien format
222ICD9(CODE) ;
223 N IEN
224 S IEN=$$FIND1^DIC(80,"","AMX",$P(CODE,".",2,99))
225 I 'IEN Q ""
226 Q "`"_IEN
227 ;
228 ;===============================================
229TIURPL(SRCH,WP,NAMEGHC,FILENUM) ;Replace TIU templates whose names have
230 ;changed.
231 N IND,RS,TEXT,TS,TYPE
232 I FILENUM=8927.1 S TYPE="TIU TEMPLATE"
233 E S TYPE="TIU OBJECT"
234 S IND=1
235 F S TEXT=$G(@WP@(IND)) Q:TEXT="" D
236 .I TEXT[SRCH D
237 ..S TS=""
238 ..F S TS=$O(NAMECHG(FILENUM,TS)) Q:TS="" D
239 ...S RS=NAMECHG(FILENUM,TS) Q:TEXT'[TS
240 ...S @WP@(IND)=$$STRREP^PXRMUTIL(TEXT,TS,RS)
241 ...;Save the replacement information for the history.
242 ...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS)=RS
243 ...S ^TMP("PXRMEXIA",$J,"DIATIU",TYPE,TS,DNAM)=""
244 .S IND=IND+1
245 Q
246 ;
Note: See TracBrowser for help on using the repository browser.