| 1 | TMGNDF2C ;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 |  | 
|---|
| 47 | Menu | 
|---|
| 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 |  | 
|---|
| 56 | MC1     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 |  | 
|---|
| 66 | MCDone | 
|---|
| 67 | quit | 
|---|
| 68 |  | 
|---|
| 69 |  | 
|---|
| 70 | FillGenerics | 
|---|
| 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 |  | 
|---|
| 103 | FGDone | 
|---|
| 104 | write "Goodbye.",! | 
|---|
| 105 | quit | 
|---|
| 106 |  | 
|---|
| 107 |  | 
|---|
| 108 | CheckGenerics(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 |  | 
|---|
| 157 | CGDone | 
|---|
| 158 | quit | 
|---|
| 159 |  | 
|---|
| 160 | Rescan(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 |  | 
|---|
| 189 | FindSimGenerics(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 |  | 
|---|
| 225 | NarrowGenMatches(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 |  | 
|---|
| 268 | FindGenContain(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 |  | 
|---|
| 285 | Scan4Generics(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 |  | 
|---|
| 311 | ScanNoGenerics(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 |  | 
|---|
| 337 | Unlock50dot6 | 
|---|
| 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 |  | 
|---|
| 353 | Lock50dot6 | 
|---|
| 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 |  | 
|---|
| 367 | SavKilRef(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 |  | 
|---|
| 374 | RestoreSK(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 |  | 
|---|
| 382 | ShowList(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 |  | 
|---|
| 416 | ProcessList(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 |  | 
|---|
| 453 | HandleAdds(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 |  | 
|---|
| 515 | Remove(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 |  | 
|---|
| 538 | CustLookup(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 |  | 
|---|
| 563 | DoAdds(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 |  | 
|---|
| 589 | Add1Generic(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 |  | 
|---|
| 606 | HandleQAdds(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 |  | 
|---|
| 670 | DoLinks(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 |  | 
|---|
| 699 | DoMltLink(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 |  | 
|---|
| 728 | DMLDone | 
|---|
| 729 | quit result | 
|---|
| 730 |  | 
|---|
| 731 |  | 
|---|
| 732 | ;"=========================================================================== | 
|---|
| 733 |  | 
|---|
| 734 | FillCompFile(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 |  | 
|---|