| [796] | 1 | TMGDRUG ;TMG/kst/Code for setting up Drugs/Pharmacy ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;01/01/06
|
|---|
| 3 |
|
|---|
| 4 | ;"TMG FUNCTIONS FOR SETTING UP DRUGS/PHARMACY
|
|---|
| 5 |
|
|---|
| 6 | ;"=======================================================================
|
|---|
| 7 | ;" API -- Public Functions.
|
|---|
| 8 | ;"=======================================================================
|
|---|
| 9 | ;"SetupDF -- Set up the Drug File
|
|---|
| 10 | ;"MakeExList
|
|---|
| 11 |
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;"PRIVATE API FUNCTIONS
|
|---|
| 14 | ;"=======================================================================
|
|---|
| 15 | ;"MakeSubExClass(ParentClass)
|
|---|
| 16 | ;"CodeInCode(TextCode,RefCode)
|
|---|
| 17 | ;"ClassInClass(ClassIEN,TextCode,RefClassIEN) Purpose: To return if a class is either equal to, or a child of a Ref Class
|
|---|
| 18 | ;"DrugInClass(DrugIEN,TextCode,ClassIEN Purpose: To see if a drug is in a given class
|
|---|
| 19 | ;"ShowClHeirarchy(ClassIEN)
|
|---|
| 20 | ;"GetClHeirarchy(ClassIEN,Array)
|
|---|
| 21 | ;"ShowClass(DrugIEN)
|
|---|
| 22 | ;"ShowRxInClass(ClassIEN) Purpose: to show all drugs in given class
|
|---|
| 23 | ;"IsClassNull(DrugIEN)
|
|---|
| 24 | ;"IsClassExcluded(ClassIEN) Purpose: To see is class is in an excluded class
|
|---|
| 25 | ;"TestExclusions
|
|---|
| 26 | ;"IsRxExcluded(DrugIEN) Purpose: To see if drug is in excluded catagory
|
|---|
| 27 | ;"ShowDrugs
|
|---|
| 28 | ;"ShowNCDrugs
|
|---|
| 29 | ;"ShowExDrugs
|
|---|
| 30 | ;"SURxArray Purpose: To set up the drug file such that the drugs are orderable in CPRS
|
|---|
| 31 | ;"MakePO(ShortName) ;Make a Pharmacy Orderable Item
|
|---|
| 32 |
|
|---|
| 33 | ;"=======================================================================
|
|---|
| 34 | ;"=======================================================================
|
|---|
| 35 |
|
|---|
| 36 | MakeExList
|
|---|
| 37 | ;"Purpose: To create an array of drug classes that are not desired
|
|---|
| 38 | ;"Output: Stores result in ^TMP("TMGPSExclude",*)
|
|---|
| 39 |
|
|---|
| 40 | new ClassIEN,LastClass
|
|---|
| 41 | new Backup set Backup=0
|
|---|
| 42 | new result set result=1
|
|---|
| 43 | set LastClass=""
|
|---|
| 44 | kill ^TMP("TMGPSExclude")
|
|---|
| 45 | new TempI set TempI=0
|
|---|
| 46 | set ClassIEN=$order(^PS(50.605,0)) ;"file# 50.605 = VA DRUG CLASS CODE
|
|---|
| 47 | for do quit:(ClassIEN="")
|
|---|
| 48 | . if ClassIEN="" quit
|
|---|
| 49 | . new Node set Node=$get(^PS(50.605,ClassIEN,0))
|
|---|
| 50 | . new Code set Code=$piece(Node,"^",1)
|
|---|
| 51 | . new Parent set Parent=+$piece(Node,"^",3)
|
|---|
| 52 | . if Parent=0 do quit:(ClassIEN="")
|
|---|
| 53 | . . set result=$$MakeSubExClass(ClassIEN)
|
|---|
| 54 | . . if result=0 set ClassIEN=""
|
|---|
| 55 | . if Backup=0 set ClassIEN=$order(^PS(50.605,ClassIEN))
|
|---|
| 56 | . else set Backup=0
|
|---|
| 57 |
|
|---|
| 58 | write "Here are the excluded IEN's from file 50.605",!
|
|---|
| 59 | zwr ^TMP("TMGPSExclude",*)
|
|---|
| 60 |
|
|---|
| 61 | write "Goodbye!",!
|
|---|
| 62 | quit
|
|---|
| 63 |
|
|---|
| 64 |
|
|---|
| 65 |
|
|---|
| 66 | MakeSubExClass(ParentClass,ChildDetail)
|
|---|
| 67 | ;"Purpose: To review the elements on one class, to see if they need to be excluded
|
|---|
| 68 | ;"Input: ParentClass -- The parent class of the class to be reviewed.
|
|---|
| 69 | ;" ChildDetail -- OPTIONAL, default=0
|
|---|
| 70 | ;" If 1, then show children of Parent Class
|
|---|
| 71 | ;" if 0, just show ParentClass (<--Default Value)
|
|---|
| 72 | ;"Output: Stores result in ^TMP("TMGPSExclude",*)
|
|---|
| 73 | ;"Result: 1 if OK to continue, 0 if aborted.
|
|---|
| 74 |
|
|---|
| 75 | new ClassIEN,LastClass
|
|---|
| 76 | new Backup set Backup=0
|
|---|
| 77 | set LastClass=""
|
|---|
| 78 | new result set result=1
|
|---|
| 79 | set ChildDetail=$get(ChildDetail,0)
|
|---|
| 80 | if '$data(ParentClass) set result=0 goto MSECDone
|
|---|
| 81 | if $$IsClassExcluded(ParentClass) goto MSECDone
|
|---|
| 82 |
|
|---|
| 83 | set ClassIEN=ParentClass ;"In file order, children come after parent.
|
|---|
| 84 | for do quit:(+ClassIEN=0) ;"Cycle, looking for children.
|
|---|
| 85 | . if +ClassIEN=0 quit
|
|---|
| 86 | . new AskThisOne set AskThisOne=0 ;"default=no show
|
|---|
| 87 | . new Node set Node=$get(^PS(50.605,ClassIEN,0))
|
|---|
| 88 | . new Code set Code=$piece(Node,"^",1)
|
|---|
| 89 | . new Class set Class=$piece(Node,"^",2)
|
|---|
| 90 | . new Parent set Parent=+$piece(Node,"^",3)
|
|---|
| 91 | . new Type set Type=$piece(Node,"^",4)
|
|---|
| 92 | . if ChildDetail=0 do ;" just show parent
|
|---|
| 93 | . . if ClassIEN=ParentClass set AskThisOne=1
|
|---|
| 94 | . else do
|
|---|
| 95 | . . set AskThisOne=1
|
|---|
| 96 | . . if ClassIEN=ParentClass set AskThisOne=0 ;"(don't show parent)
|
|---|
| 97 | . . if ($$ClassInClass(ClassIEN,,ParentClass)=0) do
|
|---|
| 98 | . . . set AskThisOne=0 ;"(don't show if not in parent's class)
|
|---|
| 99 | . . . set ClassIEN="" ;"as so as we get to an entry in the list that is not in parent, then we can escape
|
|---|
| 100 | . if AskThisOne do
|
|---|
| 101 | . . write "---------------------------------------------------",!
|
|---|
| 102 | . . write Class," (",Code,")",!
|
|---|
| 103 | . . write "---------------------------------------------------",!
|
|---|
| 104 | . . new ref set ref="^PS(50.605,"_i_",1)"
|
|---|
| 105 | . . do WriteWP^TMGSTUTL(ref)
|
|---|
| 106 | . . new Exclude set Exclude=""
|
|---|
| 107 | . . for do quit:(Exclude="")
|
|---|
| 108 | . . . write Class," (",Code,")",!
|
|---|
| 109 | . . . read "Exclude this drug class (and any derivative subclasses)? (? for help) NO//",Exclude:$get(DTIME,3600),!
|
|---|
| 110 | . . . if Exclude="" set Exclude="NO"
|
|---|
| 111 | . . . if Exclude["?" do quit
|
|---|
| 112 | . . . . Write "^ to abort",!
|
|---|
| 113 | . . . . write "^SUB to explore subclasses",!
|
|---|
| 114 | . . . . Write "^BACKUP to backup to previous category.",!
|
|---|
| 115 | . . . . write !,"Here is a list:",!!
|
|---|
| 116 | . . . . do ShowRxInClass(ClassIEN)
|
|---|
| 117 | . . . . write "End of list for: "
|
|---|
| 118 | . . . if Exclude="^SUB" do quit
|
|---|
| 119 | . . . . set result=$$MakeSubExClass(ClassIEN,1)
|
|---|
| 120 | . . . if Exclude="^BACKUP" do quit
|
|---|
| 121 | . . . . if LastClass'="" set ClassIEN=LastClass,Backup=1,Exclude=""
|
|---|
| 122 | . . . if Exclude="^" set ClassIEN="",Exclude="",result=0 quit
|
|---|
| 123 | . . . if '("YyYESYes"[Exclude) write ! set Exclude="" quit
|
|---|
| 124 | . . . set Exclude=""
|
|---|
| 125 | . . . write "OK... excluding.",!!
|
|---|
| 126 | . . . new TempI set TempI=$get(^TMP("TMGPSExclude",0,"Max"),0)
|
|---|
| 127 | . . . set TempI=TempI+1
|
|---|
| 128 | . . . set ^TMP("TMGPSExclude",TempI)=ClassIEN
|
|---|
| 129 | . . . set ^TMP("TMGPSExclude",TempI,"CLASS")=Class
|
|---|
| 130 | . . . set ^TMP("TMGPSExclude",TempI,"CLASS","CODE")=Code
|
|---|
| 131 | . . . set ^TMP("TMGPSExclude",0,ClassIEN)=""
|
|---|
| 132 | . . . set ^TMP("TMGPSExclude",0,"Max")=TempI
|
|---|
| 133 | . . set LastClass=ClassIEN
|
|---|
| 134 | . if ClassIEN="" quit
|
|---|
| 135 | . if Backup=0 set ClassIEN=$order(^PS(50.605,ClassIEN))
|
|---|
| 136 | . else set Backup=0
|
|---|
| 137 | . if ChildDetail=0 set ClassIEN=""
|
|---|
| 138 | MSECDone
|
|---|
| 139 | quit result
|
|---|
| 140 |
|
|---|
| 141 |
|
|---|
| 142 | CodeInCode(TextCode,RefCode)
|
|---|
| 143 | ;"Purpose: To see if Text Code is in reference code
|
|---|
| 144 | ;" e.g. is AX050 "in" AX00 --> yes
|
|---|
| 145 | ;"Result: 1 = match present, 0 = no match
|
|---|
| 146 |
|
|---|
| 147 | set RefCode=$$Trim^TMGSTUTL(RefCode,"0") ;"convert AX000 -> AX
|
|---|
| 148 | new CompCode set CompCode=$extract(TextCode,1,$length(RefCode))
|
|---|
| 149 | quit (CompCode=RefCode)
|
|---|
| 150 |
|
|---|
| 151 |
|
|---|
| 152 | ClassInClass(ClassIEN,TextCode,RefClassIEN)
|
|---|
| 153 | ;"Purpose: To return if a class is either equal to, or a child of a Ref Class
|
|---|
| 154 | ;"Input: ClassIEN: an IEN from file 50.605 to test
|
|---|
| 155 | ;" TextCode: OPTIONAL Text code for drug class, from field #2 in DRUG file #50
|
|---|
| 156 | ;" Note: this is the text code for RefClassIEN, not for ClassIEN
|
|---|
| 157 | ;" RefClassIEN: an IEN from file 50.605 to test against
|
|---|
| 158 | ;"Results: 1 if ClassIEN=RefClassIEN, or is child of RefClassIEN
|
|---|
| 159 | ;" 0 otherwise
|
|---|
| 160 |
|
|---|
| 161 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ClassInClass")
|
|---|
| 162 |
|
|---|
| 163 | new result set result=0
|
|---|
| 164 | set TextCode=$get(TextCode)
|
|---|
| 165 | if +$get(RefClassIEN)=0 goto CICDone
|
|---|
| 166 | if +$get(ClassIEN)=0 goto CICDone
|
|---|
| 167 | new node set node=$get(^PS(50.605,ClassIEN,0))
|
|---|
| 168 | new RefCode set RefCode=$piece(node,"^",1)
|
|---|
| 169 |
|
|---|
| 170 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is Class #",ClassIEN," in Class #",RefClassIEN,"?")
|
|---|
| 171 |
|
|---|
| 172 | if ClassIEN=RefClassIEN set result=1 goto CICDone
|
|---|
| 173 | if (TextCode'="")&($$CodeInCode(TextCode,RefCode)) set result=1 goto CICDone
|
|---|
| 174 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"looking at node: ",node)
|
|---|
| 175 | if node'="" do
|
|---|
| 176 | . new code set code=$piece(node,"^",1)
|
|---|
| 177 | . new ParentClass set ParentClass=$piece(node,"^",3)
|
|---|
| 178 | . if ParentClass=ClassIEN set ParentClass=0 ;"I found one cyclic reference->endless loop. Avoid that.
|
|---|
| 179 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"parent class=",ParentClass)
|
|---|
| 180 | . if +ParentClass'=0 do
|
|---|
| 181 | . . if ParentClass=RefClassIEN set result=1
|
|---|
| 182 | . . else do
|
|---|
| 183 | . . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"calling recursively ClassInClass(",ParentClass,",",RefClassIEN,")")
|
|---|
| 184 | . . . set result=$$ClassInClass(ParentClass,TextCode,RefClassIEN)
|
|---|
| 185 |
|
|---|
| 186 | CICDone
|
|---|
| 187 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result)
|
|---|
| 188 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ClassInClass")
|
|---|
| 189 | quit result
|
|---|
| 190 |
|
|---|
| 191 |
|
|---|
| 192 | DrugInClass(DrugIEN,TextCode,ClassIEN)
|
|---|
| 193 | ;"Purpose: To see if a drug is in a given class
|
|---|
| 194 | ;"Input: DrugIEN: The IEN of a drug in file#50
|
|---|
| 195 | ;" TextCode: Text code for drug class, from field #2 in DRUG file #50
|
|---|
| 196 | ;" ClassIEN: the IEN of a drug class in file #50.605
|
|---|
| 197 | ;"Note: If drug is in a class that is a child of ClassIEN, then
|
|---|
| 198 | ;" the drug will be considered to be that class.
|
|---|
| 199 | ;"Result: 0 if not in class, 1 if is in class, or child of class.
|
|---|
| 200 |
|
|---|
| 201 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"DrugInClass")
|
|---|
| 202 |
|
|---|
| 203 | new result set result=0
|
|---|
| 204 | if $get(DrugIEN)="" goto DICDone
|
|---|
| 205 | if $get(^PSDRUG(DrugIEN,0))="" goto DICDone
|
|---|
| 206 |
|
|---|
| 207 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is Drug #",DrugIEN," in Class #",ClassIEN,"?")
|
|---|
| 208 |
|
|---|
| 209 | new node set node=$get(^PS(50.605,ClassIEN,0))
|
|---|
| 210 | new RefCode set RefCode=$piece(node,"^",1)
|
|---|
| 211 | if $$CodeInCode(TextCode,RefCode) set result=1 goto DICDone
|
|---|
| 212 |
|
|---|
| 213 | new DrugClass
|
|---|
| 214 | set DrugClass=$piece($get(^PSDRUG(DrugIEN,"ND")),"^",6) ;"field #25,NATIONAL DRUG CLASS
|
|---|
| 215 | set result=$$ClassInClass(DrugClass,TextCode,ClassIEN)
|
|---|
| 216 |
|
|---|
| 217 | DICDone
|
|---|
| 218 | ;"write "DrugInClass result=",result,!
|
|---|
| 219 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result)
|
|---|
| 220 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"DrugInClass")
|
|---|
| 221 | quit result
|
|---|
| 222 |
|
|---|
| 223 | ShowClHeirarchy(ClassIEN)
|
|---|
| 224 | new ParentClass,indent
|
|---|
| 225 | set indent=""
|
|---|
| 226 | if (+ClassIEN'=0) for do quit:(+ClassIEN=0)
|
|---|
| 227 | . new Curnode
|
|---|
| 228 | . set Curnode=$get(^PS(50.605,ClassIEN,0))
|
|---|
| 229 | . write indent,"Class ",ClassIEN," (",$piece(Curnode,"^",1),") ",$piece(Curnode,"^",2),!
|
|---|
| 230 | . new node set node=$get(^PS(50.605,ClassIEN,0))
|
|---|
| 231 | . set ParentClass=$piece(node,"^",3)
|
|---|
| 232 | . if ParentClass=ClassIEN set ParentClass=0 ;"I found at least one circular ref.
|
|---|
| 233 | . set ClassIEN=ParentClass
|
|---|
| 234 | . set indent=indent_". "
|
|---|
| 235 |
|
|---|
| 236 | quit
|
|---|
| 237 |
|
|---|
| 238 |
|
|---|
| 239 | ShowClass(DrugIEN)
|
|---|
| 240 | ;"Purpose: To show a given drug's class, and parent classes
|
|---|
| 241 | new DrugClass
|
|---|
| 242 | set DrugClass=$piece($get(^PSDRUG(DrugIEN,"ND")),"^",6)
|
|---|
| 243 | new ParentClass set ParentClass=0
|
|---|
| 244 | new TextCode,node,Name
|
|---|
| 245 | set node=$get(^PSDRUG(DrugIEN,0))
|
|---|
| 246 | set TextCode=$piece(node,"^",2)
|
|---|
| 247 | set Name=$piece(node,"^",1)
|
|---|
| 248 |
|
|---|
| 249 | write "Drug: ",Name," [",TextCode,"]",!
|
|---|
| 250 |
|
|---|
| 251 | if (+DrugClass'=0) for do quit:(+DrugClass=0)
|
|---|
| 252 | . new Curnode
|
|---|
| 253 | . set Curnode=$get(^PS(50.605,DrugClass,0))
|
|---|
| 254 | . write "Class (",$piece(Curnode,"^",1),") ",$piece(Curnode,"^",2),!
|
|---|
| 255 | . new node set node=$get(^PS(50.605,DrugClass,0))
|
|---|
| 256 | . set ParentClass=$piece(node,"^",3)
|
|---|
| 257 | . if ParentClass=ClassIEN set ParentClass=0 ;"I found at least one circular ref.
|
|---|
| 258 | . set DrugClass=ParentClass
|
|---|
| 259 | else do
|
|---|
| 260 | . write "Drug class pointer is null",!
|
|---|
| 261 | . write "Free text drug class is",$piece($get(^PSDRUG(DrugIEN,0)),"^",2),!
|
|---|
| 262 |
|
|---|
| 263 | quit
|
|---|
| 264 |
|
|---|
| 265 |
|
|---|
| 266 | ShowRxInClass(ClassIEN)
|
|---|
| 267 | ;"Purpose: to show all drugs in given class
|
|---|
| 268 |
|
|---|
| 269 | new i,name
|
|---|
| 270 |
|
|---|
| 271 | set i=$order(^PSDRUG(0))
|
|---|
| 272 | for do quit:(i="")
|
|---|
| 273 | . if i="" quit
|
|---|
| 274 | . set Name=$piece($get(^PSDRUG(i,0)),"^",1)
|
|---|
| 275 | . if Name'="" do
|
|---|
| 276 | . . new TextCode
|
|---|
| 277 | . . set TextCode=$piece($get(^PSDRUG(i,0)),"^",2) ;"field #2,VA CLASSIFICATION
|
|---|
| 278 | . . if $$DrugInClass(i,TextCode,ClassIEN)=1 write " -- ",Name,!
|
|---|
| 279 | . set i=$order(^PSDRUG(i))
|
|---|
| 280 |
|
|---|
| 281 | SRICDone
|
|---|
| 282 | write !
|
|---|
| 283 | quit
|
|---|
| 284 |
|
|---|
| 285 |
|
|---|
| 286 | IsClassNull(DrugIEN)
|
|---|
| 287 | ;"Purpose: to return if Drug has no assigned class
|
|---|
| 288 |
|
|---|
| 289 | new result,node,class
|
|---|
| 290 | set node=$get(^PSDRUG(DrugIEN,"ND"))
|
|---|
| 291 | set class=+$piece(node,"^",6)
|
|---|
| 292 | set result=(class=0)
|
|---|
| 293 | quit result
|
|---|
| 294 |
|
|---|
| 295 |
|
|---|
| 296 | IsClassExcluded(ClassIEN)
|
|---|
| 297 | ;"Purpose: To see is class is in an excluded class, based on exclusions stored
|
|---|
| 298 | ;" in ^TMP("TMGPSExclude")
|
|---|
| 299 | ;"Input: ClassIEN -- Class to check if excluded.
|
|---|
| 300 | ;"Result: 1 if class is in an already excluded class.
|
|---|
| 301 |
|
|---|
| 302 | new i,result
|
|---|
| 303 | set result=0
|
|---|
| 304 |
|
|---|
| 305 | set i=$order(^TMP("TMGPSExclude",0))
|
|---|
| 306 | if i'="" for do quit:(i="")!(result=1)
|
|---|
| 307 | . new ExClass
|
|---|
| 308 | . set ExClass=$get(^TMP("TMGPSExclude",i))
|
|---|
| 309 | . set result=$$ClassInClass(ClassIEN,,ExClass)
|
|---|
| 310 | . set i=$order(^TMP("TMGPSExclude",i))
|
|---|
| 311 |
|
|---|
| 312 | quit result
|
|---|
| 313 |
|
|---|
| 314 | TestExclusions
|
|---|
| 315 | new ClassIEN
|
|---|
| 316 |
|
|---|
| 317 | set ClassIEN=$order(^PS(50.605,0)) ;"file# 50.605 = VA DRUG CLASS CODE
|
|---|
| 318 | for do quit:(+ClassIEN=0)
|
|---|
| 319 | . new Node set Node=$get(^PS(50.605,ClassIEN,0))
|
|---|
| 320 | . new Code set Code=$piece(Node,"^",1)
|
|---|
| 321 | . new Class set Class=$piece(Node,"^",2)
|
|---|
| 322 | . new Parent set Parent=+$piece(Node,"^",3)
|
|---|
| 323 | . new Type set Type=$piece(Node,"^",4)
|
|---|
| 324 | . write ClassIEN," (",Code,"): "
|
|---|
| 325 | . if $$IsClassExcluded(ClassIEN)=1 do
|
|---|
| 326 | . . write "Excluded:",!
|
|---|
| 327 | . . ;"do ShowClHeirarchy(ClassIEN)
|
|---|
| 328 | . else write "OK",!
|
|---|
| 329 | . set ClassIEN=$order(^PS(50.605,ClassIEN))
|
|---|
| 330 |
|
|---|
| 331 | quit
|
|---|
| 332 |
|
|---|
| 333 | IsRxExcluded(DrugIEN)
|
|---|
| 334 | ;"Purpose: To see if drug is in excluded catagory
|
|---|
| 335 | ;"Input: DrugIEN -- an IEN from file #50
|
|---|
| 336 | ;"Note: This assumes that an exclusion array has been created in
|
|---|
| 337 | ;" ^TMP("TMGPSExclude"), as setup by MakeExList()
|
|---|
| 338 | ;"Result: 1 if drug is not wanted (i.e. is excluded)
|
|---|
| 339 | ;" 0 otherwise
|
|---|
| 340 |
|
|---|
| 341 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"IsRxExcluded")
|
|---|
| 342 |
|
|---|
| 343 | new result set result=0
|
|---|
| 344 | new i
|
|---|
| 345 | new TextCode
|
|---|
| 346 |
|
|---|
| 347 | set TextCode=$piece($get(^PSDRUG(DrugIEN,0)),"^",2) ;"field #2,VA CLASSIFICATION (text field)
|
|---|
| 348 |
|
|---|
| 349 | if $$IsClassNull(DrugIEN)&(TextCode="") do goto IREDone
|
|---|
| 350 | . set result=1
|
|---|
| 351 | . write "Excluding drug #`",DrugIEN," due to null class, and empty class code.",!
|
|---|
| 352 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is drug is excluded because of no assigned class")
|
|---|
| 353 |
|
|---|
| 354 | if +$get(DrugIEN)=0 goto IREDone
|
|---|
| 355 | set i=$order(^TMP("TMGPSExclude",0))
|
|---|
| 356 | for do quit:(i="")!(result=1)
|
|---|
| 357 | . if i="" quit
|
|---|
| 358 | . new ExClass
|
|---|
| 359 | . set ExClass=$get(^TMP("TMGPSExclude",i))
|
|---|
| 360 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is drug #",DrugIEN," is class named '",^TMP("TMGPSExclude",i,"CLASS"),"'?")
|
|---|
| 361 | . set result=$$DrugInClass(DrugIEN,TextCode,ExClass)
|
|---|
| 362 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"The value of result returned from DrugInClass=",result)
|
|---|
| 363 | . set i=$order(^TMP("TMGPSExclude",i))
|
|---|
| 364 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"next exclusion class i=",i," result=",result)
|
|---|
| 365 |
|
|---|
| 366 | IREDone
|
|---|
| 367 | ;"write "IsRxExcluded result=",result,!
|
|---|
| 368 | if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result)
|
|---|
| 369 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"IsRxExcluded")
|
|---|
| 370 |
|
|---|
| 371 | quit result
|
|---|
| 372 |
|
|---|
| 373 |
|
|---|
| 374 | ShowDrugs
|
|---|
| 375 | new i
|
|---|
| 376 |
|
|---|
| 377 | set i=$order(^PSDRUG(0))
|
|---|
| 378 | for do quit:(i="")
|
|---|
| 379 | . if i="" quit
|
|---|
| 380 | . new Name
|
|---|
| 381 | . set Name=$piece($get(^PSDRUG(i,0)),"^",1)
|
|---|
| 382 | . new Class set Class=$piece($get(^PSDRUG(i,0)),"^",2)
|
|---|
| 383 | . if Name'="" do
|
|---|
| 384 | . . write $piece(Name," ",1)," -- ",Class,!
|
|---|
| 385 | . set i=$order(^PSDRUG(i))
|
|---|
| 386 |
|
|---|
| 387 | quit
|
|---|
| 388 |
|
|---|
| 389 | ShowNCDrugs
|
|---|
| 390 | ;"Show all drugs that do not have an assigned class.
|
|---|
| 391 |
|
|---|
| 392 | new i,count
|
|---|
| 393 | set count=0
|
|---|
| 394 |
|
|---|
| 395 | set i=$order(^PSDRUG(0))
|
|---|
| 396 | for do quit:(i="")
|
|---|
| 397 | . if i="" quit
|
|---|
| 398 | . new Name,node
|
|---|
| 399 | . set node=$get(^PSDRUG(i,0))
|
|---|
| 400 | . set Name=$piece(node,"^",1)
|
|---|
| 401 | . new TextCode set TextCode=$piece(node,"^",2)
|
|---|
| 402 | . new Class set Class=$piece($get(^PSDRUG(i,"ND")),"^",6)
|
|---|
| 403 | . if (Name'="")&(TextCode="")&(+Class=0) do
|
|---|
| 404 | . . write "`#",i," ",Name," -- TextCode='",TextCode,"' ClassIEN=",Class,!
|
|---|
| 405 | . . set count=count+1
|
|---|
| 406 | . set i=$order(^PSDRUG(i))
|
|---|
| 407 |
|
|---|
| 408 | write count," drugs with no class assigned.",!
|
|---|
| 409 | write "Goodbye.",!
|
|---|
| 410 | quit
|
|---|
| 411 |
|
|---|
| 412 |
|
|---|
| 413 |
|
|---|
| 414 | ShowExDrugs
|
|---|
| 415 | ;"Purpose: Show those members of file 50 that should be excluded
|
|---|
| 416 |
|
|---|
| 417 | new DBIndent
|
|---|
| 418 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ShowExDrugs")
|
|---|
| 419 |
|
|---|
| 420 | new i
|
|---|
| 421 |
|
|---|
| 422 | write "This will show all entries in File#50 that should be excluded based",!
|
|---|
| 423 | write "on exclusion list in ^TMP(""TMGPSExclude"")",!!
|
|---|
| 424 |
|
|---|
| 425 | new Y,DIC,DIR
|
|---|
| 426 | set DIR(0)="Y",DIR("B")="NO"
|
|---|
| 427 | set DIR("A")="Store values into a Search Template (for later Fileman use)? "
|
|---|
| 428 | do ^DIR
|
|---|
| 429 | if Y=1 do
|
|---|
| 430 | . set DIC=.401 ;"SORT TEMPLATE, ^DIBT
|
|---|
| 431 | . set DIC(0)="MAQE"
|
|---|
| 432 | . do ^DIC
|
|---|
| 433 | . if +Y kill ^DIBT(+Y,1)
|
|---|
| 434 |
|
|---|
| 435 | set i=$order(^PSDRUG(0))
|
|---|
| 436 | for do quit:(i="")
|
|---|
| 437 | . if i="" quit
|
|---|
| 438 | . new Name
|
|---|
| 439 | . set Name=$piece($get(^PSDRUG(i,0)),"^",1)
|
|---|
| 440 | . new Class set Class=$piece($get(^PSDRUG(i,0)),"^",2)
|
|---|
| 441 | . if (Name'="") do
|
|---|
| 442 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Considering: ",Name)
|
|---|
| 443 | . . if ($$IsRxExcluded(i)=1) do
|
|---|
| 444 | . . . write "`",i,": ",Name," -- ",Class,!
|
|---|
| 445 | . . . if +Y do
|
|---|
| 446 | . . . . set ^DIBT(+Y,1,i)="" ;"stuff valus into SORT TEMPLATE, IEN=805 (this is a hack)
|
|---|
| 447 | . . else do
|
|---|
| 448 | . . . ;write "Not #",i," ",Name,!
|
|---|
| 449 | . set i=$order(^PSDRUG(i))
|
|---|
| 450 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Next i=",i)
|
|---|
| 451 | . ;new cont read "Press Key to Continue",*cont:3600,!
|
|---|
| 452 | . ;if $char(cont)="^" set i=""
|
|---|
| 453 |
|
|---|
| 454 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ShowExDrugs")
|
|---|
| 455 |
|
|---|
| 456 | write !,"goodbye...",!
|
|---|
| 457 | quit
|
|---|
| 458 |
|
|---|
| 459 |
|
|---|
| 460 |
|
|---|
| 461 | SURxArray ;"Set Up Rx array
|
|---|
| 462 | ;"Purpose: To set up the drug file such that the drugs are orderable in CPRS
|
|---|
| 463 | ;"Note: In the first part of this function, is will group similar drugs into an
|
|---|
| 464 | ;" array like this:
|
|---|
| 465 | ;" Array("SILDENAFIL",DrugIEN1)="(full drug name)"
|
|---|
| 466 | ;" Array("SILDENAFIL",DrugIEN2)="(full drug name)"
|
|---|
| 467 | ;" Array("SILDENAFIL",DrugIEN3)="(full drug name)"
|
|---|
| 468 | ;" Array("AMOXICILLIN",DrugIEN1)="(full drug name)"
|
|---|
| 469 | ;" Array("AMOXICILLIN",DrugIEN2)="(full drug name)"
|
|---|
| 470 | ;" Array("AMOXICILLIN",DrugIEN3)="(full drug name)"
|
|---|
| 471 |
|
|---|
| 472 | new DBIndent
|
|---|
| 473 | if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SURxArray")
|
|---|
| 474 |
|
|---|
| 475 | new i
|
|---|
| 476 | new count set count=0
|
|---|
| 477 | new Class set Class=""
|
|---|
| 478 |
|
|---|
| 479 | if $data(^TMP("TMGPSExclude"))=0 do MakeExList
|
|---|
| 480 | kill ^TMP("TMGPSUSE")
|
|---|
| 481 |
|
|---|
| 482 | set i=$order(^PSDRUG(0))
|
|---|
| 483 | for do quit:(i="")
|
|---|
| 484 | . if i="" quit
|
|---|
| 485 | . set count=count+1
|
|---|
| 486 | . new Name
|
|---|
| 487 | . set Name=$piece($get(^PSDRUG(i,0)),"^",1)
|
|---|
| 488 | . new temp set temp=$$UP^XLFSTR($extract(Name,1,2))
|
|---|
| 489 | . if temp="ZZ" set Name=""
|
|---|
| 490 | . ;"new Class set Class=$piece($get(^PSDRUG(i,0)),"^",2) ;"Some bad drugs have no class--> skip
|
|---|
| 491 | . set Class="zzz"
|
|---|
| 492 | . if (Name'="")&(Class'="") do
|
|---|
| 493 | . . set Class=$piece($get(^PSDRUG(i,0)),"^",2) ;"Some bad drugs have no class--> skip
|
|---|
| 494 | . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Considering: ",Name)
|
|---|
| 495 | . . if ($$IsRxExcluded(i)=0) do
|
|---|
| 496 | . . . ;"quit ;"temp
|
|---|
| 497 | . . . write Name," -- ",Class,!
|
|---|
| 498 | . . . new NamePiece,pi
|
|---|
| 499 | . . . for pi=1:1 do quit:(NamePiece="")!(+NamePiece>0)
|
|---|
| 500 | . . . . set NamePiece=$piece(Name," ",pi)
|
|---|
| 501 | . . . new ShortName set ShortName=$piece(Name," ",1,pi-1)
|
|---|
| 502 | . . . if ShortName'="" do
|
|---|
| 503 | . . . . write "Converted '",Name,"' --> ",ShortName,!
|
|---|
| 504 | . . . . set ^TMP("TMGPSUSE",ShortName,i)=Name
|
|---|
| 505 | . . . else write "Couldn't convert: ",Name,!
|
|---|
| 506 | . . else write "Excluded: ",Name,!
|
|---|
| 507 | . else if (Name'="") write "Skipped `",i," due to no class: ",Name," class=[",Class,"]",!
|
|---|
| 508 | . set i=$order(^PSDRUG(i))
|
|---|
| 509 | . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Next i=",i)
|
|---|
| 510 |
|
|---|
| 511 | if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SURxArray")
|
|---|
| 512 |
|
|---|
| 513 | write "Processed ",count," records.",!
|
|---|
| 514 | write "Done. Goodbye.",!
|
|---|
| 515 |
|
|---|
| 516 | quit
|
|---|
| 517 |
|
|---|
| 518 | MakePO(ShortName) ;Make a Pharmacy Orderable Item
|
|---|
| 519 | ;"Purpose: To take one entry from the Rx Array (as set up by SURxArray)
|
|---|
| 520 | ;" and create a fully linked PHARMACY ORDERABLE ITEM entry (File 50.7).
|
|---|
| 521 | ;"Note: When the PHARMACY ORDERABLE ITEM record is created, records that match
|
|---|
| 522 | ;" are also created in the ORDERABLE ITEM file (101.43), and the QUICK VIEW
|
|---|
| 523 | ;" file (101.44)--although the display text in the QUICK VIEW file must be set.
|
|---|
| 524 | ;"Steps: 1.
|
|---|
| 525 |
|
|---|
| 526 |
|
|---|
| 527 |
|
|---|
