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

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

Initial upload

File size: 22.1 KB
RevLine 
[796]1TMGNDF3D ;TMG/kst/FDA Import: Ensure Possible DRUG doses ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/21/06
3
4 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
5 ;" Ensuring POSSIBLE DOSAGES field correct for File 50 Entries.
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"11-21-2006
9
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13 ;"Menu
14
15 ;"=======================================================================
16 ;"FixPosDoses -- cycle through all records in file 50 and ensure Possible Doses are
17 ;" as desired, I.e. that field 903 has a listing of possible doses
18 ;" for use in CPRS
19
20 ;"FixAppUse -- cycle through all records in file 50 and ensure drugs are marked
21 ;" with needed code for Application Use, I.e. that field 63 has
22 ;" a listing of possible doses for use in CPRS
23
24 ;"FixPkgDoses -- to ensure that a package code has been put in for all possible doses
25 ;" NOTE: FixPosDoses has not yet been fixed so that this is done
26 ;" the first time around.
27
28 ;"=======================================================================
29 ;" Private Functions.
30 ;"=======================================================================
31 ;"$$Fix1Drug(IEN50,IEN22706d9) -- ensure Possible Doses are as desired for one record
32 ;"FixMissingDoses(IEN,rxDose,rxUnit)
33 ;"EnsureMult(IEN,Mult,UnitDose,IEN50d606) -- ensure that one dosage multiple exists
34 ;"MultExists(IEN,Mult) -- return if one dosage multiple exists
35 ;"AddMult(IEN,Mult) -- add a blank record for later filling
36 ;"CheckForBad(IEN) -- Clear records in multiple field 903 that are duplicates, or have no value for DOSE (1) field
37 ;"Clear1Bad(IEN,subIEN) -- kill Subrecord number subIEN in record IEN
38 ;"Unlock902 -- remove restrictions on field 902 of file 50
39 ;"Lock902 -- replace restrictions on field 902 of file 50
40 ;"UL50d68 -- unlock fields 2 & 3 in field 50.68
41 ;"L50d68 -- restore locks on fields 4 & 5 in field 50.68
42
43
44 ;"=======================================================================
45 ;"=======================================================================
46Menu
47 ;"Purpose: Provide menu to entry points of main routines
48
49 new Menu,UsrSlct
50 set Menu(0)="Pick Option for Ensuring Available Doses in DRUG file (3D)"
51 set Menu(1)="Edit which drug FORMS are dividable"_$char(9)_"EditDividable"
52 set Menu(2)="Setup Possible Doses in DRUG File"_$char(9)_"FixPosDoses"
53 set Menu(3)="Mark DRUGs with proper APPLICATION & PACKAGE codes"_$char(9)_"FixAppUseAndPkg"
54 set Menu("P")="Prev Stage"_$char(9)_"Prev"
55 set Menu("N")="Next Stage"_$char(9)_"Next"
56
57MC1 write #
58 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^")
59 if UsrSlct="^" goto MCDone
60 if UsrSlct=0 set UsrSlct=""
61
62 if UsrSlct="FixPosDoses" do FixPosDoses goto MC1
63 if UsrSlct="FixAppUseAndPkg" do FixAppUseAndPkg goto MC1
64 if UsrSlct="EditDividable" do EditForms^TMGNDF2A goto MC1
65 if UsrSlct="Prev" goto Menu^TMGNDF3C ;"quit can occur from there...
66 if UsrSlct="Next" goto Menu^TMGNDF3E ;"quit can occur from there...
67 goto MC1
68
69MCDone
70 quit
71
72 ;"=======================================================================
73
74FixPosDoses
75 ;"Purpose: To cycle through all imports in file 50 and ensure Possible Doses are as desired
76 ;" I.e. that field 903 has a listing of possible doses for use in CPRS
77 ;"Output: Field 903 in all records might be changed
78 ;"Notes: I am going to delete duplicate, unuseful entries in the multiple field 903
79 ;" *** Also, I am going to add dosing combinations that may not be appriate or correct
80 ;" doses for a particular drug. This is because I don't have a database for maximum
81 ;" doses. In those drugs that already have VA data added, I will still add extra
82 ;" possible combinations. For example, I plan to add ability for the doctor to give
83 ;" 0.25, 0.5, 1, 2, 3, or 4 units together for a given dose (i.e. ibuprofen 200, 4 PO TID)
84 ;" If the dosage form is CAP, CAPSULE, then I won't add 0.25 or 0.5 forms.
85 ;" Addendum: I have added a field (22706.8) to file 50.606 (DRUG FORMS) which
86 ;" will be used to see if the drug is dividable or not (i.e. if to add the 0.25
87 ;" etc. dose multipliers).
88
89 do Unlock902
90
91 new count set count=0
92 new Itr,IEN22706d9
93 new abort set abort=0
94 new success set success=1
95
96 write !,"Prepairing possible doses for DRUG entries from import data...",!
97 set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr)
98 do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9")
99 if IEN22706d9'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort
100 . if $$UserAborted^TMGUSRIF set abort=1 quit
101 . if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP
102 . new RxIEN set RxIEN=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)
103 . new RxIEN2 set RxIEN2=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)
104 . if RxIEN>0 do
105 . . set success=$$Fix1Drug(RxIEN,IEN22706d9) if success=-1 quit
106 . . set count=count+1
107 . if RxIEN2>0 do
108 . . set success=$$Fix1Drug(RxIEN2,IEN22706d9) if success=-1 quit
109 . . set count=count+1
110 do ProgressDone^TMGITR(.Itr)
111
112 write count," records updated.",!
113 if success=-1 write "Process ended prematurely due to error.",!
114
115 do Lock902
116
117 quit
118
119
120Fix1Drug(IEN50,IEN22706d9)
121 ;"Purpose: To ensure Possible Doses are as desired for one record
122 ;"Input: IEN50 = IEN in file 50
123 ;" IEN22706d9 -- IEN in 22706.9, the origin of the import
124 ;"Output: Field 903 might be changed
125 ;"Notes: I am going to delete duplicate, unuseful entries in the multiple field 903
126 ;" *** Also, I am going to add dosing combinations that may not be appriate or correct
127 ;" doses for a particular drug. This is because I don't have a database for maximum
128 ;" doses. In those drugs that already have VA data added, I will still add extra
129 ;" possible combinations. For example, I plan to add ability for the doctor to give
130 ;" 0.25, 0.5, 1, 2, 3, or 4 units together for a given dose (i.e. ibuprofen 200, 4 PO TID)
131 ;" Note: If the dosage form is CAP, then I won't add 0.25 or 0.5 forms.
132 ;" Also, if there is no dosage strength or unit in the record, but it is available in the
133 ;" linked record in 50.68, then we will copy the information over.
134 ;" ADDENDUM: I will check the drug form to see if it is dividable.
135 ;"Result: 0 if OK to continue. -1 if abort
136
137 new result set result=0
138 new Mult,rxDose,rxUnit,vapRxForm,vapIEN
139 new IEN50d606
140 new abort set abort=0
141 if +$get(IEN50)=0 goto FODDone
142 if +$get(IEN22706d9)=0 goto FODDone
143 do CheckForBad(IEN50)
144 set rxDose=$piece($get(^PSDRUG(IEN50,"DOS")),"^",1) ;"DOS;1 = field 901; STRENGTH
145 set rxUnit=$$GET1^DIQ(50,IEN50,902) ;"902 = UNIT
146 set IEN50d606=$piece($get(^TMG(22706.9,IEN22706d9,0)),"^",7)
147 if (+rxDose'>0)!(rxUnit="") do
148FOD1 . set result=$$FixMissingDoses(IEN50,.rxDose,.rxUnit)
149 if result'=0 goto FODDone
150
151 for Mult=0.25,0.5,1,2,3,4 do quit:(result=-1)
152 . ;"set result=$$EnsureMult(IEN50,Mult,rxDose,rxUnit)
153 . set result=$$EnsureMult(IEN50,Mult,rxDose,IEN50d606)
154
155FODDone
156 quit result
157
158
159FixMissingDoses(IEN50,rxDose,rxUnit)
160 ;"Purpose: If there is no dosage strength or unit in the record, but it is available in the
161 ;" linked record in 50.68, then we will copy the information over.
162 ;"Input: IEN50 - IEN in file 50
163 ;" rxDose -- PASS BY REFERENCE, OUT PARAMETER
164 ;" rxUnit -- PASS BY REFERENCE, OUT PARAMETER
165 ;"Result: 0 if OK to continue. -1 if abort 1=unable to fix
166
167 new vapRxForm,vapIEN
168 new result set result=1 ;"default to failure
169 new ErrFound set ErrFound=0
170
171 set rxDose=$$GET1^DIQ(50,IEN50,901)
172 set rxUnit=$$GET1^DIQ(50,IEN50,902)
173 set vapIEN=$$GET1^DIQ(50,IEN50,22,"I")
174 set vapRxForm=$$GET1^DIQ(50.68,vapIEN,1) ;50.68=VA PRODUCT, field 1=DOSAGE FORM
175 set vapRxStrength=$$GET1^DIQ(50.68,vapIEN,2) ;"50.68=VA PRODUCT, field 2=STRENGTH
176 set vapRxUnits=$$GET1^DIQ(50.68,vapIEN,3) ;"50.68=VA PRODUCT, field 3=UNITS
177 set vapRxIUnits=$$GET1^DIQ(50.68,vapIEN,3,"I") ;"50.68=VA PRODUCT, field 3=UNITS
178
179 ;"For some reason the units must be put in FIRST
180 if (rxUnit="")&(vapRxUnits'="") do
181 . new TMGFDA,TMGMSG
182 . set TMGFDA(50,IEN50_",",902)=vapRxIUnits
183 . set rxUnit=vapRxUnits
184 . set result=0 ;"set for tenative success
185 . do FILE^DIE("K","TMGFDA","TMGMSG")
186 . if $data(TMGMSG("DIERR"))'=0 do quit
187 . . set ErrFound=1
188 . . new PriorErrorFound
189 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
190 . . set result=-1
191 if ErrFound goto FMDDone
192
193 if (rxDose="")&(vapRxStrength'="") do
194 . new TMGFDA,TMGMSG
195 . set TMGFDA(50,IEN50_",",901)=vapRxStrength
196 . set rxDose=vapRxStrength
197 . set result=0 ;"set for tenative success
198 . do FILE^DIE("ETK","TMGFDA","TMGMSG")
199 . if $data(TMGMSG("DIERR"))'=0 do quit
200 . . new PriorErrorFound
201 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
202 . . set result=-1
203 if ErrFound goto FMDDone
204
205FMDDone
206 quit result
207
208
209EnsureMult(IEN50,Mult,UnitDose,IEN50d606)
210 ;"Purpose: To ensure that one dosage multiple exists
211 ;"Input: IEN50 - the IEN in file 50
212 ;" Mult - The unit multiple to be ensured exists (e.g. 0.25, 0.5, 1, 2, 3, 4)
213 ;" UnitDose -- the dose for a Multiple of 1
214 ;" IEN50d606 -- IEN in 50.606 (DRUG FORMS)
215 ;"Result: 0 if OK to continue. -1 if abort
216 ;"Note: The DRUG FORM is checked for dividability. If the particular dose
217 ;" is not dividable (e.g. a capsule), then it ensures that a divided
218 ;" dose does NOT exist (removing if needed)
219
220 new result set result=0
221 new subIEN
222 set subIEN=+$$MultExists(IEN50,Mult)
223 if (Mult<1),($$IsDividable(IEN50d606)=0),(subIEN'=0) do goto EMDone
224 . new temp set temp=$$Clear1Bad(IEN50,subIEN)
225 if subIEN'>0 set subIEN=$$AddMult(IEN50,Mult)
226 ;"if subIEN'>0 set subIEN=$$AddMult(IEN50,Mult,Mult*UnitDose)
227 if subIEN=0 set result=1 goto EMDone
228 new dosage set dosage=$$GetDosage(UnitDose,Mult)
229 set result=$$StuffMult(IEN50,subIEN,Mult,dosage)
230
231EMDone quit result
232
233
234IsDividable(IEN50d606)
235 ;"Purpose: to determine if a particular drug form is dividable
236 ;" (as stored in the DRUG FORM file)
237 ;"Results: 1 if dividable, 0 otherwise
238
239 new result
240 set result=(+$piece($get(^PS(50.606,IEN50d606,"TMG")),"^",1)=1) ;"field 22706.8, DIVIDABLE
241 quit result
242
243
244GetDosage(UnitDose,Mult)
245 ;"Purpose to return UnitDose*Mult, but allow for 160;25 --> 80;12.5
246 ;"Input: UnitDose -- the dose for a Multiple of 1
247 ;" Mult - The unit multiple to use (e.g. 0.25, 0.5, 1, 2, 3, 4)
248 ;"Results: returns UnitDose*Mult.
249 ;" E.g. 80 * 2 ==> 160, or
250 ;" 10;12.5 * 2 ==> 20;25
251
252 new i,result
253 set result=""
254 for i=1:1:$length(UnitDose,";") do
255 . new oneDose set oneDose=+$piece(UnitDose,";",i)
256 . if i>1 set result=result_";"
257 . set result=result_(oneDose*Mult)
258
259 quit result
260
261MultExists(IEN50,Mult)
262 ;"Purpose: To return if one dosage multiple exists
263 ;"Input: IEN50 - the IEN in file 50
264 ;" Mult - The unit multiple to be check for (e.g. 0.25, 0.5, 1, 2, 3, 4)
265 ;"Results: subIEN if found, 0 otherwise
266
267 new result set result=0
268 new subIEN,Mults
269 new found set found=0
270 set subIEN=0
271 for set subIEN=$order(^PSDRUG(IEN50,"DOS1",subIEN)) quit:(+subIEN'>0) do quit:(found>0)
272 . new node set node=$get(^PSDRUG(IEN50,"DOS1",subIEN,0))
273 . new numUnits set numUnits=$piece(node,"^",1)
274 . if numUnits=Mult set found=1
275
276 if (found=1) set result=subIEN
277 quit result
278
279
280AddMult(IEN50,Mult)
281 ;"Purpose: To create a stub-in record for later filling
282 ;"Input: IEN50 - the IEN in file 50
283 ;" Mult - The unit multiple to be ensured exists (e.g. 0.25, 0.5, 1, 2, 3, 4)
284 ;"Output: Records are added to multiple field 903
285 ;"Result: returns IEN50 of added record
286
287 new result set result=0
288
289 ;"Force value into DOS;2 to overcome input transform restriction on field .01
290 ;"(will be removed below)
291 new temp set temp=$piece($get(^PSDRUG(IEN50,"DOS")),"^",2)
292 if temp="" set $piece(^PSDRUG(IEN50,"DOS"),"^",2)="(temp value)"
293
294 new TMGFDA,TMGIEN,TMGMSG
295 set TMGFDA(50.0903,"+1,"_IEN50_",",.01)=Mult
296 do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
297 do ShowIfDIERR^TMGDEBUG(.TMGMSG)
298
299 ;"remove temporary value forced in above.
300 if temp="" set $piece(^PSDRUG(IEN50,"DOS"),"^",2)=""
301
302 set result=$get(TMGIEN(1)) ;"get new record number
303AMDone
304 quit result
305
306
307StuffMult(IEN50,subIEN,Mult,Dosage)
308 ;"Purpose: To add a dosage multiple to IEN50 record
309 ;"Input: IEN50 - the IEN in file 50
310 ;" subIEN -- the IEN in subfile 50.0903
311 ;" Dosage - the value to go into field 1 (e.g. 160, or 160;12.5)
312 ;"Output: Records are added to multiple field 903
313 ;"Result: 0 if OK to continue. -1 if abort
314 ;"Note: if Dosage < 1 then Mult values < 1 will be ignored
315 ;" This is because 0.625*0.25 --> such a small a number that input transform rejects value.
316
317 new result set result=0
318 if (Dosage<1)&(Mult<1) goto SMDone
319 set Dosage=$$ClipDDigits^TMGMISC(Dosage,5)
320
321 new TMGFDA,TMGIEN,TMGMSG
322 set TMGFDA(50.0903,subIEN_","_IEN50_",",1)=Dosage
323 do FILE^DIE("K","TMGFDA","TMGMSG")
324 do ShowIfDIERR^TMGDEBUG(.TMGMSG,.result) ;"result=1 if error
325
326SMDone
327 quit result
328
329
330CheckForBad(IEN50)
331 ;"Purpose: Clear records in multiple field 903 that are duplicates, or have no value for DOSE (1) field
332 ;"Input: IEN50= IEN in file 50
333 ;"Example:
334 ;" 903-POSSIBLE DOSAGES :
335 ;" Multiple Entry #1
336 ;" .01-DISPENSE UNITS PER DOSE : 1 <---- no DOSE, so kill
337 ;" 2-PACKAGE : IO
338 ;" Multiple Entry #2
339 ;" .01-DISPENSE UNITS PER DOSE : 2 <---- no DOSE, so kill
340 ;" 2-PACKAGE : IO
341 ;" Multiple Entry #3
342 ;" .01-DISPENSE UNITS PER DOSE : 1
343 ;" 1-DOSE : 250
344 ;" 2-PACKAGE : IO
345 ;" Multiple Entry #4
346 ;" .01-DISPENSE UNITS PER DOSE : 2
347 ;" 1-DOSE : 500
348 ;" 2-PACKAGE : IO
349
350 new subIEN,Mults
351 set subIEN=$order(^PSDRUG(IEN50,"DOS1",0))
352 if subIEN>0 for do quit:(+subIEN'>0)
353 . new deleted set deleted=0
354 . new node set node=$get(^PSDRUG(IEN50,"DOS1",subIEN,0))
355 . new dose set dose=$piece(node,"^",2)
356 . if +dose'>0 set deleted=$$Clear1Bad(IEN50,subIEN)
357 . new numUnits set numUnits=$piece(node,"^",1)
358 . if $data(Mults(numUnits))=0 do
359 . . if deleted=1 quit
360 . . set Mults(numUnits)=subIEN
361 . else do ;"here we have a duplicate entry.
362 . . if deleted=1 quit
363 . . set deleted=$$Clear1Bad(IEN50,subIEN)
364 . set subIEN=$order(^PSDRUG(IEN50,"DOS1",subIEN))
365
366 quit
367
368
369Clear1Bad(IEN50,subIEN)
370 ;"Purpose: To kill Subrecord number subIEN in record IEN
371 ;"Input: IEN50 = IEN in file 50
372 ;" subIEN = IEN in subfile for field 903 (50.0903)
373 ;"Results: 1 if kill done, 0 otherwise
374
375 new DA,DIK
376 set DIK="^PSDRUG("_IEN50_",""DOS1"","
377 set DA=subIEN
378 set DA(1)=IEN50
379
380 ;"write "Should delete: IEN50=",IEN50,", subIEN=",subIEN,!
381 do ^DIK
382
383 quit 1
384
385
386Unlock902
387 ;"Purpose: remove restrictions on field 902 of file 50
388 kill ^DD(50,902,8.5)
389 kill ^DD(50,902,9)
390 quit
391
392Lock902
393 ;"Purpose: replace restrictions on field 902 of file 50
394
395 set ^DD(50,902,8.5)="^"
396 set ^DD(50,902,9)="^"
397 quit
398
399UL50d68
400 ;"Purpose: unlock fields 2 & 3 in field 50.68
401
402 kill ^DD(50.68,2,8.5)
403 kill ^DD(50.68,2,9)
404 kill ^DD(50.68,3,8.5)
405 kill ^DD(50.68,3,9)
406
407 quit
408
409
410L50d68
411 ;"Purpose: restore locks on fields 4 & 5 in field 50.68
412
413 set ^DD(50.68,2,8.5)="^"
414 set ^DD(50.68,2,9)="^"
415 set ^DD(50.68,2,8.5)="^"
416 set ^DD(50.68,2,9)="^"
417
418 quit
419
420 ;"=======================================================================
421 ;"=======================================================================
422
423
424FixAppUseAndPkg
425 ;"Purpose: To cycle through all records in file 50 and ensure drugs are marked
426 ;" with needed code for Application Use, I.e. that field 63 has
427 ;" a listing of possible doses for use in CPRS
428 ;" ALSO will ensure that Package is properly set.
429
430 new Itr
431 new NumModified set NumModified=0
432 new abort set abort=0
433
434 set IEN=$$ItrInit^TMGITR(22706.9,.Itr)
435 do PrepProgress^TMGITR(.Itr,20,0,"IEN")
436 if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort
437 . if $$UserAborted^TMGUSRIF set abort=1 quit
438 . if +$piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP
439 . new IEN50
440 . set IEN50=$piece($get(^TMG(22706.9,IEN,7)),"^",1)
441 . set NumModified=NumModified+$$Fix1AppUse(IEN50)
442 . set NumModified=NumModified+$$Fix1PkgDoses(IEN50)
443 . set IEN50=$piece($get(^TMG(22706.9,IEN,7)),"^",2)
444 . set NumModified=NumModified+$$Fix1AppUse(IEN50)
445 . set NumModified=NumModified+$$Fix1PkgDoses(IEN50)
446 do ProgressDone^TMGITR(.Itr)
447
448 write NumModified," modifications made in DRUG file.",!
449 do PressToCont^TMGUSRIF
450
451 quit
452
453
454AskFix1AppUse
455 ;"Purpose: for testing purposes, ask user for 1 drug and fix that one
456 new DIC,Y
457 set DIC(0)="MAEQ"
458 set DIC=50
459 do ^DIC write !
460 if +Y>0 do Fix1AppUse(+Y)
461 quit
462
463
464Fix1AppUse(IEN50)
465 ;"Purpose: to Fix one Drug in 50 so that field 63 contains "O" code
466 ;"Result: 1 if modified, 0 if not modified.
467
468 new result set result=0
469 if +$get(IEN50)=0 goto F1AD
470 new code set code=$piece($get(^PSDRUG(IEN50,2)),"^",3)
471 new PSIUX,PSIUDA
472 set PSIUDA=+IEN50
473 if code'["O" do
474 . set PSIUX="O^OUTPATIENT"
475 . do ENPSGIU ;"EN^PSGIU
476 . set result=1
477
478 if code'["U" do
479 . set PSIUX="U^U"
480 . do ENPSGIU ;"EN^PSGIU
481 . set result=1
482
483 ;"if code'["U" do
484 if code'["I" do
485 . set PSIUX="I^INPATIENT"
486 . do ENPSGIU ;"EN^PSGIU
487 . set result=1
488F1AD
489 quit result
490
491
492ENPSGIU
493 ;"Purpose: This code is copied from EN^PSGIU and modified so that it
494 ;" doesn't ask for confirmation, and is easier for me to read
495 ;" It is the 'appropriate' method for setting field 63 in file 50
496 ;"Input: Expected vars: PSIUDA=IEN in 50 to change
497 ;" PSIUX=Code to add. Format: 'Code^Description'
498
499 new PSIUA,PSIUQ,PSIUO,PSIUY,PSIUT,%
500
501 ;"Q:$S('$D(PSIUDA):1,'$D(PSIUX):1,PSIUX'?1E1"^"1.E:1,1:'$D(^PSDRUG(PSIUDA,0))) set PSIUO=$P($G(^(2)),"^",3) set PSIUT=$P(PSIUX,"^",2),PSIUT=$S($E(PSIUT,1,4)="UNIT":"",1:$E("N","AEIOU"[$E(PSIUT)))_" "_PSIUT,(%,PSIUQ)=PSIUO'[$E(PSIUX)+1
502 if '$D(PSIUDA)!('$D(PSIUX)) quit
503 if (PSIUX'?1E1"^"1.E)!('$D(^PSDRUG(PSIUDA,0))) quit
504 set PSIUO=$P($G(^(2)),"^",3)
505 set PSIUT=$P(PSIUX,"^",2)
506 set PSIUT=$S($E(PSIUT,1,4)="UNIT":"",1:$E("N","AEIOU"[$E(PSIUT)))_" "_PSIUT
507 set (%,PSIUQ)=PSIUO'[$E(PSIUX)+1
508 ;"F W !!,"A",PSIUT," ITEM" D YN^DICN Q:% D MQ S %=PSIUQ
509 ;"I %<0 set PSIUA="^" G DONE
510 set %=1 ;"//kt added default answer to YES
511 set PSIUA=$E("YN",%)
512 ;"G:%=PSIUQ DONE
513 if %=1 do
514 . new Code set Code=$P(PSIUX,"^")
515 . if PSIUO[Code set Code=""
516 . set PSIUY=PSIUO_Code
517 . set $P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
518 . if $P(^(0),"^")]"" do
519 . . set ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA)=""
520 if %=2 do
521 . set PSIUY=$P(PSIUO,$P(PSIUX,"^"))_$P(PSIUO,$P(PSIUX,"^"),2)
522 . set $P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
523 . if $P(^(0),"^")]"" do
524 . . kill ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA)
525 kill:PSIUO]"" ^PSDRUG("IU",PSIUO,PSIUDA)
526 set:PSIUY]"" ^PSDRUG("IU",PSIUY,PSIUDA)=""
527 ;
528DONE ;
529 kill PSIU,PSIUO,PSIUQ,PSIUT,PSIUY Q
530
531
532
533 ;"=======================================================================
534 ;"=======================================================================
535
536Fix1PkgDoses(IEN50)
537 ;"Purpose: to check all possible doses and ensure proper package codes present
538 ;"Result: 1 if modified, 0 if not modified.
539
540 new result set result=0
541 if +$get(IEN50)=0 goto FPDDone
542 new IEN50d0903 set IEN50d0903=0
543 for set IEN50d0903=$order(^PSDRUG(IEN50,"DOS1",IEN50d0903)) quit:(+IEN50d0903'>0) do
544 . new CurValue set CurValue=$piece(^PSDRUG(IEN50,"DOS1",IEN50d0903,0),"^",3)
545 . if (CurValue["I")&(CurValue["O") quit
546 . if CurValue'["I" set CurValue=CurValue_"I"
547 . if CurValue'["O" set CurValue=CurValue_"O"
548 . set $piece(^PSDRUG(IEN50,"DOS1",IEN50d0903,0),"^",3)=CurValue
549 . set result=1
550FPDDone
551 quit result
552
553
554EditDividable
555 ;"Purpose: To edit custom field 22706.8 (TMG DIVIDABLE) in file 50.606 (DOSAGE FORM)
556 ;"Input: none.
557 ;"Output: file 50.606 may be edited.
558
Note: See TracBrowser for help on using the repository browser.