TMGNDF4D ;TMG/kst/FDA Import: Activate POI's ;03/25/06 ;;1.0;TMG-LIB;**1**;11/21/06 ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS ;" Activation of records in PHARMACY ORDERABLE ITEM file ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"11-21-2006 ;"NOTE: 3/9/07 --DON'T USE THIS FUNCTION. IT IS HANDLED IN TMGNDF4C. ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"ActivAll -- to remove the inactive date for all records in 101.43 ;"======================================================================= ;" Private Functions. ;"======================================================================= ;"ActivDate(DateAfter) -- remove inactive date if inactive date on/after DateAfter ;"XFormOff -- remove restrinction in input transform that prevents deletion. ;"XFormOn -- restore the input transform to field .04 in file 50.7 ;"SetXForm(code) -- remove the old input transform, and replace with code ;"======================================================================= ActivAll ;"Purpose: To active ALL records new date,%T,X,Y set X="1/1/1960" do ^%DT set date=Y if date>-1 do ActivDate(date) write "Done.",! quit ActivDate(DateAfter) ;"Purpose: To remove inactive date for all records in ORDERABLE ITEM ;" having an inactive date on/after DateAfter ;"Input: DateAfter -- the date to compare the inactive date with. If the ;" inactive date is on/after DateAfter, then inactive date ;" will be deleted. ;" ** Must be in Fileman Date format do XFormOff new Itr,IEN,Date,Y,X new abort set abort=-5 set IEN=$$ItrInit^TMGITR(101.43,.Itr) do PrepProgress^TMGITR(.Itr,20,0,"IEN") if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort>0) . set abort=abort+$$Activ1(IEN,DateAfter) do ProgressDone^TMGITR(.Itr) do XFormOn kill TMGXFORM quit Activ1(IEN101d43,DateAfter) ;"Purpose: To remove inactive date for all records in ORDERABLE ITEM ;" having an inactive date on/after DateAfter ;"Input: IEN101d43 -- IEN in 101.43 ;" DateAfter -- the date to compare the inactive date with. If the ;" inactive date is on/after DateAfter, then inactive date ;" will be deleted. ;" ** Must be in Fileman Date format ;"NOTE: XFormOff should be called before this function, and when ;" all mods are done, XFormOn should be called. ;"Results: 0 is OK, 1 if error new Itr,IEN,Date,Y,X new result set result=0 new X2 set X2=$piece($get(^ORD(101.43,IEN,.1)),"^",1) ;".1;1 --> inactive date if X2="" goto A1Done new X1 set X1=DateAfter do ^%DTC new TMGFDA,TMGMSG set TMGFDA(101.43,IEN_",",.1)="" ;"kill inactive date new $etrap set $etrap="W ""??ERROR TRAPPED??"",! Q" do FILE^DIE("","TMGFDA","TMGMSG") new PriorErrorFound if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) goto A1Done set X2=$piece($get(^ORD(101.43,IEN,.1)),"^",1) ;".1;1 --> inactive date if X2'="" do . write "Deletion of 101.43 inactivation date FAILED. [",X2,"]",! . set result=1 A1Done quit result DoFromTMG(IEN,Option) ;"Purpose: to activate ONE entry in ORDERABLE ITEM (101.43) file, linked from 22706.9 ;"Input: IEN -- IEN in 22706.9 ;" Option -- OPTIONAL. Format: ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward ;" to file POI, OI, OQV etc. ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN ;" Option("QUIET")=1 <-- supress text output ;"Output: OI records will be added or refreshed. ;"Result: 1=Modified, 0=not modified new result set result=0 if +$get(IEN)=0 goto DFTMGDone new tradePtr,genericPtr new date,%T,X,Y set X="1/1/1960" do ^%DT set date=Y do XFormOff ;"Get 22706.9 --> 50 --> 50.7 --> 101.43 set tradePtr=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) ;" a IEN50d7 ptr set genericPtr=+$piece($get(^TMG(22706.9,IEN,7)),"^",2) ;" a IEN50d7 ptr if tradePtr'=0 do . new IEN50d7 set IEN50d7=+$piece($get(^PSDRUG(tradePtr,2)),"^",1) ;"2;1 = fld 2.1 to POI . if IEN50d7=0 quit . new IEN101d43 set IEN101d43=$$GetOI^TMGNDFUT(IEN50d7) . if IEN101d43=0 quit . do Activ1(IEN101d43,date) . if $get(Option("FIX CHAIN"))=1 do . . do Fix1OQV^TMGNDF4E(IEN101d43,.Option) if genericPtr'=0 do . new IEN50d7 set IEN50d7=$piece($get(^PSDRUG(genericPtr,2)),"^",1) ;"2;1 = fld 2.1 to POI . if IEN50d7=0 quit . new IEN101d43 set IEN101d43=$$GetOI^TMGNDF4C(IEN50d7) . if IEN101d43=0 quit . do Activ1(IEN101d43,date) . if $get(Option("FIX CHAIN"))=1 do . . do Fix1OQV^TMGNDF4E(IEN101d43,.Option) do XFormOn DFTMGDone quit result XFormOff ;"Purpose: to remove restrinction in input transform that prevents deletion. ;"new TMGXFORM ;NOTE: NO new -- will be killed later set TMGXFORM=$piece($get(^ORD(101.43,.1,0)),"^",5,99) merge ^TMG("TMP","XREF",101.43,.1,1)=^DD(101.43,.1,1) kill ^DD(101.43,.1,1) ;"kill off the screening xref code do SetXForm("W !,X,! S %DT=""E"" D ^%DT S X=Y S:Y<1 X=""""") quit XFormOn ;"Purpose: to restore the input transform to field .04 in file 50.7 set TMGXFORM=$get(TMGXFORM,"S %DT=""ESTX"" D ^%DT S X=Y K:Y<1 X") do SetXForm(TMGXFORM) kill ^DD(101.43,.1,1) merge ^DD(101.43,.1,1)=^TMG("TMP","XREF",101.43,.1,1) ;"restore screening xref code quit SetXForm(code) ;"Purpose: to remove the old input transform, and replace with code set $piece(^DD(101.43,.1,0),"^",5,99)="" ;"clear out old stuff set $piece(^DD(101.43,.1,0),"^",5)=code ;"zwr ^DD(50.7,.04,0) quit