TMGNDF3D ;TMG/kst/FDA Import: Ensure Possible DRUG doses ;03/25/06 ;;1.0;TMG-LIB;**1**;11/21/06 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS ;" Ensuring POSSIBLE DOSAGES field correct for File 50 Entries. ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"11-21-2006 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"Menu ;"======================================================================= ;"FixPosDoses -- cycle through all records in file 50 and ensure Possible Doses are ;" as desired, I.e. that field 903 has a listing of possible doses ;" for use in CPRS ;"FixAppUse -- cycle through all records in file 50 and ensure drugs are marked ;" with needed code for Application Use, I.e. that field 63 has ;" a listing of possible doses for use in CPRS ;"FixPkgDoses -- to ensure that a package code has been put in for all possible doses ;" NOTE: FixPosDoses has not yet been fixed so that this is done ;" the first time around. ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"$$Fix1Drug(IEN50,IEN22706d9) -- ensure Possible Doses are as desired for one record ;"FixMissingDoses(IEN,rxDose,rxUnit) ;"EnsureMult(IEN,Mult,UnitDose,IEN50d606) -- ensure that one dosage multiple exists ;"MultExists(IEN,Mult) -- return if one dosage multiple exists ;"AddMult(IEN,Mult) -- add a blank record for later filling ;"CheckForBad(IEN) -- Clear records in multiple field 903 that are duplicates, or have no value for DOSE (1) field ;"Clear1Bad(IEN,subIEN) -- kill Subrecord number subIEN in record IEN ;"Unlock902 -- remove restrictions on field 902 of file 50 ;"Lock902 -- replace restrictions on field 902 of file 50 ;"UL50d68 -- unlock fields 2 & 3 in field 50.68 ;"L50d68 -- restore locks on fields 4 & 5 in field 50.68 ;"======================================================================= ;"======================================================================= Menu ;"Purpose: Provide menu to entry points of main routines new Menu,UsrSlct set Menu(0)="Pick Option for Ensuring Available Doses in DRUG file (3D)" set Menu(1)="Edit which drug FORMS are dividable"_$char(9)_"EditDividable" set Menu(2)="Setup Possible Doses in DRUG File"_$char(9)_"FixPosDoses" set Menu(3)="Mark DRUGs with proper APPLICATION & PACKAGE codes"_$char(9)_"FixAppUseAndPkg" set Menu("P")="Prev Stage"_$char(9)_"Prev" set Menu("N")="Next Stage"_$char(9)_"Next" MC1 write # set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") if UsrSlct="^" goto MCDone if UsrSlct=0 set UsrSlct="" if UsrSlct="FixPosDoses" do FixPosDoses goto MC1 if UsrSlct="FixAppUseAndPkg" do FixAppUseAndPkg goto MC1 if UsrSlct="EditDividable" do EditForms^TMGNDF2A goto MC1 if UsrSlct="Prev" goto Menu^TMGNDF3C ;"quit can occur from there... if UsrSlct="Next" goto Menu^TMGNDF3E ;"quit can occur from there... goto MC1 MCDone quit ;"======================================================================= FixPosDoses ;"Purpose: To cycle through all imports in file 50 and ensure Possible Doses are as desired ;" I.e. that field 903 has a listing of possible doses for use in CPRS ;"Output: Field 903 in all records might be changed ;"Notes: I am going to delete duplicate, unuseful entries in the multiple field 903 ;" *** Also, I am going to add dosing combinations that may not be appriate or correct ;" doses for a particular drug. This is because I don't have a database for maximum ;" doses. In those drugs that already have VA data added, I will still add extra ;" possible combinations. For example, I plan to add ability for the doctor to give ;" 0.25, 0.5, 1, 2, 3, or 4 units together for a given dose (i.e. ibuprofen 200, 4 PO TID) ;" If the dosage form is CAP, CAPSULE, then I won't add 0.25 or 0.5 forms. ;" Addendum: I have added a field (22706.8) to file 50.606 (DRUG FORMS) which ;" will be used to see if the drug is dividable or not (i.e. if to add the 0.25 ;" etc. dose multipliers). do Unlock902 new count set count=0 new Itr,IEN22706d9 new abort set abort=0 new success set success=1 write !,"Prepairing possible doses for DRUG entries from import data...",! set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9") if IEN22706d9'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP . new RxIEN set RxIEN=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) . new RxIEN2 set RxIEN2=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) . if RxIEN>0 do . . set success=$$Fix1Drug(RxIEN,IEN22706d9) if success=-1 quit . . set count=count+1 . if RxIEN2>0 do . . set success=$$Fix1Drug(RxIEN2,IEN22706d9) if success=-1 quit . . set count=count+1 do ProgressDone^TMGITR(.Itr) write count," records updated.",! if success=-1 write "Process ended prematurely due to error.",! do Lock902 quit Fix1Drug(IEN50,IEN22706d9) ;"Purpose: To ensure Possible Doses are as desired for one record ;"Input: IEN50 = IEN in file 50 ;" IEN22706d9 -- IEN in 22706.9, the origin of the import ;"Output: Field 903 might be changed ;"Notes: I am going to delete duplicate, unuseful entries in the multiple field 903 ;" *** Also, I am going to add dosing combinations that may not be appriate or correct ;" doses for a particular drug. This is because I don't have a database for maximum ;" doses. In those drugs that already have VA data added, I will still add extra ;" possible combinations. For example, I plan to add ability for the doctor to give ;" 0.25, 0.5, 1, 2, 3, or 4 units together for a given dose (i.e. ibuprofen 200, 4 PO TID) ;" Note: If the dosage form is CAP, then I won't add 0.25 or 0.5 forms. ;" Also, if there is no dosage strength or unit in the record, but it is available in the ;" linked record in 50.68, then we will copy the information over. ;" ADDENDUM: I will check the drug form to see if it is dividable. ;"Result: 0 if OK to continue. -1 if abort new result set result=0 new Mult,rxDose,rxUnit,vapRxForm,vapIEN new IEN50d606 new abort set abort=0 if +$get(IEN50)=0 goto FODDone if +$get(IEN22706d9)=0 goto FODDone do CheckForBad(IEN50) set rxDose=$piece($get(^PSDRUG(IEN50,"DOS")),"^",1) ;"DOS;1 = field 901; STRENGTH set rxUnit=$$GET1^DIQ(50,IEN50,902) ;"902 = UNIT set IEN50d606=$piece($get(^TMG(22706.9,IEN22706d9,0)),"^",7) if (+rxDose'>0)!(rxUnit="") do FOD1 . set result=$$FixMissingDoses(IEN50,.rxDose,.rxUnit) if result'=0 goto FODDone for Mult=0.25,0.5,1,2,3,4 do quit:(result=-1) . ;"set result=$$EnsureMult(IEN50,Mult,rxDose,rxUnit) . set result=$$EnsureMult(IEN50,Mult,rxDose,IEN50d606) FODDone quit result FixMissingDoses(IEN50,rxDose,rxUnit) ;"Purpose: If there is no dosage strength or unit in the record, but it is available in the ;" linked record in 50.68, then we will copy the information over. ;"Input: IEN50 - IEN in file 50 ;" rxDose -- PASS BY REFERENCE, OUT PARAMETER ;" rxUnit -- PASS BY REFERENCE, OUT PARAMETER ;"Result: 0 if OK to continue. -1 if abort 1=unable to fix new vapRxForm,vapIEN new result set result=1 ;"default to failure new ErrFound set ErrFound=0 set rxDose=$$GET1^DIQ(50,IEN50,901) set rxUnit=$$GET1^DIQ(50,IEN50,902) set vapIEN=$$GET1^DIQ(50,IEN50,22,"I") set vapRxForm=$$GET1^DIQ(50.68,vapIEN,1) ;50.68=VA PRODUCT, field 1=DOSAGE FORM set vapRxStrength=$$GET1^DIQ(50.68,vapIEN,2) ;"50.68=VA PRODUCT, field 2=STRENGTH set vapRxUnits=$$GET1^DIQ(50.68,vapIEN,3) ;"50.68=VA PRODUCT, field 3=UNITS set vapRxIUnits=$$GET1^DIQ(50.68,vapIEN,3,"I") ;"50.68=VA PRODUCT, field 3=UNITS ;"For some reason the units must be put in FIRST if (rxUnit="")&(vapRxUnits'="") do . new TMGFDA,TMGMSG . set TMGFDA(50,IEN50_",",902)=vapRxIUnits . set rxUnit=vapRxUnits . set result=0 ;"set for tenative success . do FILE^DIE("K","TMGFDA","TMGMSG") . if $data(TMGMSG("DIERR"))'=0 do quit . . set ErrFound=1 . . new PriorErrorFound . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . . set result=-1 if ErrFound goto FMDDone if (rxDose="")&(vapRxStrength'="") do . new TMGFDA,TMGMSG . set TMGFDA(50,IEN50_",",901)=vapRxStrength . set rxDose=vapRxStrength . set result=0 ;"set for tenative success . do FILE^DIE("ETK","TMGFDA","TMGMSG") . if $data(TMGMSG("DIERR"))'=0 do quit . . new PriorErrorFound . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . . set result=-1 if ErrFound goto FMDDone FMDDone quit result EnsureMult(IEN50,Mult,UnitDose,IEN50d606) ;"Purpose: To ensure that one dosage multiple exists ;"Input: IEN50 - the IEN in file 50 ;" Mult - The unit multiple to be ensured exists (e.g. 0.25, 0.5, 1, 2, 3, 4) ;" UnitDose -- the dose for a Multiple of 1 ;" IEN50d606 -- IEN in 50.606 (DRUG FORMS) ;"Result: 0 if OK to continue. -1 if abort ;"Note: The DRUG FORM is checked for dividability. If the particular dose ;" is not dividable (e.g. a capsule), then it ensures that a divided ;" dose does NOT exist (removing if needed) new result set result=0 new subIEN set subIEN=+$$MultExists(IEN50,Mult) if (Mult<1),($$IsDividable(IEN50d606)=0),(subIEN'=0) do goto EMDone . new temp set temp=$$Clear1Bad(IEN50,subIEN) if subIEN'>0 set subIEN=$$AddMult(IEN50,Mult) ;"if subIEN'>0 set subIEN=$$AddMult(IEN50,Mult,Mult*UnitDose) if subIEN=0 set result=1 goto EMDone new dosage set dosage=$$GetDosage(UnitDose,Mult) set result=$$StuffMult(IEN50,subIEN,Mult,dosage) EMDone quit result IsDividable(IEN50d606) ;"Purpose: to determine if a particular drug form is dividable ;" (as stored in the DRUG FORM file) ;"Results: 1 if dividable, 0 otherwise new result set result=(+$piece($get(^PS(50.606,IEN50d606,"TMG")),"^",1)=1) ;"field 22706.8, DIVIDABLE quit result GetDosage(UnitDose,Mult) ;"Purpose to return UnitDose*Mult, but allow for 160;25 --> 80;12.5 ;"Input: UnitDose -- the dose for a Multiple of 1 ;" Mult - The unit multiple to use (e.g. 0.25, 0.5, 1, 2, 3, 4) ;"Results: returns UnitDose*Mult. ;" E.g. 80 * 2 ==> 160, or ;" 10;12.5 * 2 ==> 20;25 new i,result set result="" for i=1:1:$length(UnitDose,";") do . new oneDose set oneDose=+$piece(UnitDose,";",i) . if i>1 set result=result_";" . set result=result_(oneDose*Mult) quit result MultExists(IEN50,Mult) ;"Purpose: To return if one dosage multiple exists ;"Input: IEN50 - the IEN in file 50 ;" Mult - The unit multiple to be check for (e.g. 0.25, 0.5, 1, 2, 3, 4) ;"Results: subIEN if found, 0 otherwise new result set result=0 new subIEN,Mults new found set found=0 set subIEN=0 for set subIEN=$order(^PSDRUG(IEN50,"DOS1",subIEN)) quit:(+subIEN'>0) do quit:(found>0) . new node set node=$get(^PSDRUG(IEN50,"DOS1",subIEN,0)) . new numUnits set numUnits=$piece(node,"^",1) . if numUnits=Mult set found=1 if (found=1) set result=subIEN quit result AddMult(IEN50,Mult) ;"Purpose: To create a stub-in record for later filling ;"Input: IEN50 - the IEN in file 50 ;" Mult - The unit multiple to be ensured exists (e.g. 0.25, 0.5, 1, 2, 3, 4) ;"Output: Records are added to multiple field 903 ;"Result: returns IEN50 of added record new result set result=0 ;"Force value into DOS;2 to overcome input transform restriction on field .01 ;"(will be removed below) new temp set temp=$piece($get(^PSDRUG(IEN50,"DOS")),"^",2) if temp="" set $piece(^PSDRUG(IEN50,"DOS"),"^",2)="(temp value)" new TMGFDA,TMGIEN,TMGMSG set TMGFDA(50.0903,"+1,"_IEN50_",",.01)=Mult do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") do ShowIfDIERR^TMGDEBUG(.TMGMSG) ;"remove temporary value forced in above. if temp="" set $piece(^PSDRUG(IEN50,"DOS"),"^",2)="" set result=$get(TMGIEN(1)) ;"get new record number AMDone quit result StuffMult(IEN50,subIEN,Mult,Dosage) ;"Purpose: To add a dosage multiple to IEN50 record ;"Input: IEN50 - the IEN in file 50 ;" subIEN -- the IEN in subfile 50.0903 ;" Dosage - the value to go into field 1 (e.g. 160, or 160;12.5) ;"Output: Records are added to multiple field 903 ;"Result: 0 if OK to continue. -1 if abort ;"Note: if Dosage < 1 then Mult values < 1 will be ignored ;" This is because 0.625*0.25 --> such a small a number that input transform rejects value. new result set result=0 if (Dosage<1)&(Mult<1) goto SMDone set Dosage=$$ClipDDigits^TMGMISC(Dosage,5) new TMGFDA,TMGIEN,TMGMSG set TMGFDA(50.0903,subIEN_","_IEN50_",",1)=Dosage do FILE^DIE("K","TMGFDA","TMGMSG") do ShowIfDIERR^TMGDEBUG(.TMGMSG,.result) ;"result=1 if error SMDone quit result CheckForBad(IEN50) ;"Purpose: Clear records in multiple field 903 that are duplicates, or have no value for DOSE (1) field ;"Input: IEN50= IEN in file 50 ;"Example: ;" 903-POSSIBLE DOSAGES : ;" Multiple Entry #1 ;" .01-DISPENSE UNITS PER DOSE : 1 <---- no DOSE, so kill ;" 2-PACKAGE : IO ;" Multiple Entry #2 ;" .01-DISPENSE UNITS PER DOSE : 2 <---- no DOSE, so kill ;" 2-PACKAGE : IO ;" Multiple Entry #3 ;" .01-DISPENSE UNITS PER DOSE : 1 ;" 1-DOSE : 250 ;" 2-PACKAGE : IO ;" Multiple Entry #4 ;" .01-DISPENSE UNITS PER DOSE : 2 ;" 1-DOSE : 500 ;" 2-PACKAGE : IO new subIEN,Mults set subIEN=$order(^PSDRUG(IEN50,"DOS1",0)) if subIEN>0 for do quit:(+subIEN'>0) . new deleted set deleted=0 . new node set node=$get(^PSDRUG(IEN50,"DOS1",subIEN,0)) . new dose set dose=$piece(node,"^",2) . if +dose'>0 set deleted=$$Clear1Bad(IEN50,subIEN) . new numUnits set numUnits=$piece(node,"^",1) . if $data(Mults(numUnits))=0 do . . if deleted=1 quit . . set Mults(numUnits)=subIEN . else do ;"here we have a duplicate entry. . . if deleted=1 quit . . set deleted=$$Clear1Bad(IEN50,subIEN) . set subIEN=$order(^PSDRUG(IEN50,"DOS1",subIEN)) quit Clear1Bad(IEN50,subIEN) ;"Purpose: To kill Subrecord number subIEN in record IEN ;"Input: IEN50 = IEN in file 50 ;" subIEN = IEN in subfile for field 903 (50.0903) ;"Results: 1 if kill done, 0 otherwise new DA,DIK set DIK="^PSDRUG("_IEN50_",""DOS1""," set DA=subIEN set DA(1)=IEN50 ;"write "Should delete: IEN50=",IEN50,", subIEN=",subIEN,! do ^DIK quit 1 Unlock902 ;"Purpose: remove restrictions on field 902 of file 50 kill ^DD(50,902,8.5) kill ^DD(50,902,9) quit Lock902 ;"Purpose: replace restrictions on field 902 of file 50 set ^DD(50,902,8.5)="^" set ^DD(50,902,9)="^" quit UL50d68 ;"Purpose: unlock fields 2 & 3 in field 50.68 kill ^DD(50.68,2,8.5) kill ^DD(50.68,2,9) kill ^DD(50.68,3,8.5) kill ^DD(50.68,3,9) quit L50d68 ;"Purpose: restore locks on fields 4 & 5 in field 50.68 set ^DD(50.68,2,8.5)="^" set ^DD(50.68,2,9)="^" set ^DD(50.68,2,8.5)="^" set ^DD(50.68,2,9)="^" quit ;"======================================================================= ;"======================================================================= FixAppUseAndPkg ;"Purpose: To cycle through all records in file 50 and ensure drugs are marked ;" with needed code for Application Use, I.e. that field 63 has ;" a listing of possible doses for use in CPRS ;" ALSO will ensure that Package is properly set. new Itr new NumModified set NumModified=0 new abort set abort=0 set IEN=$$ItrInit^TMGITR(22706.9,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort . if $$UserAborted^TMGUSRIF set abort=1 quit . if +$piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP . new IEN50 . set IEN50=$piece($get(^TMG(22706.9,IEN,7)),"^",1) . set NumModified=NumModified+$$Fix1AppUse(IEN50) . set NumModified=NumModified+$$Fix1PkgDoses(IEN50) . set IEN50=$piece($get(^TMG(22706.9,IEN,7)),"^",2) . set NumModified=NumModified+$$Fix1AppUse(IEN50) . set NumModified=NumModified+$$Fix1PkgDoses(IEN50) do ProgressDone^TMGITR(.Itr) write NumModified," modifications made in DRUG file.",! do PressToCont^TMGUSRIF quit AskFix1AppUse ;"Purpose: for testing purposes, ask user for 1 drug and fix that one new DIC,Y set DIC(0)="MAEQ" set DIC=50 do ^DIC write ! if +Y>0 do Fix1AppUse(+Y) quit Fix1AppUse(IEN50) ;"Purpose: to Fix one Drug in 50 so that field 63 contains "O" code ;"Result: 1 if modified, 0 if not modified. new result set result=0 if +$get(IEN50)=0 goto F1AD new code set code=$piece($get(^PSDRUG(IEN50,2)),"^",3) new PSIUX,PSIUDA set PSIUDA=+IEN50 if code'["O" do . set PSIUX="O^OUTPATIENT" . do ENPSGIU ;"EN^PSGIU . set result=1 if code'["U" do . set PSIUX="U^U" . do ENPSGIU ;"EN^PSGIU . set result=1 ;"if code'["U" do if code'["I" do . set PSIUX="I^INPATIENT" . do ENPSGIU ;"EN^PSGIU . set result=1 F1AD quit result ENPSGIU ;"Purpose: This code is copied from EN^PSGIU and modified so that it ;" doesn't ask for confirmation, and is easier for me to read ;" It is the 'appropriate' method for setting field 63 in file 50 ;"Input: Expected vars: PSIUDA=IEN in 50 to change ;" PSIUX=Code to add. Format: 'Code^Description' new PSIUA,PSIUQ,PSIUO,PSIUY,PSIUT,% ;"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 if '$D(PSIUDA)!('$D(PSIUX)) quit if (PSIUX'?1E1"^"1.E)!('$D(^PSDRUG(PSIUDA,0))) quit set PSIUO=$P($G(^(2)),"^",3) set PSIUT=$P(PSIUX,"^",2) set PSIUT=$S($E(PSIUT,1,4)="UNIT":"",1:$E("N","AEIOU"[$E(PSIUT)))_" "_PSIUT set (%,PSIUQ)=PSIUO'[$E(PSIUX)+1 ;"F W !!,"A",PSIUT," ITEM" D YN^DICN Q:% D MQ S %=PSIUQ ;"I %<0 set PSIUA="^" G DONE set %=1 ;"//kt added default answer to YES set PSIUA=$E("YN",%) ;"G:%=PSIUQ DONE if %=1 do . new Code set Code=$P(PSIUX,"^") . if PSIUO[Code set Code="" . set PSIUY=PSIUO_Code . set $P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY . if $P(^(0),"^")]"" do . . set ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA)="" if %=2 do . set PSIUY=$P(PSIUO,$P(PSIUX,"^"))_$P(PSIUO,$P(PSIUX,"^"),2) . set $P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY . if $P(^(0),"^")]"" do . . kill ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA) kill:PSIUO]"" ^PSDRUG("IU",PSIUO,PSIUDA) set:PSIUY]"" ^PSDRUG("IU",PSIUY,PSIUDA)="" ; DONE ; kill PSIU,PSIUO,PSIUQ,PSIUT,PSIUY Q ;"======================================================================= ;"======================================================================= Fix1PkgDoses(IEN50) ;"Purpose: to check all possible doses and ensure proper package codes present ;"Result: 1 if modified, 0 if not modified. new result set result=0 if +$get(IEN50)=0 goto FPDDone new IEN50d0903 set IEN50d0903=0 for set IEN50d0903=$order(^PSDRUG(IEN50,"DOS1",IEN50d0903)) quit:(+IEN50d0903'>0) do . new CurValue set CurValue=$piece(^PSDRUG(IEN50,"DOS1",IEN50d0903,0),"^",3) . if (CurValue["I")&(CurValue["O") quit . if CurValue'["I" set CurValue=CurValue_"I" . if CurValue'["O" set CurValue=CurValue_"O" . set $piece(^PSDRUG(IEN50,"DOS1",IEN50d0903,0),"^",3)=CurValue . set result=1 FPDDone quit result EditDividable ;"Purpose: To edit custom field 22706.8 (TMG DIVIDABLE) in file 50.606 (DOSAGE FORM) ;"Input: none. ;"Output: file 50.606 may be edited.