| 1 | TMGNDF1D ;TMG/kst/FDA Import: Import name cleanup ;03/25/06
 | 
|---|
| 2 |          ;;1.0;TMG-LIB;**1**;01/23/07
 | 
|---|
| 3 | 
 | 
|---|
| 4 |  ;"FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
 | 
|---|
| 5 |  ;"Code for cleaning up names.
 | 
|---|
| 6 |  ;"Kevin Toppenberg MD
 | 
|---|
| 7 |  ;"GNU General Public License (GPL) applies
 | 
|---|
| 8 |  ;"1-23-07
 | 
|---|
| 9 | 
 | 
|---|
| 10 |  ;"=======================================================================
 | 
|---|
| 11 |  ;" API -- Public Functions.
 | 
|---|
| 12 |  ;"=======================================================================
 | 
|---|
| 13 |  ;"Menu
 | 
|---|
| 14 |  ;"Fix1Name(IEN) -- perform this units fixes for just 1 record
 | 
|---|
| 15 | 
 | 
|---|
| 16 |  ;"=======================================================================
 | 
|---|
| 17 |  ;" Private Functions.
 | 
|---|
| 18 |  ;"=======================================================================
 | 
|---|
| 19 |  ;"PickSkips -- select records to mark as to be skipped.
 | 
|---|
| 20 |  ;"RemoveDups -- Set duplicate records to be skipped
 | 
|---|
| 21 |  ;"=======================================================================
 | 
|---|
| 22 | 
 | 
|---|
| 23 | Menu
 | 
|---|
| 24 |         ;"Purpose: To give an interactive menu of tools to clean up data.
 | 
|---|
| 25 | 
 | 
|---|
| 26 |         new Menu,UsrSlct
 | 
|---|
| 27 |         new i set i=0
 | 
|---|
| 28 |         set Menu(i)="Pick Option for Cleaning Up FDA Imported Data (1D)",i=i+1
 | 
|---|
| 29 |         set Menu(i)="Fix common misspellings etc. in Trade Names"_$char(9)_"NormalizeNames",i=i+1
 | 
|---|
| 30 |         set Menu(i)="SEARCH and REPLACE words in drug TRADE NAME"_$char(9)_"SEARCHd05",i=i+1
 | 
|---|
| 31 |         set Menu(i)="SEARCH and REPLACE words in drug STRENGTH"_$char(9)_"SEARCH1",i=i+1
 | 
|---|
| 32 |         set Menu(i)="SEARCH and REPLACE words in drug UNITS"_$char(9)_"SEARCH2",i=i+1
 | 
|---|
| 33 |         set Menu(i)="Fix dose decimals (e.g. '.5;.125' --> '0.5;0.125')"_$char(9)_"DECIMAL",i=i+1
 | 
|---|
| 34 |         set Menu(i)="Fix units decimals (e.g. 'MG/.5 ML;' --> 'MG/0.5ML')"_$char(9)_"UNITS",i=i+1
 | 
|---|
| 35 |         set Menu(i)="Remove unwanted DOSES from TRADE NAME"_$char(9)_"ScrubDoses",i=i+1
 | 
|---|
| 36 |         set Menu(i)="Edit import TRADE NAME (Caution)"_$char(9)_"EditTradeName",i=i+1
 | 
|---|
| 37 |         set Menu(i)="HELP"_$char(9)_"?"
 | 
|---|
| 38 |         set Menu("P")="Prev Stage"_$char(9)_"Prev"
 | 
|---|
| 39 |         set Menu("N")="Next Stage"_$char(9)_"Next"
 | 
|---|
| 40 | 
 | 
|---|
| 41 | CD1
 | 
|---|
| 42 |         write #
 | 
|---|
| 43 |         set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
 | 
|---|
| 44 |         if UsrSlct="^" goto CDDone
 | 
|---|
| 45 |         if UsrSlct=0 set UsrSlct=""
 | 
|---|
| 46 | 
 | 
|---|
| 47 |         if UsrSlct="Prev" goto Menu^TMGNDF1A  ;"quit can occur from there...
 | 
|---|
| 48 |         if UsrSlct="Next" goto Menu^TMGNDF1E  ;"quit can occur from there...
 | 
|---|
| 49 | 
 | 
|---|
| 50 |         if UsrSlct="NormalizeNames" do NormalizeNames goto CD1
 | 
|---|
| 51 |         if UsrSlct="SEARCHd05" do Srch5Replace goto CD1
 | 
|---|
| 52 |         if UsrSlct="SEARCH1" do Srch1Replace goto CD1
 | 
|---|
| 53 |         if UsrSlct="SEARCH2" do Srch2Replace goto CD1
 | 
|---|
| 54 |         if UsrSlct="DECIMAL" do FixDecimals goto CD1
 | 
|---|
| 55 |         if UsrSlct="UNITS" do FixUnits goto CD1
 | 
|---|
| 56 |         if UsrSlct="ScrubDoses" do ScrubDoses goto CD1
 | 
|---|
| 57 |         if UsrSlct="EditTradeName" do EditTradename() goto CD1
 | 
|---|
| 58 |         if UsrSlct="?" do ShowHelp goto CD1
 | 
|---|
| 59 |         goto CDDone
 | 
|---|
| 60 | CDDone
 | 
|---|
| 61 |         quit
 | 
|---|
| 62 | 
 | 
|---|
| 63 | ShowHelp
 | 
|---|
| 64 |         ;"Purpose: to display help instructions
 | 
|---|
| 65 | 
 | 
|---|
| 66 |         write #,!
 | 
|---|
| 67 |         write "Q: Why does the data need clean up?",!
 | 
|---|
| 68 |         write "A: The FDA database seems to consist of data provided",!
 | 
|---|
| 69 |         write "   by vendors.  As such, there is a big variety in the",!
 | 
|---|
| 70 |         write "   formats of drug names and in the dose specifications,",!
 | 
|---|
| 71 |         write "   and also accuracy (many drugs are missing information.)",!
 | 
|---|
| 72 |         write !
 | 
|---|
| 73 |         write "Q: Are inaccurate or unwanted drug records deleted?",!
 | 
|---|
| 74 |         write "A: No.  They are kept so that with the NEXT import, their",!
 | 
|---|
| 75 |         write "   unwanted status will be remembered.  Instead, they are",!
 | 
|---|
| 76 |         write "   flagged with a SKIP THIS RECORD marker.  They will be",!
 | 
|---|
| 77 |         write "   ignored during further processing.",!
 | 
|---|
| 78 |         write !
 | 
|---|
| 79 |         write "Q: How do I flag an unwanted record to be SKIPPED?",!
 | 
|---|
| 80 |         write "A: Drug records are browsed in a 'selector' (more below)",!
 | 
|---|
| 81 |         write "   and all the drugs to be skipped are selected.  Then the",!
 | 
|---|
| 82 |         write "   selector is exited by typing [ESC][ESC], and one is ",!
 | 
|---|
| 83 |         write "   given a chance to mark all to be SKIPPED at once.",!
 | 
|---|
| 84 |         write !
 | 
|---|
| 85 |         do PressToCont^TMGUSRIF
 | 
|---|
| 86 |         write !
 | 
|---|
| 87 |         write "Q: How do I use the selector?",!
 | 
|---|
| 88 |         write "A: The selector is a tool from the VPE library.  It has its",!
 | 
|---|
| 89 |         write "   own help.  A quick answer is to move the cursor up and down",!
 | 
|---|
| 90 |         write "   and press SPACE to select or deselect a record.  I recommend",!
 | 
|---|
| 91 |         write "   using the '+' feature to select all records matching a",!
 | 
|---|
| 92 |         write "   specified pattern.",!
 | 
|---|
| 93 |         write !
 | 
|---|
| 94 |         write "... more later...",!
 | 
|---|
| 95 | 
 | 
|---|
| 96 |         do PressToCont^TMGUSRIF
 | 
|---|
| 97 |         quit
 | 
|---|
| 98 | 
 | 
|---|
| 99 | 
 | 
|---|
| 100 | Fix1Name(IEN)
 | 
|---|
| 101 |         ;"Purpose: perform this units fixes for just 1 record
 | 
|---|
| 102 |         ;"Input: IEN -- IEN in 22706.9
 | 
|---|
| 103 |         ;"results: none
 | 
|---|
| 104 | 
 | 
|---|
| 105 |         new temp
 | 
|---|
| 106 | 
 | 
|---|
| 107 |         set temp=$$Fix1Dec(IEN)
 | 
|---|
| 108 |         set temp=$$Fix1Unit(IEN)
 | 
|---|
| 109 |         set temp=$$Norm1Name(IEN)
 | 
|---|
| 110 |         set temp=$$Scrub1Dose(IEN)
 | 
|---|
| 111 | 
 | 
|---|
| 112 |         quit
 | 
|---|
| 113 | 
 | 
|---|
| 114 | 
 | 
|---|
| 115 | FixDecimals
 | 
|---|
| 116 |         ;"Purpose: To convert bare decimals (e.g. '.5' --> '0.5') in STRENGTH
 | 
|---|
| 117 | 
 | 
|---|
| 118 |         new Itr,IEN,strength,abort,count,newStr
 | 
|---|
| 119 |         set abort=0,count=0
 | 
|---|
| 120 |         set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
 | 
|---|
| 121 |         do PrepProgress^TMGITR(.Itr,20,0,"IEN")
 | 
|---|
| 122 |         if IEN'="" for  do  quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
 | 
|---|
| 123 |         . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit  ;"1=SKIP
 | 
|---|
| 124 |         . if $$KeyPressed^TMGUSRIF=27 set abort=1 quit
 | 
|---|
| 125 |         . set count=count+$$Fix1Dec(IEN)
 | 
|---|
| 126 | 
 | 
|---|
| 127 |         write !,count," records changed",!
 | 
|---|
| 128 |         do PressToCont^TMGUSRIF
 | 
|---|
| 129 | 
 | 
|---|
| 130 |         quit
 | 
|---|
| 131 | 
 | 
|---|
| 132 | Fix1Dec(IEN)
 | 
|---|
| 133 |         ;"Purpose: To convert bare decimals (e.g. '.5' --> '0.5') in STRENGTH
 | 
|---|
| 134 |         ;"Input: IEN -- IEN in 22706.9
 | 
|---|
| 135 |         ;"Results: 1 if modified, 0 if not
 | 
|---|
| 136 | 
 | 
|---|
| 137 |         new result set result=0
 | 
|---|
| 138 |         set strength=$piece($get(^TMG(22706.9,IEN,0)),"^",2)
 | 
|---|
| 139 |         if strength'["." goto F1DD
 | 
|---|
| 140 |         set newStr=$$FixNum(strength)
 | 
|---|
| 141 |         if newStr'=strength do
 | 
|---|
| 142 |         . new TMGFDA,TMGMSG
 | 
|---|
| 143 |         . set TMGFDA(22706.9,IEN_",",1)=newStr
 | 
|---|
| 144 |         . do FILE^DIE("K","TMGFDA","TMGMSG")
 | 
|---|
| 145 |         . do ShowIfDIERR^TMGDEBUG(.TMGMSG,.result)
 | 
|---|
| 146 | 
 | 
|---|
| 147 | F1DD    quit result
 | 
|---|
| 148 | 
 | 
|---|
| 149 | 
 | 
|---|
| 150 | FixUnits
 | 
|---|
| 151 |         ;"Purpose: To fix errors in Units (remove spaces, fix hanging decimals)
 | 
|---|
| 152 | 
 | 
|---|
| 153 |         new Itr,IEN,strength,abort,count,newStr
 | 
|---|
| 154 |         set abort=0,count=0
 | 
|---|
| 155 |         set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
 | 
|---|
| 156 |         do PrepProgress^TMGITR(.Itr,20,0,"IEN")
 | 
|---|
| 157 |         if IEN'="" for  do  quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
 | 
|---|
| 158 |         . if $$KeyPressed^TMGUSRIF=27 set abort=1 quit
 | 
|---|
| 159 |         . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit  ;"1=SKIP
 | 
|---|
| 160 |         . set count=count+$$Fix1Unit(IEN)
 | 
|---|
| 161 |         write !,count," records changed",!
 | 
|---|
| 162 |         do PressToCont^TMGUSRIF
 | 
|---|
| 163 | 
 | 
|---|
| 164 |         quit
 | 
|---|
| 165 | 
 | 
|---|
| 166 | 
 | 
|---|
| 167 | Fix1Unit(IEN)
 | 
|---|
| 168 |         ;"Purpose: To fix errors in Units (remove spaces, fix hanging decimals)
 | 
|---|
| 169 |         ;"Input: IEN -- IEN in 22706.9
 | 
|---|
| 170 |         ;"Results: 1 if changed, 0 if not
 | 
|---|
| 171 | 
 | 
|---|
| 172 |         new result set result=0
 | 
|---|
| 173 |          set units=$piece($get(^TMG(22706.9,IEN,0)),"^",3)
 | 
|---|
| 174 |          set newStr=$$FixNum(units)
 | 
|---|
| 175 |          set newStr=$$Substitute^TMGSTUTL(newStr,"/PER","/")
 | 
|---|
| 176 |          set newStr=$$Substitute^TMGSTUTL(newStr,"/VIL","/VIAL")
 | 
|---|
| 177 |          set newStr=$translate(newStr," ","")
 | 
|---|
| 178 |          if $extract(newStr,$length(newStr))=";" set newStr=$extract(newStr,1,$length(newStr)-1)
 | 
|---|
| 179 |          if newStr'=units do
 | 
|---|
| 180 |          . new TMGFDA,TMGMSG
 | 
|---|
| 181 |          . set TMGFDA(22706.9,IEN_",",2)=newStr
 | 
|---|
| 182 |          . do FILE^DIE("K","TMGFDA","TMGMSG")
 | 
|---|
| 183 |          . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
 | 
|---|
| 184 |          . set result=1
 | 
|---|
| 185 | 
 | 
|---|
| 186 |         quit result
 | 
|---|
| 187 | 
 | 
|---|
| 188 | 
 | 
|---|
| 189 | FixNum(numStr)
 | 
|---|
| 190 |         ;"Purpose: to fix hanging decimals in numStr (e.g. '.5' --> '0.5')
 | 
|---|
| 191 |         ;"Input: numStr -- the string to be fixed
 | 
|---|
| 192 |         ;"Results: returns fixed string
 | 
|---|
| 193 |         new result set result=numStr
 | 
|---|
| 194 |         new i for i=1:1:$length(result,".")-1 do
 | 
|---|
| 195 |         . new p set p=$$Pos^TMGSTUTL(".",result,i)
 | 
|---|
| 196 |         . new priorCh set priorCh=$extract(result,p-1)
 | 
|---|
| 197 |         . if +priorCh=priorCh quit
 | 
|---|
| 198 |         . if (p=1) do
 | 
|---|
| 199 |         . . set result="0"_result
 | 
|---|
| 200 |         . else  do
 | 
|---|
| 201 |         . . new sA,sB
 | 
|---|
| 202 |         . . set sA=$extract(result,1,p-1),sB=$extract(result,p,9999)
 | 
|---|
| 203 |         . . set result=sA_"0"_sB
 | 
|---|
| 204 | 
 | 
|---|
| 205 |         quit result
 | 
|---|
| 206 | 
 | 
|---|
| 207 | Srch5Replace
 | 
|---|
| 208 |         ;"Purpose: To provide a mechanism for altering the drug trade names (.05 field)
 | 
|---|
| 209 |         ;"        e.g. TETRACYCLINE HYDROCHLORIDE --> TETRACYCLINE HCL
 | 
|---|
| 210 |         ;"     or      LISINOPRIL/HYDROCHLOROTHIAZIDE --> LISINOPRIL/HCTZ
 | 
|---|
| 211 |         ;"     The reason for this is that many drugs are put in BOTH WAYS, leading to
 | 
|---|
| 212 |         ;"     duplicate entries, differing only in the expansion of these words.
 | 
|---|
| 213 | 
 | 
|---|
| 214 |         do SrchReplace^TMGMISC(22706.9,.05,"SEARCH & REPLACE in Trade Name of FDA Imported Drugs")
 | 
|---|
| 215 |         quit
 | 
|---|
| 216 | 
 | 
|---|
| 217 | Srch2Replace
 | 
|---|
| 218 |         ;"Purpose: To provide a mechanism for altering the drug UNITS (field 2)
 | 
|---|
| 219 |         ;"     The reason for this is that many drugs are put in BOTH WAYS, leading to
 | 
|---|
| 220 |         ;"     duplicate entries, differing only in the expansion of these words.
 | 
|---|
| 221 | 
 | 
|---|
| 222 |         do SrchReplace^TMGMISC(22706.9,2,"SEARCH & REPLACE in UNITS of FDA Imported Drugs")
 | 
|---|
| 223 |         quit
 | 
|---|
| 224 | 
 | 
|---|
| 225 | Srch1Replace
 | 
|---|
| 226 |         ;"Purpose: To provide a mechanism for altering the drug STRENGTH (field 1)
 | 
|---|
| 227 |         ;"     The reason for this is that many drugs are put in BOTH WAYS, leading to
 | 
|---|
| 228 |         ;"     duplicate entries, differing only in the expansion of these words.
 | 
|---|
| 229 | 
 | 
|---|
| 230 |         do SrchReplace^TMGMISC(22706.9,1,"SEARCH & REPLACE in STRENGTH of FDA Imported Drugs")
 | 
|---|
| 231 |         quit
 | 
|---|
| 232 | 
 | 
|---|
| 233 | 
 | 
|---|
| 234 | NormalizeNames
 | 
|---|
| 235 |         ;"Purpose: To 'normalize' names, meaning replacing common misspellings etc.
 | 
|---|
| 236 | 
 | 
|---|
| 237 |         new map  ;"These are numbered to preserve their order
 | 
|---|
| 238 |         do SetupMap(.map)
 | 
|---|
| 239 | 
 | 
|---|
| 240 |         new Itr,IEN,count
 | 
|---|
| 241 |         set count=0
 | 
|---|
| 242 |         new abort set abort=0
 | 
|---|
| 243 |         set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
 | 
|---|
| 244 |         do PrepProgress^TMGITR(.Itr,20,0,"IEN")
 | 
|---|
| 245 |         if IEN'="" for  do  quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
 | 
|---|
| 246 |         . if $$UserAborted^TMGUSRIF set abort=1 quit
 | 
|---|
| 247 |         . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit  ;"1=SKIP
 | 
|---|
| 248 |         . set count=count+$$Norm1Name(IEN,.map)
 | 
|---|
| 249 | 
 | 
|---|
| 250 |         do ProgressDone^TMGITR(.Itr)
 | 
|---|
| 251 | 
 | 
|---|
| 252 |         write count," Trade names (.05 field) modified.",!
 | 
|---|
| 253 |         if count>1 write "Because some changes are interdependant, please run this option again.",!
 | 
|---|
| 254 |         do PressToCont^TMGUSRIF
 | 
|---|
| 255 | 
 | 
|---|
| 256 |         quit
 | 
|---|
| 257 | 
 | 
|---|
| 258 | 
 | 
|---|
| 259 | Norm1Name(IEN,map)
 | 
|---|
| 260 |         ;"Purpose: To 'normalize' names, meaning replacing common misspellings etc. for 1 record
 | 
|---|
| 261 |         ;"Input: IEN -- IEN in 22706.9
 | 
|---|
| 262 |         ;"       map -- OPTIONAL.  Array of changes to be made.  If not provided, then
 | 
|---|
| 263 |         ;"              it will be created here.
 | 
|---|
| 264 |         ;"Results: 1 if modified, 0 if not
 | 
|---|
| 265 | 
 | 
|---|
| 266 |         if $data(map)=0 do SetupMap(.map)
 | 
|---|
| 267 | 
 | 
|---|
| 268 |         new result set result=0
 | 
|---|
| 269 |         new TradeName set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"field .05
 | 
|---|
| 270 |         new oldName set oldName=TradeName
 | 
|---|
| 271 |         new num set num=""
 | 
|---|
| 272 |         for  set num=$order(map(num)) quit:(num="")  do
 | 
|---|
| 273 |         . set srchS=$order(map(num,"")) quit:(srchS="")
 | 
|---|
| 274 |         . if TradeName'[srchS quit
 | 
|---|
| 275 |         . write !,srchS,"-->",$get(map(num,srchS)),!
 | 
|---|
| 276 |         . set TradeName=$$Substitute^TMGSTUTL(TradeName,srchS,$get(map(num,srchS)))
 | 
|---|
| 277 | 
 | 
|---|
| 278 |         if TradeName'=oldName do
 | 
|---|
| 279 |         . new TMGFDA,TMGMSG
 | 
|---|
| 280 |         . set TMGFDA(22706.9,IEN_",",.05)=TradeName
 | 
|---|
| 281 |         . do FILE^DIE("K","TMGFDA","TMGMSG")
 | 
|---|
| 282 |         . set result=1
 | 
|---|
| 283 |         . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
 | 
|---|
| 284 | 
 | 
|---|
| 285 |         quit result
 | 
|---|
| 286 | 
 | 
|---|
| 287 | 
 | 
|---|
| 288 | SetupMap(map)
 | 
|---|
| 289 |         ;"Purpose: to set up mapping of spelling corrections to be made.
 | 
|---|
| 290 |         ;"Input: map -- PASS BY REFERENCE. An OUT parameter.
 | 
|---|
| 291 | 
 | 
|---|
| 292 |         ;"NOTE: These are numbered to preserve their order
 | 
|---|
| 293 |         new i set i=0
 | 
|---|
| 294 |         set i=i+1,map(i,"SOLUTION")="SOLN"
 | 
|---|
| 295 |         set i=i+1,map(i,"OINTMENT")="OINT"
 | 
|---|
| 296 |         set i=i+1,map(i,"CAPSULES")="CAP"
 | 
|---|
| 297 |         set i=i+1,map(i,"CAPSULE")="CAP"
 | 
|---|
| 298 |         set i=i+1,map(i,"TALBETS")="TAB"
 | 
|---|
| 299 |         set i=i+1,map(i,"INJECTION")="INJ"
 | 
|---|
| 300 |         set i=i+1,map(i,"FOR INJ")="INJ"
 | 
|---|
| 301 |         set i=i+1,map(i,"EXTENDED")="EXT"
 | 
|---|
| 302 |         set i=i+1,map(i,"RELEASE")="REL"
 | 
|---|
| 303 |         set i=i+1,map(i,"INH ")="IHNL "
 | 
|---|
| 304 |         set i=i+1,map(i,"INHALATION")="INHL"
 | 
|---|
| 305 |         set i=i+1,map(i,"SUSPENSION")="SUSP"
 | 
|---|
| 306 |         set i=i+1,map(i,"OPHTHALMIC")="OPHTH"
 | 
|---|
| 307 |         set i=i+1,map(i,"HYDROCHLORIDE")="HCL"
 | 
|---|
| 308 |         set i=i+1,map(i,"FOR INJECTABLE SUSPENSION")="INJ"
 | 
|---|
| 309 |         set i=i+1,map(i,"CODEINE PHOSPHATE")="CODEINE"
 | 
|---|
| 310 |         set i=i+1,map(i,"WITH CODEINE")="CODEINE"
 | 
|---|
| 311 |         set i=i+1,map(i,"SOLN FOR INJ")="INJ SOLN"
 | 
|---|
| 312 |         set i=i+1,map(i,"POWDER FOR INJ")="INJ POWDER"
 | 
|---|
| 313 |         set i=i+1,map(i,"SOLN OPHTH")="OPHTH SOLN"
 | 
|---|
| 314 |         set i=i+1,map(i," SUFATE")=" SULFATE"
 | 
|---|
| 315 |         set i=i+1,map(i,"ALBUTEROL SULFATE")="ALBUTEROL"
 | 
|---|
| 316 |         set i=i+1,map(i,"FOR INHL")="INHL"
 | 
|---|
| 317 |         set i=i+1,map(i,"SOLN INHL")="INHL SOLN"
 | 
|---|
| 318 |         set i=i+1,map(i,"SUSTAINED")="SUST"
 | 
|---|
| 319 |         set i=i+1,map(i," BITART ")=" BITARTRATE "
 | 
|---|
| 320 |         set i=i+1,map(i," BITARTRATERATER")=" BITARTRATER"
 | 
|---|
| 321 |         set i=i+1,map(i," BITARTRATER ")=" BITARTRATE "
 | 
|---|
| 322 |         set i=i+1,map(i," BITRATE")=" BITARTRATE"
 | 
|---|
| 323 |         set i=i+1,map(i,"BITARTARATE")="BITARTRATE"
 | 
|---|
| 324 |         set i=i+1,map(i,"BITARTRATERATE")="BITARTRATE"
 | 
|---|
| 325 |         set i=i+1,map(i,"HYDROCODONEARATE")="HYDROCODONE"
 | 
|---|
| 326 |         set i=i+1,map(i,"HYDROCODONE ACET")="HYDROCODONE APAP"
 | 
|---|
| 327 |         set i=i+1,map(i,"HYDROCODONE BITARTRATE")="HYDROCODONE"
 | 
|---|
| 328 |         set i=i+1,map(i,"DIHYDROCODEINE BITARTRATE")="DIHYDROCODEINE"
 | 
|---|
| 329 |         set i=i+1,map(i,"WITH HYDROCODONE")="HYDROCODONE"
 | 
|---|
| 330 |         set i=i+1,map(i,"SOLN FOR IRRIGATION")="IRRIGATION SOLN"
 | 
|---|
| 331 |         set i=i+1,map(i,"CAPLETS")="CAP"
 | 
|---|
| 332 |         set i=i+1,map(i,"TABLET")="TAB"
 | 
|---|
| 333 |         set i=i+1,map(i,"POWDER")="PWDR"
 | 
|---|
| 334 |         set i=i+1,map(i,"TAB EXT REL")="EXT REL TAB"
 | 
|---|
| 335 |         set i=i+1,map(i,"SOLN ORAL")="ORAL SOLN"
 | 
|---|
| 336 |         set i=i+1,map(i,"TAB SUST REL")="SUST REL TAB"
 | 
|---|
| 337 |         set i=i+1,map(i,"RELD ")="REL "
 | 
|---|
| 338 |         set i=i+1,map(i,"  ")=" "
 | 
|---|
| 339 |         set i=i+1,map(i," SULFATE")=""
 | 
|---|
| 340 |         set i=i+1,map(i,"HYDROCHLOROTHIAZIDE")="HCTZ"
 | 
|---|
| 341 |         set i=i+1,map(i," AND ")=" "
 | 
|---|
| 342 |         set i=i+1,map(i,"HYDROCLORIDE")="HCL"
 | 
|---|
| 343 |         set i=i+1,map(i,"HYDROCLOROTHIAZIDE")="HCTZ"
 | 
|---|
| 344 |         set i=i+1,map(i,"HYDROCHLORITHIZIDE")="HCTZ"
 | 
|---|
| 345 |         set i=i+1,map(i,"HYDROCHLOROHIAZIDE")="HCTZ"
 | 
|---|
| 346 |         set i=i+1,map(i,"HYDROCLORTHIAZIDE")="HCTZ"
 | 
|---|
| 347 |         set i=i+1,map(i,"HYDROCLORIDE")="HCTZ"
 | 
|---|
| 348 |         set i=i+1,map(i,"HYDROCHLORIRDE")="HCTZ"
 | 
|---|
| 349 |         set i=i+1,map(i," HCT ")=" HCTZ "
 | 
|---|
| 350 |         set i=i+1,map(i,"HYDROCHLORIC ACID")="HCL"
 | 
|---|
| 351 |         set i=i+1,map(i,"HYDROCHORIDE")="HCL"
 | 
|---|
| 352 |         set i=i+1,map(i,"HYDROCHLORITHIAZIDE")="HCTZ"
 | 
|---|
| 353 |         set i=i+1,map(i,"HYDROCHLOROTIAZIDE")="HCTZ"
 | 
|---|
| 354 |         set i=i+1,map(i,"HYDROCHOROTHIAZIDE")="HCTZ"
 | 
|---|
| 355 |         set i=i+1,map(i,"HYDROCHLOROTHIAZED")="HCTZ"
 | 
|---|
| 356 |         set i=i+1,map(i,"HYDROCHLOROYTHIAZIDE")="HCTZ"
 | 
|---|
| 357 |         set i=i+1,map(i,"HYDROCHLOROTHIZED")="HCYZ"
 | 
|---|
| 358 |         set i=i+1,map(i,"HYDROCHLROTHIAZIDE")=""
 | 
|---|
| 359 |         set i=i+1,map(i,"HYDROCHOLRIDE")="HCL"
 | 
|---|
| 360 |         set i=i+1,map(i,"HYDROCHOLORIDE")="HCL"
 | 
|---|
| 361 |         set i=i+1,map(i,"HYDROCHLORTHIAZIDE")="HCTZ"
 | 
|---|
| 362 |         set i=i+1,map(i,"HYDROCHOLIRDE")="HCL"
 | 
|---|
| 363 |         set i=i+1,map(i,"HYDROCHLROIDE")="HCL"
 | 
|---|
| 364 |         set i=i+1,map(i,"HYDROCHLORIE")="HCL"
 | 
|---|
| 365 |         set i=i+1,map(i,"HYDROCHLORINE")="HCL"
 | 
|---|
| 366 |         set i=i+1,map(i,"CODIENE")="CODEINE"
 | 
|---|
| 367 |         set i=i+1,map(i,"SOLN INJ")="INJ SOLN"
 | 
|---|
| 368 |         set i=i+1,map(i,"SUBSTAINED")="SUST"
 | 
|---|
| 369 |         set i=i+1,map(i,"SODIM")="SODIUM"
 | 
|---|
| 370 |         set i=i+1,map(i,"CAP EXT REL")="EXT REL CAP"
 | 
|---|
| 371 |         set i=i+1,map(i,"CAP SUST REL")="SUST REL CAP"
 | 
|---|
| 372 |         set i=i+1,map(i,"INHAL ")="INHL "
 | 
|---|
| 373 |         set i=i+1,map(i,"FOR ORAL SOLN")="ORAL SOLN"
 | 
|---|
| 374 |         set i=i+1,map(i," I V ")=" IV "
 | 
|---|
| 375 |         set i=i+1,map(i,"INTRAVENOUS")="IV"
 | 
|---|
| 376 |         set i=i+1,map(i,"FOR ORAL SUSP")="ORAL SUSP"
 | 
|---|
| 377 |         set i=i+1,map(i,"CAPLET")="CAP"
 | 
|---|
| 378 |         set i=i+1,map(i,"WITH HCTZ")="HCTZ"
 | 
|---|
| 379 |         set i=i+1,map(i," HCL ")=" "
 | 
|---|
| 380 |         set i=i+1,map(i," HCL/")=""
 | 
|---|
| 381 |         set i=i+1,map(i,"SUST REL")="SR"
 | 
|---|
| 382 |         set i=i+1,map(i,"SR SR")="SR"
 | 
|---|
| 383 |         set i=i+1,map(i,"SUPENSION")="SUSP"
 | 
|---|
| 384 |         set i=i+1,map(i,"FOR SUSP")="SUSP"
 | 
|---|
| 385 |         set i=i+1,map(i,"SUSP ORAL")="ORAL SUSP"
 | 
|---|
| 386 |         set i=i+1,map(i," USP")=""
 | 
|---|
| 387 |         set i=i+1,map(i,"PHOSPHATE")="PHOS"
 | 
|---|
| 388 |         set i=i+1,map(i,"PHOSPHATES")="PHOS"
 | 
|---|
| 389 |         set i=i+1,map(i,"METROPROLOL")="METOPROLOL"
 | 
|---|
| 390 |         set i=i+1,map(i,"EXT-REL")="EXT REL"
 | 
|---|
| 391 |         set i=i+1,map(i," HCLT")=" HCL"
 | 
|---|
| 392 |         set i=i+1,map(i," HCLM")=" HCL"
 | 
|---|
| 393 |         set i=i+1,map(i," HCL")=""
 | 
|---|
| 394 |         set i=i+1,map(i,"INJECTABLE")="INJ"
 | 
|---|
| 395 |         set i=i+1,map(i,"HYDROCHODONE")="HYDROCODONE"
 | 
|---|
| 396 |         set i=i+1,map(i,"HYDROCHLOROTHAZIDE")="HCTZ"
 | 
|---|
| 397 |         set i=i+1,map(i,"HYDROCHLOROIDE")="HCL"
 | 
|---|
| 398 |         set i=i+1,map(i,"SODIUM CHLORIDE")="NACL"
 | 
|---|
| 399 |         set i=i+1,map(i," NAD ")=" AND "
 | 
|---|
| 400 |         set i=i+1,map(i," SODIUM")=""
 | 
|---|
| 401 |         set i=i+1,map(i,"LEVOYHYROXINE")="LEVOTHYROXINE"
 | 
|---|
| 402 |         set i=i+1,map(i," ACETAMINOPHEN")=" APAP"
 | 
|---|
| 403 |         set i=i+1,map(i,"NAPSLATE")="NAPSYLATE"
 | 
|---|
| 404 |         set i=i+1,map(i,"NAPSULATE")="NAPSYLATE"
 | 
|---|
| 405 |         set i=i+1,map(i," NAPSYLATE")=""
 | 
|---|
| 406 |         set i=i+1,map(i,"DARVOCET-N")="DARVOCET N"
 | 
|---|
| 407 |         set i=i+1,map(i,"PROPOX NAP")="PROPOXYPHENE"
 | 
|---|
| 408 |         set i=i+1,map(i,"PROPOX ")="PROPOXYPHENE "
 | 
|---|
| 409 |         set i=i+1,map(i,"PROPOXY ")="PROPOXYPHENE "
 | 
|---|
| 410 |         set i=i+1,map(i,"PROPOXYPHEN ")="PROPOXYPHENE "
 | 
|---|
| 411 |         set i=i+1,map(i,"PROPACET ")="PROPOXYPHENE APAP "
 | 
|---|
| 412 |         set i=i+1,map(i,"CLAULNATE ")="CLAVULANATE "
 | 
|---|
| 413 |         set i=i+1,map(i,"ASPPIRIN ")="ASPIRIN "
 | 
|---|
| 414 | 
 | 
|---|
| 415 |         set i=i+1,map(i," &")=""
 | 
|---|
| 416 |         set i=i+1,map(i," / ")=" "
 | 
|---|
| 417 |         set i=i+1,map(i," CAFFINE")=" CAFFEINE"
 | 
|---|
| 418 |         set i=i+1,map(i,"MGAPAP")="MG APAP"
 | 
|---|
| 419 |         set i=i+1,map(i,"5MG")="5 MG"
 | 
|---|
| 420 |         set i=i+1,map(i,"0MG")="0 MG"
 | 
|---|
| 421 | 
 | 
|---|
| 422 |         quit
 | 
|---|
| 423 | 
 | 
|---|
| 424 | 
 | 
|---|
| 425 | ScrubDoses
 | 
|---|
| 426 |         ;"Purpose: To remove doses from Tradename
 | 
|---|
| 427 |         ;"
 | 
|---|
| 428 | 
 | 
|---|
| 429 |         new skips,ignore,PreSelArray
 | 
|---|
| 430 |         do SetScrubMaps(.skips,.ignore)
 | 
|---|
| 431 | 
 | 
|---|
| 432 |         new Itr,IEN,count
 | 
|---|
| 433 |         set count=0
 | 
|---|
| 434 |         new abort set abort=0
 | 
|---|
| 435 |         write "Gathering a list of suggested name changes, removing #'s and doses...",!
 | 
|---|
| 436 |         set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
 | 
|---|
| 437 |         do PrepProgress^TMGITR(.Itr,20,0,"IEN")
 | 
|---|
| 438 |         if IEN'="" for  do  quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
 | 
|---|
| 439 |         . if $$UserAborted^TMGUSRIF set abort=1 quit
 | 
|---|
| 440 |         . set count=count+$$Scrub1Dose(IEN,.skips,.ignore,0,.PreSelArray)
 | 
|---|
| 441 |         do ProgressDone^TMGITR(.Itr)
 | 
|---|
| 442 | 
 | 
|---|
| 443 |         if $data(PreSelArray)=0 goto SDDone
 | 
|---|
| 444 |         new DelArray
 | 
|---|
| 445 |         do SelRxList("PreSelArray","DelArray","SELECT ALLOWED NAME CHANGES (COLUMN 1=OLD,2=NEW) ESC ESC WHEN DONE",3)
 | 
|---|
| 446 |         if $data(DelArray)=0 goto SDDone
 | 
|---|
| 447 | 
 | 
|---|
| 448 |         new NewName set NewName=""
 | 
|---|
| 449 |         for  set NewName=$order(DelArray(NewName)) quit:(NewName="")  do
 | 
|---|
| 450 |         . new IEN set IEN=0
 | 
|---|
| 451 |         . for  set IEN=$order(DelArray(NewName,IEN)) quit:(+IEN'>0)  do
 | 
|---|
| 452 |         . . new TMGFDA,TMGMSG
 | 
|---|
| 453 |         . . set TMGFDA(22706.9,IEN_",",.05)=NewName
 | 
|---|
| 454 |         . . do FILE^DIE("K","TMGFDA","TMGMSG")
 | 
|---|
| 455 |         . . set count=count+1
 | 
|---|
| 456 |         . . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
 | 
|---|
| 457 | 
 | 
|---|
| 458 | SDDone
 | 
|---|
| 459 |         write count," Trade names (.05 field) modified.",!
 | 
|---|
| 460 |         do PressToCont^TMGUSRIF
 | 
|---|
| 461 | 
 | 
|---|
| 462 |         quit
 | 
|---|
| 463 | 
 | 
|---|
| 464 | 
 | 
|---|
| 465 | Scrub1Dose(IEN,skips,ignore,askuser,PreSelArray)
 | 
|---|
| 466 |         ;"Purpose: To remove doses from Tradename from 1 record
 | 
|---|
| 467 |         ;"Input: skips -- PASS BY REFERENCE.  OPTIONAL
 | 
|---|
| 468 |         ;"       ignore -- PASS BY REFERENCE.  OPTIONAL
 | 
|---|
| 469 |         ;"       askuser -- if 1, then user is asked.  Default=1
 | 
|---|
| 470 |         ;"                  Otherwise, PreSelArray is filled with questions for user
 | 
|---|
| 471 |         ;"       PreSelArray -- PASS BY REFERENCE.  OPTIONAL
 | 
|---|
| 472 |         ;"Results: 1 if modified, 0 if not (including options put into PreSelArray)
 | 
|---|
| 473 | 
 | 
|---|
| 474 |         new result set result=0
 | 
|---|
| 475 |         if ($data(skips)=0)!($data(ignore)=0) do
 | 
|---|
| 476 |         . kill skips,ignore
 | 
|---|
| 477 |         . do SetScrubMaps(.skips,.ignore)
 | 
|---|
| 478 |         set askuser=+$get(askuser,1)
 | 
|---|
| 479 | 
 | 
|---|
| 480 |         new TradeName set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"field .05
 | 
|---|
| 481 |         new j set j=0
 | 
|---|
| 482 |         new ignore1 set ignore1=0
 | 
|---|
| 483 |         for  set j=$order(ignore(j)) quit:(j="")  do
 | 
|---|
| 484 |         . if TradeName[ignore(j) set ignore1=1
 | 
|---|
| 485 |         if ignore1 goto S1DD
 | 
|---|
| 486 |         set j=0
 | 
|---|
| 487 |         for  set j=$order(skips(j)) quit:(j="")  do
 | 
|---|
| 488 |         . new srchS set srchS=$get(skips(j))
 | 
|---|
| 489 |         . if TradeName'[srchS quit
 | 
|---|
| 490 |         . set TradeName=$$Substitute^TMGSTUTL(TradeName,srchS,"@@@"_$char(64+j)_"@@@")
 | 
|---|
| 491 |         new oldName set oldName=TradeName
 | 
|---|
| 492 |         set TradeName=$$ScrubNumeric^TMGSTUTL(TradeName)
 | 
|---|
| 493 |         if TradeName=oldName goto S1DD
 | 
|---|
| 494 |         if TradeName="" goto S1DD
 | 
|---|
| 495 |         if TradeName["@@@" do
 | 
|---|
| 496 |         . new j set j=$ascii($piece(TradeName,"@@@",2))-64
 | 
|---|
| 497 |         . set TradeName=$piece(TradeName,"@@@",1)_$get(skips(j))_$piece(TradeName,"@@@",3)
 | 
|---|
| 498 |         . set oldName=$piece(oldName,"@@@",1)_$get(skips(j))_$piece(oldName,"@@@",3)
 | 
|---|
| 499 |         ;"
 | 
|---|
| 500 |         if askuser'=1 set PreSelArray(TradeName,IEN)="" goto S1DD  ;"bypass user asking...
 | 
|---|
| 501 |         ;"------------------
 | 
|---|
| 502 |         write !,IEN,": '",oldName,"' --> '",TradeName,"'",!
 | 
|---|
| 503 |         new % set %=2
 | 
|---|
| 504 |         write "Accept Change" do YN^DICN write !
 | 
|---|
| 505 |         if %=-1 set abort=1 goto S1DD
 | 
|---|
| 506 |         if %'=1 goto S1DD
 | 
|---|
| 507 |         if TradeName'=oldName do
 | 
|---|
| 508 |         . new TMGFDA,TMGMSG
 | 
|---|
| 509 |         . set TMGFDA(22706.9,IEN_",",.05)=TradeName
 | 
|---|
| 510 |         . do FILE^DIE("K","TMGFDA","TMGMSG")
 | 
|---|
| 511 |         . set result=1
 | 
|---|
| 512 |         . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
 | 
|---|
| 513 | 
 | 
|---|
| 514 | S1DD    quit result
 | 
|---|
| 515 | 
 | 
|---|
| 516 | 
 | 
|---|
| 517 | SetScrubMaps(skips,ignore)
 | 
|---|
| 518 |         ;"Purpose: setup arrays for removing doses from Tradename
 | 
|---|
| 519 |         ;"Input: skips -- PASS BY REFERENCE
 | 
|---|
| 520 |         ;"       ignore -- PASS BY REFERENCE
 | 
|---|
| 521 |         ;"result
 | 
|---|
| 522 | 
 | 
|---|
| 523 |         new i
 | 
|---|
| 524 |         set i=0  ;"NOTE!!! ASCII encoding only allow i up to 63!!
 | 
|---|
| 525 |         set i=i+1,skips(i)="5% DEXTROSE"
 | 
|---|
| 526 |         set i=i+1,skips(i)="5 % DEXTROSE"
 | 
|---|
| 527 |         set i=i+1,skips(i)="10% DEXTROSE"
 | 
|---|
| 528 |         set i=i+1,skips(i)="0.9% NA"
 | 
|---|
| 529 |         set i=i+1,skips(i)=".9% NA"
 | 
|---|
| 530 |         set i=i+1,skips(i)="0.45% NA"
 | 
|---|
| 531 |         set i=i+1,skips(i)="7 7 7"
 | 
|---|
| 532 |         set i=i+1,skips(i)="70 30"
 | 
|---|
| 533 |         set i=i+1,skips(i)="7.4"
 | 
|---|
| 534 |         set i=i+1,skips(i)="3 MONTH"
 | 
|---|
| 535 |         set i=i+1,skips(i)="4 MONTH"
 | 
|---|
| 536 |         set i=i+1,skips(i)="28 TAB"
 | 
|---|
| 537 |         set i=i+1,skips(i)="I 131"
 | 
|---|
| 538 |         set i=i+1,skips(i)="I-131"
 | 
|---|
| 539 |         set i=i+1,skips(i)="I 123"
 | 
|---|
| 540 |         set i=i+1,skips(i)="7 VAGINAL"
 | 
|---|
| 541 |         set i=i+1,skips(i)="3 VAGINAL"
 | 
|---|
| 542 |         set i=i+1,skips(i)="0.3% NACL"
 | 
|---|
| 543 |         set i=i+1,skips(i)="0.2% NACL"
 | 
|---|
| 544 |         set i=i+1,skips(i)="B12"
 | 
|---|
| 545 |         set i=i+1,skips(i)="B6"
 | 
|---|
| 546 |         set i=i+1,skips(i)="TC 99M"
 | 
|---|
| 547 |         set i=i+1,skips(i)="TC99M"
 | 
|---|
| 548 |         set i=i+1,skips(i)="THEO 24"
 | 
|---|
| 549 |         set i=i+1,skips(i)="24 H"
 | 
|---|
| 550 |         set i=i+1,skips(i)="12 H"
 | 
|---|
| 551 |         set i=i+1,skips(i)=" 12 "
 | 
|---|
| 552 |         set i=i+1,skips(i)=" 24 "
 | 
|---|
| 553 |         set i=i+1,skips(i)="VITAMIN K1"
 | 
|---|
| 554 |         set i=i+1,skips(i)="PH7"
 | 
|---|
| 555 | 
 | 
|---|
| 556 |         ;"Put entries here when the presence of a word is enough to ignore entire drug name.
 | 
|---|
| 557 |         ;"if TradeName[ingore(x) then no further check done
 | 
|---|
| 558 |         set i=0  ;"no limit on # here...
 | 
|---|
| 559 |         set i=i+1,ignore(i)="TERAZOL"
 | 
|---|
| 560 |         set i=i+1,ignore(i)="ORTHO "
 | 
|---|
| 561 |         set i=i+1,ignore(i)="DARVOCET"
 | 
|---|
| 562 |         set i=i+1,ignore(i)="DEMULEN"
 | 
|---|
| 563 |         set i=i+1,ignore(i)="LEVLEN"
 | 
|---|
| 564 |         set i=i+1,ignore(i)="LEVLITE"
 | 
|---|
| 565 |         set i=i+1,ignore(i)="LOESTRIN"
 | 
|---|
| 566 |         set i=i+1,ignore(i)="NECON"
 | 
|---|
| 567 |         set i=i+1,ignore(i)=" MT "
 | 
|---|
| 568 |         set i=i+1,ignore(i)="ORTHOCEPT"
 | 
|---|
| 569 |         set i=i+1,ignore(i)="GYNAZOLE"
 | 
|---|
| 570 |         set i=i+1,ignore(i)="OVCON"
 | 
|---|
| 571 |         set i=i+1,ignore(i)="MONISTAT"
 | 
|---|
| 572 |         set i=i+1,ignore(i)="MICROGESTIN"
 | 
|---|
| 573 |         set i=i+1,ignore(i)="ULTRASE"
 | 
|---|
| 574 |         set i=i+1,ignore(i)="MTE "
 | 
|---|
| 575 |         set i=i+1,ignore(i)="M T E "
 | 
|---|
| 576 |         set i=i+1,ignore(i)="INSULIN"
 | 
|---|
| 577 | 
 | 
|---|
| 578 |         quit
 | 
|---|
| 579 | 
 | 
|---|
| 580 | 
 | 
|---|
| 581 | CautionMsg
 | 
|---|
| 582 |         ;"Purpose: To show a caution message.
 | 
|---|
| 583 | 
 | 
|---|
| 584 |         write !,"**NOTICE**",!
 | 
|---|
| 585 |         write "This will use the MULTI-selector to pick imports to be",!
 | 
|---|
| 586 |         write "be edited.  BE VERY CAREFUL not to select more than one",!
 | 
|---|
| 587 |         write "drug before exiting to enter the edit screen.",!
 | 
|---|
| 588 |         write "For example:  If 3 different drugs were selected, and then",!
 | 
|---|
| 589 |         write "ESC ESC pressed, then one will be presented with an opportunity",!
 | 
|---|
| 590 |         write "to edit the drug name.  BUT NOTE: one would be editing ALL THREE",!
 | 
|---|
| 591 |         write "drugs AT ONCE, very likely creating an error in 2 of the drugs.",!
 | 
|---|
| 592 |         write !
 | 
|---|
| 593 | 
 | 
|---|
| 594 |         do PressToCont^TMGUSRIF
 | 
|---|
| 595 |         quit
 | 
|---|
| 596 | 
 | 
|---|
| 597 | 
 | 
|---|
| 598 | EditTradename(SkipValue)
 | 
|---|
| 599 |         ;"Purpose: to select records to mark as to be skipped.
 | 
|---|
| 600 |         ;"Input: SkipValue: OPTIONAL. Default=0.
 | 
|---|
| 601 |         ;"              0=show only values NOT marked to be skipped
 | 
|---|
| 602 |         ;"              1=show only values MARKED to be skipped
 | 
|---|
| 603 |         ;"              ALL=show BOTH skip and non-skipped fields.
 | 
|---|
| 604 |         ;"Output: User may alter the value of SKIP THIS RECORD field for all records
 | 
|---|
| 605 |         ;"Results: none
 | 
|---|
| 606 | 
 | 
|---|
| 607 |         do CautionMsg
 | 
|---|
| 608 | 
 | 
|---|
| 609 |         new Options,IEN
 | 
|---|
| 610 |         set Options("FIELDS",1)=".04^LONG NAME^25"
 | 
|---|
| 611 |         set Options("FIELDS",1,"NO EDIT")=1  ;"i.e. show for browsing, but don't allow edit
 | 
|---|
| 612 |         set Options("FIELDS",2)=".05^TRADENAME^64"
 | 
|---|
| 613 |         set Options("FIELDS","MAX NUM")=2
 | 
|---|
| 614 |         set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED"
 | 
|---|
| 615 | 
 | 
|---|
| 616 |         set SkipValue=$get(SkipValue,0)  ;"0=NOT SKIPPED
 | 
|---|
| 617 |         ;"Get all records with chosed SKIP THIS RECORD value
 | 
|---|
| 618 |         do GetFldValue^TMGSELED(22706.9,6,SkipValue,$name(Options("IEN LIST")))
 | 
|---|
| 619 | 
 | 
|---|
| 620 | PSK1    if $$SELED^TMGSELED(.Options)'=2 goto ETNDone
 | 
|---|
| 621 |         if $$GetIENs^TMGSELED(.Options)=0 goto ETNDone
 | 
|---|
| 622 |         goto PSK1
 | 
|---|
| 623 | 
 | 
|---|
| 624 | ETNDone quit
 | 
|---|
| 625 | 
 | 
|---|
| 626 | 
 | 
|---|
| 627 | 
 | 
|---|
| 628 | 
 | 
|---|
| 629 | SelRxList(pList,pSelList,HdrText,mode)
 | 
|---|
| 630 |         ;"Purpose: To display the Drug list, and allow user to select from the list.
 | 
|---|
| 631 |         ;"Input: pList -- PASS BY NAME -- list of drugs to be added, as created by FillList(pList)
 | 
|---|
| 632 |         ;"                   @pList@(drugName,IEN)=""
 | 
|---|
| 633 |         ;"       pSelList -- PASS BY NAME, an OUT PARAMETER.
 | 
|---|
| 634 |         ;"              Returns list of selected items
 | 
|---|
| 635 |         ;"                   @pSelList@(drugName,IEN)=""  ;IEN is from 22706.9
 | 
|---|
| 636 |         ;"                   @pSelList@(drugName,IEN)=""
 | 
|---|
| 637 |         ;"       HdrText -- optional, some text to show on top of selector
 | 
|---|
| 638 |         ;"       mode -- OPTIONAL.  Default=1
 | 
|---|
| 639 |         ;"                 1 --> Display by LONG NAME  .04 name
 | 
|---|
| 640 |         ;"                 2 --> Display by VA PRODUCT (50.68) .01 name
 | 
|---|
| 641 |         ;"                 3 --> Display by FDA import name
 | 
|---|
| 642 |         ;"                 4 --> Display by VA GENERIC name
 | 
|---|
| 643 | 
 | 
|---|
| 644 |         ;"Results: none
 | 
|---|
| 645 | 
 | 
|---|
| 646 |         new ref set ref="^TMP(""VEE"",$J)"
 | 
|---|
| 647 |         kill @ref
 | 
|---|
| 648 |         new count set count=1
 | 
|---|
| 649 |         set mode=$get(mode,1)
 | 
|---|
| 650 | 
 | 
|---|
| 651 |         ;"new pNDCIndex set pNDCIndex=$$GetNDCIndex^TMGNDF4A(1)
 | 
|---|
| 652 | 
 | 
|---|
| 653 |         write "Prepping to display list...",!
 | 
|---|
| 654 |         ;"First convert list to a display format
 | 
|---|
| 655 |         new name,IEN,Itr
 | 
|---|
| 656 | 
 | 
|---|
| 657 |         set name=$$ItrAInit^TMGITR(pList,.Itr)
 | 
|---|
| 658 |         do PrepProgress^TMGITR(.Itr,20,1,"name")
 | 
|---|
| 659 |         if name'="" for  do  quit:($$ItrANext^TMGITR(.Itr,.name)="")
 | 
|---|
| 660 |         . new addedArray,showName
 | 
|---|
| 661 |         . set IEN=0
 | 
|---|
| 662 |         . for  set IEN=$order(@pList@(name,IEN)) quit:(IEN="")  do
 | 
|---|
| 663 |         . . new NameInfo do GetInfo^TMGNDF3B(IEN,.NameInfo)
 | 
|---|
| 664 |         . . new IdxName set IdxName=$get(NameInfo("MODES",mode))
 | 
|---|
| 665 |         . . if mode=3 do  ;"Display by FDA import name (TradeName)
 | 
|---|
| 666 |         . . . set showName=""
 | 
|---|
| 667 |         . . . for  set showName=$order(NameInfo(IdxName,showName)) quit:(showName="")  do
 | 
|---|
| 668 |         . . . . set @ref@(count)=name_"^"_IEN_$char(9)
 | 
|---|
| 669 |         . . . . new newShowName set newShowName=$extract(showName,1,35)
 | 
|---|
| 670 |         . . . . set newShowName=$$LJ^XLFSTR(newShowName,35," ")
 | 
|---|
| 671 |         . . . . new newName set newName=$extract(name,1,35)
 | 
|---|
| 672 |         . . . . set newName=$$LJ^XLFSTR(newName,35," ")
 | 
|---|
| 673 |         . . . . set @ref@(count)=@ref@(count)_newShowName_"|"_newName
 | 
|---|
| 674 |         . . . . set count=count+1
 | 
|---|
| 675 |         . . . set showName=""  ;"prevent duplicate addition below
 | 
|---|
| 676 |         . . else  if (mode>0)&(mode<5) set showName=$order(NameInfo(IdxName,""))
 | 
|---|
| 677 |         . . if (showName'="") set @ref@(count)=name_"^"_IEN_$char(9)_showName set count=count+1
 | 
|---|
| 678 | 
 | 
|---|
| 679 |         set @ref@("HD")=$get(HdrText,"MENU")
 | 
|---|
| 680 | 
 | 
|---|
| 681 |         ;"Note: Rules of use:
 | 
|---|
| 682 |         ;"  ref must=^TMP("VEE",$J)
 | 
|---|
| 683 |         ;"  Each line should be in this format:
 | 
|---|
| 684 |         ;"      @ref@(number)=ReturnValue_$char(9)_DisplayValue
 | 
|---|
| 685 |         ;"      @ref@(number)=ReturnValue_$char(9)_DisplayValue
 | 
|---|
| 686 |         ;"      @ref@(number)=ReturnValue_$char(9)_DisplayValue
 | 
|---|
| 687 |         ;"  Results come back in:
 | 
|---|
| 688 |         ;"      ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue
 | 
|---|
| 689 |         ;"      ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue
 | 
|---|
| 690 |         ;"      ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue
 | 
|---|
| 691 | 
 | 
|---|
| 692 |         write !,"Passing off to Selector..."
 | 
|---|
| 693 |         D SELECT^%ZVEMKT(ref)
 | 
|---|
| 694 | 
 | 
|---|
| 695 |         set ref="^TMP(""VPE"",""SELECT"","_$J_")"
 | 
|---|
| 696 |         new number set number=""
 | 
|---|
| 697 |         for  set number=$order(@ref@(number)) quit:(number="")  do
 | 
|---|
| 698 |         . new ReturnValue set ReturnValue=$piece(@ref@(number),$char(9),1)
 | 
|---|
| 699 |         . new drugName set drugName=$piece(ReturnValue,"^",1)
 | 
|---|
| 700 |         . new IEN set IEN=$piece(ReturnValue,"^",2)
 | 
|---|
| 701 |         . set @pSelList@(drugName,IEN)=""
 | 
|---|
| 702 | 
 | 
|---|
| 703 |         quit
 | 
|---|
| 704 | 
 | 
|---|
| 705 |  ;"========================================================
 | 
|---|
| 706 | PickEdit
 | 
|---|
| 707 |         ;"Purpose: ask user to pick record, and then edit.
 | 
|---|
| 708 | 
 | 
|---|
| 709 |         new DIC,X,Y
 | 
|---|
| 710 |         set DIC=22706.9
 | 
|---|
| 711 |         set DIC(0)="MAEQ"
 | 
|---|
| 712 |         set DIC("A")="Enter Imported Drug to Edit (^ to abort): "
 | 
|---|
| 713 | PE1
 | 
|---|
| 714 |         do ^DIC write !
 | 
|---|
| 715 |         if +Y>0 do Edit1(+Y) goto PE1
 | 
|---|
| 716 | 
 | 
|---|
| 717 |         quit
 | 
|---|
| 718 | 
 | 
|---|
| 719 | 
 | 
|---|
| 720 | Edit1(IEN)
 | 
|---|
| 721 |         ;"Purpose: To edit one record in 22706.9
 | 
|---|
| 722 |         ;"Input: IEN -- IEN in 22706.9
 | 
|---|
| 723 |         ;"Results: none
 | 
|---|
| 724 | 
 | 
|---|
| 725 |         new Options,IENlist
 | 
|---|
| 726 |         set IENlist(IEN)=""
 | 
|---|
| 727 |         set Options("FILE")=22706.9
 | 
|---|
| 728 |         new temp
 | 
|---|
| 729 |         set temp=$$GetFields^TMGSELED(.Options)
 | 
|---|
| 730 |         if temp=1 set temp=$$EditRecs^TMGSELED("IENlist",.Options)
 | 
|---|
| 731 | 
 | 
|---|
| 732 |         quit
 | 
|---|
| 733 | 
 | 
|---|
| 734 | 
 | 
|---|