source: cprs/branches/tmg-cprs/m_files/TMGNDF2G.m@ 1381

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

Initial upload

File size: 31.9 KB
Line 
1TMGNDF2G ;TMG/kst/FDA Import: Setup shortened drug names ;03/25/06
2 ;;1.0;TMG-LIB;**1**;02/24/07
3
4 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
5 ;" Creation of shortened version of drug names
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"2-24-2007
9
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13
14 ;"Menu -- Ensure other version of drug names available.
15
16 ;"=======================================================================
17 ;" Private Functions.
18 ;"=======================================================================
19 ;"MakeAltNames -- scan through all entries and set up shortened names.
20 ;"Make1Alt(IEN) --fix the names for just 1 record in 22706.9
21 ;"GetIENArray(Array) -- Gather IENS to work on
22 ;"GetPrepArray(IENArray,PrepArray) -- Prepare names for addition into 40 length fields
23 ;"PrepNames(IEN,Value55,Value56,Value75,Value76,PrepArray,AllowCut) -- Get names for IEN
24 ;"AskArray(IENArray,PrepArray) -- get array with possible fixes for 1 record
25 ;"Write1(IEN,name55,name56,name75,namd76) --write 1 record in 22706.9 file
26 ;"DispFixArray(PrepArray,MapArray,compactMode) -- Display values in PrepArray
27
28
29 ;"=======================================================================
30
31Menu
32 ;"Purpose: -- Ensure shortened version of drug names available.
33
34 new Menu,UsrSlct
35 set Menu(0)="Pick Option to Ensure All Versions of Names (2G)"
36 set Menu(1)="Ensure all drug names are ready"_$char(9)_"MakeAltNames"
37 set Menu(2)="Check for blank names"_$char(9)_"CheckForBlanks"
38 set Menu(3)="Check for BAD names"_$char(9)_"ScanBadName"
39 set Menu(4)="Ask and fix name for ONE import"_$char(9)_"FixOneName"
40 set Menu("P")="Prev Stage"_$char(9)_"Prev"
41 set Menu("N")="Next Stage"_$char(9)_"Next"
42
43M1 write #
44 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
45
46 if UsrSlct="MakeAltNames" do MakeAltNames goto M1
47 if UsrSlct="CheckForBlanks" do CheckForBlanks goto M1
48 if UsrSlct="FixOneName" do AskMake1 goto M1
49 if UsrSlct="ScanBadName" do ScanBadName goto M1
50 if UsrSlct="Prev" goto Menu^TMGNDF2E ;"quit can occur from there...
51 if UsrSlct="Next" goto Menu^TMGNDF2H ;"quit can occur from there...
52 if UsrSlct="^" goto MenuDone
53 if UsrSlct=0 set UsrSlct=""
54 goto M1
55
56MenuDone
57 quit
58
59 ;"=======================================================================================
60
61
62 ;"=======================================================================================
63MakeAltNames
64 ;"Purpose: To scan through all entries and set up alternative names.
65 ;"Input: none
66 ;"Results: none.
67 ;"Output: Fields .055, .056, .075, .076 will be filled
68 ;"Results: none
69
70 new IENArray,PrepArray
71 write "Scanning existing names of imports not skipped...",!
72 do GetIENArray(.IENArray)
73
74 write "Preparing suggested names...",!
75 do GetPrepArray(.IENArray,.PrepArray)
76
77 if $data(PrepArray)=0 do goto MKSNDone
78 . write "No fixes required. Great!",!
79 . do PressToCont^TMGUSRIF
80
81 do AskArray(.IENArray,.PrepArray)
82
83MKSNDone
84 write "Goodbye.",!
85 quit
86
87
88AskMake1
89 ;"Purpose: Ask user for record in 22706.9, and then fix
90
91 new DIC,X,Y
92 set DIC=22706.9,DIC(0)="MAEQ"
93 do ^DIC write !
94 if +Y>0 do Make1Alt(+Y)
95 quit
96
97
98Make1Alt(IEN,Option)
99 ;"Purpose: to fix the names for just 1 record in 22706.9
100 ;"Input: IEN -- IEN in 22706.9
101 ;" Option -- OPTIONAL. Format:
102 ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward
103 ;" to file 50, POI, OI, OQV etc.
104 ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN
105 ;"Note: ignores if drug is to be skipped.
106
107 new IENArray,PrepArray
108
109 set IENArray(IEN,.04)=$piece($get(^TMG(22706.9,IEN,7)),"^",6) ;" .04, LONG NAME
110 set IENArray(IEN,.055)=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;".055, TRADENAME - 40
111 set IENArray(IEN,.056)=$piece($get(^TMG(22706.9,IEN,8)),"^",1) ;".056, TRADENAME DOSE UNIT FORM - 40
112 set IENArray(IEN,.075)=$piece($get(^TMG(22706.9,IEN,7)),"^",4) ;".075, GENERIC NAME - 40
113 set IENArray(IEN,.076)=$piece($get(^TMG(22706.9,IEN,8)),"^",1) ;".076 GENERICNAME DOSE UNT FORM - 40
114
115 do GetPrepArray(.IENArray,.PrepArray,0) ;"0=no allow cut
116
117 if $data(PrepArray)=0 do goto MKSNDone
118 . write "No drug name fixes required. Great!",!
119 . do PressToCont^TMGUSRIF
120
121 do AskArray(.IENArray,.PrepArray)
122
123 if $get(Option("FIX CHAIN"))=1 do
124 . set OPTION("FIX CHAIN","IEN22706d9")=IEN
125 . do Refresh1^TMGNDF3C(IEN22706d9,.Option)
126
127M1ADone
128 write "Goodbye.",!
129 quit
130
131
132
133GetIENArray(Array)
134 ;"Purpose: Gather IENS to work on
135 ;"Input: Array -- PASS BY REFERENCE Output Format:
136 ;" Note: IEN is from file 22706.9
137 ;" Array(IEN,.04)=currentValue
138 ;" Array(IEN,.05)=currentValue
139 ;" Array(IEN,.055)=currentValue
140 ;" Array(IEN,.056)=currentValue
141 ;" Array(IEN,.07)=currentValue
142 ;" Array(IEN,.075)=currentValue
143 ;" Array(IEN,.076)=currentValue
144 ;"Results: none
145
146 new Itr,IEN
147 new abort set abort=0
148 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
149 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
150 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
151 . if $$UserAborted^TMGUSRIF set abort=1 quit
152 . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
153 . new s0,s7,s8
154 . set s0=$get(^TMG(22706.9,IEN,0))
155 . set s7=$get(^TMG(22706.9,IEN,7))
156 . set s8=$get(^TMG(22706.9,IEN,8))
157 . set Array(IEN,.04)=$piece(s7,"^",6) ;" .04 LONG NAME
158 . set Array(IEN,.05)=$piece(s0,"^",4) ;" .05 TRADENAME
159 . set Array(IEN,.055)=$piece(s7,"^",3) ;".055 TRADENAME - 40
160 . set Array(IEN,.056)=$piece(s8,"^",1) ;".056 TRADENAME DOSE UNIT FORM - 40
161 . set Array(IEN,.07)=$piece(s0,"^",6) ;" .07 GENERIC NAME
162 . set Array(IEN,.075)=$piece(s7,"^",4) ;".075 GENERIC NAME - 40
163 . set Array(IEN,.076)=$piece(s8,"^",2) ;".076 GENERICNAME DOSE UNT FORM - 40
164
165 quit
166
167
168GetPrepArray(IENArray,PrepArray,AllowCut)
169 ;"Purpose: Prepare names for addition into .055 (TRADENAME - 40)
170 ;" and .075 (GENERIC NAME - 40) fields
171 ;"Input: IENArray -- PASS BY REFERENCE Format:
172 ;" Array(IEN,.04)=currentValue
173 ;" Array(IEN,.055)=currentValue
174 ;" Array(IEN,.075)=currentValue
175 ;" PrepArray -- PASS BY REFERENCE Format:
176 ;" PrepArray(IEN1,.04)=Name for .04
177 ;" PrepArray(IEN1,.055)=Name for .055
178 ;" PrepArray(IEN1,.056)=Name for .056
179 ;" PrepArray(IEN1,.075)=Name for .075
180 ;" PrepArray(IEN1,.076)=Name for .076
181 ;" AllowCut -- OPTIONAL. Default=1. If 1, then automatic shortening of names allowed
182 ;"Output: PrepArray is Filled
183 ;"Results: none
184
185 set AllowCut=$get(AllowCut,1)
186 new Itr,IEN,abort
187 set abort=0
188 set IEN=$$ItrAInit^TMGITR("IENArray",.Itr)
189 do PrepProgress^TMGITR(.Itr,20,1,"IEN")
190 if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
191 . if $$UserAborted^TMGUSRIF() set abort=1 quit
192 . new Cur04Value set Cur04Value=$get(IENArray(IEN,.04))
193 . new Cur55Value set Cur55Value=$get(IENArray(IEN,.055))
194 . new Cur56Value set Cur56Value=$get(IENArray(IEN,.056))
195 . new Cur75Value set Cur75Value=$get(IENArray(IEN,.075))
196 . new Cur76Value set Cur76Value=$get(IENArray(IEN,.076))
197 . set abort=$$PrepNames(IEN,Cur04Value,Cur55Value,Cur56Value,Cur75Value,Cur76Value,.PrepArray,AllowCut)
198 do ProgressDone^TMGITR(.Itr)
199
200 quit
201
202
203PrepNames(IEN,Value04,Value55,Value56,Value75,Value76,PrepArray,AllowCut)
204 ;"Purpose: To get names for IEN
205 ;"Input: IEN -- the ien in file 22706.9
206 ;" Value04 -- the current value for field .04
207 ;" Value55 -- the current value for field .055
208 ;" Value56 -- the current value for field .056
209 ;" Value75 -- the current value for field .075
210 ;" Value76 -- the current value for field .076
211 ;" PrepArray -- PASS BY REFERENCE. and OUT PARAMETER.
212 ;" Format:
213 ;" PrepArray(IEN,.04)=Name for .04
214 ;" PrepArray(IEN,.055)=Name for .055
215 ;" PrepArray(IEN,.056)=Name for .056
216 ;" PrepArray(IEN,.075)=Name for .075
217 ;" PrepArray(IEN,.076)=Name for .076
218 ;" AllowCut -- OPTIONAL. Default=1. If 1 then user not prompted to shorten names
219 ;"Output: PrepArray is Filled
220 ;"Results: 0=OK to Continue, 1=abort
221
222 new result set result=0
223 set AllowCut=$get(AllowCut,1)
224 new MaxLen set MaxLen=40
225
226 ;"==Set up .04 Name (LONG NAME) ==========================
227 new New04Value set New04Value=$$MakeName(IEN,63,AllowCut,1) ;",1) Mode=Full Name
228 if New04Value="^" set result=1 goto PNDone
229 if $length(New04Value)>63 do
230 . set New04Value=$extract(New04Value,1,63-3)_"..."
231 if (New04Value["...")&(Value04'["...")&(Value04'="") set New04Value=""
232 if (New04Value'=Value04)&(New04Value'="") do
233 . set PrepArray(IEN,.04)=New04Value
234
235 ;"==Set up .075 Name (GENERIC NAME & FORM - 40)===========
236 new New75Value set New75Value=$$MakeName(IEN,MaxLen,AllowCut,5) ;",5) Mode=Generic Name
237 if New75Value="^" set result=1 goto PNDone
238 if $length(New75Value)>MaxLen do
239 . set New75Value=$extract(New75Value,1,MaxLen-3)_"..."
240 if (New75Value["...")&(Value75'["...")&(Value75'="") set New75Value=""
241 if (New75Value'=Value75)&(New75Value'="") do
242 . set PrepArray(IEN,.075)=New75Value
243
244 ;"==Set up .076 Name (GENERICNAME FORM DOSE UNT - 40) ====
245 new New76Value set New76Value=$$MakeName(IEN,MaxLen,AllowCut,3) ;"3 -> GenericName DrugForm Strength Units
246 if New76Value="^" set result=1 goto PNDone
247 if $length(New76Value)>MaxLen do
248 . set New76Value=$extract(New76Value,1,MaxLen-3)_"..."
249 if (New76Value["...")&(Value76'["...")&(Value76'="") set New76Value=""
250 if (New76Value'=Value76)&(New76Value'="") do
251 . set PrepArray(IEN,.076)=New76Value
252
253 ;"==Set up .055 Name (TRADE NAME & FORM - 40) ============
254 new New55Value set New55Value=$$MakeName(IEN,MaxLen,AllowCut,4) ;",4) Mode=TradeName
255 if New55Value="^" set result=1 goto PNDone
256 if $length(New55Value)>MaxLen do
257 . set New55Value=$extract(New55Value,1,MaxLen-3)_"..."
258 if (New55Value["...")&(Value55'["...")&(Value55'="") set New55Value=""
259 if New55Value=New75Value set New55Value="<DUPLICATE>" ;"WAS "@"
260 if (New55Value'=Value55)&(New55Value'="") do
261 . ;"if (New55Value="@")&(Value55="") quit
262 . set PrepArray(IEN,.055)=New55Value
263
264 ;"==Set up .056 Name (TRADENAME FORM DOSE UNIT - 40) ====
265 new New56Value set New56Value=$$MakeName(IEN,MaxLen,AllowCut,6) ;"6 -> TradeName DrugForm Strength Units
266 if New56Value="^" set result=1 goto PNDone
267 if $length(New56Value)>MaxLen do
268 . set New56Value=$extract(New56Value,1,MaxLen-3)_"..."
269 if (New56Value["...")&(Value56'["...")&(Value56'="") set New56Value=""
270 if New56Value=New76Value set New56Value="<DUPLICATE>" ;"WAS "@"
271 if (New56Value'=Value56)&(New56Value'="") do
272 . ;"if (New56Value="@")&(Value56="") quit
273 . set PrepArray(IEN,.056)=New56Value
274
275PNDone quit result
276
277
278MakeName(IEN,MaxLen,AllowCut,Mode)
279 ;"Purpose: to make a special name from drug info
280 ;"Input: IEN -- IEN in file 22706.9
281 ;" MaxLen -- OPTIONAL. default=256. The maximum length
282 ;" AllowCut -- OPTIONAL If 1 then name may be cut off with ... to reach target length
283 ;" If 2 then name will be shorteneded as much as possible, but the
284 ;" name will NOT be cut off to reach MaxLen
285 ;" default=1
286 ;" Mode -- OPTIONAL. Default=1.
287 ;" //1 -> GenericName (TradeName) Strength Units
288 ;" 1 -> TradeName (GenericName) Strength Units ;changed 10/30/07
289 ;" 2 -> TradeName Strength Units
290 ;" 3 -> GenericName DrugForm Strength Units
291 ;" 4 -> TradeName (includes Drug Form)
292 ;" 5 -> GenericName DrugForm
293 ;" 6 -> TradeName DrugForm Strength Units
294 ;"results: special composite name, or "^" for user abort
295
296 set AllowCut=$get(AllowCut,1)
297 set MaxLen=$get(MaxLen,256)
298 set Mode=$get(Mode,1)
299 new TMGunits,TMGstrength,TMGTradeName,tempS
300 new vaGeneric,vagIEN
301 set vagIEN=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"VA GENERIC <-Pntr [P50.6']
302 set vaGeneric=$$GET1^DIQ(50.6,vagIEN,.01)
303 if vaGeneric="" set vaGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6)
304 set TMGTradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;".05 TRADENAME [F] ;e.g. DILTIAZEM HCL SR CAPSULES
305 if $extract(TMGTradeName,1)="." set TMGTradeName="0"_TMGTradeName ;".9% saline (rejected) --> 0.9% (acceptible)
306 if TMGTradeName["..." set TMGTradeName=$$Substitute^TMGSTUTL(TMGTradeName,"...","")
307
308 set TMGstrength=$piece($get(^TMG(22706.9,IEN,0)),"^",2) ;"1 STRENGTH [F] ;e.g. 240
309
310 set TMGunits=$piece($get(^TMG(22706.9,IEN,0)),"^",3) ;"2 UNIT [F] ;e.g. MG
311
312 new vadfIEN set vadfIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",7) ;"3.5 VA DOSAGE FORM
313 new vaDoseForm
314 if vadfIEN>0 set vaDoseForm=$piece($get(^PS(50.606,vadfIEN,0)),"^",1) ;".01 NAME
315 else set vaDoseForm=""
316
317 new hideGeneric set hideGeneric=0
318 new tempS
319 if Mode=1 do ;"1 -> TradeName (GenericName) Strength Units
320 . ;"if $extract(TMGTradeName,1,$length(vaGenericName))=vaGenericName do
321 . if $extract(TMGTradeName,1,$length(vaGeneric))=vaGeneric do
322 . . set tempS=TMGTradeName
323 . . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
324 . . if TMGunits'="" set tempS=tempS_" "_TMGunits
325 . . set hideGeneric=1
326 . else do
327 . . ;"set tempS=vaGeneric_" ("_TMGTradeName_")"
328 . . set tempS=TMGTradeName_" ("_vaGeneric_")"
329 . . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
330 . . if TMGunits'="" set tempS=tempS_" "_TMGunits
331 . if $length(tempS)>MaxLen do
332 . . set tempS=$$ShortNetName^TMGSHORT(vaGeneric,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut)
333 if Mode=2 do ;"2 -> TradeName Strength Units
334 . set tempS=TMGTradeName
335 . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
336 . if TMGunits'="" set tempS=tempS_" "_TMGunits
337 . if $length(tempS)>MaxLen do
338 . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut)
339 if Mode=3 do ;"3 -> GenericName DrugForm Strength Units
340 . set tempS=vaGeneric
341 . if vaDoseForm'="" set tempS=tempS_" "_vaDoseForm
342 . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
343 . if TMGunits'="" set tempS=tempS_" "_TMGunits
344 . if $length(tempS)>MaxLen do
345 . . set tempS=$$ShortNetName^TMGSHORT(vaGeneric,,TMGstrength,TMGunits,MaxLen,.AllowCut)
346 if Mode=4 do ;"4 -> TradeName (includes Drug Form)
347 . set tempS=TMGTradeName
348 . if $length(tempS)>MaxLen do
349 . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,,,MaxLen,.AllowCut)
350 if Mode=5 do ;"5 -> GenericName DrugForm
351 . set tempS=vaGeneric
352 . if vaDoseForm'="" set tempS=tempS_" "_vaDoseForm
353 . if $length(tempS)>MaxLen do
354 . . set tempS=$$ShortNetName^TMGSHORT(tempS,,,,MaxLen,.AllowCut)
355 if Mode=6 do ;" 6 -> TradeName DrugForm Strength Units
356 . set tempS=TMGTradeName ;"Note: TradeName includes Drug Form
357 . if TMGstrength'="" set tempS=tempS_" "_TMGstrength
358 . if TMGunits'="" set tempS=tempS_" "_TMGunits
359 . if $length(tempS)>MaxLen do
360 . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut)
361
362 set tempS=$$Trim^TMGSTUTL(tempS)
363 if $extract(tempS,1,1)="(" do ;"Input transform doesn't allow first chart to be '('
364 . ;"NOTE: I should write better code to change only the LAST ) to "", i.e. not cut out ALL ()'s
365 . set tempS=$translate(tempS,"(","")
366 . set tempS=$translate(tempS,")","")
367 if $extract(tempS,1,1)="/" do ;"Input transform doesn't allow first chart to be '/'
368 . set tempS=$extract(tempS,2,999)
369
370 set tempS=$translate(tempS,";",":") ;"some input transforms don't allow ';' character
371 quit tempS
372
373
374AskArray(IENArray,PrepArray)
375 ;"Purpose: to get array with possible fixes for one record in 22706.9 file
376 ;"Input: Array -- PASS BY REFERENCE (Used if rescanning needed)
377 ;" Array(IEN)=""
378 ;" Array(IEN)=""
379 ;" FixArray -- PASS BY REFERENCE. Format:
380 ;" FixArray(IEN,.04)=Name for .04
381 ;" FixArray(IEN,.055)=Name for .055
382 ;" FixArray(IEN,.056)=Name for .056
383 ;" FixArray(IEN,.075)=Name for .075
384 ;" FixArray(IEN,.076)=Name for .076
385 ;"Results: None
386 ;"Output: records in 50.68 will be changed, field .055,.056,.075, and .076 will be checked and fixed
387
388 new input,list
389 new cmd,nums
390 new compactMode set compactMode=1
391 new MapArray
392AA1
393 do DispFixArray(.PrepArray,.MapArray,compactMode)
394 write !,"E to manually edit entries; D to delete (skip) entries",!
395 write "R to rescan; A To accept entries",!
396 write "C turn Compact display ",$select((compactMode=1):"OFF",1:"ON"),!
397 write "ALL to accept all entries WITHOUT any '...'s",!!
398 read "Enter Option: ^// ",input:$get(DTIME,3600),!
399 if input="" set input="^"
400 set input=$$UP^XLFSTR(input)
401 if input="^" goto AADone
402 set nums=""
403 set cmd=input
404 if cmd="E" do goto AA1
405 . if nums="" do
406 . . write "Enter number(s) to edit (#,#-#, etc; ^ to quit): "
407 . . read nums:$get(DTIME,3600),!
408 . if '$$MkMultList^TMGMISC(nums,.list) quit
409 . new num set num=""
410 . for set num=$order(list(num)) quit:(num="") do
411 . . new IEN,name04,name55,name75,result
412 . . set IEN=$get(MapArray(num)) if IEN="" quit
413 . . set name04=$get(PrepArray(IEN,.04))
414 . . set name55=$get(PrepArray(IEN,.055))
415 . . set name56=$get(PrepArray(IEN,.056))
416 . . set name75=$get(PrepArray(IEN,.075))
417 . . set name76=$get(PrepArray(IEN,.076))
418AA2 . . set result=$$PrepNames(IEN,name04,name55,name56,name75,name76,.PrepArray,0)
419 . . if result=1 quit
420 . . new new04Name set new04Name=$get(PrepArray(IEN,.004))
421 . . new new55Name set new55Name=$get(PrepArray(IEN,.055))
422 . . new new56Name set new56Name=$get(PrepArray(IEN,.056))
423 . . new new75Name set new75Name=$get(PrepArray(IEN,.075))
424 . . new new76Name set new76Name=$get(PrepArray(IEN,.076))
425 . . if new04Name=name04 set new04Name=""
426 . . if new55Name=name55 set new55Name=""
427 . . if new56Name=name56 set new56Name=""
428 . . if new75Name=name75 set new75Name=""
429 . . if new76Name=name76 set new76Name=""
430 . . set result=$$Write1(IEN,new04Name,new55Name,new56Name,new75Name,new76Name)
431 . . if result=0 kill PrepArray(IEN)
432 if cmd="C" do goto AA1
433 . set compactMode='compactMode
434 if cmd="ALL" do GOTO AA1
435 . new Itr,IEN,abort
436 . set abort=0
437 . set IEN=$$ItrAInit^TMGITR("PrepArray",.Itr)
438 . write "Storing accepted names for future use...",!
439 . do PrepProgress^TMGITR(.Itr,20,1,"IEN")
440 . if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
441 . . if $$UserAborted^TMGUSRIF() set abort=1 quit
442 . . new name04,name55,name56,name75,name76,result
443 . . set name04=$get(PrepArray(IEN,.04))
444 . . set name55=$get(PrepArray(IEN,.055))
445 . . set name56=$get(PrepArray(IEN,.056))
446 . . set name75=$get(PrepArray(IEN,.075))
447 . . set name76=$get(PrepArray(IEN,.076))
448 . . if name04["..." set name04=""
449 . . if name55["..." set name55=""
450 . . if name56["..." set name56=""
451 . . if name75["..." set name75=""
452 . . if name76["..." set name76=""
453 . . if (name04="")&(name55="")&(name56="")&(name75="")&(name76="") quit ;"avoid delete of names with ...
454 . . set result=$$Write1(IEN,name04,name55,name56,name75,name76)
455 . . if result=0 kill IENArray(IEN),PrepArray(IEN)
456 . do ProgressDone^TMGITR(.Itr)
457 ;"if (cmd="A")!(+cmd=cmd) do goto AA1
458 if (cmd="A") do goto AA1
459 . if nums="" do
460 . . write "Enter number(s) to accept (#,#-#, etc; ^ to quit): "
461 . . read nums:$get(DTIME,3600),!
462 . if '$$MkMultList^TMGMISC(nums,.list) quit
463 . new num set num=""
464 . for set num=$order(list(num)) quit:(num="") do
465 . . new IEN set IEN=$get(MapArray(num)) if IEN="" quit
466 . . new name04,name55,name75,result
467 . . set name04=$get(PrepArray(IEN,.04))
468 . . set name55=$get(PrepArray(IEN,.055))
469 . . set name56=$get(PrepArray(IEN,.056))
470 . . set name75=$get(PrepArray(IEN,.075))
471 . . set name76=$get(PrepArray(IEN,.076))
472 . . new result set result=$$Write1(IEN,name04,name55,name56,name75,name76)
473 . . if result=0 kill IENArray(IEN),PrepArray(IEN)
474 else if $extract(cmd,1)="D" do goto AA1
475 . new Perm,% set Perm=0,%=2
476 . write "Will remove from display list.",!
477 . write "Also perminantly mark drug so be SKIPPED"
478 . do YN^DICN write !
479 . if %=-1 quit
480 . if %=1 set Perm=1
481 . set nums=$extract(cmd,2,999)
482 . if nums="" do
483 . . write "Enter number(s) to delete (#,#-#, etc; ^ to quit): "
484 . . read nums:$get(DTIME,3600),!
485 . if '$$MkMultList^TMGMISC(nums,.list) quit
486 . new num set num=""
487 . for set num=$order(list(num)) quit:(num="") do
488 . . new IEN set IEN=+$get(MapArray(num)) if IEN="" quit
489 . . kill PrepArray(IEN),IENArray(IEN)
490 . . if (Perm=1)&(IEN>0) set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"1=SKIP
491 else if cmd="R" do goto AA1
492 . kill PrepArray
493 . do GetPrepArray(.IENArray,.PrepArray)
494
495 goto AA1
496AADone
497 quit
498
499
500Write1(IEN,name04,name55,name56,name75,name76)
501 ;"Purpose to write 1 record in 22706.9 file
502 ;"Input: IEN -- the ien in file 22706.9
503 ;" name04 -- OPTIONAL name for .04 field
504 ;" name55 -- OPTIONAL name for .055 field
505 ;" name56 -- OPTIONAL name for .056 field
506 ;" name75 -- OPTIONAL name for .075 field
507 ;" name76 -- OPTIONAL name for .076 field
508 ;"Output: records in 22706.9 will be changed, field .055 and .075 will be checked and fixed
509 ;"Results: 0 = OK. -1=error
510
511 new result set result=0 ;"default to success
512 new TMGFDA,TMGIEN,TMGMSG,IENS
513 set IENS=IEN_","
514
515 if $get(name04)'="" set TMGFDA(22706.9,IENS,.04)=name04
516 if $get(name55)'="" set TMGFDA(22706.9,IENS,.055)=name55
517 if $get(name56)'="" set TMGFDA(22706.9,IENS,.056)=name56
518 if $get(name75)'="" set TMGFDA(22706.9,IENS,.075)=name75
519 if $get(name76)'="" set TMGFDA(22706.9,IENS,.076)=name76
520
521 if $data(TMGFDA)>0 do FILE^DIE("EK","TMGFDA","TMGMSG")
522 if $data(TMGMSG("DIERR")) do goto W1NDone
523 . set result=-1
524 . if $get(Quiet)=1 quit
525 . write !,"Error writing names to file 22706.9, record# ",IEN,!
526 . new PriorErrorFound
527 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
528
529 set result=0
530
531W1NDone
532 quit result
533
534
535
536DispFixArray(PrepArray,MapArray,compactMode)
537 ;"Purpose: to Display values in PrepArray
538 ;"Input: PrepArray array will be filled as follows:
539 ;" PrepArray(IEN1,.04)=Name for .04
540 ;" PrepArray(IEN1,.055)=Name for .055
541 ;" PrepArray(IEN1,.056)=Name for .056
542 ;" PrepArray(IEN1,.075)=Name for .075
543 ;" PrepArray(IEN1,.076)=Name for .076
544 ;" MapArray PASS BY REFERENCE, an OUT PARAMETER
545 ;" MapPrep(1)=IEN
546 ;" MapPrep(2)=IEN
547 ;" MapPrep(3)=IEN
548 ;" MapPrep(4)=IEN
549 ;" compactMode -- OPTIONAL. Default=1
550 ;" if =1, then only end of list shown
551 ;"Output: will dump array
552 ;"Result: none
553
554 write !
555 write "--------------------",!
556 kill MapArray
557 new IEN,Num
558 set Num=1
559 set compactMode=$get(compactMode,1)
560 new someShown set someShown=0
561 if compactMode=0 do
562 set IEN=$order(PrepArray(""))
563 else do
564 . new i
565 . set IEN=""
566 . for i=1:1:10 do quit:(IEN="")
567 . . set IEN=$order(PrepArray(IEN),-1)
568 . if IEN="" set IEN=$order(PrepArray(""))
569 if +IEN>0 for do quit:(IEN="")
570 . new s,s2,name04,name55,name56,name75,name76
571 . set MapArray(Num)=IEN
572 . set someShown=1
573 . set s=Num_". "
574 . set s=s_"["_IEN_"] " ;"temporary
575 . set s2=$extract(" ",1,$length(s))
576 . set name04=$get(PrepArray(IEN,.04))
577 . set name55=$get(PrepArray(IEN,.055))
578 . set name56=$get(PrepArray(IEN,.056))
579 . set name75=$get(PrepArray(IEN,.075))
580 . set name76=$get(PrepArray(IEN,.076))
581 . write s
582 . if name04'="" do
583 . . write name04,!
584 . . if name55'="" write s2
585 . if name55'="" do
586 . . write name55,!
587 . . if name75'="" write s2
588 . if name75'="" write name75,!
589 . if name56'="" write name56,!
590 . if name76'="" write name76,!
591 . set IEN=$order(PrepArray(IEN))
592 . set Num=Num+1
593 if someShown=0 write " (List is empty)",!
594 write "--------------------",!
595
596 quit
597
598
599CheckForBlanks
600 new IENArray,BlankArray
601 new PrepArray
602 write "Scanning existing names of imports not skipped...",!
603 do GetIENArray(.IENArray)
604
605 write "Checking for blank names...",!
606 do Check4Blanks(.IENArray,.BlankArray)
607
608 new fixNeeded set fixNeeded=0
609
610 if $data(BlankArray)'=0 do
611 . write "Preparing suggested names...",!
612 . do GetPrepArray(.BlankArray,.PrepArray)
613 . if $data(PrepArray)'=0 do
614 . . set fixNeeded=1
615 . . do AskArray(.BlankArray,.PrepArray)
616
617 if fixNeeded=0 do
618 . write "No fixes required. Great!",!
619 . do PressToCont^TMGUSRIF
620
621 quit
622
623
624Check4Blanks(IENArray,BlankArray)
625 ;"Purpose: Check if any of the fields are blank and allow fixing
626 ;"Input: IENArray -- PASS BY REFERENCE (Used if rescanning needed)
627 ;" IENArray(IEN,.04)=currentValue
628 ;" IENArray(IEN,.055)=currentValue
629 ;" IENArray(IEN,.056)=currentValue
630 ;" IENArray(IEN,.075)=currentValue
631 ;" IENArray(IEN,.076)=currentValue
632 ;" BlankArray -- PASS BY REFERENCE. An OUT PARAMETER. Format:
633 ;" BlankArray(IEN,.04)=Name for .04
634 ;" BlankArray(IEN,.055)=Name for .055
635 ;" BlankArray(IEN,.056)=Name for .056
636 ;" BlankArray(IEN,.075)=Name for .075
637 ;" BlankArray(IEN,.076)=Name for .076
638 ;"Results: none
639
640 new Itr,IEN,abort
641 set abort=0
642 set IEN=$$ItrAInit^TMGITR("IENArray",.Itr)
643 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
644 if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
645 . if $$UserAborted^TMGUSRIF() set abort=1 quit
646 . new Cur04Value set Cur04Value=$get(IENArray(IEN,.04))
647 . new Cur55Value set Cur55Value=$get(IENArray(IEN,.055))
648 . new Cur56Value set Cur56Value=$get(IENArray(IEN,.056))
649 . new Cur75Value set Cur75Value=$get(IENArray(IEN,.075))
650 . new Cur76Value set Cur76Value=$get(IENArray(IEN,.076))
651 . if (Cur04Value="")!(Cur55Value="")!(Cur56Value="")!(Cur75Value="")!(Cur76Value="") do
652 . . write IEN,?8," .04 (LONG NAME) = ",Cur04Value,!
653 . . write ?8,".055 (TRADENAME) = ",Cur55Value,!
654 . . write ?8,".056 (TRADENAME FORM DOSE UNIT)= ",Cur56Value,!
655 . . write ?8,".075 (GENERIC NAME & FORM) = ",Cur75Value,!
656 . . write ?8,".076 (GENERICNAME FORM DOSE UNT) = ",Cur76Value,!
657 . . merge BlankArray(IEN)=IENArray(IEN)
658
659 do ProgressDone^TMGITR(.Itr)
660
661 quit
662
663 ;"==========================================
664
665ScanBadName
666 ;"Purpose: scan for bad names, and debug the problem.
667 ;"Input: none
668 ;"Results: none
669
670 new IENArray,PrepArray
671 write "Scanning existing names of imports not skipped...",!
672 do GetIENArray(.IENArray)
673
674 new Menu,UsrSlct
675 set Menu(0)="Pick Which Name to Examine (2G)"
676 set Menu(1)=" .04 LONG NAME"_$char(9)_"LongName"
677 set Menu(2)=" .05 TRADENAME"_$char(9)_"TradeName"
678 set Menu(3)=".055 TRADE NAME & FORM - 40"_$char(9)_"TradeF"
679 set Menu(4)=".056 TRADENAME FORM DOSE UNIT - 40"_$char(9)_"TradeFDU"
680 set Menu(5)=" .07 GENERIC NAME"_$char(9)_"Generic"
681 set Menu(6)=".075 GENERIC NAME & FORM - 40"_$char(9)_"GenericF"
682 set Menu(7)=".076 GENERICNAME FORM DOSE UNT - 40"_$char(9)_"GenrcFDU"
683
684SBN1 write #
685 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
686
687 if UsrSlct="LongName" do Scan(.IENArray,.04,"LONG NAME") goto SBN1
688 if UsrSlct="TradeName" do Scan(.IENArray,.055,"TRADENAME") goto SBN1
689 if UsrSlct="TradeF" do Scan(.IENArray,.055,"TRADE NAME & FORM - 40") goto SBN1
690 if UsrSlct="TradeFDU" do Scan(.IENArray,.056,"TRADENAME FORM DOSE UNIT - 40") goto SBN1
691 if UsrSlct="Generic" do Scan(.IENArray,.07,"GENERIC NAME") goto SBN1
692 if UsrSlct="GenericF" do Scan(.IENArray,.075,"GENERIC NAME & FORM - 40") goto SBN1
693 if UsrSlct="GenrcFDU" do Scan(.IENArray,.076,"GENERICNAME FORM DOSE UNT - 40") goto SBN1
694 if UsrSlct="^" goto SBN2
695 goto SBN1
696
697SBN2 quit
698
699
700Scan(IENArray,FieldNum,FldName)
701 ;"Purpose: to do scan
702 ;"Input: -- IENArray -- PASS BY REFERENCE. Format:
703 ;" Note: IEN is from file 22706.9
704 ;" Array(IEN,.04)=currentValue
705 ;" Array(IEN,.05)=currentValue
706 ;" Array(IEN,.055)=currentValue
707 ;" Array(IEN,.056)=currentValue
708 ;" Array(IEN,.07)=currentValue
709 ;" Array(IEN,.075)=currentValue
710 ;" Array(IEN,.076)=currentValue
711
712 new SrchRec
713 new Itr,IEN,abort
714 set abort=0
715 set IEN=$$ItrAInit^TMGITR("IENArray",.Itr)
716 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
717 if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
718 . if $$UserAborted^TMGUSRIF() set abort=1 quit
719 . new s set s=$get(IENArray(IEN,FieldNum))
720 . if (s="")!(s="<DUPLICATE>") quit
721 . set SrchRec(s_" (#"_IEN_")",IEN_"^22706.9")=""
722 do ProgressDone^TMGITR(.Itr)
723
724 new Results
725 write "Passing off to selector...",!
726 do Slctor2^TMGUSRIF("SrchRec","Results","Pick Example(s) of Bad Drugs Names. [ESC][ESC] when done.")
727
728 do HandleChain^TMGNDF4G(.Results) ;"Show forward array
729
730 write "Done.",!
731 do PressToCont^TMGUSRIF
732
733 quit
Note: See TracBrowser for help on using the repository browser.