source: cprs/branches/tmg-cprs/m_files/TMGDRUG.m@ 1742

Last change on this file since 1742 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 20.9 KB
RevLine 
[796]1TMGDRUG ;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
36MakeExList
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
66MakeSubExClass(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=""
138MSECDone
139 quit result
140
141
142CodeInCode(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
152ClassInClass(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
186CICDone
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
192DrugInClass(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
217DICDone
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
223ShowClHeirarchy(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
239ShowClass(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
266ShowRxInClass(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
281SRICDone
282 write !
283 quit
284
285
286IsClassNull(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
296IsClassExcluded(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
314TestExclusions
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
333IsRxExcluded(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
366IREDone
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
374ShowDrugs
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
389ShowNCDrugs
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
414ShowExDrugs
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
461SURxArray ;"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
518MakePO(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
Note: See TracBrowser for help on using the repository browser.