source: cprs/branches/tmg-cprs/m_files/TMGNDFUT.m@ 1035

Last change on this file since 1035 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 39.1 KB
RevLine 
[796]1TMGNDFUT ;TMG/kst/FDA Import -- Fix OQV Problems;11/20/07
2 ;;1.0;TMG-LIB;**1**;11/20/07
3
4 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
5 ;" Utility functions
6
7 ;"Kevin Toppenberg MD
8 ;"GNU General Public License (GPL) applies
9 ;"10-15-2007
10
11 ;"=======================================================================
12 ;" API -- Public Functions.
13 ;"=======================================================================
14
15 ;"Edit50(IEN50) -- launch a screenman form that is designed to edit file 50 records
16 ;"Index101d44(RxSet,pIndex) -- index pointers from 101.44 --> 101.43
17 ;"GetOI(IEN50d7,Array) -- return linked IEN in the ORDERABLE ITEM file (101.43) from IEN50d7
18 ;"GetPOI(IEN101d43,POI) -- return linked IEN in PHARMACY ORDERABLE ITEM (POI) file (50.7)
19 ;"$$GetOQVIENS(IEN101d43,RxSet,Array) -- get IEN ORDER QUICK VIEW (101.44) for pointer to 101.43
20 ;"GetOIInfo(IEN101d43,Array) -- Get info about ORDERABLE ITEM (101.43) record
21 ;"ChkFixOI(Array) -- check and fix pointers into and out of OI record
22 ;"GetDRUGs(IEN50d7,IEN50Array,ActiveOnly) -- For a given IEN in PHARMACY ORDERABLE ITEM, return linked #50 IEN
23 ;"GetpDRUGs(IEN50d7,IEN50Array,ActiveOnly) -- For a given IEN in POI, return linked IEN to DRUG file (50)
24 ;"GetfdaIEN(IEN50) -- return the IEN in 22706.9 that points to IEN50
25 ;"GetFDA(IEN50,FDA) -- For a given IEN in DRUG file, return linked IEN in TMG FDA IMPORT COMPILED file (22706.9)
26 ;"Unlock50: Unlock fields needed to add data to 50
27 ;"Lock50: Return locks removed from Unlock50 in file 50
28 ;"GetpTMG(IEN50d7,TMGArray,ActiveOnly) IENs in 22706.9 pointing to POI (50.7) record
29 ;"Getp1TMG(IEN101d43,TMGArray,ActiveOnly) -- IENS in 22706.9 pointing to OI (101.43) record
30 ;"GetpPOI(IEN50d7,Array,ActiveOnly) -- return all IENs pointing to POI from 22706.9, 50, or 101.43
31 ;"GetpOI(IEN101d43,Array,ActiveOnly) --return all IENs pointing to OI from 22706.9, 50.7 101.44
32 ;"KillPOI(IEN50d7) -- remove a POI, along with ptrs from 50, 22706.9, 101.43
33 ;"KillOI(IEN101d43) -- remove an OI, along with ptrs to it from files 50.7, 22706.9, 101.44
34 ;"RedirOI(oldIEN,newIEN) -- redirect pointers in ORDERABLE ITEM file from oldIEN to newIEN
35 ;"FindPOI(DrugNAF) -- return IEN in PHARMACY ORDERABLE ITEM (50.7) matching drug name
36 ;"FindOI(DrugNAF) -- return IEN in ORDERABLE ITEM (101.43) matching drug name
37 ;"GetOQVSet(quiet) -- get the active RxSet in OQV file
38 ;"Kill50(IEN50,IEN22706d9,mode,quiet) --delete entry in file 50, and links to it from 22706.9
39 ;"$$OIInactive(IEN101d43) -- Return if record has a past-due inactive date
40 ;"$$IsImport(IEN50d7) -- determine if the POI record is one linked to a FDA import
41 ;"KillOQV(IENS) -- kill/inactivate entry in ORDER QUICK VIEW (101.44)
42
43 ;"=======================================================================
44 ;" Private Functions.
45 ;"=======================================================================
46
47 ;"=======================================================================
48
49
50Edit50(IEN50)
51 ;"Purpose: to launch a screenman form that is designed to edit file 50 records
52
53
54 new PSSZ set PSSZ=1 ;"allows editing of .01 field of file 50
55 if +IEN50>0 do LaunchScreenman^TMGMISC(50,103,IEN50,1) ;"launch screenman form
56 quit
57
58
59
60Index101d44(RxSet,pIndex)
61 ;"Purpose: index pointers from 101.44 --> 101.43
62 ;"Input: RxSet -the IEN in 101.44 containing ORWDSET O RX
63 ;" pIndex: PASS BY NAME. An OUT PARAMETER. Format:
64 ;" @pIndex@(IEN101.43,IEN101.44)=""
65
66 new Itr,subIEN
67 new abort set abort=0
68 write "Gathering list of links between ORDER QUICK VIEW --> ORDERABLE ITEM...",!
69 set subIEN=$$ItrAInit^TMGITR("^ORD(101.44,"_RxSet_",20)",.Itr)
70 do PrepProgress^TMGITR(.Itr,20,1,"subIEN")
71 if subIEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.subIEN)="")!abort
72 . if $$UserAborted^TMGUSRIF set abort=1 quit
73 . new IEN101d43
74 . set IEN101d43=+$piece($get(^ORD(101.44,RxSet,20,subIEN,0)),"^",1)
75 . if IEN101d43=0 quit
76 . set @pIndex@(IEN101d43,subIEN)=1
77 do ProgressDone^TMGITR(.Itr)
78
79 quit
80
81
82
83GetOI(IEN50d7,Array)
84 ;"Purpose: for a given PHARAMCY ORDERABLE ITEM (50.7), return matching IEN
85 ;" in the ORDERABLE ITEM file (101.43)
86 ;"Input: IEN50d7 -- the IEN in 50.7
87 ;" Array -- OPTIONAL. PASS BY REFERNCE. An OUT PARAMETER.
88 ;" Will be filled with ALL pointers to 50d7. Format:
89 ;" Array(IEN)=""
90 ;"Results: the IEN in 101.43, or 0 if not found
91 ;"Note: If, for some reason, more than one record in 101.43 points to
92 ;" the specified IEN50d7, then only the first one in the list will be
93 ;" returned, but Array will return all
94
95 new result set result=0
96 new tempS set tempS=IEN50d7_";99PSP"
97
98 new IEN101d43 set IEN101d43=""
99 for set IEN101d43=$order(^ORD(101.43,"ID",tempS,IEN101d43)) quit:(IEN101d43="") do
100 . if +IEN101d43=0 quit
101 . if result=0 set result=IEN101d43
102 . set Array(IEN101d43)=""
103
104 quit result
105
106
107GetPOI(IEN101d43) ;" !! Note: this is a different function from GetpOI !!
108 ;"Purpose: for a given entry in ORDERABLE ITEM (101.43) file, return matching
109 ;" IEN in PHARMACY ORDERABLE ITEM (POI) file (50.7)
110 ;"Input: IEN101d43 -- IEN in 101.43
111 ;"Output: bad pointers may be fixed.
112 ;"Result: returns IEN in 50.7, or -1 if NON-PHARMACY entry found, or 0 if problem
113
114 new Array,result
115
116 do GetOIInfo(IEN101d43,.Array)
117
118 new tPOI,gPOI
119 set tPOI=+$get(Array("IEN 50.7 from 22706.9","TRADE"))
120 set gPOI=+$get(Array("IEN 50.7 from 22706.9","GENERIC"))
121 if (tPOI'=0)&(gPOI'=0)&(tPOI'=gPOI) do
122 . do ChkFixOI(.Array)
123
124 set result=$get(Array("IEN 50.7 from 22706.9","GENERIC"))
125 if result="" set result=$get(Array("IEN 50.7 from 22706.9","TRADE"))
126 if result="" set result=$get(Array("IEN 50.7 from 101.43"))
127
128 quit +result
129
130
131GetOIInfo(IEN101d43,Array)
132 ;"Purpose: for a given entry in ORDERABLE ITEM (101.43) file, return matching
133 ;" IEN in PHARMACY ORDERABLE ITEM (POI) file (50.7)
134 ;"Input: IEN101d43 -- IEN in 101.43
135 ;" Array -- OPTIONAL. PASS BY REFERENCE. An OUT PARAMETER. Output format:
136 ;" Array("IEN 101.43")=IEN
137 ;" Array("IEN 101.43","NAME")=Name
138 ;" Array("IEN 101.43","INACTIVE")=0 (or 1 if is inactivated)
139 ;" Array("IEN 101.43","PACKAGE") = package ('99PSP' for pharmacy)
140 ;" Array("IEN 101.44",IENS)=""
141 ;" Array("IEN 50.7 from 22706.9","GENERIC")=IEN50d7
142 ;" Array("IEN 50.7 from 22706.9","TRADE")=IEN50d7
143 ;" Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)=IEN50d7
144 ;" Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)=IEN50d7
145 ;" Array("IEN 50.7 from 101.43")=IEN50d7
146 ;" Array("IEN 50.7 from 101.43","NAME")=Name of 50.7, or "<LINK IS NOT TO A DRUG>" if problem
147 ;" Array("IEN 22706.9","GENERIC",IEN22706d9)=""
148 ;" Array("IEN 22706.9","TRADE",IEN22706d9)=""
149 ;"Output: See Array above.
150 ;"Result: none
151
152 new POIName set POIName=""
153 new IEN22706d9
154
155 set Array("IEN 101.43")=IEN101d43
156 set Array("IEN 101.43","NAME")=$piece($get(^ORD(101.43,IEN101d43,0)),"^",1)
157 set Array("IEN 101.43","INACTIVE")=$$OIInactive(IEN101d43)
158
159 set IEN22706d9=""
160 for set IEN22706d9=+$order(^TMG(22706.9,"OIG",IEN101d43,IEN22706d9)) quit:(+IEN22706d9'>0) do
161 . if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP
162 . new tempPtr set tempPtr=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) ;" 8;4 =POI GENERIC LINK
163 . set Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)=tempPtr
164 . set Array("IEN 22706.9","GENERIC",IEN22706d9)=""
165 . set Array("IEN 50.7 from 22706.9","GENERIC")=tempPtr
166
167 set IEN22706d9=""
168 for set IEN22706d9=+$order(^TMG(22706.9,"OIT",IEN101d43,IEN22706d9)) quit:(+IEN22706d9'>0) do
169 . if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP
170 . new tempPtr set tempPtr=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) ;" 8;3 = POI TRADENAME LINK
171 . set Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)=tempPtr
172 . set Array("IEN 22706.9","TRADE",IEN22706d9)=""
173 . set Array("IEN 50.7 from 22706.9","TRADE")=tempPtr
174
175 ;"Get direct pointer to 50.7
176 new ID set ID=$piece($get(^ORD(101.43,IEN101d43,0)),"^",2)
177 new pkg set pkg=$piece(ID,";",2)
178 set Array("IEN 101.43","PACKAGE")=pkg
179
180 new IEN50d7
181 if pkg="99PSP" do
182 . set IEN50d7=+$piece(ID,";",1)
183 . set POIName=$piece($get(^PS(50.7,IEN50d7,0)),"^",1)
184 else do goto GPOIDone ;"not a pharmacy item.
185 . set IEN50d7=0
186 . set POIName="<LINK IS NOT TO A DRUG>"
187 set Array("IEN 50.7 from 101.43")=IEN50d7
188 set Array("IEN 50.7 from 101.43","NAME")=POIName
189
190 new IENS set IENS=$$GetOQVIENS(IEN101d43)
191 set Array("IEN 101.44",IENS)=""
192
193GPOIDone
194 quit
195
196
197ChkFixOI(Array) ;"NOTE: This function is not finished/debugged
198 ;"Purpose: to check and fix pointers into and out of OI record
199 ;"Input -- Array -- PASS BY REFERENCE. An Array as created by GetOIInfo
200 ;" Array("IEN 101.43")=IEN
201 ;" Array("IEN 101.43","NAME")=Name
202 ;" Array("IEN 101.43","INACTIVE")=0 (or 1 if is inactivated)
203 ;" Array("IEN 101.43","PACKAGE") = package ('99PSP' for pharmacy)
204 ;" Array("IEN 101.44",IENS)=""
205 ;" Array("IEN 50.7 from 22706.9","GENERIC")=IEN50d7
206 ;" Array("IEN 50.7 from 22706.9","TRADE")=IEN50d7
207 ;" Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)=IEN50d7
208 ;" Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)=IEN50d7
209 ;" Array("IEN 50.7 from 101.43")=IEN50d7
210 ;" Array("IEN 50.7 from 101.43","NAME")=Name of 50.7, or "<LINK IS NOT TO A DRUG>" if problem
211 ;" Array("IEN 22706.9","GENERIC",IEN22706d9)=""
212 ;" Array("IEN 22706.9","TRADE",IEN22706d9)=""
213 ;"Result: none
214
215 if $get(Array("IEN 101.43","INACTIVE"))=1 goto COIFDone
216
217 new IEN101d43 set IEN101d43=+$get(Array("IEN 101.43"))
218 new IEN50d7a set IEN50d7a=+$get(Array("IEN 50.7 from 101.43"))
219 if IEN50d7a=0 do KillOI(IENE101d43) goto COIFDone
220
221 new POIName set POIName=$get(Array("IEN 50.7 from 101.43","NAME"))
222 new OIName set OIName=$get(Array("IEN 101.43","NAME"))
223
224 new tPOI,gPOI
225 set tPOI=+$get(Array("IEN 50.7 from 22706.9","TRADE"))
226 set gPOI=+$get(Array("IEN 50.7 from 22706.9","GENERIC"))
227 ;"For a given OI, see if there are two different POI's pointing to it via 22706.9
228 ;"There should be just TRADE ptrs or GENERIC ptrs, but not both.
229 if (tPOI'=0)&(gPOI'=0)&(tPOI'=gPOI) do goto COIFDone ;"we have crossed chains.
230 . ;"We need to make a new POI. But which chain gets new one?
231 . new gPOIName,tPOIName,OIName
232 . set gPOIName=$piece($get(^PS(50.7,gPOI,0)),"^",1)
233 . set tPOIName=$piece($get(^PS(50.7,tPOI,0)),"^",1)
234 . set OIName=$piece($get(^ORD(101.43,IEN101d43,0)),"^",1)
235 . if gPOIName'=OIName do ;"make a new OI for generic chain
236 . . new newOI set newOI=$$NewOI^TMGNDF4C(gPOIName)
237 . . if newOI=0 quit ;"error
238 . . new result set result=$$StuffOI^TMGNDF4C(newOI,gPOIName,,gPOI)
239 . . new IEN22706d9 set IEN22706d9=""
240 . . for set IEN22706d9=$order(Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)) quit:(IEN22706d9="") do
241 . . . new TMGFDA,TMGMSG
242 . . . set TMGFDA(22706.9,IEN22706d9_",",5.711)=newOI
243 . . . do FILE^DIE("","TMGFDA","TMGMSG")
244 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
245 . if tPOIName'=OIName do ;"make a new OI for trade chain
246 . . new newOI set newOI=$$NewOI^TMGNDF4C(tPOIName)
247 . . if newOI=0 quit ;"error
248 . . new result set result=$$StuffOI^TMGNDF4C(newOI,tPOIName,,tPOI)
249 . . new IEN22706d9 set IEN22706d9=""
250 . . for set IEN22706d9=$order(Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)) quit:(IEN22706d9="") do
251 . . . new TMGFDA,TMGMSG
252 . . . set TMGFDA(22706.9,IEN22706d9_",",5.611)=newOI
253 . . . do FILE^DIE("","TMGFDA","TMGMSG")
254 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
255
256 if ($data(Array("IEN 50.7 from 22706.9","GENERIC"))=0)&($data(Array("IEN 50.7 from 22706.9","TRADE"))=0) do
257 . write "A linked record in 22706.9 NOT found pointing to 101.43 #",IEN101d43," (",OIName,")",!
258 else do
259 . new TMGIEN set TMGIEN=""
260 . for set TMGIEN=$order(Array("IEN 50.7 from 22706.9","GENERIC",TMGIEN)) quit:(TMGIEN="") do
261 . . new IEN50d7 set IEN50d7=+$get(Array("IEN 50.7 from 22706.9","GENERIC",TMGIEN))
262 . . write "Linked record in 22706.9 #",TMGIEN," (GENERIC pointer) points to 50.7 #",IEN50d7,!
263 . set TMGIEN=""
264 . for set TMGIEN=$order(Array("IEN 50.7 from 22706.9","TRADE",TMGIEN)) quit:(TMGIEN="") do
265 . . new IEN50d7 set IEN50d7=+$get(Array("IEN 50.7 from 22706.9","TRADE",TMGIEN))
266 . . write "Linked record in 22706.9 #",TMGIEN," (TRADE pointer) points to 50.7 #",IEN50d7,!
267
268 write " 101.43 #",IEN101d43," (",OIName,")",!
269 write " points directly to 50.7 #",IEN50d7a," (",POIName,")",!
270 if (IEN50d7a'=0),$$IsImport^TMGNDF4B(IEN50d7a) do
271 . write " and that IS an active import record.",!
272 . new IEN50Array
273 . do GetDRUGs^TMGNDF4F(IEN50d7a,.IEN50Array,1)
274 . write " Pointed to by these active records:",!
275 . new name set name=""
276 . for set name=$order(IEN50Array(name)) quit:(name="") do
277 . . new IEN50 set IEN50=""
278 . . for set IEN50=$order(IEN50Array(name,IEN50)) quit:(IEN50="") do
279 . . . write " #",IEN50," ",name,!
280 else do
281 . write " and that IS NOT active import record.",!
282 . do KillOI(IEN101d43)
283 . write " .. Record in 101.43 deleted.",!
284
285COIFDone
286 quit
287
288
289
290GetDRUGs(IEN50d7,IEN50Array,ActiveOnly)
291 ;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return linked IEN to
292 ;" DRUG file (50)
293 ;"Input: IEN50d7 -- IEN in file 50.7
294 ;" IEN50Array -- PASS BY REFERENCE, an OUT PARAMETER. Format:
295 ;" IEN50Array(Name,IEN50)="" Name is from .01 field
296 ;" IEN50Array(Name,IEN50)="" Name is from .01 field
297 ;" ActiveOnly -- OPTIONAL, Default=1
298 ;"result: none.
299
300 if +$get(IEN50d7)=0 goto GDsDone
301 new tempA
302 merge tempA=^TMG(22706.9,"POIG",IEN50d7)
303 merge tempA=^TMG(22706.9,"POIT",IEN50d7)
304 new IEN22706d9 set IEN22706d9=""
305 for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do
306 . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP
307 . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped record!",!
308 . new tIEN50,gIEN50
309 . set tIEN50=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
310 . if tIEN50>0 do
311 . . new name set name=$piece($get(^PSDRUG(tIEN50,0)),"^",1)
312 . . set IEN50Array(name,tIEN50)=""
313 . set gIEN50=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
314 . if gIEN50>0 do
315 . . new name set name=$piece($get(^PSDRUG(gIEN50,0)),"^",1)
316 . . set IEN50Array(name,gIEN50)=""
317
318 ;"set ActiveOnly=1
319 ;"kill IEN50Array
320 ;"new temp merge temp=^PSDRUG("ASP",IEN50d7)
321 ;"new IEN set IEN=""
322 ;"for set IEN=$order(temp(IEN)) quit:(IEN="") do
323 ;". new Active set Active=($piece($get(^PSDRUG(IEN,"I")),"^",1)="")
324 ;". if ActiveOnly,(Active=0) quit
325 ;". new name set name=$$GET1^DIQ(50,IEN_",",.01) quit:(name="")
326 ;". ;"set name="(#"_IEN_") "_name
327 ;". new route set route=$$GET1^DIQ(50,IEN_",",62.02)
328 ;". if route'="" set name=name_" "_route
329 ;". set IEN50Array(name,IEN)=""
330GDsDone
331 quit
332
333
334GetpDRUGs(IEN50d7,IEN50Array,ActiveOnly)
335 ;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return linked IEN to
336 ;" DRUG file (50)
337 ;"Input: IEN50d7 -- IEN in file 50.7
338 ;" IEN50Array -- PASS BY REFERENCE, an OUT PARAMETER. Format:
339 ;" IEN50Array(IEN50)=""
340 ;" IEN50Array(IEN50)=""
341 ;" ActiveOnly -- OPTIONAL, Default=1
342 ;"result: none.
343
344 set ActiveOnly=$get(ActiveOnly,1)
345 new tempA
346 merge tempA=^TMG(22706.9,"POIG",IEN50d7)
347 merge tempA=^TMG(22706.9,"POIT",IEN50d7)
348 new IEN22706d9 set IEN22706d9=""
349 for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do
350 . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP
351 . . if ActiveOnly=1 quit
352 . . write " Pointer to PHARMACY ORDERABLE ITEM #",IEN50d7," found in skipped 22706.9 #",IEN22706d9," record!",!
353 . new tIEN50,gIEN50
354 . set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
355 . if tIEN50>0 set IEN50Array(tIEN50)=""
356 . set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
357 . if gIEN50>0 set IEN50Array(gIEN50)=""
358
359 ;"set ActiveOnly=1
360 ;"kill IEN50Array
361 ;"new temp merge temp=^PSDRUG("ASP",IEN50d7)
362 ;"new IEN set IEN=""
363 ;"for set IEN=$order(temp(IEN)) quit:(IEN="") do
364 ;". new Active set Active=($piece($get(^PSDRUG(IEN,"I")),"^",1)="")
365 ;". if ActiveOnly,(Active=0) quit
366 ;". set IEN50Array(IEN)=""
367
368 quit
369
370
371GetfdaIEN(IEN50)
372 ;"Purpose: to return the pointer to the record in 22706.9 that points to IEN50
373 ;"Input: IEN50 -- IEN in 50
374 ;"Results: returns a pointer, or 0 if not found
375
376 new result
377 set result=+$order(^TMG(22706.9,"DRUG",IEN50,""))
378 if result=0 set result=+$order(^TMG(22706.9,"DRUGT",IEN50,""))
379 quit result
380
381
382GetFDA(IEN50,FDA)
383 ;"Purpose: For a given IEN in DRUG file, return linked IEN in
384 ;" TMG FDA IMPORT COMPILED file (22706.9)
385 ;"Input: IEN50 -- IEN in file 50 (DRUG)
386 ;" FDA -- PASS BY REFERENCE, an OUT PARAMETER. Format:
387 ;" FDA=IEN in 22706.9
388 ;" FDA("NAME")=Name
389 ;"result: none.
390
391 set FDA=$$GetfdaIEN(IEN50)
392 if FDA'=0 set FDA("NAME")=$$GET1^DIQ(22706.9,FDA_",",.04)
393 quit
394
395
396GetDRUGIEN(IEN50d7) ;" -- DEPRECIATED. Use GetDRUGs^TMGNDFUT or GetpDRUGs^TMGNDFUT
397 ;"Purpose: get linked record in DRUG file (50) for given record in 50.7
398 ;"Input:IEN50d7 -- IEN in 50.7
399 ;"Results: IEN in 50, or 0 if not found
400 ;"NOTE: there may well be MULTIPLE records in 50 pointing to record in 50.7
401 ;" This function will only return the FIRST.
402 ;" GetDRUGs^TMGNDF4F(IEN50d7,IEN50Array,ActiveOnly) -- will return ALL entries.
403
404 new result
405 set result=$order(^PSDRUG("ASP",IEN50d7,""))
406 quit result
407
408
409GetpTMG(IEN50d7,TMGArray,ActiveOnly)
410 ;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return all IENs
411 ;" in 22706.9 pointing to this
412 ;"Input: IEN50d7 -- IEN in file 50.7
413 ;" IENTMGArray -- PASS BY REFERENCE, an OUT PARAMETER. Format:
414 ;" TMGArray(IEN22706d9)=""
415 ;" TMGArray(IEN22706d9)=""
416 ;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered
417 ;"result: none.
418
419 merge TMGArray=^TMG(22706.9,"POIG",IEN50d7)
420 merge TMGArray=^TMG(22706.9,"POIT",IEN50d7)
421
422 if $get(ActiveOnly)=1 do
423 . new IEN22706d9 set IEN22706d9=""
424 . for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
425 . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 quit ;"1=skip
426 . . kill TMGArray(IEN22706d9)
427
428 quit
429
430
431Getp1TMG(IEN101d43,TMGArray,ActiveOnly)
432 ;"Purpose: For a given IEN in ORDERABLE ITEM, return all IENs
433 ;" in 22706.9 pointing to this
434 ;"Input: IEN101d43 -- IEN in file 101.43
435 ;" IENTMGArray -- PASS BY REFERENCE, an OUT PARAMETER. Format:
436 ;" TMGArray(IEN22706d9)=""
437 ;" TMGArray(IEN22706d9)=""
438 ;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered
439 ;"result: none.
440
441 merge TMGArray=^TMG(22706.9,"OIG",IEN101d43)
442 merge TMGArray=^TMG(22706.9,"OIT",IEN101d43)
443
444 if $get(ActiveOnly)=1 do
445 . new IEN22706d9 set IEN22706d9=""
446 . for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
447 . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 quit ;"1=skip
448 . . kill TMGArray(IEN22706d9)
449
450 quit
451
452Unlock50
453 ;"Purpose: Unlock fields needed to add data to 50
454
455 kill ^DD(50,20,8.5)
456 kill ^DD(50,20,9)
457
458 kill ^DD(50,21,8.5)
459 kill ^DD(50,21,9)
460
461 kill ^DD(50,22,8.5)
462 kill ^DD(50,22,9)
463
464 kill ^DD(50,25,8.5)
465 kill ^DD(50,25,9)
466
467 kill ^DD(50,29,8.5)
468 kill ^DD(50,29,9)
469
470 kill ^DD(50,902,8.5)
471 kill ^DD(50,902,9)
472
473 new node,nodeA,nodeB,node2
474 set node=$get(^DD(50,901,0))
475 set nodeA=$piece(node,"^",1,4)
476 set nodeB="K:+X'=X!(X>99999999)!(X<0)!(X?.E1"".""5N.N) X"
477 set node2=nodeA_"^"_nodeB
478 set ^DD(50,901,0)=node2
479
480 quit
481
482Lock50
483 ;"Purpose: Return locks removed from Unlock50 in file 50
484
485 set ^DD(50,20,8.5)="^"
486 set ^DD(50,20,9)="^"
487
488 set ^DD(50,21,8.5)="^"
489 set ^DD(50,21,9)="^"
490
491 set ^DD(50,22,8.5)="^"
492 set ^DD(50,22,9)="^"
493
494 set ^DD(50,25,8.5)="^"
495 set ^DD(50,25,9)="^"
496
497 set ^DD(50,29,8.5)="^"
498 set ^DD(50,29,9)="^"
499
500 set ^DD(50,902,8.5)="^"
501 set ^DD(50,902,9)="^"
502
503 new node,nodeA,nodeB
504 set node=$get(^DD(50,901,0))
505 set nodeA=$piece(node,"^",1,4)
506 set nodeB="K:+X'=X!(X>99999999)!(X<0)!(X?.E1"".""5N.N)!('$P($G(^PSDRUG(DA,""DOS"")),""^"",2)) X"
507 set node2=nodeA_"^"_nodeB
508 set ^DD(50,901,0)=node2
509
510 quit
511
512
513GetpPOI(IEN50d7,Array,ActiveOnly) ;"!! NOTE: this is DIFFERENT from GetpOI or GetPOI!!
514 ;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return all IENs
515 ;" pointing to this, from 22706.9, 50, or 101.43
516 ;"Input: IEN50d7 -- IEN in file 50.7
517 ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. Format:
518 ;" Array(File,IENS,field)=""
519 ;" Array(File,IENS,field)=""
520 ;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered
521 ;" *** NOT FULLY IMPLEMENTED YET ***
522 ;"result: none.
523
524 new TMGFDA,TMGMSG
525 set ActiveOnly=$get(ActiveOnly,0)
526
527 ;"Get links in 50 to POI record (from 22706.9 Xref)
528 new IEN50Array
529 do GetpDRUGs(IEN50d7,.IEN50Array,0)
530 new IEN50 set IEN50=""
531 for set IEN50=$order(IEN50Array(IEN50)) quit:(IEN50="") do
532 . set Array(50,IEN50_",",2.1)=""
533
534 ;"Get links in 50 to POI record (from 50 ASP Xref)
535 new temp merge temp=^PSDRUG("ASP",IEN50d7)
536 set IEN50=""
537 for set IEN50=$order(temp(IEN50)) quit:(IEN50="") do
538 . new Active set Active=($piece($get(^PSDRUG(IEN50,"I")),"^",1)="")
539 . if (ActiveOnly=1)&(Active=0) quit
540 . set Array(50,IEN50_",",2.1)=""
541
542 ;"Get pointers in 22706.9 to POI record
543 new TMGArray
544 do GetpTMG(IEN50d7,.TMGArray,ActiveOnly)
545 new IEN22706d9 set IEN22706d9=""
546 for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
547 . if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)=IEN50d7 do
548 . . set Array(22706.9,IEN22706d9_",",5.61)=""
549 . if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)=IEN50d7 do
550 . . set Array(22706.9,IEN22706d9_",",5.71)=""
551
552 ;"Get text pointers in 101.43 to POI record
553 new ID set ID=IEN50d7_";99PSP"
554 new IEN101d43 set IEN101d43=""
555 for set IEN101d43=$order(^ORD(101.43,"ID",ID,IEN101d43)) quit:(IEN101d43="") do
556 . set Array(101.43,IEN101d43_",",2)="@"
557
558 quit
559
560
561GetpOI(IEN101d43,Array,ActiveOnly) ;"!! NOTE: this is DIFFERENT from GetpPOI!!
562 ;"Purpose: For a given IEN in ORDERABLE ITEM, return all IENs
563 ;" pointing to this, from 22706.9, 50.7 101.44
564 ;"Input: IEN101d43 -- IEN in file 101.43
565 ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. Format:
566 ;" Array(File,IENS,field)=""
567 ;" Array(File,IENS,field)=""
568 ;" Array(File,IENS,"N/A")="" for 50.7 'pointers'
569 ;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered
570 ;" *** NOT FULLY IMPLEMENTED YET ***
571 ;"result: none.
572 ;"Note: there is no direct pointer 50.7 --> 101.43
573 ;" Will use 101.43 <-- 22706.9 --> 50.7 to get 50.7 --> 101.43
574
575 new TMGFDA,TMGMSG
576 set ActiveOnly=$get(ActiveOnly,0)
577
578 ;"Get Pointers 101.44 --> 101.43
579 new all
580 if $$GetOQVIENS(IEN101d43,.all)>0 do
581 . new IENS set IENS=""
582 . for set IENS=$order(all(IENS)) quit:(IENS="") do
583 . . set Array(101.442,IENS,.01)=""
584
585 ;"Get pointers in 22706.9 to 101.43/OI record
586 ;" use to create pseudo pointers 50.7 --> 101.43
587 new TMGArray
588 do Getp1TMG(IEN101d43,.TMGArray,ActiveOnly)
589 new IEN22706d9 set IEN22706d9=""
590 for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
591 . set IEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) ;"TRADE POI
592 . if IEN50d7>0 set Array(50.7,IEN50d7_",","N/A")=""
593 . set IEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) ;"GENERIC POI
594 . if IEN50d7>0 set Array(50.7,IEN50d7_",","N/A")=""
595
596 ;"Get Pointers in 22706.9 --> 101.43
597 new IEN22706d9 set IEN22706d9=""
598 for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do
599 . if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",5)=IEN101d43 do
600 . . set Array(22706.9,IEN22706d9_",",5.611)=""
601 . if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",6)=IEN101d43 do
602 . . set Array(22706.9,IEN22706d9_",",5.711)=""
603
604 quit
605
606
607RedirOI(oldIEN,newIEN)
608 ;"Purpose: to redirect pointers to ORDERABLE ITEM file from oldIEN to newIEN
609 ;"Input: oldIEN -- IEN in ORDABLE ITEM (101.44) to switch FROM
610 ;" newIEN -- IEN in ORDABLE ITEM (101.44) to switch TO
611 ;"results: none.
612
613 new Array
614 do GetpOI(oldIEN,.Array)
615 ;"redirect pointers to this record held in other files (50.7, 22706.9, or 101.442)
616 new file set file=""
617 for set file=$order(Array(file)) quit:(file="") do
618 . new IENS set IENS=""
619 . for set IENS=$order(Array(file,IENS)) quit:(IENS="") do
620 . . new field set field=""
621 . . for set field=$order(Array(file,IENS,field)) quit:(field="") do
622 . . . if +field'=field quit ;"avoid "N/A"
623 . . . new TMGFDA,TMGMSG
624 . . . set TMGFDA(file,IENS,field)=newIEN
625 . . . do FILE^DIE("","TMGFDA","TMGMSG")
626 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
627
628 quit
629
630
631FindPOI(DrugNAF)
632 ;"Purpose: to return IEN in PHARMACY ORDERABLE ITEM (50.7) matching drug name
633 ;"Input: DrugNAF -- Drug name and form (e.g. LISINOPRIL TAB)
634 ;"results: IEN in 50.7, or 0 if not found
635 ;"Note: this will only return the FIRST such match.
636 ;" Also, this is an EXACT match only.
637
638 new result
639 set result=+$order(^PS(50.7,"B",DrugNAF,""))
640 quit result
641
642
643FindOI(DrugNAF)
644 ;"Purpose: to return IEN in ORDERABLE ITEM (101.43) matching drug name
645 ;"Input: DrugNAF -- Drug name and form (e.g. LISINOPRIL TAB)
646 ;"results: IEN in 101.43, or 0 if not found
647 ;"Note: this will only return the FIRST such match.
648 ;" Also, this is an EXACT match only.
649
650 new result
651 set result=+$order(^ORD(101.43,"B",DrugNAF,""))
652 quit result
653
654
655Kill50(IEN50,IEN22706d9,mode,quiet)
656 ;"Purpose: to delete entry in file 50, and also links to it from 22706.9
657 ;"Input: IEN50 -- IEN in file 50
658 ;" IEN22706d9 -- IEn in 22706.9
659 ;" mode -- OPTIONAL-- "TRADE" or "GENERIC"
660 ;" quiet -- OPTIONAL -- 1 = no message
661 ;"Results: none
662 ;"NOTE: Since file 50 is the head of a chain of drugs, it does not make
663 ;" sense for 22706.9 to have a 0 pointer to 50, but still have pointers
664 ;" to other entries in the chain (parts of which might be used by other
665 ;" drugs). So I will also delete pointers to 50.7 and 101.43
666 ;" This could leave dangling records. I guess I will have to deal
667 ;" with this elsewhere.
668 ;" -- I WILL be deleting records in 50.7 (if not pointed to by other drugs)
669
670 set IEN50=+$get(IEN50)
671 if IEN50=0 goto K50Done
672
673 set mode=$get(mode)
674 set quiet=$get(quiet)
675
676 ;"Get pointer to next link in chain, before deleting this link
677 new IEN50d7 ;"50.7 = PHARMACY ORDERABLE ITEM.
678 set IEN50d7=+$piece($get(^PSDRUG(IEN50,2)),"^",1)
679
680 new TMGFDA,TMGMSG
681 if (IEN50>0)&($data(^PSDRUG(IEN50))>0) do
682 . set TMGFDA(50,IEN50_",",.01)="@"
683 . do FILE^DIE("K","TMGFDA","TMGMSG")
684 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
685 . if 'quiet write !,"DRUG entry (#",IEN50,") deleted: ",$get(DrugInfo("NAME",mode))
686
687 if mode="" do
688 . new tIEN50 set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
689 . new gIEN50 set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
690 . if tIEN50=IEN50 set mode="TRADE" quit
691 . if gIEN50=IEN50 set mode="GENERIC" quit
692
693 if mode="TRADE" do
694 . if +$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)>0 do
695 . . set TMGFDA(22706.9,IEN22706d9_",",5.6)="@"
696 . . if 'quiet write " Link to trade drug from import #",IEN22706d9," removed.",!
697 . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)>0 do
698 . . set TMGFDA(22706.9,IEN22706d9_",",5.61)="@"
699 . . if 'quiet write " Link to trade POI from import #",IEN22706d9," removed.",!
700 . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",5)>0 do
701 . . set TMGFDA(22706.9,IEN22706d9_",",5.611)="@"
702 . . if 'quiet write " Link to trade OI from import #",IEN22706d9," removed.",!
703 . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA)
704 . if $data(TMGFDA)=0 quit
705 . do FILE^DIE("K","TMGFDA","TMGMSG")
706 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
707
708 if mode="GENERIC" do
709 . if +$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)>0 do
710 . . set TMGFDA(22706.9,IEN22706d9_",",5.7)="@"
711 . . if 'quiet write " Link to trade drug from import #",IEN22706d9," removed.",!
712 . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)>0 do
713 . . set TMGFDA(22706.9,IEN22706d9_",",5.71)="@"
714 . . if 'quiet write " Link to generic POI from import #",IEN22706d9," removed.",!
715 . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",6)>0 do
716 . . set TMGFDA(22706.9,IEN22706d9_",",5.711)="@"
717 . . if 'quiet write " Link to generic OI from import #",IEN22706d9," removed.",!
718 . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA)
719 . if $data(TMGFDA)=0 quit
720 . do FILE^DIE("K","TMGFDA","TMGMSG")
721 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
722
723 ;"See if any other DRUGs(50) are pointing to POI (50.7). If not kill POI
724 if $order(^PSDRUG("ASP",IEN50d7,""))="" do
725 . do KillPOI(IEN50d7) ;"will link forward to kill the rest of the chain
726
727K50Done quit
728
729
730KillPOI(IEN50d7)
731 ;"Purpose: to remove a PHARMACY ORDERABLE ITEM (50.7), along with pointers
732 ;" to it from files 50, 22706.9, 101.43
733 ;"NOTE: This function will also call subsequent functions to
734 ;" kill records chained records in 101.43,101.44
735 ;"Results: none
736
737 set IEN50d7=+$get(IEN50d7)
738 if IEN50d7=0 goto KPOIdone
739 ;"Get array of pointers to OI's from this POI record
740 new OIArray,temp
741 set temp=$$GetOI(IEN50d7,.OIArray)
742
743 new Array
744 do GetpPOI(IEN50d7,.Array,0)
745
746 new PSSZ set PSSZ=1 ;"Key for editing 50 (?)
747 do Unlock50 ;"if I relock here, may lock another function out. Will leave unlocked
748
749 ;"Delete pointers to this record held in other files (50, 22706.9, or 101.43)
750 new file set file=""
751 for set file=$order(Array(file)) quit:(file="") do
752 . if file=101.43 quit ;"ignore these, to be handled below
753 . new IENS set IENS=""
754 . for set IENS=$order(Array(file,IENS)) quit:(IENS="") do
755 . . new field set field=""
756 . . for set field=$order(Array(file,IENS,field)) quit:(field="") do
757 . . . new TMGFDA,TMGMSG
758 . . . set TMGFDA(file,IENS,field)="@"
759 . . . do FILE^DIE("","TMGFDA","TMGMSG")
760 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
761
762 ;"Delete the record itself.
763 if $data(^PS(50.7,IEN50d7))'=0 do
764 . new TMGFDA,TMGMSG
765 . set TMGFDA(50.7,IEN50d7_",",.01)="@"
766 . do FILE^DIE("","TMGFDA","TMGMSG")
767 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
768
769 ;"Kill chained records in OI
770 new IEN101d43 set IEN101d43=""
771 for set IEN101d43=$order(OIArray(IEN101d43)) quit:(IEN101d43="") do
772 . do KillOI(IEN101d43) ;"Will chain forward to delete further records in chain.
773
774KPOIdone
775 quit
776
777
778KillOI(IEN101d43)
779 ;"Purpose: to remove an ORDERABLE ITEM, along with pointers to it
780 ;" from files 50.7, 22706.9, 101.44
781 ;"Results: none
782
783 set IEN101d43=+$get(IEN101d43)
784 if IEN101d43=0 goto KOIDone
785
786 new Array
787 do GetpOI(IEN101d43,.Array,0)
788
789 ;"Delete pointers to this record held in other files (50.7, 22706.9, or 101.442)
790 new file set file=""
791 for set file=$order(Array(file)) quit:(file="") do
792 . if file=101.442 quit ;" ignore these... will handle below
793 . new IENS set IENS=""
794 . for set IENS=$order(Array(file,IENS)) quit:(IENS="") do
795 . . new field set field=""
796 . . for set field=$order(Array(file,IENS,field)) quit:(field="") do
797 . . . if +field'=field quit ;"avoid "N/A"
798 . . . new TMGFDA,TMGMSG
799 . . . set TMGFDA(file,IENS,field)="@"
800 . . . do FILE^DIE("","TMGFDA","TMGMSG")
801 . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
802
803 ;"Delete record in 101.43
804 if $data(^ORD(101.43,IEN101d43))'=0 do
805 . new TMGFDA,TMGMSG
806 . set TMGFDA(101.43,IEN101d43_",",.01)="@"
807 . do FILE^DIE("","TMGFDA","TMGMSG")
808 . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
809
810 ;"Delete chained records in 101.44
811 new OQVIENS set OQVIENS=""
812 for set OQVIENS=$order(Array(101.442,OQVIENS)) quit:(OQVIENS="") do
813 . do KillOQV(OQVIENS)
814
815KOIDone quit
816
817
818KillOQV(IENS)
819 ;"Purpose: to kill/inactivate entry in ORDER QUICK VIEW (101.44)
820 ;"Input: IENS -- the IENS entry locating record to 'kill'
821 ;"Results: none
822 ;"Note: for now, I am not going to actually delete the record, just
823 ;" mark it as deleted
824
825 new TMGFDA,TMGMSG
826 set TMGFDA(101.442,IENS,.01)=0
827 set TMGFDA(101.442,IENS,2)="<DELETED>"
828 do FILE^DIE("","TMGFDA","TMGMSG")
829 do ShowIfDIERR^TMGDEBUG(.TMGMSG)
830
831 quit
832
833
834GetOQVIENS(IEN101d43,RxSet,Array)
835 ;"Purpose: Scan in ORDER QUICK VIEW (101.44) for pointer to 101.43
836 ;"Input: IEN101d43 -- IEN in ORDERABLE ITEM (101.43) file
837 ;" RxSet -- OPTIONAL -- the IEN of the ORWDSET O RX record in 101.44
838 ;" Array -- OPTIONAL. PASS BY REFERNCE. An OUT PARAMETER.
839 ;" Will be filled with ALL pointers to 101.43. Format:
840 ;" Array(IENS)=""
841 ;"Result: IENS pointing to Entry in OQV (e.g. '104,57,'), or 0 if not found
842
843 ;"If there happened to be 2 pointers to 101.43, this would only return
844 ;" the FIRST one, but Array will return all pointers.
845
846 ;"On my initial run index was empty. May need to programatically launch reindex in the future
847
848 new result set result=0
849 if +$get(RxSet)=0 set RxSet=$$GetOQVSet
850 if RxSet=0 goto GPrDone
851
852 new IENS set IENS=""
853 new OQVIEN set OQVIEN=""
854 for set OQVIEN=$order(^ORD(101.44,RxSet,20,"B",IEN101d43,OQVIEN)) quit:(OQVIEN="") do
855 . if +OQVIEN=0 quit
856 . new tempIENS set tempIENS=OQVIEN_","_RxSet_","
857 . if result=0 set result=tempIENS
858 . set Array(tempIENS)=""
859
860GPrDone quit result
861
862
863
864GetOQVSet(quiet)
865 ;"Purpose: get the active RxSet in ORDER QUICK VIEW (101.44)
866 ;"Input: quiet -- OPTIONAL. If 1, then no error message
867 ;"results: returns RxSet, or 0 if problem.
868
869 set quiet=+$get(quiet)
870 new DIC,X,Y
871 set DIC=101.44
872 set X="ORWDSET O RX"
873 do ^DIC
874 if +Y'>0 do
875 . if quiet quit
876 . write "Can't find record 'ORWDSET O RX' in ORDER QUICK VIEW (101.44) file.",!
877
878 quit +Y
879
880
881OIInactive(IEN101d43)
882 ;"Purpose -- Return if record has a past-due inactive date
883 ;"Input: IEN101d43 -- IEn in 101.43
884 ;"Results: 0 -- not inactive, 1 is inactive
885
886 new date set date=$piece($get(^ORD(101.43,IEN101d43,.1)),"^",1)
887 new pastInactiveDate set pastInactiveDate=0
888 if date'="" do
889 . new X,Y set X="NOW" do ^%DT ;"results in Y
890 . new X1,X2
891 . set X1=Y,X2=date
892 . do ^%DTC ;"result is X=X1-X2 (X=NOW-InactiveDate) X>-1 means past inactive date
893 . set pastInactiveDate=(X>-1)
894
895 quit pastInactiveDate
896
897
898IsImport(IEN50d7)
899 ;"Purpose: To determine if the POI record is one linked to a FDA import
900 ;"Input: IEN50d7 -- IEN in 50.7
901 ;"Results: 1 if linked to a DRUG entry that is linked to an NON-SKIPPED
902 ;" record in 22706.9
903 ;" 0 otherwise
904 ;"Addendum: This function will be changed slightly, to such that it returns
905 ;" 1 if linked to an entry in 22706.9 that is NON-SKIPPED
906
907 new result set result=0
908 new IEN22706d9 set IEN22706d9=""
909 for set IEN22706d9=$order(^TMG(22706.9,"POIT",IEN50d7,IEN22706d9)) quit:(IEN22706d9="")!(result=1) do
910 . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 set result=1
911
912 if result=1 goto IIDone
913
914 for set IEN22706d9=$order(^TMG(22706.9,"POIG",IEN50d7,IEN22706d9)) quit:(IEN22706d9="")!(result=1) do
915 . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 set result=1
916
917 goto IIDone
918
919 ;"==== old code, delete later
920 new result set result=0
921 new IEN50Array
922 do GetpDRUGs^TMGNDFUT(IEN50d7,.IEN50Array,1)
923 new IEN50 set IEN50=""
924 for set IEN50=$order(IEN50Array(IEN50)) quit:(IEN50="")!(result=1) do
925 . new fdaIEN set fdaIEN=$$GetfdaIEN^TMGNDFUT(IEN50) if fdaIEN'>0 quit
926 . if $piece($get(^TMG(22706.9,fdaIEN,1)),"^",4)'=1 set result=1
927IIDone
928 quit result
929
930
Note: See TracBrowser for help on using the repository browser.