| 1 | TMGNDF4G ;TMG/kst/FDA Import -- Fix OQV Problems;10/15/07
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;10/15/07
|
|---|
| 3 |
|
|---|
| 4 | ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
|
|---|
| 5 | ;" Fixing problems with ORDER QUICK VIEW
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU General Public License (GPL) applies
|
|---|
| 8 | ;"10-15-2007
|
|---|
| 9 |
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" API -- Public Functions.
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;"(No menu -- called from ^TMGNDF4F)
|
|---|
| 14 | ;"AskFix1TMG -- ask user for entry in 22706.9 and allow editing.
|
|---|
| 15 | ;"=======================================================================
|
|---|
| 16 |
|
|---|
| 17 | ;"=======================================================================
|
|---|
| 18 | ;" Private Functions.
|
|---|
| 19 | ;"=======================================================================
|
|---|
| 20 | ;"FixOQVMissing -- fix a missing ORDER QUICK VIEW.
|
|---|
| 21 | ;"FindOQV(Prefix,RxName,RxSet,SrchRec) -- Search ORDER QUICk VIEW for RxName, and return if found
|
|---|
| 22 | ;"FindTMG(Prefix,RxName,RxSet,SrchRec,IgnoreSkipped) -- Scan 22706.9 for RxName, and return if found
|
|---|
| 23 | ;"DoFind(Prefix,RxName,FileNum,Field,SrchRec,index) -- Scam file for RxName, and return if found
|
|---|
| 24 | ;"HandleChain(array) -- Show chain and alow user editing etc. from input entry towards final part of chain (Order Quick View)
|
|---|
| 25 | ;"HandleOne(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9,GorT) -- show the user a drug chain and allow manipulation of it
|
|---|
| 26 | ;"Hndl22706d9(IEN,RxSet,OutArray,array1,GorT) -- A brief subroutine to format 22706.9 input
|
|---|
| 27 | ;"Fmt101d43(IEN,RxSet) -- add an entry from file 101.43 to output string
|
|---|
| 28 | ;"Fmt50d7(IEN,RxSet) -- add an entry from file 50.7 to output string
|
|---|
| 29 | ;"Fmt50(IEN,RxSet) -- add an entry from file 50 to output string
|
|---|
| 30 | ;"Fmt22706d9(IEN,RxSet,s) -- add an entry from file 22706.9 to output string
|
|---|
| 31 | ;"EditTMG(IEN) -- to edit the TMG entry in 22706.9
|
|---|
| 32 | ;"FullEDTMG(IEN) -- allow editing of any field in TMG 22706.9
|
|---|
| 33 |
|
|---|
| 34 | ;"=======================================================================
|
|---|
| 35 |
|
|---|
| 36 | FixOQVMissing
|
|---|
| 37 | ;"Purpose: to fix a missing ORDER QUICK VIEW. I.e. add entry and
|
|---|
| 38 | ;" and interviening entries needed.
|
|---|
| 39 | ;"Input: none.
|
|---|
| 40 |
|
|---|
| 41 | new RxSet
|
|---|
| 42 | set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto FOQVDone
|
|---|
| 43 |
|
|---|
| 44 | new RxName,SrchRec
|
|---|
| 45 | read "Enter DRUG NAME to FIND/ADD (may be partial name): ",RxName:$get(DTIME,3600),!
|
|---|
| 46 | if (RxName="")!(RxName="^") goto FOQVDone
|
|---|
| 47 |
|
|---|
| 48 | ;"do FindOQV("A. (101.44): ",RxName,RxSet,.SrchRec) ;"ORDER QUICK VIEW
|
|---|
| 49 | ;"do DoFind("B. (101.43): ",RxName,101.43,.01,.SrchRec,"B") ;"ORDERABLE ITEM
|
|---|
| 50 | ;"do DoFind("C. (50.7): ",RxName,50.7,.01,.SrchRec,"B") ;"PHARMACY ORDERABLE ITEM
|
|---|
| 51 | ;"do DoFind("D. (50): ",RxName,50,.01,.SrchRec,"B") ;"DRUG file
|
|---|
| 52 | ;"do DoFind("E. (22706.9): ",RxName,22706.9,.04,.SrchRec,"LN^C") ;"TMG FDA IMPORT COMPILED (22706.9)
|
|---|
| 53 | ;"do DoFind("",RxName,22706.9,.04,.SrchRec,"B^C^D^E^LN") ;"TMG FDA IMPORT COMPILED (22706.9)
|
|---|
| 54 |
|
|---|
| 55 | new % set %=1
|
|---|
| 56 | write "Ignore drugs marked to be SKIPPED"
|
|---|
| 57 | do YN^DICN write !
|
|---|
| 58 | if %=-1 goto FOQVDone
|
|---|
| 59 | do FindTMG("",RxName,RxSet,.SrchRec,(%=1))
|
|---|
| 60 |
|
|---|
| 61 | write !,"Next, select one or more drugs that are ",!
|
|---|
| 62 | write "examples of a drug that is missing.",!
|
|---|
| 63 | do PressToCont^TMGUSRIF
|
|---|
| 64 |
|
|---|
| 65 | new Results
|
|---|
| 66 | do Slctor2^TMGUSRIF("SrchRec","Results","Pick Example(s) of Missing Drugs. [ESC][ESC] when done.")
|
|---|
| 67 |
|
|---|
| 68 | set %=1
|
|---|
| 69 | write "Automatically Refreshing Selected Before Editing"
|
|---|
| 70 | do YN^DICN write !
|
|---|
| 71 | if %=-1 goto FOQVDone
|
|---|
| 72 | if %=1 do RefreshChain(.Results)
|
|---|
| 73 |
|
|---|
| 74 | do HandleChain(.Results) ;"Show forward array
|
|---|
| 75 |
|
|---|
| 76 | write "Done.",!
|
|---|
| 77 | do PressToCont^TMGUSRIF
|
|---|
| 78 |
|
|---|
| 79 | FOQVDone
|
|---|
| 80 | quit
|
|---|
| 81 |
|
|---|
| 82 |
|
|---|
| 83 | AskFix1TMG
|
|---|
| 84 | ;"Purpose: ask user for entry in 22706.9 and allow editing.
|
|---|
| 85 |
|
|---|
| 86 | new DIC,X,Y,IEN22706d9
|
|---|
| 87 |
|
|---|
| 88 | set DIC=22706.9,DIC(0)="MAEQ"
|
|---|
| 89 | do ^DIC
|
|---|
| 90 | if +Y>0 do
|
|---|
| 91 | . new array
|
|---|
| 92 | . set array($piece(Y,"^",2),+Y_"^22706.9")=""
|
|---|
| 93 | . do HandleChain(.array)
|
|---|
| 94 |
|
|---|
| 95 | quit
|
|---|
| 96 |
|
|---|
| 97 |
|
|---|
| 98 | FindOQV(Prefix,RxName,RxSet,SrchRec)
|
|---|
| 99 | ;"Purpose: look through ORDER QUICk VIEW for RxName, and return if found
|
|---|
| 100 | ;"Input: Prefix -- a string to prefix name with in index.
|
|---|
| 101 | ;" RxName -- the string of the Rx name to look for (may be a partial name)
|
|---|
| 102 | ;" RxSet -- IEN of 'ORWDSET O RX' in 101.44
|
|---|
| 103 | ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format:
|
|---|
| 104 | ;" SrchRec(NameFound)=IEN^File#
|
|---|
| 105 | ;" SrchRec(NameFound)=IEN^File#
|
|---|
| 106 | ;"Output: SrchRec is filled.
|
|---|
| 107 | ;"Result: none
|
|---|
| 108 |
|
|---|
| 109 | new TMGDATA,TMGERR
|
|---|
| 110 | do FIND^DIC(101.442,","_RxSet_",","","M",RxName,"*","B","","","TMGDATA","TMGERR")
|
|---|
| 111 |
|
|---|
| 112 | if +$get(TMGDATA("DILIST",0))>0 do
|
|---|
| 113 | . new j,IEN,Name
|
|---|
| 114 | . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do
|
|---|
| 115 | . . set IEN=$get(TMGDATA("DILIST",2,j))
|
|---|
| 116 | . . set name=Prefix_$$GET1^DIQ(101.442,IEN_","_RxSet_",",".01")
|
|---|
| 117 | . . set SrchRec(name,IEN_","_RxSet_",^101.442")=""
|
|---|
| 118 |
|
|---|
| 119 | quit
|
|---|
| 120 |
|
|---|
| 121 |
|
|---|
| 122 | FindTMG(Prefix,RxName,RxSet,SrchRec,IgnoreSkipped)
|
|---|
| 123 | ;"Purpose: look through 22706.9 for RxName, and return if found
|
|---|
| 124 | ;"Input: Prefix -- a string to prefix name with in index.
|
|---|
| 125 | ;" RxName -- the string of the Rx name to look for (may be a partial name)
|
|---|
| 126 | ;" RxSet -- IEN of 'ORWDSET O RX' in 101.44
|
|---|
| 127 | ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format:
|
|---|
| 128 | ;" SrchRec(NameFound,IEN^File#)=""
|
|---|
| 129 | ;" SrchRec(NameFound,IEN^File#)=""
|
|---|
| 130 | ;" IgnoreSkipped -- if 1 then only show drugs not marked to be SKIPPED
|
|---|
| 131 | ;"Output: SrchRec is filled.
|
|---|
| 132 | ;"Result: none
|
|---|
| 133 |
|
|---|
| 134 | new TMGDATA,TMGERR
|
|---|
| 135 | ;"do FIND^DIC(22706.9,"","","M",RxName,"*","B^C^D^E^LN","","","TMGDATA","TMGERR")
|
|---|
| 136 | do FIND^DIC(22706.9,"","","M",RxName,"*","B^C^D^LN","","","TMGDATA","TMGERR")
|
|---|
| 137 |
|
|---|
| 138 | if +$get(TMGDATA("DILIST",0))>0 do
|
|---|
| 139 | . new j,IEN,IENS,name,name1,name2,name3,TMGARRAY
|
|---|
| 140 | . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do
|
|---|
| 141 | . . set IEN=$get(TMGDATA("DILIST",2,j)),IENS=IEN_","
|
|---|
| 142 | . . do GETS^DIQ(22706.9,IENS,".05;.07;6;.04",,"TMGARRAY","TMGMSG")
|
|---|
| 143 | . . if IgnoreSkipped,($get(TMGARRAY(22706.9,IENS,"6"))="SKIP") quit
|
|---|
| 144 | . . set name1=$get(TMGARRAY(22706.9,IENS,".05"))
|
|---|
| 145 | . . set name2=$get(TMGARRAY(22706.9,IENS,".07"))
|
|---|
| 146 | . . set name3=$get(TMGARRAY(22706.9,IENS,".04"))
|
|---|
| 147 | . . set name=name1_" | "_name2_" | "_name3
|
|---|
| 148 | . . set name=$extract(name,1,75)
|
|---|
| 149 | . . set SrchRec(name,IENS_"^"_"22706.9")=""
|
|---|
| 150 |
|
|---|
| 151 | quit
|
|---|
| 152 |
|
|---|
| 153 |
|
|---|
| 154 | DoFind(Prefix,RxName,FileNum,Field,SrchRec,index)
|
|---|
| 155 | ;"Purpose: look through file for RxName, and return if found
|
|---|
| 156 | ;"Input: Prefix -- a string to prefix name with in index.
|
|---|
| 157 | ;" RxName -- the string of the Rx name to look for (may be a partial name)
|
|---|
| 158 | ;" FileNum -- The file number to look in.
|
|---|
| 159 | ;" Field -- OPTIONAL. Field to return value in. Default=.01
|
|---|
| 160 | ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format:
|
|---|
| 161 | ;" SrchRec(NameFound)=IEN^File#
|
|---|
| 162 | ;" SrchRec(NameFound)=IEN^File#
|
|---|
| 163 | ;" --NOTE: if Name has already been found, it will NOT be overwritten here.
|
|---|
| 164 | ;" index -- OPTIONAL. Index to search. Default="B"
|
|---|
| 165 | ;"Output: SrchRec is filled.
|
|---|
| 166 | ;"Result: none
|
|---|
| 167 |
|
|---|
| 168 | set Field=$get(Field,".01")
|
|---|
| 169 | set index=$get(index,"B")
|
|---|
| 170 |
|
|---|
| 171 | new TMGDATA,TMGERR
|
|---|
| 172 | do FIND^DIC(FileNum,"","","M",RxName,"*",index,"","","TMGDATA","TMGERR")
|
|---|
| 173 |
|
|---|
| 174 | if +$get(TMGDATA("DILIST",0))>0 do
|
|---|
| 175 | . new j,IEN,Name
|
|---|
| 176 | . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do
|
|---|
| 177 | . . set IEN=$get(TMGDATA("DILIST",2,j))
|
|---|
| 178 | . . set name=Prefix_$$GET1^DIQ(FileNum,IEN,Field)
|
|---|
| 179 | . . set SrchRec(name,IEN_"^"_FileNum)=""
|
|---|
| 180 |
|
|---|
| 181 | quit
|
|---|
| 182 |
|
|---|
| 183 |
|
|---|
| 184 | RefreshChain(array)
|
|---|
| 185 | ;"Purpose: Refresh entries in 22706.9
|
|---|
| 186 | ;"Input: -- array: PASS BY REFERENCE. Format:
|
|---|
| 187 | ;" array(DrugName,IEN^File#)=""
|
|---|
| 188 | ;" array(DrugName,IEN^File#)=""
|
|---|
| 189 | ;" Note: it is expected that File# will be:
|
|---|
| 190 | ;" 101.44, 101.43, 50.7, 50, or 22706.9
|
|---|
| 191 |
|
|---|
| 192 | new name,IENArray
|
|---|
| 193 | set name=""
|
|---|
| 194 | for set name=$order(array(name)) quit:(name="") do
|
|---|
| 195 | . new fInfo set fInfo=""
|
|---|
| 196 | . for set fInfo=$order(array(name,fInfo)) quit:(fInfo="") do
|
|---|
| 197 | . . new IEN,FileNum
|
|---|
| 198 | . . set FileNum=$piece(fInfo,"^",2)
|
|---|
| 199 | . . if FileNum'=22706.9 quit
|
|---|
| 200 | . . set IEN=$piece(fInfo,"^",1)
|
|---|
| 201 | . . set IENArray(+IEN)=""
|
|---|
| 202 |
|
|---|
| 203 | new Option set Option("FIX CHAIN")=1
|
|---|
| 204 | set Option("QUIET")=1
|
|---|
| 205 | do RefreshBatch^TMGNDF3C(.IENArray,.Option)
|
|---|
| 206 |
|
|---|
| 207 | quit
|
|---|
| 208 |
|
|---|
| 209 |
|
|---|
| 210 | HandleChain(array) ;"Show forward array
|
|---|
| 211 | ;"Purpose: Show chain from input entry towards final part of chain (Order Quick View)
|
|---|
| 212 | ;"Input: -- array: PASS BY REFERENCE. Format:
|
|---|
| 213 | ;" array(DrugName,IEN^File#)=""
|
|---|
| 214 | ;" array(DrugName,IEN^File#)=""
|
|---|
| 215 | ;" Note: it is expected that File# will be:
|
|---|
| 216 | ;" 101.44, 101.43, 50.7, 50, or 22706.9
|
|---|
| 217 |
|
|---|
| 218 | new output,RxSet,OutArray
|
|---|
| 219 |
|
|---|
| 220 | set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto HCnDone
|
|---|
| 221 | new IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9
|
|---|
| 222 | new array1,array2,num
|
|---|
| 223 | new abort,rescan
|
|---|
| 224 | new name
|
|---|
| 225 | HC1
|
|---|
| 226 | kill output,array2,array1
|
|---|
| 227 | set name=""
|
|---|
| 228 | for set name=$order(array(name)) quit:(name="") do
|
|---|
| 229 | . new fInfo set fInfo=""
|
|---|
| 230 | . for set fInfo=$order(array(name,fInfo)) quit:(fInfo="") do
|
|---|
| 231 | . . new IEN,FileNum
|
|---|
| 232 | . . set IEN=$piece(fInfo,"^",1)
|
|---|
| 233 | . . set FileNum=$piece(fInfo,"^",2)
|
|---|
| 234 | . . if FileNum=101.44 set output=IEN
|
|---|
| 235 | . . else if FileNum=101.43 set output=$$Fmt101d43(IEN,RxSet)
|
|---|
| 236 | . . else if FileNum=50.7 set output=$$Fmt50d7(IEN,RxSet)
|
|---|
| 237 | . . else if FileNum=50 set output=$$Fmt50(IEN,RxSet)
|
|---|
| 238 | . . else if FileNum=22706.9 do
|
|---|
| 239 | . . . do Hndl22706d9(IEN,RxSet,.OutArray,.array1,"T")
|
|---|
| 240 | . . . set output=$$Fmt22706d9(IEN,RxSet,"G")
|
|---|
| 241 | . . set IEN10144=+$piece(output,"^",1)
|
|---|
| 242 | . . set IEN10143=+$piece(output,"^",2)
|
|---|
| 243 | . . set IEN50d7=+$piece(output,"^",3)
|
|---|
| 244 | . . set IEN50=+$piece(output,"^",4)
|
|---|
| 245 | . . set IEN22706d9=+$piece(output,"^",5)
|
|---|
| 246 | . . if IEN22706d9=0 quit
|
|---|
| 247 | . . set OutArray(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9)="G"
|
|---|
| 248 | . . set array1(IEN22706d9,IEN10144_"^"_IEN10143_"^"_IEN50d7_"^"_IEN50_"^"_IEN22706d9_"^"_"G")=""
|
|---|
| 249 |
|
|---|
| 250 | ;"Now rearrange into a numbered array
|
|---|
| 251 | set num=0,IEN22706d9=""
|
|---|
| 252 | for set IEN22706d9=$order(array1(IEN22706d9)) quit:(IEN22706d9="") do
|
|---|
| 253 | . new s set s=""
|
|---|
| 254 | . for set s=$order(array1(IEN22706d9,s)) quit:(s="") do
|
|---|
| 255 | . . set num=num+1
|
|---|
| 256 | . . set array2(num)=s
|
|---|
| 257 |
|
|---|
| 258 | ;"Now display array -- this setup will allow user to back up in list
|
|---|
| 259 | set abort=0,rescan=0,num=0
|
|---|
| 260 | for set num=$order(array2(num)) quit:(num="")!(abort=1)!(rescan=1) do
|
|---|
| 261 | . new s set s=$get(array2(num))
|
|---|
| 262 | . new result
|
|---|
| 263 | . set result=$$HandleOne($piece(s,"^",1),$piece(s,"^",2),$piece(s,"^",3),$piece(s,"^",4),$piece(s,"^",5),$piece(s,"^",6))
|
|---|
| 264 | . if result="^" set abort=1 quit
|
|---|
| 265 | . else if result=-3 kill array2(num) quit
|
|---|
| 266 | . else if result=-4 set rescan=1 quit
|
|---|
| 267 | . else if result=-1 do quit
|
|---|
| 268 | . . set num=$order(array2(num),-1)
|
|---|
| 269 | . . if num>0 set num=$order(array2(num),-1)
|
|---|
| 270 |
|
|---|
| 271 | if rescan=1 goto HC1
|
|---|
| 272 |
|
|---|
| 273 | HCnDone
|
|---|
| 274 | quit
|
|---|
| 275 |
|
|---|
| 276 |
|
|---|
| 277 | HandleOne(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9,GorT)
|
|---|
| 278 | ;"Purpose: to show the user a drug chain and allow manipulation of it
|
|---|
| 279 | ;"Input: IEN's
|
|---|
| 280 | ;" GorT -- G or T
|
|---|
| 281 | ;"NOTE: makes use of RxSet (a variable globally scoped here)
|
|---|
| 282 | ;"Results: 1: go to next,
|
|---|
| 283 | ;" -1: go back one,
|
|---|
| 284 | ;" ^: abort,
|
|---|
| 285 | ;" -3: delete this record
|
|---|
| 286 | ;" -4: Rescan and re-setup array
|
|---|
| 287 |
|
|---|
| 288 | new input
|
|---|
| 289 | new result set result=1
|
|---|
| 290 | H1L1
|
|---|
| 291 | write #
|
|---|
| 292 | write "-- TMG FDA IMPORT COMPILED (22706.9) file, Record# ",IEN22706d9," [",GorT,"] -----------",!
|
|---|
| 293 | new tabCol set tabCol=50
|
|---|
| 294 | ;"write $extract($$GET1^DIQ(22706.9,IEN22706d9_",",.04),1,48),?50," [.04;22706.9:#",IEN22706d9,"]",!
|
|---|
| 295 | write "1. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.04),?tabCol," [.04; Long]",!
|
|---|
| 296 | write "2. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.05),?tabCol," [.05; Trade (inclds Frm)]",!
|
|---|
| 297 | write "3. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.055),?tabCol," [.055; Trade&Frm]",!
|
|---|
| 298 | write "4. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),?tabCol," [.056; Trade,Frm,Dose,Unit]",!
|
|---|
| 299 | write "5. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.07),?tabCol," [.07; Generic]",!
|
|---|
| 300 | write "6. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.075),?tabCol," [.075; Genrc&Frm]",!
|
|---|
| 301 | write "7. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.076),?tabCol," [.076; Generc,Frm,Dose,Unit]",!
|
|---|
| 302 | write "8. +-> [",GorT,"] ",$$GET1^DIQ(50,IEN50_",",.01),?tabCol," [50:#",IEN50,"]",!
|
|---|
| 303 | new vapIEN set vapIEN=+$piece($get(^PSDRUG(IEN50,"ND")),"^",3)
|
|---|
| 304 | if vapIEN>0 write "9. +~~~> 50.68: ",$$GET1^DIQ(50.68,vapIEN_",",.01),!
|
|---|
| 305 | write "10. +->",$$GET1^DIQ(50.7,IEN50d7_",",.01),?tabCol," [50.7:#",IEN50d7,"]",!
|
|---|
| 306 | write "11. +->",$$GET1^DIQ(101.43,IEN10143_",",.01),?tabCol," [101.43:#",IEN10143,"]",!
|
|---|
| 307 | write "12. +->",$$GET1^DIQ(101.442,IEN10144_","_RxSet_",",.01),?tabCol," [101.44:#",IEN10144,"]",!
|
|---|
| 308 | write !
|
|---|
| 309 | write "'-'=Backward; '+'=Forward; '^'=quit;",!
|
|---|
| 310 | write "F=show FDA source; T=show Compiled record dump",!
|
|---|
| 311 | write "S=mark import to be SKIPPED'",!
|
|---|
| 312 | write "FE=Full edit of Compiled",!
|
|---|
| 313 | write "1..7=Edit Compiled, 8=Edit DRUG (50) record",!
|
|---|
| 314 | write "RC=Recompile; N=Alt Names setup; RDL=Refresh DRUG link",!
|
|---|
| 315 | read "Enter option: +// ",input,!
|
|---|
| 316 | if input="" set input="+"
|
|---|
| 317 | set input=$$UP^XLFSTR(input)
|
|---|
| 318 | if input="^" set result="^" goto HODone
|
|---|
| 319 | if input="-" set result=-1 goto HODone
|
|---|
| 320 | if input="+" set result=1 goto HODone
|
|---|
| 321 | if input="FE" do
|
|---|
| 322 | . do FullEDTMG(IEN22706d9)
|
|---|
| 323 | . set input="RDL"
|
|---|
| 324 | if (+input>0)&(+input<8) do
|
|---|
| 325 | . do EditTMG(IEN22706d9)
|
|---|
| 326 | . set input="RDL"
|
|---|
| 327 | if input="8" do
|
|---|
| 328 | . do Edit50^TMGNDFUT(IEN50)
|
|---|
| 329 | . set input="RDL"
|
|---|
| 330 | if input="9" do
|
|---|
| 331 | . do EditVAP(IEN22706d9)
|
|---|
| 332 | . set input="RDL"
|
|---|
| 333 | if input="F" do goto H1L1
|
|---|
| 334 | . do Show1Source^TMGNDF1A(IEN22706d9)
|
|---|
| 335 | . do PressToCont^TMGUSRIF
|
|---|
| 336 | if input="T" do goto H1L1
|
|---|
| 337 | . do DumpRec2^TMGDEBUG(22706.9,IEN22706d9,0)
|
|---|
| 338 | . do PressToCont^TMGUSRIF
|
|---|
| 339 | if input="S" do goto HODone
|
|---|
| 340 | . new Option
|
|---|
| 341 | . set Option("FIX CHAIN")=1
|
|---|
| 342 | . set Option("FIX CHAIN","IEN22706d9")=IEN22706d9
|
|---|
| 343 | . set Option("DELETING")=1
|
|---|
| 344 | . set Option("QUIET")=1
|
|---|
| 345 | . do Refresh1^TMGNDF3C(IEN22706d9,.Option)
|
|---|
| 346 | . new TMGFDA,TMGMSG
|
|---|
| 347 | . set TMGFDA(22706.9,IEN22706d9,6)=1
|
|---|
| 348 | . do FILE^DIE("","TMGFDA","TMGMSG")
|
|---|
| 349 | . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
|
|---|
| 350 | . ;"set $piece(^TMG(22706.9,IEN22706d9,1),"^",4)=1 ;"set SKIP=true
|
|---|
| 351 | . set result=-3
|
|---|
| 352 | if input="RC" do goto H1L1
|
|---|
| 353 | . new Option set Option("FIX CHAIN")=1
|
|---|
| 354 | . do ReCompOne^TMGNDF1A(IEN22706d9,.Option)
|
|---|
| 355 | . do PressToCont^TMGUSRIF
|
|---|
| 356 | if input="N" do goto H1L1
|
|---|
| 357 | . new Option set Option("FIX CHAIN")=1
|
|---|
| 358 | . do Make1Alt^TMGNDF2G(IEN22706d9,.Option)
|
|---|
| 359 | . do PressToCont^TMGUSRIF
|
|---|
| 360 | if input="RDL" do goto HODone
|
|---|
| 361 | . new Option set Option("FIX CHAIN")=1
|
|---|
| 362 | . set Option("FIX CHAIN","IEN22706d9")=IEN22706d9
|
|---|
| 363 | . do Refresh1^TMGNDF3C(IEN22706d9,.Option)
|
|---|
| 364 | . set result=-4
|
|---|
| 365 | . write "Will now rescan and setup array to detect possible changes.",!
|
|---|
| 366 | . do PressToCont^TMGUSRIF
|
|---|
| 367 |
|
|---|
| 368 | HODone
|
|---|
| 369 | quit result
|
|---|
| 370 |
|
|---|
| 371 | Hndl22706d9(IEN,RxSet,OutArray,array1,GorT)
|
|---|
| 372 | ;"Purpose: A brief subroutine to format 22706.9 input
|
|---|
| 373 |
|
|---|
| 374 | new output
|
|---|
| 375 | new IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9
|
|---|
| 376 | set output=$$Fmt22706d9(IEN,RxSet,GorT)
|
|---|
| 377 | set IEN10144=+$piece(output,"^",1)
|
|---|
| 378 | set IEN10143=+$piece(output,"^",2)
|
|---|
| 379 | set IEN50d7=+$piece(output,"^",3)
|
|---|
| 380 | set IEN50=+$piece(output,"^",4)
|
|---|
| 381 | set IEN22706d9=+$piece(output,"^",5)
|
|---|
| 382 | if IEN22706d9=0 quit
|
|---|
| 383 | set OutArray(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9)=GorT
|
|---|
| 384 | set array1(IEN22706d9,IEN10144_"^"_IEN10143_"^"_IEN50d7_"^"_IEN50_"^"_IEN22706d9_"^"_GorT)=""
|
|---|
| 385 | quit
|
|---|
| 386 |
|
|---|
| 387 |
|
|---|
| 388 |
|
|---|
| 389 | Fmt101d43(IEN,RxSet)
|
|---|
| 390 | ;"Purpose: to add an entry from file 101.43 to output string
|
|---|
| 391 | ;"Input: IEN -- an IEN from file 101.43
|
|---|
| 392 | ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record
|
|---|
| 393 | ;"Result: IEN101.44^IEN101.43
|
|---|
| 394 |
|
|---|
| 395 | new parentIEN
|
|---|
| 396 | set IEN=+$get(IEN)
|
|---|
| 397 | if IEN>0 do
|
|---|
| 398 | . set parentIEN=+$order(^ORD(101.44,RxSet,20,"B",IEN,""))
|
|---|
| 399 | else set parentIEN=0
|
|---|
| 400 |
|
|---|
| 401 | quit parentIEN_"^"_IEN
|
|---|
| 402 |
|
|---|
| 403 |
|
|---|
| 404 | Fmt50d7(IEN,RxSet)
|
|---|
| 405 | ;"Purpose: to add an entry from file 50.7 to output string
|
|---|
| 406 | ;"Input: IEN -- an IEN from file 50.7
|
|---|
| 407 | ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record
|
|---|
| 408 | ;"Result: IEN101.44^IEN101.43^IEN50.7
|
|---|
| 409 |
|
|---|
| 410 | new parentIEN
|
|---|
| 411 | set IEN=+$get(IEN)
|
|---|
| 412 | if IEN>0 do
|
|---|
| 413 | . set parentIEN=$order(^ORD(101.43,"ID",IEN_";99PSP",""))
|
|---|
| 414 | else set parentIEN=0
|
|---|
| 415 |
|
|---|
| 416 | quit $$Fmt101d43(parentIEN,RxSet)_"^"_IEN
|
|---|
| 417 |
|
|---|
| 418 |
|
|---|
| 419 | Fmt50(IEN,RxSet)
|
|---|
| 420 | ;"Purpose: to add an entry from file 50 to output string
|
|---|
| 421 | ;"Input: IEN -- an IEN from file 50
|
|---|
| 422 | ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record
|
|---|
| 423 | ;"Result: IEN101.44^IEN101.43^IEN50.7^IEN50
|
|---|
| 424 |
|
|---|
| 425 | new parentIEN
|
|---|
| 426 | set IEN=+$get(IEN)
|
|---|
| 427 | if IEN>0 do
|
|---|
| 428 | . set parentIEN=+$piece($get(^PSDRUG(IEN,2)),"^",1)
|
|---|
| 429 | else set parentIEN=0
|
|---|
| 430 |
|
|---|
| 431 | quit $$Fmt50d7(parentIEN,RxSet)_"^"_IEN
|
|---|
| 432 |
|
|---|
| 433 |
|
|---|
| 434 | Fmt22706d9(IEN,RxSet,s)
|
|---|
| 435 | ;"Purpose: to add an entry from file 22706.9 to output string
|
|---|
| 436 | ;"Input: IEN -- an IEN from file 22706.9
|
|---|
| 437 | ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record
|
|---|
| 438 | ;" s -- "G" or "T" for Generic or Trade
|
|---|
| 439 | ;"Result: IEN101.44^IEN101.43^IEN50.7^IEN50^IEN22706.9
|
|---|
| 440 |
|
|---|
| 441 | new parentIEN set parentIEN=0
|
|---|
| 442 | new parentS
|
|---|
| 443 | set IEN=+$get(IEN)
|
|---|
| 444 | if IEN>0 do
|
|---|
| 445 | . if $get(s)="T" do
|
|---|
| 446 | . . set parentIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) ;" 7;1 DRUG TRADENAME LINK
|
|---|
| 447 | . else do
|
|---|
| 448 | . . set parentIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",2) ;" 7;2 DRUG GENERIC LINK
|
|---|
| 449 |
|
|---|
| 450 | if parentIEN>0 do
|
|---|
| 451 | . set parentS=$$Fmt50(parentIEN,RxSet)
|
|---|
| 452 | else do
|
|---|
| 453 | . set parentS="???"
|
|---|
| 454 |
|
|---|
| 455 | quit parentS_"^"_IEN
|
|---|
| 456 |
|
|---|
| 457 |
|
|---|
| 458 | ;"============================================================
|
|---|
| 459 |
|
|---|
| 460 | EditTMG(IEN)
|
|---|
| 461 | ;"Purpose: to edit the TMG
|
|---|
| 462 |
|
|---|
| 463 | ;"do Edit1^TMGNDF1D(IEN)
|
|---|
| 464 |
|
|---|
| 465 | new Options,IENlist
|
|---|
| 466 | set IENlist(IEN)=""
|
|---|
| 467 | set Options("FILE")=22706.9
|
|---|
| 468 | set Options("FIELDS",1)=.04
|
|---|
| 469 | set Options("FIELDS",2)=.05
|
|---|
| 470 | set Options("FIELDS",3)=.055
|
|---|
| 471 | set Options("FIELDS",4)=.056
|
|---|
| 472 | set Options("FIELDS",5)=.07
|
|---|
| 473 | set Options("FIELDS",6)=.075
|
|---|
| 474 | set Options("FIELDS",7)=.076
|
|---|
| 475 | set Options("FIELDS",8)=6
|
|---|
| 476 | set Options("FIELDS","MAX NUM")=8
|
|---|
| 477 |
|
|---|
| 478 | new temp set temp=$$EditRecs^TMGSELED("IENlist",.Options)
|
|---|
| 479 |
|
|---|
| 480 | quit
|
|---|
| 481 |
|
|---|
| 482 |
|
|---|
| 483 | FullEDTMG(IEN)
|
|---|
| 484 | ;"Purpose: allow editing of any field in TMG
|
|---|
| 485 |
|
|---|
| 486 | new Options
|
|---|
| 487 | set Options("FILE")=22706.9
|
|---|
| 488 | if $$GetFields^TMGSELED(.Options)=0 goto FETDone
|
|---|
| 489 |
|
|---|
| 490 | new list set list(IEN)=""
|
|---|
| 491 | new temp set temp=$$EditRecs^TMGSELED("list",.Options)
|
|---|
| 492 |
|
|---|
| 493 | FETDone quit
|
|---|
| 494 |
|
|---|
| 495 |
|
|---|
| 496 |
|
|---|
| 497 | EditVAP(IEN)
|
|---|
| 498 | ;"Purpose: to edit the TMG
|
|---|
| 499 | ;"Input: IEN -- IEN in 22706.9
|
|---|
| 500 |
|
|---|
| 501 | new Options,IENlist
|
|---|
| 502 | set IENlist(IEN)=""
|
|---|
| 503 | set Options("FILE")=22706.9
|
|---|
| 504 | set Options("FIELDS",1)=.04
|
|---|
| 505 | set Options("FIELDS",1,"NO EDIT")=1
|
|---|
| 506 | set Options("FIELDS",2)=.055
|
|---|
| 507 | set Options("FIELDS",2,"NO EDIT")=1
|
|---|
| 508 | set Options("FIELDS",3)=.075
|
|---|
| 509 | set Options("FIELDS",3,"NO EDIT")=1
|
|---|
| 510 | set Options("FIELDS",4)=.076
|
|---|
| 511 | set Options("FIELDS",4,"NO EDIT")=1
|
|---|
| 512 | set Options("FIELDS",5)=5.5
|
|---|
| 513 | set Options("FIELDS","MAX NUM")=5
|
|---|
| 514 |
|
|---|
| 515 | new temp set temp=$$EditRecs^TMGSELED("IENlist",.Options)
|
|---|
| 516 |
|
|---|
| 517 | quit
|
|---|
| 518 |
|
|---|
| 519 |
|
|---|
