| [796] | 1 | TMGNDF2E ;TMG/kst/FDA Import: Fix ingredients IEN linkages ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;11/21/06
|
|---|
| 3 |
|
|---|
| 4 | ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
|
|---|
| 5 | ;" Further processing, after functions in TMGNDF2D
|
|---|
| 6 | ;" Fixing ingredients IEN linkages
|
|---|
| 7 | ;"Kevin Toppenberg MD
|
|---|
| 8 | ;"GNU General Public License (GPL) applies
|
|---|
| 9 | ;"11-21-2006
|
|---|
| 10 |
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 | ;" API -- Public Functions.
|
|---|
| 13 | ;"=======================================================================
|
|---|
| 14 | ;"Menu
|
|---|
| 15 | ;"=======================================================================
|
|---|
| 16 | ;"FixMissing -- Find and fix missing ingredient IEN's in TMG FDA IMPORT COMPILED
|
|---|
| 17 |
|
|---|
| 18 | ;"=======================================================================
|
|---|
| 19 | ;" Private Functions.
|
|---|
| 20 | ;"=======================================================================
|
|---|
| 21 | ;"FindMissing(Array)
|
|---|
| 22 | ;"EasyFix(Array) ;handle the easy fixes from Array (created by FindMissing)
|
|---|
| 23 | ;"HardFix(Array) ;handle the more difficult fixes from Array (created by FindMissing)
|
|---|
| 24 | ;"GetRxIEN(RxName,pDrugInfo) ;get the IEN of the given drug name
|
|---|
| 25 |
|
|---|
| 26 | ;"BatchNDCFix -- Scan TMG FDA IMPORT COMPILED file, and fix NDC codes
|
|---|
| 27 | ;"NewNDC(NDC) -- convert an NDC code with invalid formatting into one acceptible to VistA
|
|---|
| 28 |
|
|---|
| 29 |
|
|---|
| 30 | ;"=======================================================================
|
|---|
| 31 | ;"=======================================================================
|
|---|
| 32 |
|
|---|
| 33 | ;"Notes: I have discovered, when I went to actually add entries from
|
|---|
| 34 | ;" TMG NDF IMPORT COMPILED into VA PRODUCT, that many of the ingredients
|
|---|
| 35 | ;" did not have appropriate links to a VA drug. I am not sure how this
|
|---|
| 36 | ;" happened. Perhaps the drugs had not been added at the time that the
|
|---|
| 37 | ;" compiled entry was create? Perhaps it was drug ingredient that I
|
|---|
| 38 | ;" chose to skip? Anyway, the purpose of this code is to fix this problem.
|
|---|
| 39 | ;" And since I don't know at which step the problem occured, and I am
|
|---|
| 40 | ;" unwilling to put the HOURS of classification work in again if I were
|
|---|
| 41 | ;" to start over, I will just fix the problem at this step of the process.
|
|---|
| 42 |
|
|---|
| 43 | ;"=======================================================================
|
|---|
| 44 |
|
|---|
| 45 | Menu
|
|---|
| 46 | ;"Purpose: Provide menu to entry points of main routines
|
|---|
| 47 |
|
|---|
| 48 | set XUMF=1 ;"secret programmer's key
|
|---|
| 49 | do Unlock50d416
|
|---|
| 50 | new Menu,UsrSlct
|
|---|
| 51 | set Menu(0)="Pick Option for Fixing Missing Ingredients (2E)"
|
|---|
| 52 | set Menu(1)="Fix UNMATCHED ingredients in import."_$char(9)_"FixMissing"
|
|---|
| 53 | set Menu(2)="Fix MISSING ingredients in import."_$char(9)_"FixMissing2"
|
|---|
| 54 | set Menu("P")="Prev Stage"_$char(9)_"Prev"
|
|---|
| 55 | set Menu("N")="Next Stage"_$char(9)_"Next"
|
|---|
| 56 |
|
|---|
| 57 | MC1 write #
|
|---|
| 58 | set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
|
|---|
| 59 | if UsrSlct="^" goto MCDone
|
|---|
| 60 | if UsrSlct=0 set UsrSlct=""
|
|---|
| 61 |
|
|---|
| 62 | if UsrSlct="FixMissing" do FixMissing goto MC1
|
|---|
| 63 | if UsrSlct="FixMissing2" do FixMissing^TMGNDF2F goto MC1
|
|---|
| 64 | if UsrSlct="Prev" goto Menu^TMGNDF2C ;"quit can occur from there...
|
|---|
| 65 | if UsrSlct="Next" goto Menu^TMGNDF2G ;"quit can occur from there...
|
|---|
| 66 | goto MC1
|
|---|
| 67 |
|
|---|
| 68 | MCDone
|
|---|
| 69 | do Lock50d416
|
|---|
| 70 | quit
|
|---|
| 71 |
|
|---|
| 72 |
|
|---|
| 73 |
|
|---|
| 74 | FixMissing
|
|---|
| 75 | ;"Purpose: To find and fix missing ingredient IEN's in TMG FDA IMPORT COMPILED
|
|---|
| 76 |
|
|---|
| 77 | new Array
|
|---|
| 78 | write "Gathering missing ingredient link entries...",!
|
|---|
| 79 | do FindMissing(.Array)
|
|---|
| 80 | if $data(Array)=0 do goto FMDone
|
|---|
| 81 | . write !,"No missing entries. Great!",!
|
|---|
| 82 | write "Fixing easy problems...",!
|
|---|
| 83 | do EasyFix(.Array)
|
|---|
| 84 | write "Now to fix the more difficult problems...",!
|
|---|
| 85 | do HardFix(.Array)
|
|---|
| 86 |
|
|---|
| 87 | FMDone
|
|---|
| 88 | write "Done. Goodbye...",!
|
|---|
| 89 | do PressToCont^TMGUSRIF
|
|---|
| 90 | quit
|
|---|
| 91 |
|
|---|
| 92 |
|
|---|
| 93 |
|
|---|
| 94 | FindMissing(Array)
|
|---|
| 95 | ;"Purpose: to scan TMG FDA IMPORT COMPILED and find ingredients that
|
|---|
| 96 | ;" don't have a linkage to a VA drug.
|
|---|
| 97 | ;"Input: Array -- PASS BY REFERENCE, it is an OUT PARAMETER. Format below
|
|---|
| 98 | ;" prior entries in array are NOT KILLED.
|
|---|
| 99 | ;"Output: Array is filled as follows:
|
|---|
| 100 | ;" Array(IEN,subIEN)=UnmatchedIngredientName
|
|---|
| 101 | ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
|
|---|
| 102 | ;" Array(IEN,subIEN)=UnmatchedIngredientName
|
|---|
| 103 | ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
|
|---|
| 104 | ;"Results: none.
|
|---|
| 105 |
|
|---|
| 106 | new Itr,IEN
|
|---|
| 107 | set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
|
|---|
| 108 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 109 | if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)
|
|---|
| 110 | . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;" 1=SKIP
|
|---|
| 111 | . new subIEN set subIEN=0
|
|---|
| 112 | . for set subIEN=+$order(^TMG(22706.9,IEN,4,subIEN)) quit:(+subIEN'>0) do
|
|---|
| 113 | . . new node set node=$get(^TMG(22706.9,IEN,4,subIEN,0))
|
|---|
| 114 | . . new ingredients set ingredients=$piece(node,"^",3) ;"INGREDIENTS
|
|---|
| 115 | . . if ingredients="" do
|
|---|
| 116 | . . . new FDAitemNum
|
|---|
| 117 | . . . set FDAitemNum=$piece($get(^TMG(22706.9,IEN,0)),"^",1)
|
|---|
| 118 | . . . new DrugInfo
|
|---|
| 119 | . . . new result
|
|---|
| 120 | . . . set result=$$GetDrugInfo^TMGNDF1A(FDAitemNum,.DrugInfo,"",1)
|
|---|
| 121 | . . . if result=0 do quit
|
|---|
| 122 | . . . . write "Unable to get drug info for entry: ",FDAitemNum,!
|
|---|
| 123 | . . . new ingrName,ingrIEN
|
|---|
| 124 | . . . set ingrName=$get(DrugInfo("FORMULATION",subIEN,"INGREDIENT NAME"))
|
|---|
| 125 | . . . set ingrIEN=$get(DrugInfo("FORMULATION",subIEN,"INGREDIENT NAME","FILE 50.416 IEN"))
|
|---|
| 126 | . . . set Array(IEN,subIEN)=ingrName
|
|---|
| 127 | . . . set Array(IEN,subIEN,"FILE 50.416 IEN")=ingrIEN
|
|---|
| 128 | . . . merge Array(IEN,subIEN,"INFO")=DrugInfo
|
|---|
| 129 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 130 |
|
|---|
| 131 | quit
|
|---|
| 132 |
|
|---|
| 133 |
|
|---|
| 134 | EasyFix(Array)
|
|---|
| 135 | ;"Purpose: to handle the easy fixes from Array (created by FindMissing)
|
|---|
| 136 | ;"Input: Array -- array as cread by FindMissing()
|
|---|
| 137 | ;" Array(IEN,subIEN)=UnmatchedIngredientName
|
|---|
| 138 | ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
|
|---|
| 139 | ;" Array(IEN,subIEN)=UnmatchedIngredientName
|
|---|
| 140 | ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
|
|---|
| 141 | ;"Output: Missing information will be stuffed into records
|
|---|
| 142 |
|
|---|
| 143 | new IEN,subIEN
|
|---|
| 144 | set IEN=$order(Array(""))
|
|---|
| 145 | if IEN'="" for do quit:IEN=""
|
|---|
| 146 | . set subIEN=$order(Array(IEN,""))
|
|---|
| 147 | . if subIEN'="" for do quit:subIEN=""
|
|---|
| 148 | . . new RxIEN set RxIEN=$get(Array(IEN,subIEN,"FILE 50.416 IEN"))
|
|---|
| 149 | . . if RxIEN'="" do
|
|---|
| 150 | . . . set $piece(^TMG(22706.9,IEN,4,subIEN,0),"^",3)=RxIEN
|
|---|
| 151 | . . set subIEN=$order(Array(IEN,subIEN))
|
|---|
| 152 | . set IEN=$order(Array(IEN))
|
|---|
| 153 |
|
|---|
| 154 | quit
|
|---|
| 155 |
|
|---|
| 156 |
|
|---|
| 157 | HardFix(Array)
|
|---|
| 158 | ;"Purpose: to handle the more difficult fixes from Array (created by FindMissing)
|
|---|
| 159 | ;"Input: Array -- array as cread by FindMissing()
|
|---|
| 160 | ;" Array(IEN,subIEN)=UnmatchedIngredientName
|
|---|
| 161 | ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
|
|---|
| 162 | ;" Array(IEN,subIEN)=UnmatchedIngredientName
|
|---|
| 163 | ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN
|
|---|
| 164 | ;"Output: Missing information will be stuffed into records
|
|---|
| 165 |
|
|---|
| 166 | write !,$$ListCt^TMGMISC("Array")," items to fix.",!
|
|---|
| 167 | new IEN,subIEN,PriorAnswer
|
|---|
| 168 | new abort set abort=0
|
|---|
| 169 | set IEN=$order(Array(""))
|
|---|
| 170 | if IEN'="" for do quit:(IEN="")!(abort=1)
|
|---|
| 171 | . set subIEN=$order(Array(IEN,""))
|
|---|
| 172 | . if subIEN'="" for do quit:(subIEN="")!(abort=1)
|
|---|
| 173 | . . new RxName,RxIEN
|
|---|
| 174 | . . set RxName=$get(Array(IEN,subIEN))
|
|---|
| 175 | . . set RxIEN=+$get(PriorAnswer(RxName))
|
|---|
| 176 | . . if (RxIEN=0)!(RxIEN=-1) do
|
|---|
| 177 | . . . set RxIEN=$$LookupRx^TMGNDF0C(RxName)
|
|---|
| 178 | . . . set PriorAnswer(RxName)=RxIEN
|
|---|
| 179 | . . . if RxIEN=-1 do
|
|---|
| 180 | . . . . set RxIEN=$$GetRxIEN(RxName,$name(Array(IEN,subIEN,"INFO")))
|
|---|
| 181 | . . . . set PriorAnswer(RxName)=RxIEN
|
|---|
| 182 | . . if +RxIEN>0 do
|
|---|
| 183 | . . . new TMGFDA,TMGMSG
|
|---|
| 184 | . . . set TMGFDA(22706.916,subIEN_","_IEN_",",2)=+RxIEN
|
|---|
| 185 | . . . do FILE^DIE("K","TMGFDA","TMGMSG")
|
|---|
| 186 | . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
|
|---|
| 187 | . . if RxIEN=-3 set abort=1 quit
|
|---|
| 188 | . . if RxIEN=-2 do
|
|---|
| 189 | . . . set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"1=SKIP
|
|---|
| 190 | . . set subIEN=$order(Array(IEN,subIEN))
|
|---|
| 191 | . set IEN=$order(Array(IEN))
|
|---|
| 192 |
|
|---|
| 193 | quit
|
|---|
| 194 |
|
|---|
| 195 | GetRxIEN(RxName,pDrugInfo)
|
|---|
| 196 | ;"Purpose: To get the IEN of the given drug name
|
|---|
| 197 | ;"Input: RxName -- the name of the drug to find.
|
|---|
| 198 | ;" pDrugInfo -- NAME OF array containing drug info (as created by GetDrugInfo^TMGNDF1A
|
|---|
| 199 | ;"Result: IEN of drug found, or 0 if not found,
|
|---|
| 200 | ;" -2 if drug should be excluded from addition to VA PRODUCT file.
|
|---|
| 201 | ;" -3 if abort requested
|
|---|
| 202 |
|
|---|
| 203 | new result set result=0
|
|---|
| 204 | new DrugInfo merge DrugInfo=@pDrugInfo
|
|---|
| 205 | new Menu,UsrSlct
|
|---|
| 206 |
|
|---|
| 207 | set Menu(1)="Manual lookup"_$char(9)_"1"
|
|---|
| 208 | set Menu(2)="Show info of drug containing this ingredient"_$char(9)_"2"
|
|---|
| 209 | set Menu(3)="Set drug containing this ingredient to NOT BE ADDED to the VA PRODUCT file"_$char(9)_"3"
|
|---|
| 210 | set Menu(4)="NEXT"_$char(9)_"0"
|
|---|
| 211 | GRLoop
|
|---|
| 212 | set Menu(0)="Can't find a ingredient match for: "_RxName
|
|---|
| 213 | write #
|
|---|
| 214 | set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
|
|---|
| 215 | if UsrSlct="^" goto MCDone
|
|---|
| 216 | if UsrSlct=0 set UsrSlct=""
|
|---|
| 217 |
|
|---|
| 218 | if UsrSlct="" set temp="0"
|
|---|
| 219 | if UsrSlct="^" set result=-3 goto GRDone
|
|---|
| 220 | if UsrSlct=0 goto GRDone
|
|---|
| 221 | if UsrSlct=1 do goto:(result>0) GRDone
|
|---|
| 222 | . new DIC,Y
|
|---|
| 223 | . set DIC=50.416
|
|---|
| 224 | . set DIC(0)="AEQML"
|
|---|
| 225 | . do ^DIC
|
|---|
| 226 | . if +Y>0 set result=+Y
|
|---|
| 227 | if UsrSlct=2 do goto GRLoop
|
|---|
| 228 | . do FormatDrug^TMGND2A(.DrugInfo)
|
|---|
| 229 | if UsrSlct=3 do goto GRDone
|
|---|
| 230 | . set result=-2
|
|---|
| 231 | goto GRLoop
|
|---|
| 232 | GRDone
|
|---|
| 233 | quit result
|
|---|
| 234 |
|
|---|
| 235 | Unlock50d416
|
|---|
| 236 | set XUMF=1
|
|---|
| 237 | set PSNDF=1
|
|---|
| 238 | quit
|
|---|
| 239 |
|
|---|
| 240 | Lock50d416
|
|---|
| 241 | kill XUMF,PSNDF
|
|---|
| 242 | quit
|
|---|
| 243 |
|
|---|
| 244 | ;"=======================================================================
|
|---|
| 245 | ;"Code for Fixing NDC's
|
|---|
| 246 | ;"=======================================================================
|
|---|
| 247 | ;"Note: The NDC's given by the FDA database are not always acceptible by the
|
|---|
| 248 | ;" VistA input transform, because they include *'s. The FDA explains
|
|---|
| 249 | ;" this as follows:
|
|---|
| 250 | ;" Here is the official info from fda.gov on NDC codes:
|
|---|
| 251 | ;"
|
|---|
| 252 | ;" NDC Number
|
|---|
| 253 | ;"
|
|---|
| 254 | ;" Each listed drug product listed is assigned a unique 10-digit, 3-segment
|
|---|
| 255 | ;" number. This number, known as the NDC, identifies the labeler, product, and
|
|---|
| 256 | ;" trade package size. The first segment, the labeler code, is assigned by the
|
|---|
| 257 | ;" FDA. A labeler is any firm that manufactures (including repackers or
|
|---|
| 258 | ;" relabelers), or distributes (under its own name) the drug. The second
|
|---|
| 259 | ;" segment, the product code, identifies a specific strength, dosage form, and
|
|---|
| 260 | ;" formulation for a particular firm. The third segment, the package code,
|
|---|
| 261 | ;" identifies package sizes and types. Both the product and package codes are
|
|---|
| 262 | ;" assigned by the firm. The NDC will be in one of the following
|
|---|
| 263 | ;" configurations: 4-4-2, 5-3-2, or 5-4-1.
|
|---|
| 264 | ;"
|
|---|
| 265 | ;" An asterisk may appear in either a product code or a package code. It
|
|---|
| 266 | ;" simply acts as a place holder and indicates the configuration of the NDC.
|
|---|
| 267 | ;" Since the NDC is limited to 10 digits, a firm with a 5 digit labeler code
|
|---|
| 268 | ;" must choose between a 3 digit product code and 2 digit package code, or a 4
|
|---|
| 269 | ;" digit product code and 1 digit package code.
|
|---|
| 270 | ;"
|
|---|
| 271 | ;" Thus, you have either a 5-4-1 or a 5-3-2 configuration for the three
|
|---|
| 272 | ;" segments of the NDC. Because of a conflict with the HIPAA standard of an 11
|
|---|
| 273 | ;" digit NDC, many programs will pad the product code or package code segments
|
|---|
| 274 | ;" of the NDC with a leading zero instead of the asterisk.
|
|---|
| 275 | ;"
|
|---|
| 276 | ;" kt note: I.e. the problem is how to convert 10 digits --> 11 digits.
|
|---|
| 277 | ;" where to put the extra digit?
|
|---|
| 278 | ;"
|
|---|
| 279 | ;" Since a zero can be a valid digit in the NDC, this can lead to confusion
|
|---|
| 280 | ;" when trying to reconstitute the NDC back to its FDA standard. Example:
|
|---|
| 281 | ;" 12345-0678-09 (11 digits) could be 12345-678-09 or 12345-678-90 depending on
|
|---|
| 282 | ;" the firm's configuration.
|
|---|
| 283 | ;"
|
|---|
| 284 | ;" kt note: I think the example is wrong. It should be:
|
|---|
| 285 | ;" Example:
|
|---|
| 286 | ;" 12345-0678-09 (11 digits) could be 12345-678-09 (i.e. 5-3-2)
|
|---|
| 287 | ;" or 12345-0678-9 (5-4-1) depending on the firm's configuration.
|
|---|
| 288 |
|
|---|
| 289 | ;" By storing the segments as character data and
|
|---|
| 290 | ;" using the * as place holders we eliminate the confusion. In the example, FDA
|
|---|
| 291 | ;" stores the segments as 12345-*678-09 for a 5-3-2 configuration or
|
|---|
| 292 | ;" 12345-0678-*9 for a 5-4-1
|
|---|
| 293 | ;"
|
|---|
| 294 | ;"
|
|---|
| 295 |
|
|---|
| 296 | BatchNDCFix
|
|---|
| 297 | ;"Purpose: Scan TMG FDA IMPORT COMPILED file, and fix NDC codes
|
|---|
| 298 | ;"Output: data in file will be changed, NDC and NDC-12-digit fields will be altered.
|
|---|
| 299 |
|
|---|
| 300 | new IEN
|
|---|
| 301 | set IEN=$order(^TMG(22706.9,0))
|
|---|
| 302 | if +IEN>0 for do quit:(+IEN'>0)
|
|---|
| 303 | . new node set node=$get(^TMG(22706.9,IEN,1))
|
|---|
| 304 | . new NDC,newNDC
|
|---|
| 305 | . set NDC=$piece(node,"^",1)
|
|---|
| 306 | . set newNDC=$$NewNDC(NDC)
|
|---|
| 307 | . new digits12NDC set digits12NDC=$translate(newNDC,"-","")
|
|---|
| 308 | . new d1
|
|---|
| 309 | . if '$$IsNumeric^TMGMISC(digits12NDC) do
|
|---|
| 310 | . . new name set name=$piece(^TMG(22706.9,IEN,0),"^",4)
|
|---|
| 311 | . . write IEN,". NDC=",NDC," ",name,!
|
|---|
| 312 | . if newNDC'=NDC do
|
|---|
| 313 | . . write IEN,". ",NDC," needs --> ",newNDC,!
|
|---|
| 314 | . . if $length(digits12NDC)<12 do
|
|---|
| 315 | . . . set digits12NDC=$extract("000000",1,12-$length(digits12NDC))_digits12NDC
|
|---|
| 316 | BLabel . . new TMGFDA,TMGIEN,TMGMSG
|
|---|
| 317 | . . set TMGFDA(22706.9,IEN_",",4)=newNDC
|
|---|
| 318 | . . set TMGFDA(22706.9,IEN_",",5)=digits12NDC
|
|---|
| 319 | . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 320 | . . if $data(TMGMSG("DIERR")) do
|
|---|
| 321 | . . . set result=0
|
|---|
| 322 | . . . if $get(Quiet)=1 quit
|
|---|
| 323 | . . . new PriorErrorFound
|
|---|
| 324 | . . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
|
|---|
| 325 | . set IEN=$order(^TMG(22706.9,IEN))
|
|---|
| 326 |
|
|---|
| 327 | quit
|
|---|
| 328 |
|
|---|
| 329 | NewNDC(NDC)
|
|---|
| 330 | ;"Purpose: convert an NDC code with invalid formatting into one acceptible to VistA
|
|---|
| 331 | ;"Input: NDC -- the NDC as provided by FDA, with hyphens ('-'s)
|
|---|
| 332 | ;"Output: the correctly formatted NDC, or "" if not valid conversion possible.
|
|---|
| 333 |
|
|---|
| 334 | ;"Examples of conversions:
|
|---|
| 335 | ;" 12345-*678-09 --> 12345-678-09 (5-3-2 digits)
|
|---|
| 336 | ;" 12345-0678-*9 --> 12345-0678-9 (5-4-1 digits)
|
|---|
| 337 |
|
|---|
| 338 | ;"Sometimes there are two *'s (i.e. **) (always in the LAST grouping -- the package code
|
|---|
| 339 | ;"Here is some examples of how I will convert them:
|
|---|
| 340 | ;" 057587-*022-** (6-4-2) --> 57587-022-00 (5-3-2)
|
|---|
| 341 | ;" 053360-4189-** (6-4-2) --> 53360-4189-0 (5-4-1)
|
|---|
| 342 | ;" 000034-1025-** (6-4-2) --> 00034-1025-0 (5-4-1)
|
|---|
| 343 | ;" 046672-*122-** (6-4-2) --> 46672-122-00 (5-3-2)
|
|---|
| 344 |
|
|---|
| 345 | ;"Also, sometimes the FDA database did not include values for codes.
|
|---|
| 346 | ;"Initially, I converted these to ????'s
|
|---|
| 347 | ;"Now, that won't be acceptible to VistA, so I will convert these to 0's
|
|---|
| 348 | ;"e.g. 000034-????-56 --> 000034-0000-56
|
|---|
| 349 |
|
|---|
| 350 | new result,valid,digits
|
|---|
| 351 |
|
|---|
| 352 | ;"Setup check for valid digits combo. Allowed combos are:
|
|---|
| 353 | ;" 4-4-2, 5-3-2, 5-4-1, 5-4-2, or 6-4-2
|
|---|
| 354 | set digits("VALID",4,4,2)=1 ;"total of 10 digits
|
|---|
| 355 | set digits("VALID",5,3,2)=1 ;"total of 10 digits
|
|---|
| 356 | set digits("VALID",5,4,1)=1 ;"total of 10 digits
|
|---|
| 357 | set digits("VALID",5,4,2)=1 ;"total of 11 digits
|
|---|
| 358 | set digits("VALID",6,4,2)=1 ;"total of 12 digits
|
|---|
| 359 | ;"set digits("VALID",6,3,1)=1 ;"total of 10 digits
|
|---|
| 360 |
|
|---|
| 361 | ;"Remove single *'s
|
|---|
| 362 | set result=$$Substitute^TMGSTUTL(NDC,"**","##") ;"protect double **'s
|
|---|
| 363 | ;" 010130-*124-*1 --> 010130-*124-01
|
|---|
| 364 | if ($piece(result,"-",2)["*")&($piece(result,"-",3)["*") do
|
|---|
| 365 | . set $piece(result,"-",3)=$translate($piece(result,"-",3),"*","0")
|
|---|
| 366 | ;" 010130-*124-01 --> 010130-124-01
|
|---|
| 367 | set result=$translate(result,"*","")
|
|---|
| 368 |
|
|---|
| 369 | set result=$$Substitute^TMGSTUTL(result,"##","**")
|
|---|
| 370 |
|
|---|
| 371 | ;"Change ?'s into 0's
|
|---|
| 372 | if $length($piece(result,"-",2))=4 do
|
|---|
| 373 | . if $piece(result,"-",3)="??" set $piece(result,"-",3)="0"
|
|---|
| 374 | set result=$translate(result,"?","0")
|
|---|
| 375 |
|
|---|
| 376 | NNDCL1
|
|---|
| 377 | set digits(1)=$length($piece(result,"-",1))
|
|---|
| 378 | set digits(2)=$length($piece(result,"-",2))
|
|---|
| 379 | set digits(3)=$length($piece(result,"-",3))
|
|---|
| 380 |
|
|---|
| 381 | if result["**" do
|
|---|
| 382 | . if digits(2)=3 set result=$$Substitute^TMGSTUTL(result,"**","00")
|
|---|
| 383 | . else if digits(2)=4 set result=$$Substitute^TMGSTUTL(result,"**","0")
|
|---|
| 384 | . else do
|
|---|
| 385 | . . write "Error converting NDC code: ",NDC,!
|
|---|
| 386 | . . set result="",digits(1)=-1
|
|---|
| 387 | . set digits(3)=$length($extract(result,"-",3))
|
|---|
| 388 |
|
|---|
| 389 | ;"convert 12345-123-x --> 12345-123-0x
|
|---|
| 390 | if (digits(1)=5)&(digits(2)=3)&(digits(3)=1) do goto NNDCL1
|
|---|
| 391 | . new value set value=+$piece(result,"-",3)
|
|---|
| 392 | . set $piece(result,"-",3)="0"_value
|
|---|
| 393 |
|
|---|
| 394 | set digits=digits(1)+digits(2)+digits(3)
|
|---|
| 395 | set valid=+$get(digits("VALID",digits(1),digits(2),digits(3)))
|
|---|
| 396 |
|
|---|
| 397 | if (valid'=1)&(digits(1)=6)&($extract(result,1,1)="0") do goto NNDCL1
|
|---|
| 398 | . set result=$extract(result,2,99)
|
|---|
| 399 |
|
|---|
| 400 | if valid'=1 set result=""
|
|---|
| 401 |
|
|---|
| 402 | quit result
|
|---|
| 403 |
|
|---|
