| [796] | 1 | TMGNDF1A ;TMG/kst/FDA Import: Compile FDA files into import file ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;11/21/06
|
|---|
| 3 |
|
|---|
| 4 | ;"FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
|
|---|
| 5 | ;"Kevin Toppenberg MD
|
|---|
| 6 | ;"GNU General Public License (GPL) applies
|
|---|
| 7 | ;"11-21-2006
|
|---|
| 8 |
|
|---|
| 9 | ;"=======================================================================
|
|---|
| 10 | ;" API -- Public Functions.
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 | ;"Menu
|
|---|
| 13 | ;"=======================================================================
|
|---|
| 14 | ;"Compile -- collect relevent data from the TMG FDA * files and put into one record
|
|---|
| 15 |
|
|---|
| 16 | ;"GetpVAPIndex() -- return a pointer to an index of the VAProduct file
|
|---|
| 17 | ;"ReCompOne(IEN22706d9)
|
|---|
| 18 |
|
|---|
| 19 | ;"=======================================================================
|
|---|
| 20 | ;" Private Functions.
|
|---|
| 21 | ;"=======================================================================
|
|---|
| 22 | ;"CompileOne(IEN,Quiet,pIndex,ExclArray,OnlyIfNew)
|
|---|
| 23 | ;"$$MakeCompRec(IEN,Array,Quiet)
|
|---|
| 24 | ;"StuffCompRec(IEN,Array,Quiet,ExclArray,Option)
|
|---|
| 25 | ;"FillGenericName(IEN)
|
|---|
| 26 | ;"MakeGenericName(IEN)
|
|---|
| 27 |
|
|---|
| 28 | ;"GetVADrugInfo(IEN,Array)
|
|---|
| 29 | ;"$$GetDrugInfo(IEN,Array,pIndex,noLink)
|
|---|
| 30 |
|
|---|
| 31 | ;"GetSingleRec(File,GRef,IEN,Array)
|
|---|
| 32 | ;"GetMultRec(File,GRef,IEN,Array)
|
|---|
| 33 | ;"LinkToVAProd(Array,Results)
|
|---|
| 34 | ;"Link2VAProd(Array,Results,pIndex)
|
|---|
| 35 | ;"CheckLink(IEN,Array,Results)
|
|---|
| 36 | ;"CheckNDCLink(IEN,Array,Results)
|
|---|
| 37 | ;"IndexVAProd(pArray)
|
|---|
| 38 | ;"GetIndexList(Ingredient,pIndex,pArray)
|
|---|
| 39 |
|
|---|
| 40 | ;"FixGenerics
|
|---|
| 41 | ;"ScanFor(Name,Array)
|
|---|
| 42 | ;"FindSimNames(Name,Array)
|
|---|
| 43 |
|
|---|
| 44 | ;"=======================================================================
|
|---|
| 45 | ;"=======================================================================
|
|---|
| 46 | Menu
|
|---|
| 47 | ;"Purpose: To give an interactive menu
|
|---|
| 48 |
|
|---|
| 49 | new Menu,UsrSlct
|
|---|
| 50 | set Menu(0)="Pick Option for Compiling FDA Imported Data (1A)"
|
|---|
| 51 | set Menu(1)="Compile/Refresh ALL FDA data into IMPORT file"_$char(9)_"CompileAll"
|
|---|
| 52 | set Menu(2)="Compile/Refresh JUST NEW FDA data into IMPORT file"_$char(9)_"CompileNew"
|
|---|
| 53 | set Menu(3)="Compile/Refresh ONE chosen FDA entry into IMPORT file"_$char(9)_"CompileChosen"
|
|---|
| 54 | set Menu(4)="Read instructions"_$char(9)_"Instructions"
|
|---|
| 55 | set Menu("P")="Prev Stage"_$char(9)_"Prev"
|
|---|
| 56 | set Menu("N")="Next Stage"_$char(9)_"Next"
|
|---|
| 57 |
|
|---|
| 58 | CD1
|
|---|
| 59 | write #
|
|---|
| 60 | set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
|
|---|
| 61 | if UsrSlct="^" goto CDDone
|
|---|
| 62 | if UsrSlct=0 set UsrSlct=""
|
|---|
| 63 |
|
|---|
| 64 | if UsrSlct="Prev" goto Menu^TMGNDF0C ;"quit can occur from there...
|
|---|
| 65 | if UsrSlct="Next" goto Menu^TMGNDF1D ;"quit can occur from there...
|
|---|
| 66 | if UsrSlct="CompileAll" do Compile(0) goto CD1
|
|---|
| 67 | if UsrSlct="CompileNew" do Compile(2) goto CD1
|
|---|
| 68 | if UsrSlct="CompileChosen" do Compile(1) goto CD1
|
|---|
| 69 | if UsrSlct="Instructions" do Instructions goto CD1
|
|---|
| 70 | goto CDDone
|
|---|
| 71 | CDDone
|
|---|
| 72 | quit
|
|---|
| 73 |
|
|---|
| 74 | ;"=======================================================================
|
|---|
| 75 | Instructions
|
|---|
| 76 | ;"Purpose: show instructions.
|
|---|
| 77 |
|
|---|
| 78 | write !,!
|
|---|
| 79 | write "COMPILATION",!
|
|---|
| 80 | write "===========",!
|
|---|
| 81 | write "The process of compilation takes the various FDA import",!
|
|---|
| 82 | write "tables and compiles them into a format ready for integration",!
|
|---|
| 83 | write "into VistA. The compiled records will be stored in the custom",!
|
|---|
| 84 | write "file TMG FDA IMPORT COMPILED (22706.9).",!,!
|
|---|
| 85 | write "In a subsequent step, you will be asked about excluding certain",!
|
|---|
| 86 | write "drugs from import into VistA. Your choices will be stored in these",!
|
|---|
| 87 | write "compiled records. The point being that overwriting file 22706.9",!
|
|---|
| 88 | write "would lead to a substantial amount of work. Thus the code is",!
|
|---|
| 89 | write "designed to integrate the new download data with prior data.",!
|
|---|
| 90 | write "If prior data is found then the user will be prompted: ",!
|
|---|
| 91 | write "'Import ONLY NEW drugs?' It is recommended that this be answered",!
|
|---|
| 92 | write "with 'YES'.",!
|
|---|
| 93 | write !
|
|---|
| 94 | do PressToCont^TMGUSRIF
|
|---|
| 95 | quit
|
|---|
| 96 |
|
|---|
| 97 | Compile(Option)
|
|---|
| 98 | ;"Purpose: To collect relevent data from the TMG FDA * files and put into one record
|
|---|
| 99 | ;"Input: Option: OPTIONAL. Default=0.
|
|---|
| 100 | ;" if 0, all records are added
|
|---|
| 101 | ;" If 1, then only ONE record (user chosed) will be compiled.
|
|---|
| 102 | ;" If 2, then only records that are NEW will
|
|---|
| 103 | ;" be added. Existing records in 22706.9 will not be affected
|
|---|
| 104 | ;" If 3, then only record(s) supplied will be compiled.
|
|---|
| 105 | ;" Option(IEN)=""
|
|---|
| 106 | ;" Option(IEN)=""
|
|---|
| 107 | ;" If Option("FIX CHAIN")=1 <--- changes will be propigate forward
|
|---|
| 108 | ;" to file 50, POI, OI, OQV etc.
|
|---|
| 109 | ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has records added.
|
|---|
| 110 | ;"Result: none
|
|---|
| 111 |
|
|---|
| 112 | new pIndex set pIndex=$$GetpVAPIndex()
|
|---|
| 113 |
|
|---|
| 114 | new abort set abort=0
|
|---|
| 115 | set Option=+$get(Option)
|
|---|
| 116 | set OnlyIfNew=(Option=2)
|
|---|
| 117 | new CompOption set CompOption=OnlyIfNew
|
|---|
| 118 | merge CompOption("FIX CHAIN")=Option("FIX CHAIN")
|
|---|
| 119 |
|
|---|
| 120 | new % set %=1
|
|---|
| 121 | new ExclArray
|
|---|
| 122 | if $data(^TMG(22706.9,"VAP1"))>0 do ;"a test for a prior run
|
|---|
| 123 | . if (Option=1)!(Option=2)!(Option=3) quit
|
|---|
| 124 | . write "Prior import processing detected.",!
|
|---|
| 125 | . if Option=0 write "Import ONLY NEW drugs ('YES' Recommended)" do YN^DICN write !
|
|---|
| 126 | . if %=-1 quit
|
|---|
| 127 | . if %=1 set OnlyIfNew=1 quit
|
|---|
| 128 | . write "Choose fields in import file to NOT to OVER WRITE" do YN^DICN write !
|
|---|
| 129 | . if %=1 do GetExclFields(.ExclArray)
|
|---|
| 130 | if %=-1 goto CADone
|
|---|
| 131 |
|
|---|
| 132 | write "Compiling FDA data into a unified file, for later import.",!
|
|---|
| 133 | new Itr,IEN
|
|---|
| 134 | if Option=1 do
|
|---|
| 135 | . new X,Y,DIC
|
|---|
| 136 | . set DIC=22706.5,DIC(0)="MAEQ"
|
|---|
| 137 | . set DIC("A")="Select FDA drug for import: "
|
|---|
| 138 | . do ^DIC write !
|
|---|
| 139 | . if +Y'>-1 quit
|
|---|
| 140 | . do CompileOne(+Y,0,pIndex,.ExclArray,.CompOption)
|
|---|
| 141 | . new killthis
|
|---|
| 142 |
|
|---|
| 143 | if Option=3 do
|
|---|
| 144 | . set IEN=""
|
|---|
| 145 | . for set IEN=$order(Option(IEN)) quit:(IEN="")!abort do
|
|---|
| 146 | . . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 147 | . . do CompileOne(IEN,0,pIndex,.ExclArray,.CompOption)
|
|---|
| 148 | . . new killthis
|
|---|
| 149 |
|
|---|
| 150 | else do
|
|---|
| 151 | . set IEN=$$ItrInit^TMGITR(22706.5,.Itr)
|
|---|
| 152 | . do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 153 | . if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort=1)
|
|---|
| 154 | . . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 155 | . . do CompileOne(IEN,0,pIndex,.ExclArray,.CompOption)
|
|---|
| 156 | . . new killthis
|
|---|
| 157 | CADone
|
|---|
| 158 | write !,"Done.",!
|
|---|
| 159 | do PressToCont^TMGUSRIF
|
|---|
| 160 | quit
|
|---|
| 161 |
|
|---|
| 162 |
|
|---|
| 163 | ReCompOne(IEN22706d9,Option)
|
|---|
| 164 | ;"Purpose: To recompile a given record in file 22706.9
|
|---|
| 165 | ;"Input: IEN -- IEN from 22706.9
|
|---|
| 166 | ;" OPTION -- Optional. Option("FIX CHAIN")=1 <--- changes will be propigate forward
|
|---|
| 167 | ;" to file DRUG, POI, OI, OQV etc.
|
|---|
| 168 | ;"Results: none
|
|---|
| 169 |
|
|---|
| 170 | new fdaIEN
|
|---|
| 171 | set fdaIEN=+$piece($get(^TMG(22706.9,IEN22706d9,0)),"^",1)
|
|---|
| 172 | new pIndex set pIndex=$$GetpVAPIndex()
|
|---|
| 173 | set Option=2 ;"2-> ask for overwrites.
|
|---|
| 174 | do CompileOne(fdaIEN,0,pIndex,,.Option)
|
|---|
| 175 |
|
|---|
| 176 | quit
|
|---|
| 177 |
|
|---|
| 178 |
|
|---|
| 179 | CompileOne(IEN,Quiet,pIndex,ExclArray,Option)
|
|---|
| 180 | ;"Purpose: To collect relevent data from the TMG FDA * files, or one entry, and put into one record
|
|---|
| 181 | ;"Input: IEN -- the IEN from file 22706.5 (TMG FDA LISTING) that should be added.
|
|---|
| 182 | ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed.
|
|---|
| 183 | ;" pIndex -- OPTIONAL -- the NAME OF index (as created by IndexVAProd), for faster processing
|
|---|
| 184 | ;" ExclArray --OPTIONAL -- an array with fields to NOT OVERWRITE preexisting fields in. Format:
|
|---|
| 185 | ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten.
|
|---|
| 186 | ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten.
|
|---|
| 187 | ;" Option : OPTIONAL. Default=0. PASS BY REFERECE *if* SUBNODES DEFINED
|
|---|
| 188 | ;" 1 -> only records that are NEW will be added. Existing records in 22706.9 will not be affected
|
|---|
| 189 | ;" 2 -> User is prompted for overwrites
|
|---|
| 190 | ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward
|
|---|
| 191 | ;" to file 50, POI, OI, OQV etc.
|
|---|
| 192 | ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) may have data/records added.
|
|---|
| 193 | ;"Result: none
|
|---|
| 194 |
|
|---|
| 195 | new Array,result
|
|---|
| 196 | set Quiet=$get(Quiet,1)
|
|---|
| 197 | new destIEN
|
|---|
| 198 | set Option=+$get(Option)
|
|---|
| 199 | new OnlyIfNew set OnlyIfNew=(Option=1)
|
|---|
| 200 | new stuffOption set stuffOption=""
|
|---|
| 201 | if Option=2 set stuffOption("ASK OVERWRITE")=1
|
|---|
| 202 |
|
|---|
| 203 | if +$get(IEN)'>0 goto C1Done
|
|---|
| 204 | if $$GetDrugInfo(IEN,.Array,.pIndex)=0 goto C1Done ;"returns 0 for error
|
|---|
| 205 | set destIEN=$$FindPriorRec(.Array)
|
|---|
| 206 | if (destIEN>0)&(OnlyIfNew=1) goto C1Done ;"Skip preexisting, don't update, per flag
|
|---|
| 207 | if destIEN'>0 set destIEN=$$MakeCompRec(IEN,.Array,Quiet)
|
|---|
| 208 | if destIEN'>0 goto C1Done
|
|---|
| 209 | if $$StuffCompRec(destIEN,.Array,.Quiet,.ExclArray,.stuffOption)=1 goto C1Done ;"returns 1 for error
|
|---|
| 210 | do FillGenericName(destIEN)
|
|---|
| 211 |
|
|---|
| 212 | ;"Set link between COMPILED field in 22706.5 and record in 22706.9
|
|---|
| 213 | new TMGFDA,TMGMSG,PriorErrorFound
|
|---|
| 214 | set TMGFDA(22706.5,IEN_",",8)=destIEN
|
|---|
| 215 | do FILE^DIE("S","TMGFDA","TMGMSG")
|
|---|
| 216 | do ShowIfDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 217 |
|
|---|
| 218 | if $get(Option("FIX CHAIN"))=1 do
|
|---|
| 219 | . do Fix1Name^TMGNDF1D(IEN)
|
|---|
| 220 | . ;"consider if checking for 1 new ROUTE is need in TMGNDF1F
|
|---|
| 221 | . ;"consider if checking for 1 new FORM is need in TMGNDF2A
|
|---|
| 222 | . do Make1Alt^TMGNDF2G(IEN)
|
|---|
| 223 | . do Check1^TMGNDF2H(IEN)
|
|---|
| 224 | . do Refresh1^TMGNDF3C(IEN,.Option) ;"further chaining to occur from this fn.
|
|---|
| 225 | .;"NOTE: I also need to go through modules and add code to handle DELETIONS
|
|---|
| 226 | . ;" (esp DRUG-->POI etc.)
|
|---|
| 227 |
|
|---|
| 228 | C1Done
|
|---|
| 229 | quit
|
|---|
| 230 |
|
|---|
| 231 |
|
|---|
| 232 | FindPriorRec(Array)
|
|---|
| 233 | ;"Purpose: To find an entry in file 22706.9 (TMG FDA IMPORT COMPILED) that
|
|---|
| 234 | ;" matches data in Array, meaning that the data has been previously
|
|---|
| 235 | ;" added.
|
|---|
| 236 | ;" Match criteria:
|
|---|
| 237 | ;"Input: Array: PASS BY REEFRENCE. The drug info array, as created by GetDrugInfo()
|
|---|
| 238 | ;"Result: Returns the IEN from 22706.9, or 0 if no prior match found.
|
|---|
| 239 |
|
|---|
| 240 | new result set result=0
|
|---|
| 241 | new NDC12 set NDC12=$get(Array("NDC","12DIGIT"))
|
|---|
| 242 | if NDC12>0 set result=$order(^TMG(22706.9,"NDC12",NDC12,""))
|
|---|
| 243 |
|
|---|
| 244 | quit result
|
|---|
| 245 |
|
|---|
| 246 |
|
|---|
| 247 | MakeCompRec(IEN,Array,Quiet)
|
|---|
| 248 | ;"Purpose: To create one entry in file 22706.9 (TMG FDA IMPORT COMPILED)
|
|---|
| 249 | ;" entry will be essentially empty, to be filled later by StuffCompRec
|
|---|
| 250 | ;" Array: PASS BY REFERENCE. The drug info array, as created by GetDrugInfo()
|
|---|
| 251 | ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed.
|
|---|
| 252 | ;"Input: IEN
|
|---|
| 253 | ;" Array
|
|---|
| 254 | ;" Quiet
|
|---|
| 255 | ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has one records added or modified.
|
|---|
| 256 | ;"Result: IEN of new record, or 0 if error
|
|---|
| 257 | ;"Note: any pre-existing data is removed from record.
|
|---|
| 258 |
|
|---|
| 259 | new TMGFDA,IENS,TMGIEN,TMGMSG
|
|---|
| 260 | new result set result=0 ;"default to failure
|
|---|
| 261 | if +$get(IEN)'>0 goto MCRD
|
|---|
| 262 | set Quiet=$get(Quiet,1)
|
|---|
| 263 | set IENS="+1,"
|
|---|
| 264 | set TMGFDA(22706.9,IENS,.01)=IEN
|
|---|
| 265 | do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") ;"create new record
|
|---|
| 266 | if $data(TMGMSG) do
|
|---|
| 267 | . if Quiet=1 quit
|
|---|
| 268 | . new PriorErrorFound
|
|---|
| 269 | . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 270 | else set result=+$get(TMGIEN(1))
|
|---|
| 271 | MCRD quit result
|
|---|
| 272 |
|
|---|
| 273 |
|
|---|
| 274 | GetExclFields(ExclArray)
|
|---|
| 275 | ;"Purpose: to determine if there are fields that should not be overwritten
|
|---|
| 276 | ;" during stuffing of records
|
|---|
| 277 | ;"Input: ExclArray -- PASS BY REFERENCE, AN OUT PARAMETER. FORMAT:
|
|---|
| 278 | ;" ExclArray(FieldNum)=FieldName
|
|---|
| 279 | ;" Any preexisting entries will be KILLED
|
|---|
| 280 |
|
|---|
| 281 | kill ExclArray
|
|---|
| 282 |
|
|---|
| 283 | new DIC,X,Y
|
|---|
| 284 | set DIC="^DD(22706.9,"
|
|---|
| 285 | set DIC(0)="AEQM"
|
|---|
| 286 | set DIC("S")="IF (Y=.05)!(Y=.05)!(Y=1)!(Y=2)!(Y=3)!(Y=3.4)!(Y=4)!(Y=5)!(Y=7)"
|
|---|
| 287 | set DIC("A")="Pick field to NOT OVERWRITE (^ when done): "
|
|---|
| 288 | GEF1 do ^DIC
|
|---|
| 289 | if Y=-1 goto GEF2
|
|---|
| 290 | set ExclArray(+Y)=$piece(Y,"^",2)
|
|---|
| 291 | goto GEF1
|
|---|
| 292 | GEF2
|
|---|
| 293 | if $data(ExclArray)=0 goto GEFDone
|
|---|
| 294 | write !!,"Will NOT OVERWRITE any preexisting data in these fields:",!
|
|---|
| 295 | new i set i=""
|
|---|
| 296 | for set i=$order(ExclArray(i)) quit:(i="") do
|
|---|
| 297 | . write " ",ExclArray(i)," (",i,")",!
|
|---|
| 298 | new % set %=1
|
|---|
| 299 | write "OK" do YN^DICN write !
|
|---|
| 300 | if %=1 goto GEFDone
|
|---|
| 301 | kill ExclArray
|
|---|
| 302 | set %=2
|
|---|
| 303 | write "Pick again" do YN^DICN write !
|
|---|
| 304 | if %=1 goto GEF1
|
|---|
| 305 |
|
|---|
| 306 | GEFDone
|
|---|
| 307 | quit
|
|---|
| 308 |
|
|---|
| 309 |
|
|---|
| 310 | StuffCompRec(IEN,Array,Quiet,ExclArray,Option)
|
|---|
| 311 | ;"Purpose: To fill in data for one entry in file 22706.9 (TMG FDA IMPORT COMPILED)
|
|---|
| 312 | ;"Input: IEN: The IEN of the new record for data to be stuffed into (i.e. IEN22706d9)
|
|---|
| 313 | ;" Array: PASS BY REFERENCE. The drug info array, as created by GetDrugInfo()
|
|---|
| 314 | ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed.
|
|---|
| 315 | ;" ExclArray --OPTIONAL -- an array with fields to NOT OVERWRITE preexisting fields in. Format:
|
|---|
| 316 | ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten.
|
|---|
| 317 | ;" Option -- OPTIONAL. PASS BY REFERENCE
|
|---|
| 318 | ;" Option("ASK OVERWRITE")=1 --> ask user if overwrites are OK.
|
|---|
| 319 | ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward
|
|---|
| 320 | ;" to file 50, POI, OI, OQV etc.
|
|---|
| 321 | ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has one records added or modified.
|
|---|
| 322 | ;"Result: 0=OK, 1=fatal error encountered
|
|---|
| 323 | ;"Note: any pre-existing data is removed from record. (<--??)
|
|---|
| 324 |
|
|---|
| 325 | new TMGFDA,IENS,TMGIEN,TMGMSG,newIENS
|
|---|
| 326 | new result set result=0
|
|---|
| 327 | new dataAdded set dataAdded=0
|
|---|
| 328 | new askOverwrite set askOverwrite=($get(Option("ASK OVERWRITE"))=1)
|
|---|
| 329 |
|
|---|
| 330 | set Quiet=$get(Quiet,1)
|
|---|
| 331 | new map
|
|---|
| 332 | set map(.05)=$name(tradeName)
|
|---|
| 333 | set map(1)=$name(Array("STRENGTH"))
|
|---|
| 334 | set map(2)=$name(Array("UNIT"))
|
|---|
| 335 | set map(3)=$name(Array("ROUTE",1,"NAME"))
|
|---|
| 336 | set map(3.4)=$name(Array("DOSE",1,"DOSAGE NAME"))
|
|---|
| 337 | set map(4)=$name(Array("NDC"))
|
|---|
| 338 | set map(5)=$name(Array("NDC","12DIGIT"))
|
|---|
| 339 | set map(7)=$name(codeOTC)
|
|---|
| 340 |
|
|---|
| 341 | new codeOTC set codeOTC=$get(Array("RX OR OTC"))
|
|---|
| 342 | if codeOTC["PRESCRIPTION" set codeOTC="R"
|
|---|
| 343 | else if codeOTC["OTC" set codeOTC="O"
|
|---|
| 344 | else set codeOTC=""
|
|---|
| 345 |
|
|---|
| 346 | new tradeName set tradeName=$get(Array("TRADENAME"))
|
|---|
| 347 | if $length(tradeName)>64 set tradeName=$extract(tradeName,1,61)_"..."
|
|---|
| 348 |
|
|---|
| 349 | set IENS=IEN_","
|
|---|
| 350 |
|
|---|
| 351 | new oldData
|
|---|
| 352 | new field set field=""
|
|---|
| 353 | for set field=$order(map(field)) quit:(field="") do
|
|---|
| 354 | . new pVar,value
|
|---|
| 355 | . set pVar=$get(map(field))
|
|---|
| 356 | . set value=$get(@pVar)
|
|---|
| 357 | . if value="" quit
|
|---|
| 358 | . set oldData(field)=$$GET1^DIQ(22706.9,IENS,field)
|
|---|
| 359 | . if ($data(ExclArray(field))'=0)&(oldData(field)'="") quit
|
|---|
| 360 | . set TMGFDA(22706.9,IENS,field)=value
|
|---|
| 361 |
|
|---|
| 362 | new untrimFDA merge untrimFDA=TMGFDA
|
|---|
| 363 | set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present.
|
|---|
| 364 | if $data(TMGFDA)=0 goto SCR1
|
|---|
| 365 |
|
|---|
| 366 | new abort set abort=0
|
|---|
| 367 | if askOverwrite do
|
|---|
| 368 | . new field set field=""
|
|---|
| 369 | . for set field=$order(TMGFDA(22706.9,IENS,field)) quit:(field="") do
|
|---|
| 370 | . . write field,": '",$get(oldData(field)),"' --> '",$get(TMGFDA(22706.9,IENS,field)),"'",!
|
|---|
| 371 | . write !,"Stuff this data into file 22706.9, record #",IEN,"? "
|
|---|
| 372 | . new % set %=2 do YN^DICN write !
|
|---|
| 373 | . if %=1 quit
|
|---|
| 374 | . set abort=1
|
|---|
| 375 | if abort=1 goto MCRDone
|
|---|
| 376 |
|
|---|
| 377 | do FILE^DIE("ES","TMGFDA","TMGMSG") ;" Fill existing record
|
|---|
| 378 | if $data(TMGMSG) do goto MCRDone
|
|---|
| 379 | . if Quiet=1 quit
|
|---|
| 380 | . new PriorErrorFound
|
|---|
| 381 | . write !,"StuffCompRec^TMGNDF1A",!
|
|---|
| 382 | . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 383 | . set result=1
|
|---|
| 384 | else set dataAdded=1
|
|---|
| 385 |
|
|---|
| 386 | if $get(Option("FIX CHAIN"))=1 do
|
|---|
| 387 | . new opt
|
|---|
| 388 | . set opt("FIX CHAIN")=1
|
|---|
| 389 | . set opt("FIX CHAIN","IEN22706d9")=IEN ;"used later in chain
|
|---|
| 390 | . ;"pass signal to fix chain forward
|
|---|
| 391 | . do Refresh1^TMGNDF3C(IEN,.opt) ;" no results
|
|---|
| 392 |
|
|---|
| 393 | SCR1
|
|---|
| 394 | new i,MaxCount,subfile
|
|---|
| 395 | kill TMGFDA,TMGIEN
|
|---|
| 396 | set MaxCount=$get(Array("FILE 50.68 IEN","COUNT"))
|
|---|
| 397 | set subfile=22706.914
|
|---|
| 398 | for i=1:1:MaxCount do quit:(abort=1)
|
|---|
| 399 | . set IENS="+"_i_","_IEN_","
|
|---|
| 400 | . new addIEN set addIEN=$get(Array("FILE 50.68 IEN",i))
|
|---|
| 401 | . if addIEN="" quit ;"This occasionally happens...
|
|---|
| 402 | . set TMGFDA(subfile,IENS,.01)=addIEN
|
|---|
| 403 | . ;"------
|
|---|
| 404 | . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present.
|
|---|
| 405 | . if $data(TMGFDA)'>0 quit
|
|---|
| 406 | . if askOverwrite do quit:(abort=1)
|
|---|
| 407 | . . new field set field=""
|
|---|
| 408 | . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do
|
|---|
| 409 | . . . write field,": ",$$GET1^DIQ(subfile,IENS,field)," --> ",$get(TMGFDA(subfile,IENS,field)),!
|
|---|
| 410 | . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? "
|
|---|
| 411 | . . new % set %=2 do YN^DICN write !
|
|---|
| 412 | . . if %=1 quit
|
|---|
| 413 | . . set abort=1
|
|---|
| 414 | . if newIENS["+" do
|
|---|
| 415 | . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 416 | . else do
|
|---|
| 417 | . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS)
|
|---|
| 418 | . . kill TMGFDA merge TMGFDA=tempFDA
|
|---|
| 419 | . . do FILE^DIE("KS","TMGFDA","TMGMSG")
|
|---|
| 420 | . if $data(TMGMSG) do
|
|---|
| 421 | . . if Quiet=1 quit
|
|---|
| 422 | . . new PriorErrorFound
|
|---|
| 423 | . . write !,"SCR1^StuffCompRec^TMGNDF1A",!
|
|---|
| 424 | . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 425 | . else set dataAdded=1
|
|---|
| 426 | if abort=1 goto MCRDone
|
|---|
| 427 |
|
|---|
| 428 | SCR2
|
|---|
| 429 | kill TMGFDA,TMGIEN
|
|---|
| 430 | set MaxCount=$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT"))
|
|---|
| 431 | set subfile=22706.915
|
|---|
| 432 | for i=1:1:MaxCount do quit:(abort=1)
|
|---|
| 433 | . set IENS="+"_i_","_IEN_","
|
|---|
| 434 | . new addIEN set addIEN=$get(Array("FILE 50.68 IEN","POSS MATCH",i))
|
|---|
| 435 | . if addIEN="" quit ;"This occasionally happens...
|
|---|
| 436 | . set TMGFDA(subfile,IENS,.01)=addIEN
|
|---|
| 437 | . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present.
|
|---|
| 438 | . if $data(TMGFDA)'>0 quit
|
|---|
| 439 | . if askOverwrite do quit:(abort=1)
|
|---|
| 440 | . . new field set field=""
|
|---|
| 441 | . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do
|
|---|
| 442 | . . . write field,": '",$$GET1^DIQ(subfile,IENS,field),"' --> ",$get(TMGFDA(subfile,IENS,field)),!
|
|---|
| 443 | . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? "
|
|---|
| 444 | . . new % set %=2 do YN^DICN write !
|
|---|
| 445 | . . if %=1 quit
|
|---|
| 446 | . . set abort=1
|
|---|
| 447 | . if newIENS["+" do
|
|---|
| 448 | . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 449 | . else do
|
|---|
| 450 | . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS)
|
|---|
| 451 | . . kill TMGFDA merge TMGFDA=tempFDA
|
|---|
| 452 | . . do FILE^DIE("SK","TMGFDA","TMGMSG")
|
|---|
| 453 | . if $data(TMGMSG) do
|
|---|
| 454 | . . if Quiet=1 quit
|
|---|
| 455 | . . new PriorErrorFound
|
|---|
| 456 | . . write !,"SCR1^StuffCompRec^TMGNDF1A",!
|
|---|
| 457 | . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 458 | . else set dataAdded=1
|
|---|
| 459 | if abort=1 goto MCRDone
|
|---|
| 460 |
|
|---|
| 461 | SCR3
|
|---|
| 462 | kill TMGFDA,TMGIEN
|
|---|
| 463 | set MaxCount=$get(Array("FORMULATION","COUNT"))
|
|---|
| 464 | set subfile=22706.916
|
|---|
| 465 | for i=1:1:MaxCount do
|
|---|
| 466 | . set IENS="+"_i_","_IEN_","
|
|---|
| 467 | . set TMGFDA(subfile,IENS,.01)=i
|
|---|
| 468 | . set TMGFDA(subfile,IENS,2)=$get(Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN"))
|
|---|
| 469 | . set TMGFDA(subfile,IENS,3)=$get(Array("FORMULATION",i,"STRENGTH"))
|
|---|
| 470 | . set TMGFDA(subfile,IENS,5)=$get(Array("FORMULATION",i,"UNIT","FILE 50.607 IEN")) ;"should be a ptr
|
|---|
| 471 | . ;"set TMGFDA(subfile,IENS,5)=$get(Array("FORMULATION",2,"UNIT")) ;"should be a ptr
|
|---|
| 472 | . ;"----------------------
|
|---|
| 473 | . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present.
|
|---|
| 474 | . if $data(TMGFDA)=0 quit
|
|---|
| 475 | . if askOverwrite do quit:(abort=1)
|
|---|
| 476 | . . new field set field=""
|
|---|
| 477 | . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do
|
|---|
| 478 | . . . write field,": '",$$GET1^DIQ(subfile,IENS,field),"' --> ",$get(TMGFDA(subfile,IENS,field)),!
|
|---|
| 479 | . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? "
|
|---|
| 480 | . . new % set %=2 do YN^DICN write !
|
|---|
| 481 | . . if %=1 quit
|
|---|
| 482 | . . set abort=1
|
|---|
| 483 | . if newIENS["+" do
|
|---|
| 484 | . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 485 | . else do
|
|---|
| 486 | . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS)
|
|---|
| 487 | . . kill TMGFDA merge TMGFDA=tempFDA
|
|---|
| 488 | . . do FILE^DIE("SK","TMGFDA","TMGMSG")
|
|---|
| 489 | . if $data(TMGMSG) do
|
|---|
| 490 | . . if Quiet=1 quit
|
|---|
| 491 | . . new PriorErrorFound
|
|---|
| 492 | . . write !,"SCR3^StuffCompRec^TMGNDF1A",!
|
|---|
| 493 | . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 494 | . else set dataAdded=1
|
|---|
| 495 | if abort=1 goto MCRDone
|
|---|
| 496 |
|
|---|
| 497 | SCR4
|
|---|
| 498 | ;"Add a comment
|
|---|
| 499 | if dataAdded=0 goto MCRDone
|
|---|
| 500 | kill TMGFDA
|
|---|
| 501 | new %DT,X,Y
|
|---|
| 502 | set %DT="T",X="NOW" do ^%DT ;"get current time
|
|---|
| 503 | set IENS="+1,"_IEN_","
|
|---|
| 504 | set TMGFDA(22706.9001,IENS,.01)="UPDATE VIA AUTOMATIC IMPORT COMPILE"
|
|---|
| 505 | set TMGFDA(22706.9001,IENS,1)=Y
|
|---|
| 506 | do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 507 | if $data(TMGMSG) do
|
|---|
| 508 | . if Quiet=1 quit
|
|---|
| 509 | . new PriorErrorFound
|
|---|
| 510 | . write !,"SCR4^StuffCompRec^TMGNDF1A",!
|
|---|
| 511 | . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 512 |
|
|---|
| 513 | MCRDone
|
|---|
| 514 | if abort=1 set result=1
|
|---|
| 515 | quit result
|
|---|
| 516 |
|
|---|
| 517 |
|
|---|
| 518 | FillGenericName(IEN)
|
|---|
| 519 | ;"Purpose: To create an entry for the GENERIC NAME (field .07) in TMG FDA IMPORT (22706.9)
|
|---|
| 520 | ;"Input: IEN -- the IEN in 22706.9 to alter
|
|---|
| 521 | ;"Output: the record specified by IEN will be altered (if ingredients are known)
|
|---|
| 522 | ;"Result: None
|
|---|
| 523 |
|
|---|
| 524 | new name
|
|---|
| 525 | set name=$$MakeGenericName(IEN)
|
|---|
| 526 | if $data(^TMG(22706.9,IEN,0))>0 do
|
|---|
| 527 | . new TMGFDA,TMGMSG
|
|---|
| 528 | . set TMGFDA(22706.9,IEN_",",.07)=name
|
|---|
| 529 | . do FILE^DIE("SK","TMGFDA","TMGMSG")
|
|---|
| 530 | . if $data(TMGMSG) do
|
|---|
| 531 | . . if Quiet=1 quit
|
|---|
| 532 | . . new PriorErrorFound
|
|---|
| 533 | . . write !,"FillGenericName^TMGNDF1A",!
|
|---|
| 534 | . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 535 | . ;"set $piece(^TMG(22706.9,IEN,0),"^",6)=name ;"There is no index on this field, so direct write OK
|
|---|
| 536 | quit
|
|---|
| 537 |
|
|---|
| 538 |
|
|---|
| 539 | MakeGenericName(IEN)
|
|---|
| 540 | ;"Purpose: To create a GENERIC NAME string
|
|---|
| 541 | ;"Input: IEN -- the IEN in 22706.9 to use
|
|---|
| 542 | ;"Result: returns a string for the generic name.
|
|---|
| 543 |
|
|---|
| 544 | new Ingredients
|
|---|
| 545 | new i
|
|---|
| 546 | new result set result=""
|
|---|
| 547 |
|
|---|
| 548 | set i=$order(^TMG(22706.9,IEN,4,0))
|
|---|
| 549 | if i'="" for do quit:(+i'>0)
|
|---|
| 550 | . new IgdIEN,IgdName
|
|---|
| 551 | . set IgdIEN=+$piece($get(^TMG(22706.9,IEN,4,i,0)),"^",3) ;"get field#2, INGREDIENT (ptr to 50.416)
|
|---|
| 552 | . if IgdIEN>0 do
|
|---|
| 553 | . . set IgdName=$$GET1^DIQ(50.416,IgdIEN,.01)
|
|---|
| 554 | . . set IgdName=$$Substitute^TMGSTUTL(IgdName,"HYDROCHLORIDE","") ;"This is what the VA does...
|
|---|
| 555 | . . new temp set temp=IgdName
|
|---|
| 556 | . . set IgdName=$piece(IgdName,",",1) ;"I will also trim off anything after a comma.
|
|---|
| 557 | . . if $length(IgdName)<5 set IgdName=temp ;"I had problem with: N,N-1 ACETYL.... --> 'N'
|
|---|
| 558 | . . set IgdName=$translate(IgdName,"/","\") ;convert '/' --> '\' ('/' used later to concate ingredients)
|
|---|
| 559 | . . set IgdName=$$Trim^TMGSTUTL(IgdName)
|
|---|
| 560 | . . if IgdName'="" set Ingredients(IgdName)="" ;"will sort alphabetically
|
|---|
| 561 | . set i=$order(^TMG(22706.9,IEN,4,i))
|
|---|
| 562 |
|
|---|
| 563 | set i=$order(Ingredients(""))
|
|---|
| 564 | if i'="" for do quit:(i="")
|
|---|
| 565 | . if result'="" set result=result_"/"
|
|---|
| 566 | . set result=result_i
|
|---|
| 567 | . set i=$order(Ingredients(i))
|
|---|
| 568 |
|
|---|
| 569 | set result=$extract(result,1,64)
|
|---|
| 570 |
|
|---|
| 571 | quit result
|
|---|
| 572 |
|
|---|
| 573 |
|
|---|
| 574 | GetVADrugInfo(IEN,Array)
|
|---|
| 575 | ;"Purpose: To collect info from VA Product file into an array similar (but limited) to
|
|---|
| 576 | ;" that returned from GetDrugInfo
|
|---|
| 577 | ;"Input: IEN -- the IEN from file 50.68 (VA PRODUCT)
|
|---|
| 578 |
|
|---|
| 579 | kill Array
|
|---|
| 580 | new DIC,X,Y
|
|---|
| 581 |
|
|---|
| 582 | set Array("TRADENAME")=$$GET1^DIQ(50.68,IEN,.01)
|
|---|
| 583 | set Array("STRENGTH")=$$GET1^DIQ(50.68,IEN,2)
|
|---|
| 584 | set Array("UNIT")=$$GET1^DIQ(50.68,IEN,3)
|
|---|
| 585 |
|
|---|
| 586 | set DIC=50.67
|
|---|
| 587 | set DIC(0)="M"
|
|---|
| 588 | set X=Array("TRADENAME")
|
|---|
| 589 | do ^DIC
|
|---|
| 590 | set Array("NDC")=$$GET1^DIQ(50.67,+Y_",",1)
|
|---|
| 591 | ;"set Array("NDC 12DIGIT")=ndc (see format below)
|
|---|
| 592 |
|
|---|
| 593 | new i,count
|
|---|
| 594 | set count=0
|
|---|
| 595 | set i=$order(^PSNDF(50.68,IEN,2,0))
|
|---|
| 596 | if +i>0 for do quit:(+i'>0)
|
|---|
| 597 | . new node set node=$get(^PSNDF(50.68,IEN,2,i,0))
|
|---|
| 598 | . set count=count+1
|
|---|
| 599 | . set Array("FORMULATION","COUNT")=count
|
|---|
| 600 | . set Array("FORMULATION",count,"INGREDIENT NAME","FILE 50.416 IEN")=$piece(node,"^",1)
|
|---|
| 601 | . set Array("FORMULATION",count,"INGREDIENT NAME")=$$GET1^DIQ(50.416,$piece(node,"^",1),.01)
|
|---|
| 602 | . set Array("FORMULATION",count,"STRENGTH")=$piece(node,"^",2)
|
|---|
| 603 | . set Array("FORMULATION",count,"UNIT","FILE 50.607 IEN")=$piece(node,"^",3)
|
|---|
| 604 | . set Array("FORMULATION",count,"UNIT")=$$GET1^DIQ(50.607,$piece(node,"^",3),.01)
|
|---|
| 605 | . set i=$order(^PSNDF(50.68,IEN,2,i))
|
|---|
| 606 |
|
|---|
| 607 | quit
|
|---|
| 608 |
|
|---|
| 609 | GetDrugInfo(IEN,Array,pIndex,noLink)
|
|---|
| 610 | ;"Purpose: To collect all info about a drug into one array
|
|---|
| 611 | ;"Input: IEN -- the IEN from TMG FDA LISTING file
|
|---|
| 612 | ;" Array -- an OUT parameter. See format below
|
|---|
| 613 | ;" pIndex -- OPTIONAL -- the NAME OF index (as created by IndexVAProd), for faster processing
|
|---|
| 614 | ;" noLink -- OPTIONAL -- default=0. If 1, then linkage to prior VA drugs is NOT attempted.
|
|---|
| 615 | ;"Output: Array will be filled with info as above
|
|---|
| 616 | ;" Array('FILE 50.68 IEN',1)=IEN
|
|---|
| 617 | ;" Array('FILE 50.68 IEN','COUNT')
|
|---|
| 618 | ;" Array('LABEL CODE')
|
|---|
| 619 | ;" Array('PRODUCT CODE')
|
|---|
| 620 | ;" Array('STRENGTH')
|
|---|
| 621 | ;" Array('UNIT')
|
|---|
| 622 | ;" Array('RX OR OTC')
|
|---|
| 623 | ;" Array('FIRM','NAME')
|
|---|
| 624 | ;" Array('FIRM','LABEL CODE')
|
|---|
| 625 | ;" Array('FIRM','ADDRESS HEADER')
|
|---|
| 626 | ;" Array('FIRM','STREET')
|
|---|
| 627 | ;" Array('FIRM','PO BOX')
|
|---|
| 628 | ;" Array('FIRM','FOREIGN ADDRESS')
|
|---|
| 629 | ;" Array('FIRM','CITY')
|
|---|
| 630 | ;" Array('FIRM','STATE')
|
|---|
| 631 | ;" Array('FIRM','ZIP')
|
|---|
| 632 | ;" Array('FIRM','PROVINCE')
|
|---|
| 633 | ;" Array('FIRM','COUNTRY')
|
|---|
| 634 | ;" Array('TRADENAME')
|
|---|
| 635 | ;" Array('PACKAGE',1,'CODE')
|
|---|
| 636 | ;" Array('PACKAGE',1,'SIZE')
|
|---|
| 637 | ;" Array('PACKAGE',1,'TYPE')
|
|---|
| 638 | ;" Array('FORMULATION','COUNT')=1
|
|---|
| 639 | ;" Array('FORMULATION',1,'STRENGTH')
|
|---|
| 640 | ;" Array('FORMULATION',1,'UNIT')
|
|---|
| 641 | ;" Array('FORMULATION',1,'UNIT','FILE 50.607 IEN') ;note may contain -1 if match not found
|
|---|
| 642 | ;" Array('FORMULATION',1,'INGREDIENT NAME')
|
|---|
| 643 | ;" Array('FORMULATION',1,'INGREDIENT NAME','FILE 50.416 IEN) ;note may contain -1 if match not found
|
|---|
| 644 | ;" Array('APPLICATION')
|
|---|
| 645 | ;" Array('PRODUCT NUMBER')
|
|---|
| 646 | ;" Array('ROUTE',1,'CODE'
|
|---|
| 647 | ;" Array('ROUTE',1,'NAME')
|
|---|
| 648 | ;" Array('DOSE',1,'DOSE FORM')
|
|---|
| 649 | ;" Array('DOSE',1,'DO SAGE NAME')
|
|---|
| 650 | ;" Array('NDC')=ndc (see format below)
|
|---|
| 651 | ;" Array('NDC','12DIGIT')=ndc (see format below)
|
|---|
| 652 | ;" Array('FILE 50.68 IEN','COUNT')=1
|
|---|
| 653 | ;" Array('FILE 50.68 IEN',1)=1234
|
|---|
| 654 | ;" Array('FILE 50.68 IEN','POSS MATCH','COUNT')=1
|
|---|
| 655 | ;" Array('FILE 50.68 IEN','POSS MATCH',1)=2345
|
|---|
| 656 | ;"result: 0 if error found, 1 otherwise (i.e. is OKToContinue)
|
|---|
| 657 |
|
|---|
| 658 | ;"Note the NDC (national drug code) is comprised as follows:
|
|---|
| 659 | ;"It is a 10 digit number comprised of three segments
|
|---|
| 660 | ;" 1st 4-5 digits - producer/packager <--> field#1 (LABEL CODE) in TMG FDA LISTING
|
|---|
| 661 | ;" next 3-4 digits -- the product code <--> field#2 (PRODUCT CODE) in TMG FDA LISTING
|
|---|
| 662 | ;" next 1-2 digits -- package code, specifying the package size <--> field#1 (CODE) in TMG FDA PACKAGES
|
|---|
| 663 | ;" the grouping will be: 4-4-2, or 5-3-2, or 5-4-1
|
|---|
| 664 |
|
|---|
| 665 | ;" Example Array("NDC")="000002-0351-02"
|
|---|
| 666 | ;" Example Array("NDC","12DIGIT")="000002035102"
|
|---|
| 667 |
|
|---|
| 668 | new TMGARRAY,TMGMSG
|
|---|
| 669 | new PriorErrorFound,i
|
|---|
| 670 | new IENS set IENS=IEN_","
|
|---|
| 671 | kill Array
|
|---|
| 672 | new result set result=1
|
|---|
| 673 |
|
|---|
| 674 | do GETS^DIQ(22706.5,IENS,"*","R","TMGARRAY","TMGMSG")
|
|---|
| 675 |
|
|---|
| 676 | if $data(TMGMSG) do
|
|---|
| 677 | . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG")
|
|---|
| 678 | . if $data(TMGMSG("DIERR"))'=0 do quit
|
|---|
| 679 | . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 680 | . . set result=0
|
|---|
| 681 |
|
|---|
| 682 | if result=0 goto GDIDone
|
|---|
| 683 |
|
|---|
| 684 | merge Array=TMGARRAY(22706.5,IENS)
|
|---|
| 685 |
|
|---|
| 686 | ;"Now look for entries in TMG FDA APPLICATION (22706.1)
|
|---|
| 687 | do GetSingleRec(22706.1,"^TMG(22706.1,""B"",",IEN,.Array)
|
|---|
| 688 | set Array("STRENGTH")=$translate(Array("STRENGTH"),",","") ;"remove ',''s from numbers
|
|---|
| 689 |
|
|---|
| 690 | ;"Now look for entries in TMG FDA DOSAGE FORM (22706.2)
|
|---|
| 691 | do GetMultRec(22706.2,"^TMG(22706.2,""B"",",IEN,.Array,"DOSE")
|
|---|
| 692 |
|
|---|
| 693 | ;"Now look for entries in TMG FDA FIRMS (22706.3)
|
|---|
| 694 | do GetSingleRec(22706.3,"^TMG(22706.3,""B"",",IEN,.Array)
|
|---|
| 695 |
|
|---|
| 696 | ;"Now look for entries in TMG FDA FORMULATION (22706.4)
|
|---|
| 697 | do
|
|---|
| 698 | . new tempArray,index
|
|---|
| 699 | . do GetMultRec(22706.4,"^TMG(22706.4,""B"",",IEN,.tempArray,"FORMULATION")
|
|---|
| 700 | . ;"Note: I need instead to screen for duplicates ingredient entries
|
|---|
| 701 | . set index=$order(tempArray("FORMULATION",""))
|
|---|
| 702 | . if +index>0 for do quit:(+index'>0)
|
|---|
| 703 | . . new i2 set i2=index+1
|
|---|
| 704 | . . new name1,name2
|
|---|
| 705 | . . set name1=$name(tempArray("FORMULATION",index))
|
|---|
| 706 | . . for do quit:(+i2'>0)
|
|---|
| 707 | . . . set name2=$name(tempArray("FORMULATION",i2))
|
|---|
| 708 | . . . set i2=$order(tempArray("FORMULATION",i2))
|
|---|
| 709 | . . . if $data(@name2)'>0 quit
|
|---|
| 710 | . . . if $$CompArray^TMGMISC(name1,name2) do
|
|---|
| 711 | . . . . kill @name2
|
|---|
| 712 | . . set index=$order(tempArray("FORMULATION",index))
|
|---|
| 713 | . ;"Now put cleaned results of tempArray into Array
|
|---|
| 714 | . set index=$order(tempArray("FORMULATION",""))
|
|---|
| 715 | . new count set count=0
|
|---|
| 716 | . set Array("FORMULATION","COUNT")=0
|
|---|
| 717 | . if +index>0 for do quit:(+index'>0)
|
|---|
| 718 | . . if $data(tempArray("FORMULATION",index)) do
|
|---|
| 719 | . . . set count=count+1
|
|---|
| 720 | . . . merge Array("FORMULATION",count)=tempArray("FORMULATION",index)
|
|---|
| 721 | . . . set Array("FORMULATION","COUNT")=count
|
|---|
| 722 | . . set index=$order(tempArray("FORMULATION",index))
|
|---|
| 723 |
|
|---|
| 724 | ;"Now look for entries in TMG FDA PACKAGES (22706.6)
|
|---|
| 725 | do GetMultRec(22706.6,"^TMG(22706.6,""B"",",IEN,.Array,"PACKAGE")
|
|---|
| 726 |
|
|---|
| 727 | ;"Now look for entries in TMG FDA ROUTES (22706.7)
|
|---|
| 728 | do GetMultRec(22706.7,"^TMG(22706.7,""B"",",IEN,.Array,"ROUTE")
|
|---|
| 729 | if $length($get(Array("ROUTE",1,"NAME")))>16 do
|
|---|
| 730 | . new temp set temp=$$PShortName^TMGSHORT(Array("ROUTE",1,"NAME"),16,1)
|
|---|
| 731 | . if temp="^" quit
|
|---|
| 732 | . set Array("ROUTE",1,"NAME")=temp
|
|---|
| 733 |
|
|---|
| 734 | if $get(Array("FORMULATION","COUNT"),1)=1 do
|
|---|
| 735 | . new strength,str2
|
|---|
| 736 | . new units,units2
|
|---|
| 737 | . set strength=Array("STRENGTH")
|
|---|
| 738 | . set str2=$get(Array("FORMULATION",1,"STRENGTH"))
|
|---|
| 739 | . set units=$get(Array("UNIT"))
|
|---|
| 740 | . set units2=$get(Array("FORMULATION",1,"UNIT"))
|
|---|
| 741 | . if (+str2'>0)!(strength'=str2) do
|
|---|
| 742 | . . set Array("FORMULATION",1,"STRENGTH","OLD")=str2
|
|---|
| 743 | . . set Array("FORMULATION",1,"STRENGTH")=strength
|
|---|
| 744 | . . set Array("FORMULATION",1,"UNIT","OLD")=units2
|
|---|
| 745 | . . set Array("FORMULATION",1,"UNIT")=units
|
|---|
| 746 |
|
|---|
| 747 | ;"Now search for IEN in 50.68 of all ingredients, and find IEN for units name(s)
|
|---|
| 748 | new i,X,Y,TMGROOT,TMGMSG
|
|---|
| 749 | for i=1:1:Array("FORMULATION","COUNT") do
|
|---|
| 750 | . new DIC
|
|---|
| 751 | . set X=$get(Array("FORMULATION",i,"INGREDIENT NAME"))
|
|---|
| 752 | . if X="" quit
|
|---|
| 753 | . set Y=$$LookupRx^TMGNDF0C(X)
|
|---|
| 754 | . if +Y>0 set Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN")=+Y
|
|---|
| 755 | . ;"look up unit name to find IEN in file 50.607
|
|---|
| 756 | . set DIC(0)="M"
|
|---|
| 757 | . set DIC=50.607
|
|---|
| 758 | . set X=$get(Array("FORMULATION",i,"UNIT"))
|
|---|
| 759 | . if X="" quit
|
|---|
| 760 | . do ^DIC
|
|---|
| 761 | . if +Y>0 set Array("FORMULATION",i,"UNIT","FILE 50.607 IEN")=+Y
|
|---|
| 762 |
|
|---|
| 763 | ;"Note the NDC (national drug code) is comprised as follows:
|
|---|
| 764 | ;"It is a 10 digit number comprised of three segments
|
|---|
| 765 | ;" 1st 4-5 digits - producer/packager <--> field#1 (LABEL CODE) in TMG FDA LISTING
|
|---|
| 766 | ;" next 3-4 digits -- the product code <--> field#2 (PRODUCT CODE) in TMG FDA LISTING
|
|---|
| 767 | ;" next 1-2 digits -- package code, specifying the package size <--> field#1 (CODE) in TMG FDA PACKAGES
|
|---|
| 768 | ;" the grouping will be: 4-4-2, or 5-3-2, or 5-4-1
|
|---|
| 769 |
|
|---|
| 770 | set Array("NDC")=$get(Array("LABEL CODE"),"????")_"-"
|
|---|
| 771 | set Array("NDC")=Array("NDC")_$get(Array("PRODUCT CODE"),"????")_"-"
|
|---|
| 772 | set Array("NDC")=Array("NDC")_$get(Array("PACKAGE",1,"CODE"),"??")
|
|---|
| 773 |
|
|---|
| 774 | set Array("NDC")=$$NewNDC^TMGNDF2E(Array("NDC")) ;"added 5/28/06 //kt
|
|---|
| 775 |
|
|---|
| 776 | set Array("NDC","12DIGIT")=$translate(Array("NDC"),"-","")
|
|---|
| 777 | do ;"ensure length=12
|
|---|
| 778 | . new num set num=Array("NDC","12DIGIT")
|
|---|
| 779 | . new l set l=$length(num)
|
|---|
| 780 | . if l>12 set num=$extract(num,l-11,99)
|
|---|
| 781 | . if l<12 set num=$extract("00000000000",1,12-l)_num ;"pad with leading 0's
|
|---|
| 782 | . set Array("NDC","12DIGIT")=num
|
|---|
| 783 |
|
|---|
| 784 | if $get(noLink)=1 goto GDIDone ;"Skip linkages if requested.
|
|---|
| 785 |
|
|---|
| 786 | ;"Now try to link to pre-existing VistA entries
|
|---|
| 787 | ;"Note--2/12/07 -- I am changing the significance of this link to 50.68
|
|---|
| 788 | ;" I found that many drugs had multiple links to entries in 50.68, i.e.
|
|---|
| 789 | ;" there was a one-to-many relationship. And while it is helpful to
|
|---|
| 790 | ;" have a connection to *similar* drugs (i.e. to obtain missing
|
|---|
| 791 | ;" drug class, ingredients etc.), there is also value from having
|
|---|
| 792 | ;" a link to an EXACT match in 50.68 -- i.e. a one-to-one relationship.
|
|---|
| 793 | ;" I have therefore renamed the field in TMG FDA IMPORT COMPILED where
|
|---|
| 794 | ;" this information is stored to: VA PRODUCT SIMILAR MATCHES, and for
|
|---|
| 795 | ;" less certain matches, renamed it to: VA PRODUCT POSSIBLE MATCHES.
|
|---|
| 796 | ;" I have introduced a new field: 'NDC --> VA PRODUCT LINK' that
|
|---|
| 797 | ;" will hold a pointer to a record with the exact same NDC (national
|
|---|
| 798 | ;" drug code). This link will be established in a later stage.
|
|---|
| 799 | do
|
|---|
| 800 | . new DIC,X,Y
|
|---|
| 801 | . set DIC=50.67
|
|---|
| 802 | . set DIC(0)="M"
|
|---|
| 803 | . ;"set X=""""_Array("NDC","12DIGIT")_""""
|
|---|
| 804 | . set X=Array("NDC","12DIGIT")
|
|---|
| 805 | . do ^DIC
|
|---|
| 806 | . if Y=-1 quit
|
|---|
| 807 | . new tempIEN set tempIEN=$$GET1^DIQ(50.67,+Y_",",5,"I")
|
|---|
| 808 | . new tempResults
|
|---|
| 809 | . ;"do CheckNDCLink(tempIEN,.Array,.tempResults)
|
|---|
| 810 | . ;"if +$get(tempResults("COUNT"))'>0 do quit
|
|---|
| 811 | . ;". set Array("NDC","NOTE")="NDC Conflict found with drug IEN (in 50.68)="_tempIEN
|
|---|
| 812 | . set Array("FILE 50.68 IEN",1)=tempIEN
|
|---|
| 813 | . set Array("FILE 50.68 IEN","COUNT")=1
|
|---|
| 814 |
|
|---|
| 815 | if +$get(Array("FILE 50.68 IEN","COUNT"))=0 do
|
|---|
| 816 | . new RArray
|
|---|
| 817 | . new temp
|
|---|
| 818 | . if $get(pIndex)'="" do
|
|---|
| 819 | . . set temp=$$Link2VAProd(.Array,.RArray,pIndex)
|
|---|
| 820 | . else do
|
|---|
| 821 | . . set temp=$$LinkToVAProd(.Array,.RArray)
|
|---|
| 822 | . merge Array("FILE 50.68 IEN")=RArray
|
|---|
| 823 |
|
|---|
| 824 | GDIDone
|
|---|
| 825 | quit result
|
|---|
| 826 |
|
|---|
| 827 |
|
|---|
| 828 | GetSingleRec(File,GRef,IEN,Array)
|
|---|
| 829 | ;"Purpose: To get the data from single record, that points to IEN, and put in Array
|
|---|
| 830 | ;"Input: File -- the file NUMBER
|
|---|
| 831 | ;" GRef -- the OPEN FORMAT global reference of B xref (e.g. '^TMG(22706.1,"B",' )
|
|---|
| 832 | ;" IEN -- The IEN that is pointed to
|
|---|
| 833 | ;" Array -- an out parameter. PASS BY REFERENCE
|
|---|
| 834 |
|
|---|
| 835 | set GRef=GRef_IEN_","""")"
|
|---|
| 836 | set i=$order(@GRef)
|
|---|
| 837 | if +i>0 do
|
|---|
| 838 | . new IENS,TMGARRAY,TMGMSG
|
|---|
| 839 | . set IENS=i_","
|
|---|
| 840 | . do GETS^DIQ(File,IENS,"*","R","TMGARRAY","TMGMSG")
|
|---|
| 841 | . if $data(TMGMSG) do quit
|
|---|
| 842 | . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG")
|
|---|
| 843 | . . if $data(TMGMSG("DIERR"))'=0 do quit
|
|---|
| 844 | . . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 845 | . merge Array=TMGARRAY(File,IENS)
|
|---|
| 846 |
|
|---|
| 847 | quit
|
|---|
| 848 |
|
|---|
| 849 | GetMultRec(File,GRef,IEN,Array,Label)
|
|---|
| 850 | ;"Purpose: To get the data from mult records, that point to IEN, and put in Array
|
|---|
| 851 | ;"Input: File -- the file NUMBER
|
|---|
| 852 | ;" GRef -- the OPEN FORMAT global reference of B xref (e.g. '^TMG(22706.1,"B",' )
|
|---|
| 853 | ;" IEN -- The IEN that is pointed to
|
|---|
| 854 | ;" Array -- an out parameter. PASS BY REFERENCE
|
|---|
| 855 |
|
|---|
| 856 | new count set count=1
|
|---|
| 857 | new Ref
|
|---|
| 858 | set Ref=GRef_IEN_","""")"
|
|---|
| 859 | set i=$order(@Ref)
|
|---|
| 860 | if +i>0 for do quit:(+i'>0)
|
|---|
| 861 | . new IENS,TMGARRAY,TMGMSG
|
|---|
| 862 | . set IENS=i_","
|
|---|
| 863 | . do GETS^DIQ(File,IENS,"*","R","TMGARRAY","TMGMSG")
|
|---|
| 864 | . if $data(TMGMSG) do quit
|
|---|
| 865 | . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG")
|
|---|
| 866 | . . if $data(TMGMSG("DIERR"))'=0 do quit
|
|---|
| 867 | . . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 868 | . kill TMGARRAY(File,IENS,"LISTING")
|
|---|
| 869 | . if Label="ROUTE" kill TMGARRAY(File,IENS,"CODE")
|
|---|
| 870 | . if Label="DOSE" kill TMGARRAY(File,IENS,"DOSE FORM")
|
|---|
| 871 | . merge Array(Label,count)=TMGARRAY(File,IENS)
|
|---|
| 872 | . set Ref=GRef_IEN_",i)"
|
|---|
| 873 | . set i=$order(@Ref)
|
|---|
| 874 | . set count=count+1
|
|---|
| 875 |
|
|---|
| 876 | quit
|
|---|
| 877 |
|
|---|
| 878 |
|
|---|
| 879 | LinkToVAProd(Array,Results)
|
|---|
| 880 | ;"Purpose: To take a given drug array, and match to an entry in file VA PRODUCT (50.68)
|
|---|
| 881 | ;"Input: Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array)
|
|---|
| 882 | ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array
|
|---|
| 883 | ;" if more than one IEN. e.g.
|
|---|
| 884 | ;" Results("COUNT")=3
|
|---|
| 885 | ;" Results(1)=IEN ;IEN is from file 50.68
|
|---|
| 886 | ;" Results(2)=IEN ;IEN is from file 50.68
|
|---|
| 887 | ;" Results(3)=IEN ;IEN is from file 50.68
|
|---|
| 888 | ;" Because a full match is sometimes not found (i.e. because minor variance), I
|
|---|
| 889 | ;" will return all close (but not necessarily perfect) matches as:
|
|---|
| 890 | ;" Results("POSS MATCH","COUNT")=IEN
|
|---|
| 891 | ;" Results("POSS MATCH",1)=ien
|
|---|
| 892 | ;"Result: Returns IEN in file 50.68, or 0 if not found, or -2 if multiple results found
|
|---|
| 893 | ;" (in which case all matches will be reported in Results array
|
|---|
| 894 | ;"Note: this function will have to scan through tens of thousands of entries in the main
|
|---|
| 895 | ;" drug files, so response may be slow.
|
|---|
| 896 |
|
|---|
| 897 | new result set result=0
|
|---|
| 898 | kill Results
|
|---|
| 899 | new lmCount set lmCount=0
|
|---|
| 900 | ;"Cycle through all records in file 50.68 (VA PRODUCT FILE) (global: ^PSNDF(50.68, )
|
|---|
| 901 | new IEN
|
|---|
| 902 | set IEN=$order(^PSNDF(50.68,0))
|
|---|
| 903 | if +IEN>0 for do quit:(IEN'>0)
|
|---|
| 904 | . if ($get(tmgTEST)=1) write IEN,!
|
|---|
| 905 | . do CheckLink(IEN,.Array,.Results)
|
|---|
| 906 | . set IEN=$order(^PSNDF(50.68,IEN))
|
|---|
| 907 |
|
|---|
| 908 | if $get(Results("COUNT"))=1 do
|
|---|
| 909 | . set result=$order(Results(""))
|
|---|
| 910 | else if +$get(Results("COUNT"))=0 do
|
|---|
| 911 | . set result=0
|
|---|
| 912 | else if $get(Results("COUNT"))>1 do
|
|---|
| 913 | . set result=-2
|
|---|
| 914 |
|
|---|
| 915 | quit result
|
|---|
| 916 |
|
|---|
| 917 |
|
|---|
| 918 | Link2VAProd(Array,Results,pIndex)
|
|---|
| 919 | ;"Purpose: To take a given drug array, and match to an entry in file VA PRODUCT (50.68)
|
|---|
| 920 | ;" -- using a faster index method
|
|---|
| 921 | ;"Input: Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array)
|
|---|
| 922 | ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array
|
|---|
| 923 | ;" if more than one IEN. e.g.
|
|---|
| 924 | ;" Results("COUNT")=3
|
|---|
| 925 | ;" Results(1)=IEN ;IEN is from file 50.68
|
|---|
| 926 | ;" Results(2)=IEN ;IEN is from file 50.68
|
|---|
| 927 | ;" Results(3)=IEN ;IEN is from file 50.68
|
|---|
| 928 | ;" Because a full match is sometimes not found (i.e. because minor variance), I
|
|---|
| 929 | ;" will return all close (but not necessarily perfect) matches as:
|
|---|
| 930 | ;" Results("POSS MATCH","COUNT")=IEN
|
|---|
| 931 | ;" Results("POSS MATCH",1)=ien
|
|---|
| 932 | ;" pIndex -- NAME OF index array to use, as created by IndexVAProd()
|
|---|
| 933 | ;" @pIndex@(IngredientIEN, 50.68 IEN, 50.6814 IEN)=""
|
|---|
| 934 | ;" @pIndex@(IngredientIEN, 50.68 IEN, 50.6814 IEN)=""
|
|---|
| 935 | ;"Result: Returns IEN in file 50.68, or 0 if not found, or -2 if multiple results found
|
|---|
| 936 | ;" (in which case all matches will be reported in Results array
|
|---|
| 937 | ;"Note: this function will have to scan through tens of thousands of entries in the main
|
|---|
| 938 | ;" drug files, so response may be slow.
|
|---|
| 939 |
|
|---|
| 940 | new result set result=0
|
|---|
| 941 | kill Results
|
|---|
| 942 | new lmCount set lmCount=0
|
|---|
| 943 |
|
|---|
| 944 | new PossMatch ;"an array to list all IENs in 50.68 containing ONE specified ingredient
|
|---|
| 945 | new IngredList ;"an array to hold IENS of all ingredients for drug info held in Array
|
|---|
| 946 | new NumIngredients
|
|---|
| 947 | new i
|
|---|
| 948 | for i=1:1:$get(Array("FORMULATION","COUNT")) do
|
|---|
| 949 | . new IngredIEN
|
|---|
| 950 | . set IngredIEN=$get(Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN"))
|
|---|
| 951 | . set IngredList(IngredIEN)=""
|
|---|
| 952 | . do GetIndexList(IngredIEN,pIndex,$name(PossMatch(IngredIEN)))
|
|---|
| 953 | ;"Example of Output from code above:
|
|---|
| 954 | ;" PossMatch(50,3456)=""
|
|---|
| 955 | ;" PossMatch(50,57698)=""
|
|---|
| 956 | ;" PossMatch(50,993)=""
|
|---|
| 957 | ;" PossMatch(99,3456)="" <-- 3456 has ingredient 99 and 50
|
|---|
| 958 | ;" PossMatch(99,3876)=""
|
|---|
| 959 | ;" PossMatch(99,9902)=""
|
|---|
| 960 | set NumIngredients=$$ListCt^TMGMISC("PossMatch")
|
|---|
| 961 |
|
|---|
| 962 | ;"Now, add node to array above, with indexes switched.
|
|---|
| 963 | ;" PossMatch("x",3456,50)=""
|
|---|
| 964 | ;" PossMatch("x",3456,99)="" <-- 3456 has ingredient 99 and 50
|
|---|
| 965 | ;" PossMatch("x",57698,50)=""
|
|---|
| 966 | ;" PossMatch("x",993,50)=""
|
|---|
| 967 | ;" PossMatch("x",3876,99)=""
|
|---|
| 968 | ;" PossMatch("x",9902,99)=""
|
|---|
| 969 | new VAPIEN
|
|---|
| 970 | set IngredIEN=$order(PossMatch(""))
|
|---|
| 971 | if +IngredIEN>0 for do quit:(+IngredIEN'>0)
|
|---|
| 972 | . set VAPIEN=$order(PossMatch(IngredIEN,""))
|
|---|
| 973 | . if +VAPIEN>0 for do quit:(+VAPIEN'>0)
|
|---|
| 974 | . . set PossMatch("x",VAPIEN,IngredIEN)=""
|
|---|
| 975 | . . set VAPIEN=$order(PossMatch(IngredIEN,VAPIEN))
|
|---|
| 976 | . set IngredIEN=$order(PossMatch(IngredIEN))
|
|---|
| 977 |
|
|---|
| 978 | ;"now find those entries containing ALL given ingredients
|
|---|
| 979 | ;" PossMatch("+",3456)="" <--- only 3456 is a possible match
|
|---|
| 980 | set VAPIEN=$order(PossMatch("x",""))
|
|---|
| 981 | if +VAPIEN>0 for do quit:(+VAPIEN'>0)
|
|---|
| 982 | . if $$ListCt^TMGMISC($name(PossMatch("x",VAPIEN)))'<NumIngredients do
|
|---|
| 983 | . . set PossMatch("+",VAPIEN)=""
|
|---|
| 984 | . set VAPIEN=$order(PossMatch("x",VAPIEN))
|
|---|
| 985 |
|
|---|
| 986 | ;"Cycle through all PossMatch("+") entries from file 50.68 (VA PRODUCT FILE)
|
|---|
| 987 | new IEN
|
|---|
| 988 | set IEN=$order(PossMatch("+",""))
|
|---|
| 989 | if +IEN>0 for do quit:(IEN'>0)
|
|---|
| 990 | . do CheckLink(IEN,.Array,.Results)
|
|---|
| 991 | . set IEN=$order(PossMatch("+",IEN))
|
|---|
| 992 |
|
|---|
| 993 | if $get(Results("COUNT"))=1 do
|
|---|
| 994 | . set result=$order(Results(""))
|
|---|
| 995 | else if +$get(Results("COUNT"))=0 do
|
|---|
| 996 | . set result=0
|
|---|
| 997 | else if $get(Results("COUNT"))>1 do
|
|---|
| 998 | . set result=-2
|
|---|
| 999 |
|
|---|
| 1000 | L2VPDone
|
|---|
| 1001 | quit result
|
|---|
| 1002 |
|
|---|
| 1003 |
|
|---|
| 1004 | CheckLink(IEN,Array,Results)
|
|---|
| 1005 | ;"Purpose: To take a given drug array, and check for match to an entry in file VA PRODUCT (50.68)
|
|---|
| 1006 | ;"Input: IEN -- An IEN in file 50.68 to try for a match, seeing if matches info in Array
|
|---|
| 1007 | ;" Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array)
|
|---|
| 1008 | ;" partial reference below (See GetDrugInfo for full reference)
|
|---|
| 1009 | ;" Array('FORMULATION','COUNT')=1
|
|---|
| 1010 | ;" Array('FORMULATION',1,'STRENGTH')
|
|---|
| 1011 | ;" Array('FORMULATION',1,'UNIT')
|
|---|
| 1012 | ;" Array('FORMULATION',1,'UNIT','FILE 50.607 IEN') ;note may contain -1 if match not found
|
|---|
| 1013 | ;" Array('FORMULATION',1,'INGREDIENT NAME')
|
|---|
| 1014 | ;" Array('FORMULATION',1,'INGREDIENT NAME','FILE 50.416 IEN) ;note may contain -1 if match not found
|
|---|
| 1015 | ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array
|
|---|
| 1016 | ;" if more than one IEN. e.g.
|
|---|
| 1017 | ;" Results("COUNT")=3
|
|---|
| 1018 | ;" Results(1)=IEN ;IEN is from file 50.68
|
|---|
| 1019 | ;" Results(2)=IEN ;IEN is from file 50.68
|
|---|
| 1020 | ;" Results(3)=IEN ;IEN is from file 50.68
|
|---|
| 1021 | ;" Because a full match is sometimes not found (i.e. because minor variance), I
|
|---|
| 1022 | ;" will return all close (but not necessarily perfect) matches as:
|
|---|
| 1023 | ;" Results("POSS MATCH","COUNT")=IEN
|
|---|
| 1024 | ;" Results("POSS MATCH",1)=ien
|
|---|
| 1025 | ;"Result: None (but returns results in Results array)
|
|---|
| 1026 |
|
|---|
| 1027 | ;"Note: this function will have to scan through tens of thousands of entries in the main
|
|---|
| 1028 | ;" drug files, so response may be slow.
|
|---|
| 1029 |
|
|---|
| 1030 | new result set result=0
|
|---|
| 1031 | new lmCount set lmCount=0
|
|---|
| 1032 |
|
|---|
| 1033 | new ingredient,igdIEN
|
|---|
| 1034 | new match set match=1 ;"default to true
|
|---|
| 1035 | new numIngredients
|
|---|
| 1036 | set numIngredients=$get(Array("FORMULATION","COUNT"))
|
|---|
| 1037 | if numIngredients=0 set match=0
|
|---|
| 1038 | else for ingredient=1:1 do quit:(+igdIEN'>0)!(match=0)
|
|---|
| 1039 | . set igdIEN=$get(Array("FORMULATION",ingredient,"INGREDIENT NAME","FILE 50.416 IEN"))
|
|---|
| 1040 | . if +igdIEN'>0 do quit
|
|---|
| 1041 | . . if igdIEN="" quit ;"just at end of list of ingredients
|
|---|
| 1042 | . . if igdIEN=-1 set match=0 ;"here igdIEN must =-1 (prior ^DIC failed to find match)
|
|---|
| 1043 | . new node set node=$get(^PSNDF(50.68,IEN,2,igdIEN,0))
|
|---|
| 1044 | . if node="" do quit
|
|---|
| 1045 | . . set match=0 quit ;"no match found
|
|---|
| 1046 | . ;"If we get here, we have a match. Now check for matching strength and units
|
|---|
| 1047 | . set lmCount=lmCount+1
|
|---|
| 1048 | . set Results("POSS MATCH",lmCount)=IEN
|
|---|
| 1049 | . set Results("POSS MATCH","COUNT")=lmCount
|
|---|
| 1050 | . set Results("POSS MATCH","INDEX",IEN)=lmCount
|
|---|
| 1051 | . new strength set strength=$piece(node,"^",2)
|
|---|
| 1052 | . new str2 set str2=$get(Array("FORMULATION",ingredient,"STRENGTH"))
|
|---|
| 1053 | . if +strength'=+str2 do quit
|
|---|
| 1054 | . . set Results("POSS MATCH",lmCount,"PROBLEM")="dosage STRENGTH mis-match"
|
|---|
| 1055 | . . set Results("POSS MATCH",lmCount,"MSG")="Import="_str2_", VistA="_strength
|
|---|
| 1056 | . . set match=0
|
|---|
| 1057 | . new units set units=$piece(node,"^",3)
|
|---|
| 1058 | . new units2 set units2=$get(Array("FORMULATION",ingredient,"UNIT","FILE 50.607 IEN"))
|
|---|
| 1059 | . if units'=units2 do
|
|---|
| 1060 | . . set Results("POSS MATCH",lmCount,"PROBLEM")="dosage UNITS mis-match"
|
|---|
| 1061 | . . new s
|
|---|
| 1062 | . . set s="Import="_$$GET1^DIQ(50.607,units2_",",".01")
|
|---|
| 1063 | . . set s=s_", VistA="_$$GET1^DIQ(50.607,units_",",".01")
|
|---|
| 1064 | . . set Results("POSS MATCH",lmCount,"MSG")=s
|
|---|
| 1065 | . . set match=0
|
|---|
| 1066 | . ;"Now see if VistA drug has more ingredients than import drug.
|
|---|
| 1067 | . new IgdCount set IgdCount=0
|
|---|
| 1068 | . new TempIdx set TempIdx=$order(^PSNDF(50.68,IEN,2,0))
|
|---|
| 1069 | . if TempIdx'="" for do quit:(+TempIdx'>0)
|
|---|
| 1070 | . . set IgdCount=IgdCount+1
|
|---|
| 1071 | . . set TempIdx=$order(^PSNDF(50.68,IEN,2,TempIdx))
|
|---|
| 1072 | . if IgdCount'=numIngredients do quit
|
|---|
| 1073 | . . set Results("POSS MATCH",lmCount,"PROBLEM")="Number of ingredients mismatch"
|
|---|
| 1074 | . . set Results("POSS MATCH",lmCount,"MSG")="Import="_numIngredients_", VistA="_IgdCount
|
|---|
| 1075 | . . set match=0
|
|---|
| 1076 | if match=1 do
|
|---|
| 1077 | . new count set count=$get(Results("COUNT"))+1
|
|---|
| 1078 | . set Results(count)=IEN
|
|---|
| 1079 | . set Results("COUNT")=count
|
|---|
| 1080 |
|
|---|
| 1081 | ;"Now, remove entries in POSS MATCH that are actual full matches.
|
|---|
| 1082 | new SomeKilled set SomeKilled=0
|
|---|
| 1083 | new index
|
|---|
| 1084 | for index=1:1:+$get(Results("COUNT")) do
|
|---|
| 1085 | . new matchIEN set matchIEN=$get(Results(index))
|
|---|
| 1086 | . new possEntry set possEntry=$get(Results("POSS MATCH","INDEX",matchIEN))
|
|---|
| 1087 | . kill Results("POSS MATCH",possEntry)
|
|---|
| 1088 | . kill Results("POSS MATCH","INDEX",matchIEN)
|
|---|
| 1089 | . set SomeKilled=1
|
|---|
| 1090 | . set Results("POSS MATCH","COUNT")=$get(Results("POSS MATCH","COUNT"))-1
|
|---|
| 1091 |
|
|---|
| 1092 | ;"Now renumber remaining POSS MATCHES
|
|---|
| 1093 | if SomeKilled do
|
|---|
| 1094 | . do ListPack^TMGMISC($name(Results("POSS MATCH")))
|
|---|
| 1095 | . set Results("POSS MATCH","COUNT")=$$ListCt^TMGMISC($name(Results("POSS MATCH")))
|
|---|
| 1096 |
|
|---|
| 1097 | ;"set index=$order(Results("POSS MATCH",""))
|
|---|
| 1098 | ;"new newCount set newCount=0
|
|---|
| 1099 | ;"if +index>0 for do quit:(index'>0)
|
|---|
| 1100 | ;". set newCount=newCount+1
|
|---|
| 1101 | ;". merge Results("POSS MATCH 2",newCount)=Results("POSS MATCH",index)
|
|---|
| 1102 | ;". set Results("POSS MATCH 2","COUNT")=$get(Results("POSS MATCH 2","COUNT"))+1
|
|---|
| 1103 | ;". set index=$order(Results("POSS MATCH",index))
|
|---|
| 1104 | ;"if $data(Results("POSS MATCH 2"))>0 do
|
|---|
| 1105 | ;". kill Results("POSS MATCH")
|
|---|
| 1106 | ;". merge Results("POSS MATCH")=Results("POSS MATCH 2")
|
|---|
| 1107 | ;". kill Results("POSS MATCH 2")
|
|---|
| 1108 |
|
|---|
| 1109 | quit
|
|---|
| 1110 |
|
|---|
| 1111 |
|
|---|
| 1112 | CheckNDCLink(IEN,Array,Results)
|
|---|
| 1113 | ;"This is like CheckLink, except is it a little bit more lenient about the allowed
|
|---|
| 1114 | ;" variances. For example if UNITS of measure are different (e.g. MG vs. MG/VIAL).
|
|---|
| 1115 | ;"Input: IEN -- An IEN in file 50.68 to try for a match, seeing if matches info in Array
|
|---|
| 1116 | ;" Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array)
|
|---|
| 1117 | ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array
|
|---|
| 1118 | ;" if more than one IEN. e.g.
|
|---|
| 1119 | ;" Results("COUNT")=3
|
|---|
| 1120 | ;" Results(1)=IEN ;IEN is from file 50.68
|
|---|
| 1121 | ;" Results(2)=IEN ;IEN is from file 50.68
|
|---|
| 1122 | ;" Results(3)=IEN ;IEN is from file 50.68
|
|---|
| 1123 | ;" Because a full match is sometimes not found (i.e. because minor variance), I
|
|---|
| 1124 | ;" will return all close (but not necessarily perfect) matches as:
|
|---|
| 1125 | ;" Results("POSS MATCH","COUNT")=IEN
|
|---|
| 1126 | ;" Results("POSS MATCH",1)=ien
|
|---|
| 1127 | ;"Result: None (but returns results in Results array)
|
|---|
| 1128 |
|
|---|
| 1129 | ;"Note: this function will have to scan through tens of thousands of entries in the main
|
|---|
| 1130 | ;" drug files, so response may be slow.
|
|---|
| 1131 |
|
|---|
| 1132 | new match
|
|---|
| 1133 |
|
|---|
| 1134 | do CheckLink(IEN,.Array,.Results)
|
|---|
| 1135 | if +$get(Results("COUNT"))<1 do
|
|---|
| 1136 | . new i,max,done
|
|---|
| 1137 | . set done=0
|
|---|
| 1138 | . set max=$get(Results("POSS MATCH","COUNT"))
|
|---|
| 1139 | . for i=1:1:max do quit:(done=1)
|
|---|
| 1140 | . . if Results("POSS MATCH",i,"PROBLEM")="dosage UNITS mis-match" do
|
|---|
| 1141 | . . . set Results(1)=Results("POSS MATCH",i)
|
|---|
| 1142 | . . . kill Results("POSS MATCH",i)
|
|---|
| 1143 | . . . do ListPack^TMGMISC($name(Results("POSS MATCH")))
|
|---|
| 1144 | . . . set Results("COUNT")=$$ListCt^TMGMISC("Results")
|
|---|
| 1145 | . . . set done=1
|
|---|
| 1146 |
|
|---|
| 1147 | quit
|
|---|
| 1148 |
|
|---|
| 1149 |
|
|---|
| 1150 | GetpVAPIndex()
|
|---|
| 1151 | ;"Purpose: to return a pointer to an index of the VAProduct file
|
|---|
| 1152 | ;"Input: none
|
|---|
| 1153 | ;"Output: returns the NAME of index of VAProduct, or ^ for abort
|
|---|
| 1154 |
|
|---|
| 1155 | new pIndex set pIndex=$name(^TMG("TMP","indexVAProduct"))
|
|---|
| 1156 | new abort set abort=0
|
|---|
| 1157 | if $data(@pIndex) do
|
|---|
| 1158 | . new % set %=2
|
|---|
| 1159 | . write "Recreate temporary VA PRODUCT file index *IF* there have",!
|
|---|
| 1160 | . write "been any changes made to this file since last index.",!
|
|---|
| 1161 | . write "Re-index" do YN^DICN write !
|
|---|
| 1162 | . if %=1 kill @pIndex
|
|---|
| 1163 | . if %=-1 set abort=1
|
|---|
| 1164 | if abort=1 set pIndex="^" goto GVAPIDone
|
|---|
| 1165 |
|
|---|
| 1166 | if $data(@pIndex)=0 do IndexVAProd(pIndex)
|
|---|
| 1167 |
|
|---|
| 1168 | GVAPIDone
|
|---|
| 1169 | quit pIndex
|
|---|
| 1170 |
|
|---|
| 1171 | IndexVAProd(pArray)
|
|---|
| 1172 | ;"Purpose: to make a temporary index of the VA PRODUCT file based on the ACTIVE INGREDIENTS field
|
|---|
| 1173 | ;"Input: pArray: the NAME OF the array to store index in
|
|---|
| 1174 | ;"Output: Index will be stored in array like this:
|
|---|
| 1175 | ;" @pArray@(IngredientIEN, 50.68 IEN, 50.6814 IEN)=""
|
|---|
| 1176 | ;"Result: none:
|
|---|
| 1177 | ;"Note: prior values in pArray will NOT be killed.
|
|---|
| 1178 | ;" Also, the VA PRODUCT file is setup such that the 50.6814 IEN will also watch IngredientIEN
|
|---|
| 1179 |
|
|---|
| 1180 | new IEN,subIEN,node,Ingredient
|
|---|
| 1181 |
|
|---|
| 1182 | ;"set IEN=$order(^PSNDF(50.68,0))
|
|---|
| 1183 | ;"if (+IEN>0) for do quit:(+IEN'>0)
|
|---|
| 1184 |
|
|---|
| 1185 | write "Creating a temporary index of VA PRODUCT FILE",!
|
|---|
| 1186 | new Itr,IEN
|
|---|
| 1187 | set IEN=$$ItrInit^TMGITR(50.68,.Itr)
|
|---|
| 1188 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 1189 | if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
|
|---|
| 1190 | . set subIEN=$order(^PSNDF(50.68,IEN,2,0))
|
|---|
| 1191 | . if (+subIEN>0) for do quit:(+subIEN'>0)
|
|---|
| 1192 | . . set node=$get(^PSNDF(50.68,IEN,2,subIEN,0))
|
|---|
| 1193 | . . set Ingredient=$piece(node,"^",1)
|
|---|
| 1194 | . . if +Ingredient>0 do
|
|---|
| 1195 | . . . set @pArray@(Ingredient,IEN,subIEN)=""
|
|---|
| 1196 | . . . ;"set @pArray@("IEN",IEN,subIEN)=Ingredient
|
|---|
| 1197 | . . set subIEN=$order(^PSNDF(50.68,IEN,2,subIEN))
|
|---|
| 1198 | . ;"set IEN=$order(^PSNDF(50.68,IEN))
|
|---|
| 1199 |
|
|---|
| 1200 | write !
|
|---|
| 1201 | quit
|
|---|
| 1202 |
|
|---|
| 1203 |
|
|---|
| 1204 | GetIndexList(Ingredient,pIndex,pArray)
|
|---|
| 1205 | ;"Purpose: for a given Ingredient, return a list of all records containing this ingredient
|
|---|
| 1206 | ;"Input: Ingredient -- the IEN (from file 50.416) to scan for
|
|---|
| 1207 | ;" pIndex -- NAME OF index array, as created by IndexVaProd()
|
|---|
| 1208 | ;" pArray -- NAME OF array to put data into
|
|---|
| 1209 | ;"Output: results will be put in like this:
|
|---|
| 1210 | ;" @pArray@(IEN from 50.68)=""
|
|---|
| 1211 | ;"results: none
|
|---|
| 1212 | ;"Note: any prior data in pArray WILL BE KILLED
|
|---|
| 1213 |
|
|---|
| 1214 | kill @pArray
|
|---|
| 1215 | if $get(Ingredient)="" quit
|
|---|
| 1216 | new IEN set IEN=$order(@pIndex@(Ingredient,""))
|
|---|
| 1217 | if +IEN>0 for do quit:(+IEN'>0)
|
|---|
| 1218 | . set @pArray@(IEN)=""
|
|---|
| 1219 | . set IEN=$order(@pIndex@(Ingredient,IEN))
|
|---|
| 1220 |
|
|---|
| 1221 | quit
|
|---|
| 1222 |
|
|---|
| 1223 |
|
|---|
| 1224 | FixGenerics
|
|---|
| 1225 | ;"Purpose: After running the Compile function, I found that many records did not have
|
|---|
| 1226 | ;" an entry for the GENERIC NAME field. This seems to happen when a drug has no
|
|---|
| 1227 | ;" Ingredients listed. But often there are other drugs with the same name that DO
|
|---|
| 1228 | ;" have ingredients. If so, then the errent record is essentially a duplicate (except
|
|---|
| 1229 | ;" for different NDC etc), and isn't needed. Therefore the SKIP THIS RECORD field
|
|---|
| 1230 | ;" can be set to 1 (SKIP). But, if there isn't a duplicate record, then the tradename
|
|---|
| 1231 | ;" will be used as the GENERIC name
|
|---|
| 1232 |
|
|---|
| 1233 | new IEN,count
|
|---|
| 1234 | new TMGGeneric,TradeName
|
|---|
| 1235 |
|
|---|
| 1236 | set IEN=$order(^TMG(22706.9,0))
|
|---|
| 1237 | if IEN'="" for do quit:(+IEN'>0)
|
|---|
| 1238 | . set TMGGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"get field#.07, GENERIC NAME
|
|---|
| 1239 | . if (TMGGeneric="") do
|
|---|
| 1240 | . . set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME
|
|---|
| 1241 | . . new list
|
|---|
| 1242 | . . do ScanFor(TradeName,.list)
|
|---|
| 1243 | . . set count=$$ListCt^TMGMISC("list")
|
|---|
| 1244 | . . if count=1 do
|
|---|
| 1245 | . . . write "Unique drug, with no ingredients: ",TradeName,!
|
|---|
| 1246 | . . . do FindSimNames(TradeName,.list)
|
|---|
| 1247 | . . . if $data(list) zwr list
|
|---|
| 1248 | . . else do
|
|---|
| 1249 | . . . write "Drug, with no ingredients: ",TradeName," --> ",count," other similar drugs.",!
|
|---|
| 1250 | . set IEN=$order(^TMG(22706.9,IEN))
|
|---|
| 1251 |
|
|---|
| 1252 | quit
|
|---|
| 1253 |
|
|---|
| 1254 |
|
|---|
| 1255 | ScanFor(Name,Array)
|
|---|
| 1256 | ;"Purpose: To scan file 22706.9 (TMG FDA IMPORT COMPILED) for records with field TRADENAME
|
|---|
| 1257 | ;" contains to 'TradeName'
|
|---|
| 1258 | ;"Input: Name -- the value to search for
|
|---|
| 1259 | ;" Array -- PASS BY REFERENCE. An OUT parameter for result:
|
|---|
| 1260 | ;" Array(Name,IEN)=""
|
|---|
| 1261 | ;" Array(Name,IEN)=""
|
|---|
| 1262 | ;" Array(Name,IEN)=""
|
|---|
| 1263 | ;"Results: none
|
|---|
| 1264 |
|
|---|
| 1265 | new IEN
|
|---|
| 1266 | new TradeName
|
|---|
| 1267 |
|
|---|
| 1268 | set IEN=$order(^TMG(22706.9,0))
|
|---|
| 1269 | if IEN'="" for do quit:(+IEN'>0)
|
|---|
| 1270 | . set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME
|
|---|
| 1271 | . if TradeName[Name do
|
|---|
| 1272 | . . set Array(Name,IEN)=TradeName
|
|---|
| 1273 | . set IEN=$order(^TMG(22706.9,IEN))
|
|---|
| 1274 |
|
|---|
| 1275 | quit
|
|---|
| 1276 |
|
|---|
| 1277 |
|
|---|
| 1278 | FindSimNames(Name,Array)
|
|---|
| 1279 | ;"Purpose: to scan TMG FDA IMPORT COMPILED file and return an array of similar entries.
|
|---|
| 1280 | ;"Input: Name: the name of the Name drug name to scan for
|
|---|
| 1281 | ;" Array: PASS BY REFERENCE, and OUT PARAMETER -- prior entries are killed
|
|---|
| 1282 | ;"Result: none (output is in Array)
|
|---|
| 1283 |
|
|---|
| 1284 | new i,i2,s
|
|---|
| 1285 | new NumWords,TradeName
|
|---|
| 1286 | set NumWords=$length(Name," ")
|
|---|
| 1287 | kill Array
|
|---|
| 1288 |
|
|---|
| 1289 | set i2=$order(^TMG(22706.9,0))
|
|---|
| 1290 | if i2'="" for do quit:(i2="")
|
|---|
| 1291 | . set TradeName=$piece($get(^TMG(22706.9,i2,0)),"^",4) ;"get field#.05, TRADENAME
|
|---|
| 1292 | . new IEN set IEN=i2
|
|---|
| 1293 | . set i2=$order(^TMG(22706.9,i2))
|
|---|
| 1294 | . if NumWords'=$length(TradeName," ") quit
|
|---|
| 1295 | . new temp set temp=TradeName
|
|---|
| 1296 | . for i=1:1:NumWords do quit:(s="")!(temp="")
|
|---|
| 1297 | . . set s=$piece(Name," ",i)
|
|---|
| 1298 | . . set s=$piece(s," ",1) ;"get first word of multi-word drug name
|
|---|
| 1299 | . . if s="" quit
|
|---|
| 1300 | . . if $extract(TradeName,1,$length(s))'=s set temp=""
|
|---|
| 1301 | . if temp'="" do
|
|---|
| 1302 | . . set Array(TradeName)=IEN_"^"_TradeName
|
|---|
| 1303 |
|
|---|
| 1304 | new count
|
|---|
| 1305 | set count=$$ListCt^TMGMISC("Array")
|
|---|
| 1306 | if count>1 do
|
|---|
| 1307 | . do NarrowGenMatches^TMGNDF2C(Name,.Array," ")
|
|---|
| 1308 | . if (($$ListCt^TMGMISC("Array")/count)>0.5)&(count>5) do ;"i.e. no improvement
|
|---|
| 1309 | . . kill Array
|
|---|
| 1310 |
|
|---|
| 1311 | quit
|
|---|
| 1312 |
|
|---|
| 1313 |
|
|---|
| 1314 | FixLink
|
|---|
| 1315 | ;"Purpose: ask user for entry in 22706.9 to fix, then try to fix link
|
|---|
| 1316 |
|
|---|
| 1317 | new IEN
|
|---|
| 1318 | new DIC,X,Y
|
|---|
| 1319 | set DIC=22706.9,DIC(0)="MAEQ"
|
|---|
| 1320 | do ^DIC write !
|
|---|
| 1321 | if +Y>0 do Fix1Link(+Y)
|
|---|
| 1322 | quit
|
|---|
| 1323 |
|
|---|
| 1324 |
|
|---|
| 1325 | Fix1Link(IEN)
|
|---|
| 1326 | ;"Purpose: To attemp to fix an entry that doesn't have a link to a VA PRODUCT entry
|
|---|
| 1327 | ;"Input: IEN -- an IEN from 22706.9
|
|---|
| 1328 |
|
|---|
| 1329 | new array,results,vapIEN
|
|---|
| 1330 | new listIEN set listIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",1)
|
|---|
| 1331 | if listIEN'>0 goto F1LDone
|
|---|
| 1332 |
|
|---|
| 1333 | if $$GetDrugInfo(listIEN,.array)=0 goto F1LDone
|
|---|
| 1334 | set vapIEN=$$LinkToVAProd(.array,.results)
|
|---|
| 1335 | write vapIEN,!
|
|---|
| 1336 | if $data(results) zwr results(*)
|
|---|
| 1337 |
|
|---|
| 1338 | ;"finish....
|
|---|
| 1339 | ;"
|
|---|
| 1340 | F1LDone
|
|---|
| 1341 | quit
|
|---|
| 1342 |
|
|---|
| 1343 | ;"=======================================================================
|
|---|
| 1344 |
|
|---|
| 1345 | Show1Source(IEN)
|
|---|
| 1346 | ;"Purpose: to show the source fields for the record
|
|---|
| 1347 | ;"Input: IEN -- records number from 22706.9
|
|---|
| 1348 | ;"Output: source data for record is dumped to screen.
|
|---|
| 1349 |
|
|---|
| 1350 | new fdaIEN
|
|---|
| 1351 | set fdaIEN=$piece($get(^TMG(22706.9,IEN,0)),"^",1)
|
|---|
| 1352 |
|
|---|
| 1353 | do Show1Drug^TMGNDF0B(fdaIEN)
|
|---|
| 1354 | quit
|
|---|
