source: cprs/branches/tmg-cprs/m_files/TMGNDF2C.m@ 861

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

Initial upload

File size: 30.1 KB
Line 
1TMGNDF2C ;TMG/kst/FDA Import: Fill VA GENERIC entries;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/21/06
3
4 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
5 ;" -- FILLING VA GENERIC FILE WITH NEW VALUES
6 ;" -- and linking field .08 (VA GENERIC) in file TMG FDA IMPORT with links to apprpriate values.
7 ;"Kevin Toppenberg MD
8 ;"GNU General Public License (GPL) applies
9 ;"11-21-2006
10
11 ;"=======================================================================
12 ;" API -- Public Functions.
13 ;"=======================================================================
14 ;"Menu
15 ;"=======================================================================
16 ;"FillGenerics -- scan TMG FDA IMPORT file and make sure that all of the GENERIC NAMEs
17 ;" have been added into the VA GENERIC file, or that a link exists between a
18 ;" GENERIC name and an existing VA GENERIC name.
19 ;" Then use this data and fill in field .08 in file TMG FDA IMPORT COMPILED
20
21 ;"=======================================================================
22 ;" Private Functions.
23 ;"=======================================================================
24 ;"CheckGenerics(Results)
25 ;"Rescan(Array,Label,number)
26 ;"FindSimGenerics(Generic,Array)
27 ;"NarrowGenMatches(Generic,Array)
28 ;"FindGenContain(name,Array)
29 ;"Scan4Generics(Array)
30 ;"Unlock50dot6
31 ;"Lock50dot6
32 ;"ShowList(Array,Label)
33 ;"ProcessList(Array) -- handle adding generic names, returning a list of linkages
34 ;"HandleAdds(Array) -- handle adding those entries in Array that need to be added to VA GENERIC file.
35 ;"Remove(Array,Label,Num,EndNum) -- remove name(s) from Array of additions to VA GENERIC file
36 ;"CustLookup(Array,Label,Num) -- manually link entry in Array to an existing entry in VA GENERIC file
37 ;"DoAdds(Array,Label,Num,EndNum) -- extract name(s) from Array and add to VA GENERIC file, via Add1Generic
38 ;"Add1Generic(Name) -- add on entry to the VA GENERIC FILE
39 ;"HandleQAdds(Array) -- review 'Uncertain Matches' node of Array and allow user to specify whether
40 ;"DoLinks(Array,Num,EndNum) -- change a link from the "Uncertain Matches" node, to a formal link
41 ;"DoMltLink(Array,Num,TMGGeneric) -- interact with user and pick which link (amoung multiple)
42 ;"FillCompFile(Array) -- fill in field .08 in file TMG FDA IMPORT COMPILED
43
44 ;"=======================================================================
45 ;"=======================================================================
46
47Menu
48 ;"Purpose: Provide menu to entry points of main routines
49
50 new Menu,UsrSlct
51 set Menu(0)="Pick Option for filling VA GENERIC entries (2C)"
52 set Menu(1)="Ensure link between import GENERIC name, and VA GENERIC name"_$char(9)_"FillGenerics"
53 set Menu("P")="Prev Stage"_$char(9)_"Prev"
54 set Menu("N")="Next Stage"_$char(9)_"Next"
55
56MC1 write #
57 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
58 if UsrSlct="^" goto MCDone
59 if UsrSlct=0 set UsrSlct=""
60
61 if UsrSlct="FillGenerics" do FillGenerics goto MC1
62 if UsrSlct="Prev" goto Menu^TMGNDF2A ;"quit can occur from there...
63 if UsrSlct="Next" goto Menu^TMGNDF2E ;"quit can occur from there...
64 goto MC1
65
66MCDone
67 quit
68
69
70FillGenerics
71 ;"Purpose: To scan TMG FDA IMPORT file and make sure that all of the GENERIC NAMEs
72 ;" have been added into the VA GENERIC file, or that a link exists between a
73 ;" GENERIC name and an existing VA GENERIC name.
74 ;" Then use this data and fill in field .08 in file TMG FDA IMPORT COMPILED
75
76 new list
77
78 write #
79 write "======================================================",!
80 write "Link FDA import entries to entries in VA GENERIC file",!
81 write "======================================================",!,!
82 new list
83 if $data(^TMG("templist")) do
84 . write "Data from another work run found. Continue to use this"
85 . new % set %=1 do YN^DICN write !
86 . if %=1 merge list=^TMG("templist")
87 . if %=2 do
88 . . write "Delete old data from prior run"
89 . . set %=2 do YN^DICN write !
90 . . if %=1 kill ^TMG("templist"),list
91 . . do CheckGenerics(.list)
92 else do CheckGenerics(.list)
93 kill ^TMG("templist")
94
95 if $data(list)=0 goto FGDone
96
97 do ProcessList(.list)
98 merge ^TMG("templist")=list
99 write "Use data to fill in VA GENERIC field in TMG FDA IMPORT COMPILED now"
100 set %=1 do YN^DICN write !
101 if %=1 do FillCompFile(.list)
102
103FGDone
104 write "Goodbye.",!
105 quit
106
107
108CheckGenerics(Results)
109 ;"Purpose: To scan TMG FDA IMPORT file and make sure that all of the GENERIC NAMEs
110 ;" have been added into the VA GENERIC file, or that a link exists between a
111 ;" GENERIC NAME and an existing VA GENERIC name.
112 ;"Input: Results -- PASS BY REFERENCE, and OUT PARAMETER. Returns array with results.
113
114 new Array,i
115 write "Collecting list of imports not linked to a VA GENERIC entry.",!
116 do Scan4Generics(.Array) ;"note: result Array will not include SKIPPED records
117 if $data(Array)=0 do goto CGDone
118 . write "No unmatched entries found--great!",!
119
120 write "Processing GENERIC names...",!
121
122 new DIC,X,Y
123 set DIC=50.6
124 set DIC(0)="M" ;"multiple index, LAYGO (add if not found)
125
126 new abort set abort=0
127 new temp set temp=""
128 new count set count=1
129 new TMGGeneric
130 new Itr,i
131 set i=$$ItrAInit^TMGITR("Array",.Itr)
132 do PrepProgress^TMGITR(.Itr,20,1,"i")
133 if i'="" for do quit:($$ItrANext^TMGITR(.Itr,.i)="")!abort
134 . set X=i,TMGGeneric=i
135 . set DIC(0)="M" do ^DIC
136 . if Y=-1 do
137 . . set DIC(0)="MX"
138 . . do ^DIC
139 . if Y=-1 do
140 . . if $data(^PSNDF(50.6,"B",X)) do
141 . . . new IEN set IEN=+$order(^PSNDF(50.6,"B",X,""))
142 . . . if IEN'>0 write "?? IEN for ",X," is NULL??",! quit
143 . . . set Y=IEN_"^"_X ;"only get first match
144 . if +Y>0 do quit
145 . . set Results("Uncertain Matches",count,TMGGeneric,$piece(Y,"^",2))=Y
146 . . set count=count+1
147 . new list
148 . do FindSimGenerics(TMGGeneric,.list)
149 . if $data(list) do
150 . . merge Results("Uncertain Matches",count,TMGGeneric)=list
151 . . set count=count+1 ;"is this right???
152 . else do
153 . . set Results("Should Add",count,TMGGeneric)=""
154 . . set count=count+1
155 do ProgressDone^TMGITR(.Itr)
156
157CGDone
158 quit
159
160Rescan(Array,Label,number)
161 ;"Purpose: to allow rescan of one entry
162 ;"Input: Array -- PASS BY REFERENCE -- Array with drug lists, as used by CheckGenerics
163 ;" Label -- i.e. "Uncertain Matches", or "Should Add"
164 ;" number -- the number of the listing to rescan
165 ;" NOTE: This affects Results from a global scope
166 ;" ??? Was this intended ???
167 ;"Output:
168 ;"results: none
169
170 new DIC,X,Y
171 set DIC=50.6
172 set DIC(0)="M" ;"multiple index, LAYGO (add if not found)
173
174 set X=$order(Array(Label,number,""))
175 if X'="" do
176 . do ^DIC
177 . if +Y'>0 do
178 . . new list
179 . . do FindSimGenerics(X,.list)
180 . . if $data(list) do
181 . . . merge Results("Uncertain Matches",number,X)=list
182 . . else do
183 . . . set Results("Should Add",number,X)=""
184 . else set Results(X)=Y
185
186 quit
187
188
189FindSimGenerics(Generic,Array)
190 ;"Purpose: to scan VA GENERIC file and return an array of similar entries.
191 ;"Input: Generic: the name of the generic drug name to scan for
192 ;" Array: PASS BY REFERENCE, and OUT PARAMETER -- prior entries are killed
193 ;"Result: none (output is in Array)
194
195 new i,i2,s
196 kill Array
197 new NumRxs
198 set NumRxs=$length(Generic,"/")
199
200 set i2=$order(^PSNDF(50.6,0))
201 if i2'="" for do quit:(i2="")
202 . new VAGeneric set VAGeneric=$piece($get(^PSNDF(50.6,i2,0)),"^",1)
203 . new IEN set IEN=i2
204 . set i2=$order(^PSNDF(50.6,i2))
205 . if NumRxs'=$length(VAGeneric,"/") quit
206 . new temp set temp=VAGeneric
207 . for i=1:1:NumRxs do quit:(s="")!(temp="")
208 . . set s=$piece(Generic,"/",i)
209 . . set s=$piece(s," ",1) ;"get first word of multi-word drug name
210 . . if s="" quit
211 . . if $extract(VAGeneric,1,$length(s))'=s set temp=""
212 . if temp'="" do
213 . . set Array(VAGeneric)=IEN_"^"_VAGeneric
214
215 new count
216 set count=$$ListCt^TMGMISC("Array")
217 if count>1 do
218 . do NarrowGenMatches(Generic,.Array)
219 . if (($$ListCt^TMGMISC("Array")/count)>0.5)&(count>5) do ;"i.e. no improvement
220 . . kill Array
221
222 quit
223
224
225NarrowGenMatches(Generic,Array,DivCh)
226 ;"Purpose: To take a number of matches, and weed out bad matches (narrow down the list).
227 ;"Input: Generic -- Name of Generic name that ideal match should equal
228 ;" Array -- PASS BY REFERENCE, the array that needs trimming.
229 ;" DivCH -- OPTIONAL, default="/"
230 ;"Output: Array will be thinned if possible.
231 ;"Results: none
232
233 new i,j,result
234 new MaxScore set MaxScore=0
235 set DivCh=$get(DivCh,"/")
236
237 set i=$order(Array(""))
238 if i'="" for do quit:(i="")
239 . new score set score=0
240 . for j=1:1:$length(i,DivCh) do
241 . . new GenIgd,ArrayIgd
242 . . set GenIgd=$piece(Generic,DivCh,j)
243 . . set ArrayIgd=$piece(i,DivCh,j)
244 . . set score=score+$$Comp2Strs^TMGSTUTL(GenIgd,ArrayIgd)
245 . if score>MaxScore set MaxScore=score
246 . if score'<MaxScore do
247 . . set result(score,i)=""
248 . set i=$order(Array(i))
249
250 new output,count
251 set score=0,count=0
252 set i=$order(result(""),-1)
253 if i'="" for do quit:(i="")
254 . if (i'<score) do
255 . . set j=$order(result(i,""),-1)
256 . . if j'="" for do quit:(j="")
257 . . . set output(j)=$get(Array(j))
258 . . . set j=$order(result(i,j),-1)
259 . . set score=i
260 . set i=$order(result(i),-1)
261
262 kill Array
263 merge Array=output
264
265 quit
266
267
268FindGenContain(name,Array)
269 ;"Purpose to scan the VA GENERIC file and return a list off all entries containing name
270 ;"Input -- name: the string to scan for
271 ;" Array: PASS BY REFERENCE, and OUT PARAMETER (prior entries are killed
272 ;"Results: none
273
274 kill Array
275 new i
276 set i=$order(^PSNDF(50.6,0))
277 if i'="" for do quit:(i="")
278 . new VAGeneric set VAGeneric=$piece($get(^PSNDF(50.6,i,0)),"^",1)
279 . if VAGeneric[name set Array(VAGeneric)=""
280 . set i=$order(^PSNDF(50.6,i))
281
282 quit
283
284
285Scan4Generics(Array)
286 ;"Purpose: To scan TMG FDA IMPORT file and collect all the GENERICS NAME entries into the array
287 ;" It collects all instances were GENERIC NAME is provided, but VAGeneric pointer is NULL
288 ;"Input -- Array -- PASS BY REFERENCE. An Out parameter
289 ;"Results -- the Array is filled with names of GENERICS NAME
290 ;" Array(GenericName)=""
291 ;" Array(GenericName)=""
292 ;"Note: This will only return GENERICS NAMEs when there is NO entry already in field
293 ;" .08 (VA GENERIC)
294 ;" This will skip records marked to be skipped.
295
296 new name,VAGeneric
297 new Itr,IEN
298 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
299 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
300 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
301 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
302 . set name=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"get field#.07, GENERIC NAME
303 . set VAGeneric=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"get field#.08, VA GENERIC
304 . if (+name'=name)&(name'="")&(+VAGeneric=0) do
305 . . set Array(name)=""
306 do ProgressDone^TMGITR(.Itr)
307
308 quit
309
310
311ScanNoGenerics(Array)
312 ;"Purpose: To scan TMG FDA IMPORT file and collect all entries into the array
313 ;" where there is NO GENERIC NAME is provided, and VAGeneric pointer is NULL
314 ;"Input -- Array -- PASS BY REFERENCE. An Out parameter
315 ;"Results -- the Array is filled with names of drugs missing GENERICS NAME & VAGeneric Ptr
316 ;" This will skip records marked to be skipped.
317
318 new IEN
319 new name,VAGeneric
320
321 set IEN=$order(^TMG(22706.9,""))
322 if IEN'="" for do quit:(+IEN'>0)
323 . new skip set skip=$piece($get(^TMG(22706.9,IEN,1)),"^",4)
324 . if skip=0 do
325 . . set name=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"get field#.07, GENERIC NAME
326 . . set VAGeneric=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"get field#.08, VA GENERIC
327 . . if (name="")&(+VAGeneric=0) do
328 . . . if name["ALLERGENIC EXTRACT" quit ;"skip all these... I don't want them
329 . . . new tradeName set tradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME
330 . . . set Array(tradeName)=""
331 . set IEN=$order(^TMG(22706.9,IEN))
332
333 quit
334
335
336
337Unlock50dot6
338 ;"note: could just set DUZ(0)="^" and not remove this...
339 ;"Purpose: to remove the write restrictions for file 50.6
340
341 new Lbl set Lbl="50.6"
342 do SavKilRef(Lbl,$name(^DIC(50.6,0,"LAYGO")))
343 do SavKilRef(Lbl,$name(^DIC(50.6,0,"WR")))
344 do SavKilRef(Lbl,$name(^DIC(50.6,0,"DEL")))
345 do SavKilRef(Lbl,$name(^DD(50.6,.01,9)))
346 do SavKilRef(Lbl,$name(^DD(50.6,.01,"DEL",.01,0)))
347 set XUMF=1 ;"a secret programmer's key
348 set XPDGREF=1
349
350 quit
351
352
353Lock50dot6
354 ;"Purpose: to restore the write restrictions for file 50.6
355
356 do RestoreSK("50.6")
357 ;"set ^DIC(50.6,0,"LAYGO")="^"
358 ;"set ^DIC(50.6,0,"WR")="^"
359 ;"set ^DIC(50.6,0,"DEL")="^"
360 ;"set ^DD(50.6,.01,9)="^"
361 ;"set ^DD(50.6,.01,"DEL",.01,0)="I 1 D EN^DDIOL(""DELETIONS ARE NOT ALLOWED"")"
362 kill XUMF
363 kill XPDGREF
364
365 quit
366
367SavKilRef(Label,Ref)
368 if ($get(Label)="")!($get(Ref)="") quit
369 kill ^TMG("BAK",Label,Ref)
370 merge ^TMG("BAK",Label,Ref)=@Ref
371 kill @Ref
372 quit
373
374RestoreSK(Label)
375 if ($get(Label)="") quit
376 new Ref set Ref=""
377 for set Ref=$order(^TMG("BAK",Label,Ref)) quit:(Ref="") do
378 . merge @Ref=^TMG("BAK",Label,Ref)
379 . kill ^TMG("BAK",Label,Ref)
380 quit
381
382ShowList(Array,Label)
383 ;"Purpose: To display the list generated by CheckGenerics
384 ;"Input: Array -- the array containing the data
385 ;" Label -- the name of the node to display
386
387 new count,ingredient,value,first
388 new someShown set someShown=0
389 set count=$order(Array(Label,""))
390 if count'="" for do quit:(count="")
391 . new TMGGeneric,VAGeneric
392 . set TMGGeneric=$order(Array(Label,count,""))
393 . set first=1
394 . set someShown=1
395 . set VAGeneric=$order(Array(Label,count,TMGGeneric,""))
396 . if VAGeneric'="" for do quit:(VAGeneric="")
397 . . new next set next=$order(Array(Label,count,TMGGeneric,VAGeneric))
398 . . if first=1 do
399 . . . if next'="" do
400 . . . . write count,". ",TMGGeneric," ---> (multiple)",!
401 . . . . write " ---> ",VAGeneric,!
402 . . . else do
403 . . . . write count,". ",TMGGeneric," ---> ",VAGeneric,!
404 . . . set first=0
405 . . else write " ---> ",VAGeneric,!
406 . . set VAGeneric=$order(Array(Label,count,TMGGeneric,VAGeneric))
407 . else do
408 . . write count,". ",TMGGeneric,!
409 . set count=$order(Array(Label,count))
410
411 if someShown=0 do
412 . write " --- (List is Empty) ---",!
413
414 quit
415
416ProcessList(Array)
417 ;"Purpose: After list of linkages between GENERIC NAMEs and VA GENERIC names
418 ;" is created by CheckGenerics(), then this function will handle adding those
419 ;" generic names that need adding, and returning a list of linkages to use those
420 ;" cases there an entry already exists that is not exactly the same, but will be
421 ;" used as equivalent.
422 ;"Input: Array -- PASS BY REFERENCE the array generated by CheckGenerics
423 ;" Results are passed back in Array
424 ;" Array(GENERIC NAME)=IEN in VA GENERIC file
425 ;" Array(GENERIC NAME)=IEN in VA GENERIC file
426 ;"Results: none
427
428 new datafound,abort
429 set abort=0
430
431 for do quit:(datafound=0)!(abort=1)
432 . set datafound=0
433 . if $data(Array("Should Add"))>0 do quit:(abort=1)
434 . . set datafound=1
435 . . write !!,"There are entries that should be added to the VA GENERIC file",!
436 . . write "Process now (^ to abort)"
437 . . new % set %=1 ;"default to YES
438 . . do YN^DICN write !
439 . . if %=-1 set abort=1 quit
440 . . if %=1 do HandleAdds(.Array)
441 . if $data(Array("Uncertain Matches"))>0 do
442 . . set datafound=1
443 . . write !!,"There are presumed linkages that need approval.",!
444 . . write "Process now (^ to abort)"
445 . . new % set %=1 ;"default to YES
446 . . do YN^DICN write !
447 . . if %'=1 set abort=1 quit
448 . . do HandleQAdds(.Array)
449
450 quit
451
452
453HandleAdds(Array)
454 ;"Purpose: To handle adding those entries in Array that need to be added to VA GENERIC file.
455 ;"Input: Array -- PASS BY REFERENCE the array generated by CheckGenerics
456 ;" Results are passed back in Array
457 ;" Array(GENERIC NAME)=IEN in VA GENERIC file
458 ;" Array(GENERIC NAME)=IEN in VA GENERIC file
459 ;"Output: results returned in Array, as above.
460 ;"Results: none
461
462 do Unlock50dot6
463
464 new done set done=0
465 new input set input="R"
466
467 for do quit:(done=1)
468 . if input="R" do
469 . . write !!
470 . . write "-------------------------------------------------------------------",!
471 . . write "Specify which GENERIC names are OK for ADDITION to VA GENERIC file",!
472 . . write "-------------------------------------------------------------------",!
473 . . do ShowList(.Array,"Should Add")
474 . . write "-------------------------------------------------------------------",!
475 . . write "Specify which GENERIC names are OK for ADDITION to VA GENERIC file",!
476 . . write "-------------------------------------------------------------------",!
477 . write " R to refresh, L lookup, ? for instructions",!
478 . write " # or #-#, ^ to continue, X remove from list",!
479 . write "Enter number(s) to ACCEPT (or codes listed above): ^//"
480 . read input,!
481 . if input="" set input="^"
482 . set input=$$UP^XLFSTR(input)
483 . if input="^" set done=1
484 . if (input="?") do
485 . . ;"do ShowInstructions
486 . . set input="R"
487 . if +input=input do
488 . . do DoAdds(.Array,"Should Add",+input)
489 . . set input="R"
490 . if input["-" do
491 . . new N1,N2
492 . . set N1=$piece(input,"-",1)
493 . . set N2=$piece(input,"-",2)
494 . . do DoAdds(.Array,"Should Add",N1,N2)
495 . . set input="R"
496 . if input="L" do
497 . . read "Enter number to lookup manually: ",input,!
498 . . do CustLookup(.Array,"Should Add",+input)
499 . . set input="R"
500 . if input="X" do
501 . . read "Enter number(s) to REMOVE from list: ",input,!
502 . . if +input=input do
503 . . . do Remove(.Array,"Should Add",+input)
504 . . if input["-" do
505 . . . new N1,N2
506 . . . set N1=$piece(input,"-",1)
507 . . . set N2=$piece(input,"-",2)
508 . . . do Remove(.Array,"Should Add",N1,N2)
509 . . set input="R"
510
511 do Lock50dot6
512 quit
513
514
515Remove(Array,Label,Num,EndNum)
516 ;"Purpose: To remove name(s) from Array of additions to VA GENERIC file
517 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by CheckGenerics()
518 ;" Label -- the section of the array to extract from (i.e. "Already Present", or "Should Add" etc.)
519 ;" Num -- entry number to add
520 ;" EndNum -- OPTIONAL. If supplied, then range of Num-EndNum are all added.
521 ;"Output: Those values that are removed are changed to a different node, i.e.
522 ;" Array("Should Add",count,Generic)=""
523 ;"Results: none
524
525 set EndNum=$get(EndNum,Num)
526 new i,Generic,Y
527
528 for i=Num:1:EndNum do
529 . set Generic=$order(Array(Label,i,""))
530 . if Generic'="" do
531 . . ;"set Array("Rescan",i,Generic)=""
532 . . set Array("Should Add",i,Generic)=""
533 . . kill Array(Label,i)
534
535 quit
536
537
538CustLookup(Array,Label,Num)
539 ;"Purpose: To manually link entry in Array to an existing entry in VA GENERIC file
540 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by CheckGenerics()
541 ;" Results are passed back in Array
542 ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name
543 ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name
544 ;" Label -- the section of the array to extract from (i.e. "Already Present", or "Should Add" etc.)
545 ;" Num -- entry number to add
546 ;"Results: none
547
548 new DIC,X,Y,Generic
549 set DIC=50.6
550 set DIC(0)="AEQM"
551
552 set Generic=$order(Array(Label,Num,""))
553 if Generic'="" do
554 . write !,"Look up an entry to match with: ",Generic
555 . do ^DIC
556 . if +Y>0 do
557 . . kill Array(Label,Num,Generic)
558 . . set Array(Generic)=Y
559
560 quit
561
562
563DoAdds(Array,Label,Num,EndNum)
564 ;"Purpose: To extract name(s) from Array and add to VA GENERIC file, via Add1Generic
565 ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by CheckGenerics()
566 ;" Results -- PASS BY REFERENCE. An OUT array to received results
567 ;" Results(GENERIC NAME)=IEN in VA GENERIC file^Name
568 ;" Results(GENERIC NAME)=IEN in VA GENERIC file^Name
569 ;" Label -- the section of the array to extract from (i.e. "Already Present", or "Should Add" etc.)
570 ;" Num -- entry number to add
571 ;" EndNum -- OPTIONAL. If supplied, then range of Num-EndNum are all added.
572 ;"Results: none
573
574 set EndNum=$get(EndNum,Num)
575 new i,Generic,Y
576
577 for i=Num:1:EndNum do
578 . set Generic=$order(Array(Label,i,""))
579 . if Generic'="" do
580 . . set Y=$$Add1Generic(Generic)
581 . . if +Y>0 do
582 . . . set Array(Generic)=Y
583 . . . kill Array(Label,i,Generic)
584 . . . ;"set Array("Already Present",i,Generic)=Y
585
586 quit
587
588
589Add1Generic(Name)
590 ;"Purpose: To add on entry to the VA GENERIC FILE
591 ;"Input: the name of the genric to be added. Should be 3-64 characters in length
592 ;"Results: returns the added entry: IEN^NAME, or -1 if Fileman error
593 ;"Note: This function assumes that the file as been UNLOCKED via Unlock50dot6
594
595 new X,DIC
596 set DIC=50.6
597 set DIC(0)="XL"
598 set X=Name
599 do ^DIC
600
601 quit Y
602
603
604 ;"--------------------------------
605
606HandleQAdds(Array)
607 ;"Purpose: To review 'Uncertain Matches' node of Array and allow user to specify whether
608 ;" to accept equivilence of match, or to disallow link and add new GENERIC name.
609 ;"Input: Array -- PASS BY REFERENCE the array generated by CheckGenerics
610 ;" Results are passed back in Array
611 ;" Array(GENERIC NAME)=IEN in VA GENERIC file
612 ;" Array(GENERIC NAME)=IEN in VA GENERIC file
613 ;" Array(GENERIC NAME)=IEN in VA GENERIC file
614 ;"Output: results returned in Results array, as above.
615 ;"Results: none
616
617 do Unlock50dot6
618
619 new done set done=0
620 new input set input="R"
621
622 for do quit:(done=1)
623 . if input="R" do
624 . . write !!
625 . . write "-------------------------------------------------------------------",!
626 . . write "Specify which links between New --> Existing GENERIC names are OK",!
627 . . write "-------------------------------------------------------------------",!
628 . . do ShowList(.Array,"Uncertain Matches")
629 . . write "-------------------------------------------------------------------",!
630 . . write "Specify which links between New --> Existing GENERIC names are OK",!
631 . . write "-------------------------------------------------------------------",!
632 . write " R to refresh, ? for instructions",!
633 . write " # or #-#, ^ to continue, X remove from list",!
634 . write "Enter number(s) to ACCEPT (or codes listed above): ^//"
635 . read input,!
636 . if input="" set input="^"
637 . set input=$$UP^XLFSTR(input)
638 . if input="^" set done=1
639 . if (input="?") do
640 . . ;"do ShowInstructions
641 . . set input="R"
642 . if +input=input do
643 . . do DoLinks(.Array,+input)
644 . . set input="R"
645 . if input["-" do
646 . . new N1,N2
647 . . set N1=$piece(input,"-",1)
648 . . set N2=$piece(input,"-",2)
649 . . do DoLinks(.Array,N1,N2)
650 . . set input="R"
651 . if input="S" do
652 . . read "Enter number to re-SCAN: ",input,!
653 . . if +input=input do
654 . . . do Rescan(.Array,"Uncertain Matches",+input)
655 . if input="X" do
656 . . read "Enter number(s) to REMOVE from list: ",input,!
657 . . if +input=input do
658 . . . do Remove(.Array,"Uncertain Matches",+input)
659 . . if input["-" do
660 . . . new N1,N2
661 . . . set N1=$piece(input,"-",1)
662 . . . set N2=$piece(input,"-",2)
663 . . . ;"do Remove(.Array,"Uncertain Matches",N1,N2)
664 . . set input="R"
665
666 do Lock50dot6
667 quit
668
669
670DoLinks(Array,Num,EndNum)
671 ;"Purpose: To change a link from the "Uncertain Matches" node, to a formal link
672 ;"Input: Array -- PASS BY REFERENCE the array generated by CheckGenerics
673 ;" Results are passed back in Array
674 ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name
675 ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name
676 ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name
677 ;" Num -- entry number to add
678 ;" EndNum -- OPTIONAL. If supplied, then range of Num-EndNum are all added.
679 ;"Results: none
680
681 set EndNum=$get(EndNum,Num)
682 new i,TMGGeneric,VAGeneric,Y
683
684 for i=Num:1:EndNum do
685 . set TMGGeneric=$order(Array("Uncertain Matches",i,""))
686 . if TMGGeneric'="" do
687 . . if $data(Array("Uncertain Matches",i,TMGGeneric))>0 do
688 . . . set VAGeneric=$order(Array("Uncertain Matches",i,TMGGeneric,""))
689 . . . set Y=$get(Array("Uncertain Matches",i,TMGGeneric,VAGeneric))
690 . . else do ;"pick from multiple options.
691 . . . set Y=$$DoMltLink(.Array,i,TMGGeneric)
692 . . if +Y>0 do
693 . . . ;"kill Array("Uncertain Matches",i,TMGGeneric,VAGeneric)
694 . . . kill Array("Uncertain Matches",i,TMGGeneric)
695 . . . set Array(TMGGeneric)=Y
696
697 quit
698
699DoMltLink(Array,Num,TMGGeneric)
700 ;"Purpose: To interact with user and pick which link (amoung multiple)
701 ;"Input: Array -- PASS BY REFERENCE. Array as created by CheckGenerics
702 ;" Num -- The number in the "Uncertain Matches" to pick amoung.
703 ;" TMGGeneric -- the Generic Name for to look for a match to
704 ;"Results: The selected link: i.e. IEN^Name, or "" if not found
705
706
707 new VAGeneric,j,tempResults
708 new name,input,result
709 new NumAnswers set NumAnswers=0
710
711 set VAGeneric=$order(Array("Uncertain Matches",Num,TMGGeneric,""))
712 if VAGeneric'="" for j=1:1 do quit:(VAGeneric="")
713 . set tempResults(j)=$get(Array("Uncertain Matches",Num,TMGGeneric,VAGeneric))
714 . set NumAnswers=j
715 . set VAGeneric=$order(Array("Uncertain Matches",Num,TMGGeneric,VAGeneric))
716
717 if NumAnswers=1 set result=$get(tempResult(1)) goto DMLDone
718
719 write "Please select match for ",TMGGeneric,!
720 for j=1:1 do quit:(name="")
721 . set name=$get(tempResult(j))
722 . if name="" quit
723 . write " ",j,". ",$piece(name,"^",2),!
724
725 read "Enter number of match (^ to quit): ^// ",input,!
726 set result=$get(tempResult(+input))
727
728DMLDone
729 quit result
730
731
732 ;"===========================================================================
733
734FillCompFile(Array)
735 ;"Purpose: To take the list (generated in FillGenerics(), with its linkages
736 ;" between new drug names and existing drug name data, and fill
737 ;" in field .08 in file TMG FDA IMPORT COMPILED
738 ;"Input: Array -- PASS BY REFERENCE. List of linkages between names.
739 ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name
740 ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name
741 ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name
742 ;"Output: Data is put into TMG FDA IMPORT COMPILED
743 ;"Results: none
744
745 write "Filling field .08 (VA GENERIC) in file TMG FDA IMPORT COMPILED",!
746 write "based on data from field .07 (GENERIC NAME)...",!
747
748 new TMGGeneric,VAGeneric
749 new IEN,oldval
750 new count set count=0
751
752 new Itr,IEN
753 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
754 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
755 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
756 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
757 . set TMGGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"0;6 --> field .07, GENERIC NAME
758 . set oldval=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"1;3 --> field .08, VA GENERIC
759 . if (+oldval'=0)!(TMGGeneric="") quit
760 . set VAGeneric=$get(Array(TMGGeneric))
761 . if +VAGeneric>0 do
762 . . if +VAGeneric'=oldval do
763 . . new TMGFDA,TMGMSG
764 . . set TMGFDA(22706.9,IEN_",",.08)=+VAGeneric
765 . . do FILE^DIE("K","TMGFDA","TMGMSG")
766 . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
767 . . set count=count+1
768 . . ;"write "Stored ",$piece(VAGeneric,"^",2)," in record# ",IEN,!
769 . else do
770 . . write !,"Can't find entry for: ",TMGGeneric,!
771 do ProgressDone^TMGITR(.Itr)
772 write count," records modified.",!
773
774 quit
775
776
777
Note: See TracBrowser for help on using the repository browser.