| 1 | TMGNDF2H ;TMG/kst/FDA Import: Fill VA Product entries ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;11/21/06
|
|---|
| 3 |
|
|---|
| 4 | ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
|
|---|
| 5 | ;" Addition of records from TMG FDA IMPORT COMPILED into VA PRODUCT file.
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU General Public License (GPL) applies
|
|---|
| 8 | ;"11-21-2006
|
|---|
| 9 |
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" API -- Public Functions.
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;"Menu
|
|---|
| 14 |
|
|---|
| 15 | ;"=======================================================================
|
|---|
| 16 | ;"Link2VAP -- fill file 22706.9, field 5.5 in with link 50.68 with SAME NDC
|
|---|
| 17 | ;"Batch2VAP -- Batch add drugs to VA PRODUCT file (50.68) and NDC/UPC
|
|---|
| 18 |
|
|---|
| 19 | ;"=======================================================================
|
|---|
| 20 | ;" Private Functions.
|
|---|
| 21 | ;"=======================================================================
|
|---|
| 22 | ;"Add2VAProd(IEN,Quiet)
|
|---|
| 23 | ;"EnsureNDC(IEN) Make record in NDC/UPN file (50.67).
|
|---|
| 24 | ;"EnsureUnits(UnitS) -- ensure that the UnitS is valid in file 50.607
|
|---|
| 25 | ;"Unlock50dot607
|
|---|
| 26 | ;"Lock50dot607
|
|---|
| 27 |
|
|---|
| 28 |
|
|---|
| 29 | ;"=======================================================================
|
|---|
| 30 | ;"=======================================================================
|
|---|
| 31 |
|
|---|
| 32 | Menu
|
|---|
| 33 | new Menu,UsrSlct
|
|---|
| 34 | set Menu(0)="Pick Option to Add imports to VA PRODUCT & NDC/UPN file (2H)"
|
|---|
| 35 | set Menu(1)="Link imports to VA PRODUCT via NDC-- *DO THIS FIRST*"_$char(9)_"Link2VAP"
|
|---|
| 36 | set Menu(2)="ADD unlinked imports to VA PRODUCT file."_$char(9)_"Batch2VAP"
|
|---|
| 37 | set Menu(3)="Synchronize VA PRODUCT file with import data."_$char(9)_"Sync2VAP"
|
|---|
| 38 | ;"set Menu(3)="Fix Names with '...'s (SHOULD run AFTER Batch Add)"_$char(9)_"FixNames"
|
|---|
| 39 | ;"set Menu(4)="Check/Fix ALL Names (May be run AFTER Batch Add)"_$char(9)_"FixNames2"
|
|---|
| 40 | set Menu("P")="Prev Stage"_$char(9)_"Prev"
|
|---|
| 41 | set Menu("N")="Next Stage"_$char(9)_"Next"
|
|---|
| 42 |
|
|---|
| 43 | M1 write #
|
|---|
| 44 | set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
|
|---|
| 45 |
|
|---|
| 46 | if UsrSlct="Link2VAP" do Link2VAP goto M1
|
|---|
| 47 | if UsrSlct="Batch2VAP" do Batch2VAP goto M1
|
|---|
| 48 | if UsrSlct="Sync2VAP" do Sync2VAP goto M1
|
|---|
| 49 | ;"if UsrSlct="FixNames" do FixNames(0) goto M1
|
|---|
| 50 | ;"if UsrSlct="FixNames2" do FixNames(1) goto M1
|
|---|
| 51 | if UsrSlct="Prev" goto Menu^TMGNDF2G ;"quit can occur from there...
|
|---|
| 52 | if UsrSlct="Next" goto Menu^TMGNDF3A ;"quit can occur from there...
|
|---|
| 53 | if UsrSlct="^" goto MenuDone
|
|---|
| 54 | goto M1
|
|---|
| 55 |
|
|---|
| 56 | MenuDone
|
|---|
| 57 | quit
|
|---|
| 58 |
|
|---|
| 59 |
|
|---|
| 60 | ;"==========================================================================
|
|---|
| 61 |
|
|---|
| 62 |
|
|---|
| 63 | Batch2VAP
|
|---|
| 64 | ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of
|
|---|
| 65 | ;" possible entries for addition to VA PRODUCT, also creating an entry in
|
|---|
| 66 | ;" the NDC/UPC file.
|
|---|
| 67 | ;"Input: none
|
|---|
| 68 | ;"Output: database will be filled with data (records added to VA PRODUCT file)
|
|---|
| 69 | ;"Results: none
|
|---|
| 70 |
|
|---|
| 71 | ;"Note: After making this function, I changed the function MakeName such that it is better
|
|---|
| 72 | ;" at shortening long names to fit into the field limits.
|
|---|
| 73 | ;" So I wrote the code FixNames to go back and correct the names for better fits.
|
|---|
| 74 | ;" The problem is that it takes user interaction to do this well (asking for abbreviations etc)
|
|---|
| 75 | ;" And this is best done in a batch manner (i.e. not asking each drug, one at a time).
|
|---|
| 76 | ;" So this function was modified such that it shortens the names non-interactively
|
|---|
| 77 | ;" (i.e. AllowCut=1), and then FixNames can be run to review all of the abbreviations
|
|---|
| 78 | ;" are appropriate
|
|---|
| 79 |
|
|---|
| 80 |
|
|---|
| 81 | new AddList
|
|---|
| 82 | do GetAddList(.AddList)
|
|---|
| 83 | new count set count=$$ListCt^TMGMISC("AddList")
|
|---|
| 84 | if count=0 do goto B2VDone
|
|---|
| 85 | . write "No entries need to be be added to VA PRODUCT file.",!
|
|---|
| 86 | . do PressToCont^TMGUSRIF
|
|---|
| 87 | write count," entries will now be added to VA PRODUCT file.",!
|
|---|
| 88 | new % set %=1
|
|---|
| 89 | write "Continue" do YN^DICN write !
|
|---|
| 90 | if %=1 do DoAdd(.AddList)
|
|---|
| 91 | B2VDone
|
|---|
| 92 | quit
|
|---|
| 93 |
|
|---|
| 94 |
|
|---|
| 95 | Check1(IEN)
|
|---|
| 96 | ;"Purpose: to check one record in TMG FDA IMPORT COMPILED (22706.9)
|
|---|
| 97 | ;"NOTE: this just checks if one exists, NOT if correct link is present.
|
|---|
| 98 | ;"Input: IEN -- IEN in 22706.9
|
|---|
| 99 |
|
|---|
| 100 | new AddList,vapIEN,syncList
|
|---|
| 101 |
|
|---|
| 102 | set vapIEN=+$piece($get(^TMG(22706.9,IEN,6)),"^",2)
|
|---|
| 103 | set AddList(IEN)=""
|
|---|
| 104 | if vapIEN=0 set vapIEN=$$Add2VAProd(IEN)
|
|---|
| 105 | set syncList(IEN)=vapIEN
|
|---|
| 106 | do DoSync(.syncList)
|
|---|
| 107 |
|
|---|
| 108 | C1Done quit
|
|---|
| 109 |
|
|---|
| 110 |
|
|---|
| 111 | Sync2VAP
|
|---|
| 112 | ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED (22706.9)
|
|---|
| 113 | ;" and synchronize data with records in VA PRODUCT.
|
|---|
| 114 | ;"Input: none
|
|---|
| 115 | ;"Output: database will be modified with data from 22706.9
|
|---|
| 116 | ;"Results: none
|
|---|
| 117 |
|
|---|
| 118 | new SyncList
|
|---|
| 119 | do GetSyncList(.SyncList)
|
|---|
| 120 | new count set count=$$ListCt^TMGMISC("SyncList")
|
|---|
| 121 | if count=0 do goto S2VDone
|
|---|
| 122 | . write "No entries available to update VA PRODUCT file with.",!
|
|---|
| 123 | . do PressToCont^TMGUSRIF
|
|---|
| 124 | write count," entries will now be used to update VA PRODUCT file.",!
|
|---|
| 125 | new % set %=1
|
|---|
| 126 | write "Continue" do YN^DICN write !
|
|---|
| 127 | if %=1 do DoSync(.SyncList)
|
|---|
| 128 | S2VDone
|
|---|
| 129 | quit
|
|---|
| 130 |
|
|---|
| 131 |
|
|---|
| 132 | GetAddList(AddList)
|
|---|
| 133 | ;"Purpose: to create a list of IEN's that need addition
|
|---|
| 134 | ;"Input: AddList-- PASS BY REFERENCE. An OUT PARAMETER.
|
|---|
| 135 | ;"Output: AddList is filled: Format:
|
|---|
| 136 | ;" AddList(IEN)="" ;IEN is from file 22706.9
|
|---|
| 137 | ;" AddList(IEN)=""
|
|---|
| 138 | ;"Results: none.
|
|---|
| 139 |
|
|---|
| 140 | write "Scanning for imports to be added into VA PRODUCT file...",!
|
|---|
| 141 | new Itr,IEN,success
|
|---|
| 142 | new abort set abort=0
|
|---|
| 143 | set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
|
|---|
| 144 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 145 | if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
|
|---|
| 146 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 147 | . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
|
|---|
| 148 | . if $piece($get(^TMG(22706.9,IEN,6)),"^",2)>0 quit ;"IEN of linked entry in 50.68
|
|---|
| 149 | . set AddList(IEN)=""
|
|---|
| 150 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 151 |
|
|---|
| 152 | quit
|
|---|
| 153 |
|
|---|
| 154 |
|
|---|
| 155 | GetSyncList(SyncList)
|
|---|
| 156 | ;"Purpose: to create a list of IEN's can be used for syncing data
|
|---|
| 157 | ;"Input: SyncList-- PASS BY REFERENCE. An OUT PARAMETER.
|
|---|
| 158 | ;"Output: SyncList is filled: Format:
|
|---|
| 159 | ;" SyncList(IEN22706d9)=vapIEN
|
|---|
| 160 | ;"Results: none.
|
|---|
| 161 |
|
|---|
| 162 | write "Scanning for imports to be synchronized with VA PRODUCT file...",!
|
|---|
| 163 | new Itr,IEN,success
|
|---|
| 164 | new abort set abort=0
|
|---|
| 165 | set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
|
|---|
| 166 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 167 | if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
|
|---|
| 168 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 169 | . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
|
|---|
| 170 | . new vapIEN set vapIEN=$piece($get(^TMG(22706.9,IEN,6)),"^",2) ;"IEN of linked entry in 50.68
|
|---|
| 171 | . if vapIEN=0 quit
|
|---|
| 172 | . set SyncList(IEN)=vapIEN
|
|---|
| 173 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 174 |
|
|---|
| 175 | quit
|
|---|
| 176 |
|
|---|
| 177 |
|
|---|
| 178 | DoAdd(AddList)
|
|---|
| 179 | ;"Purpose: To process the AddList, doing actual adds.
|
|---|
| 180 | ;"Input: AddList-- PASS BY REFERENCE. Format:
|
|---|
| 181 | ;" AddList(IEN)="" ;IEN is from file 22706.9
|
|---|
| 182 | ;" AddList(IEN)=""
|
|---|
| 183 | ;"Results: none.
|
|---|
| 184 |
|
|---|
| 185 | do Unlock50dot607
|
|---|
| 186 | do Unlock50^TMGNDF3C
|
|---|
| 187 |
|
|---|
| 188 | write "Adding records into VA PRODUCT file from import information...",!
|
|---|
| 189 | new count set count=0
|
|---|
| 190 | new Itr,IEN,success,addedIEN
|
|---|
| 191 | new abort set abort=0
|
|---|
| 192 | set IEN=$$ItrAInit^TMGITR("AddList",.Itr)
|
|---|
| 193 | do PrepProgress^TMGITR(.Itr,1,1,"IEN")
|
|---|
| 194 | if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
|
|---|
| 195 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 196 | L1 . set addedIEN=$$Add2VAProd(IEN,0,1) ;"0=not quiet, 1=quiet,Allow Cut automatically
|
|---|
| 197 | . if addedIEN>0 do
|
|---|
| 198 | . . set count=count+1
|
|---|
| 199 | . . new TMGFDA,TMGMSG
|
|---|
| 200 | . . set TMGFDA(22706.9,IEN_",",5.5)=addedIEN
|
|---|
| 201 | . . do FILE^DIE("K","TMGFDA","TMGMSG")
|
|---|
| 202 | . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
|
|---|
| 203 | . else do
|
|---|
| 204 | . . write !,"Unable to add record# ",IEN," from file 22706.9 to file 50.68.",!
|
|---|
| 205 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 206 |
|
|---|
| 207 | do Lock50dot607
|
|---|
| 208 | do Lock50^TMGNDF3C
|
|---|
| 209 |
|
|---|
| 210 | write count," imports added to VA PRODUCT (file 50.68 )",!
|
|---|
| 211 | do PressToCont^TMGUSRIF
|
|---|
| 212 |
|
|---|
| 213 | quit
|
|---|
| 214 |
|
|---|
| 215 |
|
|---|
| 216 | DoSync(SyncList)
|
|---|
| 217 | ;"Purpose: To process the SyncList, doing actual synchronization.
|
|---|
| 218 | ;"Input: SyncList-- PASS BY REFERENCE. Format:
|
|---|
| 219 | ;" SyncList(IEN)=vapIEN ;IEN is from file 22706.9; vapIEN=IEN 50.68
|
|---|
| 220 | ;"Results: none.
|
|---|
| 221 |
|
|---|
| 222 | do Unlock50dot607
|
|---|
| 223 | do Unlock50^TMGNDF3C
|
|---|
| 224 |
|
|---|
| 225 | write "Synchronizing VA PRODUCT file from import information...",!
|
|---|
| 226 | new count set count=0
|
|---|
| 227 | new Itr,IEN,success
|
|---|
| 228 | new abort set abort=0
|
|---|
| 229 | set IEN=$$ItrAInit^TMGITR("SyncList",.Itr)
|
|---|
| 230 | do PrepProgress^TMGITR(.Itr,1,1,"IEN")
|
|---|
| 231 | if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort
|
|---|
| 232 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 233 | . new vapIEN set vapIEN=+$get(SyncList(IEN))
|
|---|
| 234 | . if +vapIEN=0 quit
|
|---|
| 235 | . set success=$$Sync1Rec(IEN,vapIEN)
|
|---|
| 236 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 237 |
|
|---|
| 238 | do Lock50dot607
|
|---|
| 239 | do Lock50^TMGNDF3C
|
|---|
| 240 |
|
|---|
| 241 | do PressToCont^TMGUSRIF
|
|---|
| 242 |
|
|---|
| 243 | quit
|
|---|
| 244 |
|
|---|
| 245 |
|
|---|
| 246 | Add2VAProd(IEN,Quiet,AllowCut)
|
|---|
| 247 | ;"Purpose: to take drug information from Array and use this to create a new entry
|
|---|
| 248 | ;" in file #50.68 (VA PRODUCT)--and any supporting files needed.
|
|---|
| 249 | ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add
|
|---|
| 250 | ;" Quiet -- OPTIONAL -- default = 1 (quiet), if 1 no output generated to console.
|
|---|
| 251 | ;" AllowCut -- OPTIONAL -- default = 0 (no cut).
|
|---|
| 252 | ;" If value=1 then names will be shortened to needed length without
|
|---|
| 253 | ;" asking user for abbreviations etc.
|
|---|
| 254 | ;"Output: A new record will be created in 50.68, and any supporint files (such as
|
|---|
| 255 | ;" drug manufacturer, package type etc if needed)
|
|---|
| 256 | ;"Result: the IEN in 50.68 of added record, 0 if error
|
|---|
| 257 |
|
|---|
| 258 |
|
|---|
| 259 | new TMGFDA,TMGIEN,TMGMSG
|
|---|
| 260 | set IENS="+1,"
|
|---|
| 261 | do SetupFDA(IEN,IENS,.TMGFDA)
|
|---|
| 262 |
|
|---|
| 263 | ALabel
|
|---|
| 264 | do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 265 | if $data(TMGMSG("DIERR")) do goto A2VPDone
|
|---|
| 266 | . set result=0
|
|---|
| 267 | . if Quiet=1 quit
|
|---|
| 268 | . write !,"Error adding new record to 50.68",!
|
|---|
| 269 | . new PriorErrorFound
|
|---|
| 270 | . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 271 |
|
|---|
| 272 | ;"Check that record was added, then then add subfile entries: active ingredients...
|
|---|
| 273 | new AddedIEN set AddedIEN=$get(TMGIEN(1)) ;"also used to create NDC/UPC record;
|
|---|
| 274 | if +AddedIEN=0 do goto A2VPDone
|
|---|
| 275 | . set result=0 if Quiet=1 quit
|
|---|
| 276 | . write !,"Can't find record number of added record to 50.68",!
|
|---|
| 277 | . do PressToCont^TMGUSRIF
|
|---|
| 278 |
|
|---|
| 279 | set result=$$EnsureIngredients(IEN,AddedIEN) if result=0 goto A2VPDone
|
|---|
| 280 |
|
|---|
| 281 | BLabel ;"set result=$$Add2NDC(IEN,.DrugInfo)
|
|---|
| 282 | set result=$$EnsureNDC(IEN) if result=0 goto A2VPDone
|
|---|
| 283 |
|
|---|
| 284 | A2VPDone
|
|---|
| 285 | ;"1=OK to continue, 0 if error
|
|---|
| 286 | if result=1 set result=+$get(AddedIEN)
|
|---|
| 287 | quit result ;"changed to return IEN in 50.68
|
|---|
| 288 |
|
|---|
| 289 |
|
|---|
| 290 | Sync1Rec(IEN,vapIEN)
|
|---|
| 291 | ;"Purpose: to take drug information from Array and use this to create a new entry
|
|---|
| 292 | ;" in file #50.68 (VA PRODUCT)--and any supporting files needed.
|
|---|
| 293 | ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add
|
|---|
| 294 | ;" vapIEN -- IEN in 50.68 that is the target of the synchronization.
|
|---|
| 295 | ;"Output: data in VA PRODUCT will be updated as needed to match the info in
|
|---|
| 296 | ;" file 22706.9
|
|---|
| 297 | ;"Result: 1 if OK, 0 if error
|
|---|
| 298 |
|
|---|
| 299 | new result set result=0
|
|---|
| 300 | new TMGFDA,TMGIEN,TMGMSG
|
|---|
| 301 | set IENS=vapIEN_","
|
|---|
| 302 | do SetupFDA(IEN,IENS,.TMGFDA)
|
|---|
| 303 | new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA)
|
|---|
| 304 |
|
|---|
| 305 | if $data(TMGFDA) do
|
|---|
| 306 | . do FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 307 | . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
|
|---|
| 308 |
|
|---|
| 309 | set result=$$EnsureIngredients(IEN,vapIEN)
|
|---|
| 310 | if result=0 goto S2VPDone
|
|---|
| 311 | set result=$$EnsureNDC(IEN) if result=0 goto S2VPDone
|
|---|
| 312 | S2VPDone
|
|---|
| 313 | quit result ;"changed to return IEN in 50.68
|
|---|
| 314 |
|
|---|
| 315 |
|
|---|
| 316 | SetupFDA(IEN,IENS,TMGFDA,vapIEN)
|
|---|
| 317 | ;"Purpose: to set up FDA for data in a#50.68 (VA PRODUCT) entry
|
|---|
| 318 | ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add
|
|---|
| 319 | ;" IENS -- a standard FM IENS for FDA to use
|
|---|
| 320 | ;" TMGFDA -- PASS BY REFEERNCE. A standard FM FDA
|
|---|
| 321 | ;" vapIEN -- OPTIONAL. If provided, then the FDA wil be trimmed to contain
|
|---|
| 322 | ;" only those fields that need to be changed
|
|---|
| 323 | ;"Output: TMGFDA is filled
|
|---|
| 324 | ;"Result: none
|
|---|
| 325 |
|
|---|
| 326 | ;"NOTE: this function will create an FDA in EXTERNAL form
|
|---|
| 327 |
|
|---|
| 328 | ;"VA PRODUCT FILE RECORD STRUCTURE
|
|---|
| 329 | ;"-----------------------------------
|
|---|
| 330 | ;" .01 NAME [RFa]
|
|---|
| 331 | ;" e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
|
|---|
| 332 | ;" .05 VA GENERIC NAME <-Pntr [P50.6'a]
|
|---|
| 333 | ;" e.g. VA GENERIC NAME: DILTIAZEM
|
|---|
| 334 | ;" 1 DOSAGE FORM <-Pntr [P50.606'a]
|
|---|
| 335 | ;" e.g. DOSAGE FORM: CAP,SA
|
|---|
| 336 | ;" 2 STRENGTH [Fa]
|
|---|
| 337 | ;" e.g. STRENGTH: 240
|
|---|
| 338 | ;" 3 UNITS <-Pntr [P50.607'a]
|
|---|
| 339 | ;" e.g. UNITS: MG
|
|---|
| 340 | ;" 4 NATIONAL FORMULARY NAME [Fa]
|
|---|
| 341 | ;" e.g. NATIONAL FORMULARY NAME: DILTIAZEM CAP,SA
|
|---|
| 342 | ;" 5 VA PRINT NAME [Fa]
|
|---|
| 343 | ;" e.g. VA PRINT NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
|
|---|
| 344 | ;" 6 VA PRODUCT IDENTIFIER [Fa] <--- will use to store "0^TMG ADDED"
|
|---|
| 345 | ;" e.g. VA PRODUCT IDENTIFIER: D0230
|
|---|
| 346 | ;" 8 VA DISPENSE UNIT <-Pntr [P50.64a]
|
|---|
| 347 | ;" e.g. VA DISPENSE UNIT: CAPNSE UNIT <-Pntr [P50.64a] <-- plan to leave blank, for CMOP use
|
|---|
| 348 | ;" 14 ACTIVE INGREDIENTS W:^ D:^ <-Mult [50.6814P]
|
|---|
| 349 | ;" .01 -ACTIVE INGREDIENTS <-Pntr [P50.416'Xa]
|
|---|
| 350 | ;" e.g. ACTIVE INGREDIENTS: DILTIAZEM HYDROCHLORIDE
|
|---|
| 351 | ;" 1 -STRENGTH [Fa]
|
|---|
| 352 | ;" e.g. STRENGTH: 240
|
|---|
| 353 | ;" 2 -UNITS <-Pntr [P50.607'a]
|
|---|
| 354 | ;" e.g. UNITS: MG
|
|---|
| 355 | ;" 15 PRIMARY VA DRUG CLASS <-Pntr [P50.605'a]
|
|---|
| 356 | ;" e.g. PRIMARY VA DRUG CLASS: CV200
|
|---|
| 357 | ;" 16 SECONDARY VA DRUG CLASS W:^ D:^ <-Mult [50.6816P]
|
|---|
| 358 | ;" .01 -SECONDARY VA DRUG CLASS <-Pntr [MP50.605'aX]
|
|---|
| 359 | ;" 17 NATIONAL FORMULARY INDICATOR [Sa]
|
|---|
| 360 | ;" e.g. NATIONAL FORMULARY INDICATOR: NO
|
|---|
| 361 | ;" 18 NATIONAL FORMULARY RESTRICTIONW:^ D:^ <-WP [50.6818]
|
|---|
| 362 | ;" .01 -NATIONAL FORMULARY RESTRICTION [W]
|
|---|
| 363 | ;" 19 CS FEDERAL SCHEDULE [Sa]
|
|---|
| 364 | ;" 20 SINGLE/MULTI SOURCE PRODUCT [Sa]
|
|---|
| 365 | ;" 21 INACTIVATION DATE [Da]
|
|---|
| 366 | ;" 23 EXCLUDE DRG-DRG INTERACTION CK [S]
|
|---|
| 367 | ;" 25 MAX SINGLE DOSE [NJ13,4a]
|
|---|
| 368 | ;" 26 MIN SINGLE DOSE [NJ13,4a]
|
|---|
| 369 | ;" 27 MAX DAILY DOSE [NJ13,4a]
|
|---|
| 370 | ;" 28 MIN DAILY DOSE [NJ13,4a]
|
|---|
| 371 | ;" 29 MAX CUMULATIVE DOSE [NJ13,4a]
|
|---|
| 372 | ;" 30 DSS NUMBER [NJ6,0a]
|
|---|
| 373 |
|
|---|
| 374 | ;"---------------------------------------------------------
|
|---|
| 375 |
|
|---|
| 376 |
|
|---|
| 377 | ;"File: TMG FDA IMPORT COMPILED Branch: 1
|
|---|
| 378 | ;"REF NODE;PIECE FLD NUM FIELD NAME
|
|---|
| 379 | ;"===============================================================================
|
|---|
| 380 | ;" 1 0;1 .01 TMG FDA LISTING ENTRY <-Pntr [RP22706.5']
|
|---|
| 381 | ;" e.g. TMG FDA LISTING ENTRY: 154001
|
|---|
| 382 | ;" 2 0;4 .05 TRADENAME [F]
|
|---|
| 383 | ;" e.g. TRADENAME: DILTIAZEM HCL SR CAPSULES
|
|---|
| 384 | ;" 3 0;6 .07 GENERIC NAME [F]
|
|---|
| 385 | ;" 4 1;3 .08 VA GENERIC <-Pntr [P50.6']
|
|---|
| 386 | ;" 5 1;5 .09 VA DRUG CLASS <-Pntr [P50.605']
|
|---|
| 387 | ;" 6 0;2 1 STRENGTH [F]
|
|---|
| 388 | ;" e.g. STRENGTH: 240
|
|---|
| 389 | ;" 7 0;3 2 UNIT [F]
|
|---|
| 390 | ;" e.g. UNIT: MG
|
|---|
| 391 | ;" 8 0;5 3 ROUTE [F]
|
|---|
| 392 | ;" e.g. ???
|
|---|
| 393 | ;" 9 0;7 3.5 DOSAGE FORM <-Pntr [P50.606]
|
|---|
| 394 | ;" 9 1;1 4 NDC [F]
|
|---|
| 395 | ;" e.g. NDC: 053978-3062-*3
|
|---|
| 396 | ;" 10 1;2 5 NDC 12-DIGIT [F]
|
|---|
| 397 | ;" e.g. NDC: 0539783062*3
|
|---|
| 398 | ;" 11 1;4 6 SKIP THIS RECORD [S]
|
|---|
| 399 | ;" 12 1;7 7 DONE ADDING TO 50.68 [S]
|
|---|
| 400 | ;" 2;0 14 VA PRODUCT MATCHES <-Mult [22706.914P]
|
|---|
| 401 | ;" 13 -0;1 .01 -ONE MATCH <-Pntr [P50.68']
|
|---|
| 402 | ;" e.g. ONE MATCH: DILTIAZEM (DILACOR XR) 240MG SA CAP
|
|---|
| 403 | ;" e.g. ONE MATCH: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
|
|---|
| 404 | ;" e.g. ONE MATCH: DILTIAZEM (TIAZAC) 240MG SA CAP
|
|---|
| 405 | ;" e.g. ONE MATCH: DILTIAZEM (WATSON-XR) 240MG SA CAP
|
|---|
| 406 | ;" e.g. ONE MATCH: DILTIAZEM (TIAZAC) 240MG SA CAP,UD
|
|---|
| 407 | ;" e.g. ONE MATCH: DILTIAZEM (CARDIZEM CD) 240MG SA CAP,UD
|
|---|
| 408 | ;" 3;0 15 VA PRODUCT POSS MATCH <-Mult [22706.915P]
|
|---|
| 409 | ;" 14 -0;1 .01 -POSS MATCH <-Pntr [P50.68']
|
|---|
| 410 | ;" 4;0 16 INGREDIENTS <-Mult [22706.916]
|
|---|
| 411 | ;" 15 -0;1 .01 -NUMBER [NJ3,0]
|
|---|
| 412 | ;" e.g. NUMBER: 1
|
|---|
| 413 | ;" 17 -0;3 2 -INGREDIENT <-Pntr [P50.416']
|
|---|
| 414 | ;" e.g. INGREDIENT: DILTIAZEM HYDROCHLORIDE
|
|---|
| 415 | ;" 18 -0;4 3 -STRENGTH [F]
|
|---|
| 416 | ;" e.g. STRENGTH: 240
|
|---|
| 417 | ;" 19 -0;6 5 -UNIT <-Pntr [P50.607']
|
|---|
| 418 | ;" e.g. ???
|
|---|
| 419 | ;"
|
|---|
| 420 | ;"===============================================================================
|
|---|
| 421 | ;"<> 'n',I=FldDD DA=Data F=Find G=Goto N=Node P=Pointer VGL=VGL ?=Help
|
|---|
| 422 | ;"
|
|---|
| 423 |
|
|---|
| 424 | ;"new FDAitemNum
|
|---|
| 425 | ;"set FDAitemNum=$$GET1^DIQ(22706.9,IEN,.01)
|
|---|
| 426 | ;"new DrugInfo
|
|---|
| 427 | ;"set result=$$GetDrugInfo^TMGNDF1A(FDAitemNum,.DrugInfo,"",1)
|
|---|
| 428 | ;"if result=0 do goto A2VPDone
|
|---|
| 429 | ;". if Quiet=1 quit
|
|---|
| 430 | ;". write !,"Unable to Get Drug Info for record: ",FDAitemNum,!
|
|---|
| 431 |
|
|---|
| 432 | ;".01 NAME [RFa]
|
|---|
| 433 | ;" e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
|
|---|
| 434 | set tempS=$piece($get(^TMG(22706.9,IEN,7)),"^",6) ;"7;6= field .04 LONG NAME
|
|---|
| 435 | set TMGFDA(50.68,IENS,.01)=tempS ;".01 NAME [RFa] ;e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
|
|---|
| 436 | ;"set DrugInfo("ADDED","GENERIC+BRAND")=tempS
|
|---|
| 437 |
|
|---|
| 438 | ;".05 VA GENERIC NAME <-Pntr [P50.6'a]
|
|---|
| 439 | ;" e.g. VA GENERIC NAME: DILTIAZEM
|
|---|
| 440 | set TMGFDA(50.68,IENS,.05)=$$GET1^DIQ(22706.9,IEN,.08)
|
|---|
| 441 |
|
|---|
| 442 | ;"1 DOSAGE FORM <-Pntr [P50.606'a]
|
|---|
| 443 | ;" e.g. DOSAGE FORM: CAP,SA
|
|---|
| 444 | set TMGFDA(50.68,IENS,1)=$$GET1^DIQ(22706.9,IEN,3.5)
|
|---|
| 445 |
|
|---|
| 446 | ;"2 STRENGTH [Fa]
|
|---|
| 447 | ;" e.g. STRENGTH: 240
|
|---|
| 448 | set TMGFDA(50.68,IENS,2)=$$GET1^DIQ(22706.9,IEN,1)
|
|---|
| 449 |
|
|---|
| 450 | ;"3 UNITS <-Pntr [P50.607'a]
|
|---|
| 451 | ;" e.g. UNITS: MG
|
|---|
| 452 | new tempUnits set tempUnits=$$GET1^DIQ(22706.9,IEN,2)
|
|---|
| 453 | if tempUnits'="" do
|
|---|
| 454 | . do EnsureUnits(tempUnits)
|
|---|
| 455 | . set TMGFDA(50.68,IENS,3)=tempUnits
|
|---|
| 456 |
|
|---|
| 457 | ;"5 VA PRINT NAME [Fa]
|
|---|
| 458 | ;" e.g. VA PRINT NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP
|
|---|
| 459 | ;"set tempS=$$MakeName(IEN,40,AllowCut)
|
|---|
| 460 | ;"if tempS="^" set result=0 goto A2VPDone
|
|---|
| 461 | set tempS=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;"7;3 = .055 TRADEBANE - 40
|
|---|
| 462 | set TMGFDA(50.68,IENS,5)=tempS ;" 5=VA PRINT NAME
|
|---|
| 463 |
|
|---|
| 464 | ;"6 VA PRODUCT IDENTIFIER [Fa] <--- will use to store "0;TMG"
|
|---|
| 465 | ;" e.g. VA PRODUCT IDENTIFIER: D0230
|
|---|
| 466 | set TMGFDA(50.68,IENS,6)="0;TMG"
|
|---|
| 467 |
|
|---|
| 468 | ;"14 ACTIVE INGREDIENTS W:^ D:^ <-Mult [50.6814P]
|
|---|
| 469 | ;"(multiple/subfile, add after this record added)
|
|---|
| 470 |
|
|---|
| 471 | ;"15 PRIMARY VA DRUG CLASS <-Pntr [P50.605'a]
|
|---|
| 472 | ;" e.g. PRIMARY VA DRUG CLASS: CV200
|
|---|
| 473 | set TMGFDA(50.68,IENS,15)=$$GET1^DIQ(22706.9,IEN,.09)
|
|---|
| 474 |
|
|---|
| 475 | quit
|
|---|
| 476 |
|
|---|
| 477 |
|
|---|
| 478 | EnsureIngredients(fdaIEN,vapIEN)
|
|---|
| 479 | ;"Purpose: to ensure that all the ingredients from the FDA record (22706.9) are in the
|
|---|
| 480 | ;" VA PRODUCT record (50.68)
|
|---|
| 481 | ;"Input: fdaIEN -- the IEN from 22706.9
|
|---|
| 482 | ;" vapIEN -- the target IEN in 50.68
|
|---|
| 483 | ;"result: 1= OK to continue, 0=error
|
|---|
| 484 |
|
|---|
| 485 | new result set result=1 ;"default to success
|
|---|
| 486 | new recNum set recNum=1
|
|---|
| 487 | ;"new IENS set IENS=fdaIEN_","
|
|---|
| 488 | new IENS set IENS=vapIEN_","
|
|---|
| 489 | new TMGFDA,TMGMSG,TMGIEN
|
|---|
| 490 |
|
|---|
| 491 | new subIEN set subIEN=0 ;"INGREDIENTS
|
|---|
| 492 | for set subIEN=+$order(^TMG(22706.9,fdaIEN,4,subIEN)) quit:(+subIEN'>0) do
|
|---|
| 493 | . new node set node=$get(^TMG(22706.9,fdaIEN,4,subIEN,0))
|
|---|
| 494 | . new pIngredients,strength,units
|
|---|
| 495 | . set pIngredients=$piece(node,"^",3) ;"INGREDIENTS (a POINTER)
|
|---|
| 496 | . set strength=$piece(node,"^",4) ;"STRENGTH
|
|---|
| 497 | . set units=$piece(node,"^",6) ;"UNITS
|
|---|
| 498 | . ;"First search to ensure ingredient is not already present.
|
|---|
| 499 | . new subIEN2 set subIEN2=0
|
|---|
| 500 | . new found set found=0
|
|---|
| 501 | . for set subIEN2=$order(^PSNDF(50.68,vapIEN,2,subIEN2)) quit:(+subIEN2'>0)!found do
|
|---|
| 502 | . . new ptr set ptr=$piece($get(^PSNDF(50.68,vapIEN,2,subIEN2,0)),"^",1)
|
|---|
| 503 | . . if ptr=pIngredients set found=1
|
|---|
| 504 | . if found=1 quit
|
|---|
| 505 | . if pIngredients="" do quit
|
|---|
| 506 | . . write !,"Ingredient entry is missing actual ingredient, so that subpart was DELETED.",!
|
|---|
| 507 | . . new TMGFDA,TMGMSG
|
|---|
| 508 | . . set TMGFDA(22706.916,subIEN_","_fdaIEN_",",.01)="@" ;"delete entry.
|
|---|
| 509 | . . do FILE^DIE("E","TMGFDA","TMGMSG")
|
|---|
| 510 | . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 511 | . set TMGFDA(50.6814,"+"_recNum_","_IENS,.01)=pIngredients
|
|---|
| 512 | . if strength'="" set TMGFDA(50.6814,"+"_recNum_","_IENS,1)=strength
|
|---|
| 513 | . if units'="" set TMGFDA(50.6814,"+"_recNum_","_IENS,2)=units
|
|---|
| 514 | . set recNum=recNum+1
|
|---|
| 515 |
|
|---|
| 516 | if $data(TMGFDA)=0 goto EIDone
|
|---|
| 517 | do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 518 | if $data(TMGMSG("DIERR")) do goto A2VPDone
|
|---|
| 519 | . set result=0 if $get(Quiet)=1 quit
|
|---|
| 520 | . write !,"Error adding ingredients subrecord. IEN in 22706.9=",fdaIEN,!
|
|---|
| 521 | . new PriorErrorFound
|
|---|
| 522 | . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 523 | EIDone
|
|---|
| 524 | quit result
|
|---|
| 525 |
|
|---|
| 526 |
|
|---|
| 527 | EnsureNDC(IEN)
|
|---|
| 528 | ;"Purpose: Ensure record exists in NDC/UPN file (50.67).
|
|---|
| 529 | ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add from
|
|---|
| 530 | ;"Output: An entry to be added to file 50.67
|
|---|
| 531 | ;"Result: 1=OK to continue, 0 if error
|
|---|
| 532 |
|
|---|
| 533 | ;"Make record in NDC/UPN file (50.67).
|
|---|
| 534 | ;"File: NDC/UPN Branch: 1
|
|---|
| 535 | ;"REF NODE;PIECE FLD NUM FIELD NAME
|
|---|
| 536 | ;"===============================================================================
|
|---|
| 537 | ;" 1 0;1 .01 SEQUENCE NUMBER [RNJ9,0aX]
|
|---|
| 538 | ;" 2 0;2 1 NDC [Fa]
|
|---|
| 539 | ;" 3 0;3 2 UPN [Fa]
|
|---|
| 540 | ;" 4 0;4 3 MANUFACTURER <-Pntr [P55.95'a]
|
|---|
| 541 | ;" 5 0;5 4 TRADE NAME [Fa]
|
|---|
| 542 | ;" 6 0;6 5 VA PRODUCT NAME <-Pntr [P50.68'a]
|
|---|
| 543 | ;" 1;0 6 ROUTE OF ADMINISTRATION W:^ D:^ <-Mult [50.676A]
|
|---|
| 544 | ;" 7 -0;1 .01 -ROUTE OF ADMINISTRATION [FaX]
|
|---|
| 545 | ;" 8 0;7 7 INACTIVATION DATE [Da]
|
|---|
| 546 | ;" 9 0;8 8 PACKAGE SIZE <-Pntr [P50.609'a]
|
|---|
| 547 | ;" 10 0;9 9 PACKAGE TYPE <-Pntr [P50.608'a]
|
|---|
| 548 | ;" 11 0;10 10 OTX/RX INDICATOR [Sa]
|
|---|
| 549 | ;" 2;0 11 PREVIOUS NDC W:^ D:^ <-Mult [50.6711A]
|
|---|
| 550 | ;" 12 -0;1 .01 -PREVIOUS NDC [Fa]
|
|---|
| 551 | ;" 3;0 12 PREVIOUS UPN W:^ D:^ <-Mult [50.6712A]
|
|---|
| 552 | ;" 13 -0;1 .01 -PREVIOUS UPN [Fa]
|
|---|
| 553 | ;" <> <> <>
|
|---|
| 554 |
|
|---|
| 555 | new result set result=0 ;" default to failure
|
|---|
| 556 |
|
|---|
| 557 | new TMGFDA,TMGMSG,TMGIEN
|
|---|
| 558 |
|
|---|
| 559 | new NDC set NDC=$piece($get(^TMG(22706.9,IEN,1)),"^",2) ;"1;2= field 5, NDC 12 digit
|
|---|
| 560 | new ndcIEN set ndcIEN=$order(^PSNDF(50.67,"NDC",NDC,""))
|
|---|
| 561 | if +ndcIEN>0 set IENS=ndcIEN_"," goto EN1
|
|---|
| 562 |
|
|---|
| 563 | ;"Below is for NEW records. DINUM at play here...
|
|---|
| 564 | new newIEN set newIEN=""
|
|---|
| 565 | for set newIEN=$order(^PSNDF(50.67,newIEN),-1) quit:(+newIEN=newIEN)!(newIEN="")
|
|---|
| 566 | if +newIEN=0 do write "Unable to create NDF entry for ",IEN,! goto ENDone
|
|---|
| 567 | set newIEN=newIEN+1
|
|---|
| 568 | set TMGFDA(50.67,IENS,.01)=newIEN ;" .01 SEQUENCE NUMBER
|
|---|
| 569 | set IENS="+1,"
|
|---|
| 570 |
|
|---|
| 571 | EN1 if NDC'="" set TMGFDA(50.67,IENS,1)=NDC ;"1=NDC
|
|---|
| 572 |
|
|---|
| 573 | ;"**Must add manufacturer if to be used!
|
|---|
| 574 | ;" 3 MANUFACTURER <-Pntr [P55.95'a]
|
|---|
| 575 | ;"new Firm set Firm=$get(DrugInfo("FIRM","NAME"))
|
|---|
| 576 | ;"if Firm'="" set TMGFDA(50.67,IENS,3)=Firm
|
|---|
| 577 |
|
|---|
| 578 | new tName set tName=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;"7;3 = TRADE NAME - 40
|
|---|
| 579 | if tName'="" set TMGFDA(50.67,IENS,4)=tName ;" 4 TRADE NAME
|
|---|
| 580 |
|
|---|
| 581 | new vapIEN set vapIEN=+$piece($get(^TMG(22706.9,IEN,6)),"^",2) ;"6;2=field 5.5, VA PRODUCT LINK
|
|---|
| 582 | if vapIEN>0 set TMGFDA(50.67,IENS,5)=vapIEN;" 5 VA PRODUCT NAME --pointer to newly added 50.68 record
|
|---|
| 583 |
|
|---|
| 584 | ;" 10 OTX/RX INDICATOR
|
|---|
| 585 | new codeOTC set codeOTC=$piece($get(^TMG(22706.9,IEN,7)),"^",5) ;"7;5= field 7, RX or OTC
|
|---|
| 586 | if codeOTC'="" set TMGFDA(50.67,IENS,10)=codeOTC
|
|---|
| 587 |
|
|---|
| 588 | ;"If I decide to add this, must do it after adding parent record.
|
|---|
| 589 | ;" 1;0 6 ROUTE OF ADMINISTRATION W:^ D:^ <-Mult [50.676A]
|
|---|
| 590 | ;" 7 -0;1 .01 -ROUTE OF ADMINISTRATION [FaX]
|
|---|
| 591 |
|
|---|
| 592 | if IENS'["+" do goto EN2 ;"update existing record
|
|---|
| 593 | . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA)
|
|---|
| 594 | . if $data(TMGFDA)=0 quit
|
|---|
| 595 | . do FILE^DIE("K","TMGFDA","TMGMSG") ;"FDA is in INTERNAL format
|
|---|
| 596 |
|
|---|
| 597 | else do ;"add new record
|
|---|
| 598 | . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 599 | EN2
|
|---|
| 600 | if $data(TMGMSG("DIERR")) do goto ENDone
|
|---|
| 601 | . set result=0
|
|---|
| 602 | . new PriorErrorFound
|
|---|
| 603 | . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 604 |
|
|---|
| 605 | set result=1 ;"ensure we are at success.
|
|---|
| 606 |
|
|---|
| 607 | ENDone
|
|---|
| 608 | quit result
|
|---|
| 609 |
|
|---|
| 610 |
|
|---|
| 611 | ;"==========================================================
|
|---|
| 612 | ;"==========================================================
|
|---|
| 613 | EnsureUnits(UnitS)
|
|---|
| 614 | ;"Purpose: to ensure that the UnitS is valid in file 50.607
|
|---|
| 615 | ;"Input: UnitS -- the string such as "mg;mg"
|
|---|
| 616 | ;"Output: If UnitS is not found in 50.607, then it will be added
|
|---|
| 617 | ;"Results: none
|
|---|
| 618 |
|
|---|
| 619 | new TMGROOT,TMGMSG
|
|---|
| 620 |
|
|---|
| 621 | ;"Finish later...
|
|---|
| 622 |
|
|---|
| 623 | ;"do FIND^DIC(50.607,"","","",UnitS,"*",,,,"TMGROOT","TMGMSG")
|
|---|
| 624 | ;"if +$get(TMGROOT("DILIST",0))=1 goto EUDone
|
|---|
| 625 | ;"goto EUDone
|
|---|
| 626 |
|
|---|
| 627 | ;"Note: if there are duplicate entries (i.e. 2 entries for MG/0.5ML), then Y=-1
|
|---|
| 628 | new X,Y,DIC
|
|---|
| 629 | set DIC=50.607
|
|---|
| 630 | set DIC(0)="XML"
|
|---|
| 631 | set X=UnitS
|
|---|
| 632 | do ^DIC
|
|---|
| 633 | if +Y'>0 do
|
|---|
| 634 | . if $get(Quiet)=1 quit
|
|---|
| 635 | . write !,"Can't find or add: ",UnitS,!
|
|---|
| 636 |
|
|---|
| 637 | EUDone
|
|---|
| 638 | quit
|
|---|
| 639 |
|
|---|
| 640 | Unlock50dot607
|
|---|
| 641 | ;"Purpose to allow deletion in file 50.607
|
|---|
| 642 |
|
|---|
| 643 | kill ^DD(50.607,.01,8.5)
|
|---|
| 644 | kill ^DD(50.607,.01,9)
|
|---|
| 645 |
|
|---|
| 646 | quit
|
|---|
| 647 |
|
|---|
| 648 | Lock50dot607
|
|---|
| 649 | ;"Purpose: to restore lock on file 50.607
|
|---|
| 650 |
|
|---|
| 651 | set ^DD(50.607,.01,8.5)="^"
|
|---|
| 652 | set ^DD(50.607,.01,9)="^"
|
|---|
| 653 |
|
|---|
| 654 | quit
|
|---|
| 655 |
|
|---|
| 656 | Link2VAP
|
|---|
| 657 | ;"Purpose: to fill file 22706.9, field 5.5 in with link to a record
|
|---|
| 658 | ;" in VA PRODUCT file (50.68) that has the SAME national drug
|
|---|
| 659 | ;" code (NDC). It checks for and handles situations where there
|
|---|
| 660 | ;" are multiple entries in 50.68 with the same NDC. It picks
|
|---|
| 661 | ;" the entry with the closest name as the one to use.
|
|---|
| 662 | ;" --It also removes such a link from the VA PRODUCT SIMILAR MATCHES
|
|---|
| 663 | ;" field. I.e. it is not a 'similar' match if it is an exact match.
|
|---|
| 664 | ;" --It also removes such a link from the VA PRODUCT POSSIBLE MATCHES
|
|---|
| 665 | ;" field. I.e. it is not a 'possible' match if it is an exact match.
|
|---|
| 666 | ;"Results: none.
|
|---|
| 667 |
|
|---|
| 668 | ;"new pNDCIndex
|
|---|
| 669 | ;"set pNDCIndex=$name(^TMG("TMP","INDEX NDC-->VAP"))
|
|---|
| 670 | set pNDCIndex=$name(^PSNDF(50.67,"NDC"))
|
|---|
| 671 |
|
|---|
| 672 | new Itr,IEN,success
|
|---|
| 673 | new abort set abort=0
|
|---|
| 674 | new modCount set modCount=0
|
|---|
| 675 | set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
|
|---|
| 676 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 677 | if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
|
|---|
| 678 | . if $$UserAborted^TMGUSRIF set abort=1 quit
|
|---|
| 679 | . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP THIS RECORD
|
|---|
| 680 | . new NDC set NDC=$piece($get(^TMG(22706.9,IEN,1)),"^",2)
|
|---|
| 681 | . if NDC="" quit ;"Can't link if no NDC. Fix later?
|
|---|
| 682 | . new count set count=$$ListCt^TMGMISC($name(@pNDCIndex@(NDC)))
|
|---|
| 683 | . new VAP set VAP=0
|
|---|
| 684 | . if count=1 do
|
|---|
| 685 | . . new ndcP1
|
|---|
| 686 | . . set ndcP1=+$order(@pNDCIndex@(NDC,""))
|
|---|
| 687 | . . set VAP=+$piece($get(^PSNDF(50.67,ndcP1,0)),"^",6)
|
|---|
| 688 | . else do
|
|---|
| 689 | . . new vap1,s1,fdaS,ndcP1
|
|---|
| 690 | . . new bestScore set bestScore=0
|
|---|
| 691 | . . new bestVAP set bestVAP=0
|
|---|
| 692 | . . new bestS set bestS=""
|
|---|
| 693 | . . set fdaS=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"TradeName, field .05
|
|---|
| 694 | . . set ndcP1=+$order(@pNDCIndex@(NDC,""))
|
|---|
| 695 | . . for do set ndcP1=+$order(@pNDCIndex@(NDC,ndcP1)) quit:(+ndcP1'>0)
|
|---|
| 696 | . . . set vap1=+$piece($get(^PSNDF(50.67,ndcP1,0)),"^",6)
|
|---|
| 697 | . . . set s1=$piece($get(^PSNDF(50.68,vap1,0)),"^",1)
|
|---|
| 698 | . . . new tempScore set tempScore=$$Comp2Strs^TMGSTUTL(fdaS,s1)
|
|---|
| 699 | . . . if tempScore>bestScore set bestScore=tempScore,bestVAP=vap1,bestS=s1
|
|---|
| 700 | . . if bestScore'>1 set bestVAP=0
|
|---|
| 701 | . . set VAP=bestVAP
|
|---|
| 702 | . if VAP=0 quit
|
|---|
| 703 | . if $piece($get(^TMG(22706.9,IEN,6)),"^",2)'=VAP do
|
|---|
| 704 | . . new TMGFDA,TMGMSG
|
|---|
| 705 | . . set TMGFDA(22706.9,IEN_",",5.5)=VAP
|
|---|
| 706 | . . do FILE^DIE("K","TMGFDA","TMGMSG")
|
|---|
| 707 | . . do ShowIfDIERR^TMGDEBUG("TMGMSG")
|
|---|
| 708 | . . set modCount=modCount+1
|
|---|
| 709 | . new subIEN set subIEN=0
|
|---|
| 710 | . for set subIEN=$order(^TMG(22706.9,IEN,2,subIEN)) quit:(+subIEN'>0) do
|
|---|
| 711 | . . new nearVAP set nearVAP=$piece($get(^TMG(22706.9,IEN,2,subIEN,0)),"^",1)
|
|---|
| 712 | . . if nearVAP'=VAP quit
|
|---|
| 713 | . . ;"write "SIMILAR MATCH contains this link. Deleting...",!
|
|---|
| 714 | . . new TMGFDA,TMGMSG
|
|---|
| 715 | . . set TMGFDA(22706.914,subIEN_","_IEN_",",.01)="@"
|
|---|
| 716 | . . do FILE^DIE("K","TMGFDA","TMGMSG")
|
|---|
| 717 | . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
|
|---|
| 718 | . . set modCount=modCount+1
|
|---|
| 719 | . for set subIEN=$order(^TMG(22706.9,IEN,3,subIEN)) quit:(+subIEN'>0) do
|
|---|
| 720 | . . new nearVAP set nearVAP=$piece($get(^TMG(22706.9,IEN,3,subIEN,0)),"^",1)
|
|---|
| 721 | . . if nearVAP'=VAP quit
|
|---|
| 722 | . . ;"write "POSS SIMILAR MATCH contains this link. Deleting...",!
|
|---|
| 723 | . . new TMGFDA,TMGMSG
|
|---|
| 724 | . . set TMGFDA(22706.915,subIEN_","_IEN_",",.01)="@"
|
|---|
| 725 | . . do FILE^DIE("K","TMGFDA","TMGMSG")
|
|---|
| 726 | . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
|
|---|
| 727 | . . set modCount=modCount+1
|
|---|
| 728 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 729 |
|
|---|
| 730 | write modCount," modifications made.",!
|
|---|
| 731 | do PressToCont^TMGUSRIF
|
|---|
| 732 | quit
|
|---|
| 733 |
|
|---|
