| 1 | TMGNDF4D ;TMG/kst/FDA Import: Activate POI's ;03/25/06
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;11/21/06
|
|---|
| 3 |
|
|---|
| 4 | ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
|
|---|
| 5 | ;" Activation of records in PHARMACY ORDERABLE ITEM file
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU General Public License (GPL) applies
|
|---|
| 8 | ;"11-21-2006
|
|---|
| 9 |
|
|---|
| 10 |
|
|---|
| 11 | ;"NOTE: 3/9/07 --DON'T USE THIS FUNCTION. IT IS HANDLED IN TMGNDF4C.
|
|---|
| 12 |
|
|---|
| 13 | ;"=======================================================================
|
|---|
| 14 | ;" API -- Public Functions.
|
|---|
| 15 | ;"=======================================================================
|
|---|
| 16 | ;"ActivAll -- to remove the inactive date for all records in 101.43
|
|---|
| 17 |
|
|---|
| 18 | ;"=======================================================================
|
|---|
| 19 | ;" Private Functions.
|
|---|
| 20 | ;"=======================================================================
|
|---|
| 21 | ;"ActivDate(DateAfter) -- remove inactive date if inactive date on/after DateAfter
|
|---|
| 22 | ;"XFormOff -- remove restrinction in input transform that prevents deletion.
|
|---|
| 23 | ;"XFormOn -- restore the input transform to field .04 in file 50.7
|
|---|
| 24 | ;"SetXForm(code) -- remove the old input transform, and replace with code
|
|---|
| 25 |
|
|---|
| 26 |
|
|---|
| 27 | ;"=======================================================================
|
|---|
| 28 |
|
|---|
| 29 | ActivAll
|
|---|
| 30 | ;"Purpose: To active ALL records
|
|---|
| 31 |
|
|---|
| 32 | new date,%T,X,Y
|
|---|
| 33 | set X="1/1/1960"
|
|---|
| 34 | do ^%DT
|
|---|
| 35 | set date=Y
|
|---|
| 36 | if date>-1 do ActivDate(date)
|
|---|
| 37 |
|
|---|
| 38 | write "Done.",!
|
|---|
| 39 | quit
|
|---|
| 40 |
|
|---|
| 41 |
|
|---|
| 42 | ActivDate(DateAfter)
|
|---|
| 43 | ;"Purpose: To remove inactive date for all records in ORDERABLE ITEM
|
|---|
| 44 | ;" having an inactive date on/after DateAfter
|
|---|
| 45 | ;"Input: DateAfter -- the date to compare the inactive date with. If the
|
|---|
| 46 | ;" inactive date is on/after DateAfter, then inactive date
|
|---|
| 47 | ;" will be deleted.
|
|---|
| 48 | ;" ** Must be in Fileman Date format
|
|---|
| 49 |
|
|---|
| 50 | do XFormOff
|
|---|
| 51 |
|
|---|
| 52 | new Itr,IEN,Date,Y,X
|
|---|
| 53 | new abort set abort=-5
|
|---|
| 54 | set IEN=$$ItrInit^TMGITR(101.43,.Itr)
|
|---|
| 55 | do PrepProgress^TMGITR(.Itr,20,0,"IEN")
|
|---|
| 56 | if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort>0)
|
|---|
| 57 | . set abort=abort+$$Activ1(IEN,DateAfter)
|
|---|
| 58 | do ProgressDone^TMGITR(.Itr)
|
|---|
| 59 |
|
|---|
| 60 | do XFormOn
|
|---|
| 61 | kill TMGXFORM
|
|---|
| 62 |
|
|---|
| 63 | quit
|
|---|
| 64 |
|
|---|
| 65 |
|
|---|
| 66 | Activ1(IEN101d43,DateAfter)
|
|---|
| 67 | ;"Purpose: To remove inactive date for all records in ORDERABLE ITEM
|
|---|
| 68 | ;" having an inactive date on/after DateAfter
|
|---|
| 69 | ;"Input: IEN101d43 -- IEN in 101.43
|
|---|
| 70 | ;" DateAfter -- the date to compare the inactive date with. If the
|
|---|
| 71 | ;" inactive date is on/after DateAfter, then inactive date
|
|---|
| 72 | ;" will be deleted.
|
|---|
| 73 | ;" ** Must be in Fileman Date format
|
|---|
| 74 | ;"NOTE: XFormOff should be called before this function, and when
|
|---|
| 75 | ;" all mods are done, XFormOn should be called.
|
|---|
| 76 | ;"Results: 0 is OK, 1 if error
|
|---|
| 77 |
|
|---|
| 78 | new Itr,IEN,Date,Y,X
|
|---|
| 79 | new result set result=0
|
|---|
| 80 |
|
|---|
| 81 | new X2 set X2=$piece($get(^ORD(101.43,IEN,.1)),"^",1) ;".1;1 --> inactive date
|
|---|
| 82 | if X2="" goto A1Done
|
|---|
| 83 | new X1 set X1=DateAfter
|
|---|
| 84 | do ^%DTC
|
|---|
| 85 | new TMGFDA,TMGMSG
|
|---|
| 86 | set TMGFDA(101.43,IEN_",",.1)="" ;"kill inactive date
|
|---|
| 87 | new $etrap set $etrap="W ""??ERROR TRAPPED??"",! Q"
|
|---|
| 88 | do FILE^DIE("","TMGFDA","TMGMSG")
|
|---|
| 89 | new PriorErrorFound
|
|---|
| 90 | if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) goto A1Done
|
|---|
| 91 | set X2=$piece($get(^ORD(101.43,IEN,.1)),"^",1) ;".1;1 --> inactive date
|
|---|
| 92 | if X2'="" do
|
|---|
| 93 | . write "Deletion of 101.43 inactivation date FAILED. [",X2,"]",!
|
|---|
| 94 | . set result=1
|
|---|
| 95 |
|
|---|
| 96 | A1Done
|
|---|
| 97 | quit result
|
|---|
| 98 |
|
|---|
| 99 |
|
|---|
| 100 |
|
|---|
| 101 | DoFromTMG(IEN,Option)
|
|---|
| 102 | ;"Purpose: to activate ONE entry in ORDERABLE ITEM (101.43) file, linked from 22706.9
|
|---|
| 103 | ;"Input: IEN -- IEN in 22706.9
|
|---|
| 104 | ;" Option -- OPTIONAL. Format:
|
|---|
| 105 | ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward
|
|---|
| 106 | ;" to file POI, OI, OQV etc.
|
|---|
| 107 | ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN
|
|---|
| 108 | ;" Option("QUIET")=1 <-- supress text output
|
|---|
| 109 |
|
|---|
| 110 | ;"Output: OI records will be added or refreshed.
|
|---|
| 111 | ;"Result: 1=Modified, 0=not modified
|
|---|
| 112 |
|
|---|
| 113 | new result set result=0
|
|---|
| 114 | if +$get(IEN)=0 goto DFTMGDone
|
|---|
| 115 |
|
|---|
| 116 | new tradePtr,genericPtr
|
|---|
| 117 |
|
|---|
| 118 | new date,%T,X,Y
|
|---|
| 119 | set X="1/1/1960"
|
|---|
| 120 | do ^%DT
|
|---|
| 121 | set date=Y
|
|---|
| 122 | do XFormOff
|
|---|
| 123 |
|
|---|
| 124 | ;"Get 22706.9 --> 50 --> 50.7 --> 101.43
|
|---|
| 125 | set tradePtr=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) ;" a IEN50d7 ptr
|
|---|
| 126 | set genericPtr=+$piece($get(^TMG(22706.9,IEN,7)),"^",2) ;" a IEN50d7 ptr
|
|---|
| 127 | if tradePtr'=0 do
|
|---|
| 128 | . new IEN50d7 set IEN50d7=+$piece($get(^PSDRUG(tradePtr,2)),"^",1) ;"2;1 = fld 2.1 to POI
|
|---|
| 129 | . if IEN50d7=0 quit
|
|---|
| 130 | . new IEN101d43 set IEN101d43=$$GetOI^TMGNDFUT(IEN50d7)
|
|---|
| 131 | . if IEN101d43=0 quit
|
|---|
| 132 | . do Activ1(IEN101d43,date)
|
|---|
| 133 | . if $get(Option("FIX CHAIN"))=1 do
|
|---|
| 134 | . . do Fix1OQV^TMGNDF4E(IEN101d43,.Option)
|
|---|
| 135 |
|
|---|
| 136 | if genericPtr'=0 do
|
|---|
| 137 | . new IEN50d7 set IEN50d7=$piece($get(^PSDRUG(genericPtr,2)),"^",1) ;"2;1 = fld 2.1 to POI
|
|---|
| 138 | . if IEN50d7=0 quit
|
|---|
| 139 | . new IEN101d43 set IEN101d43=$$GetOI^TMGNDF4C(IEN50d7)
|
|---|
| 140 | . if IEN101d43=0 quit
|
|---|
| 141 | . do Activ1(IEN101d43,date)
|
|---|
| 142 | . if $get(Option("FIX CHAIN"))=1 do
|
|---|
| 143 | . . do Fix1OQV^TMGNDF4E(IEN101d43,.Option)
|
|---|
| 144 |
|
|---|
| 145 | do XFormOn
|
|---|
| 146 |
|
|---|
| 147 | DFTMGDone
|
|---|
| 148 | quit result
|
|---|
| 149 |
|
|---|
| 150 |
|
|---|
| 151 |
|
|---|
| 152 | XFormOff
|
|---|
| 153 | ;"Purpose: to remove restrinction in input transform that prevents deletion.
|
|---|
| 154 |
|
|---|
| 155 | ;"new TMGXFORM ;NOTE: NO new -- will be killed later
|
|---|
| 156 | set TMGXFORM=$piece($get(^ORD(101.43,.1,0)),"^",5,99)
|
|---|
| 157 | merge ^TMG("TMP","XREF",101.43,.1,1)=^DD(101.43,.1,1)
|
|---|
| 158 | kill ^DD(101.43,.1,1) ;"kill off the screening xref code
|
|---|
| 159 | do SetXForm("W !,X,! S %DT=""E"" D ^%DT S X=Y S:Y<1 X=""""")
|
|---|
| 160 |
|
|---|
| 161 | quit
|
|---|
| 162 |
|
|---|
| 163 |
|
|---|
| 164 | XFormOn
|
|---|
| 165 | ;"Purpose: to restore the input transform to field .04 in file 50.7
|
|---|
| 166 |
|
|---|
| 167 | set TMGXFORM=$get(TMGXFORM,"S %DT=""ESTX"" D ^%DT S X=Y K:Y<1 X")
|
|---|
| 168 | do SetXForm(TMGXFORM)
|
|---|
| 169 | kill ^DD(101.43,.1,1)
|
|---|
| 170 | merge ^DD(101.43,.1,1)=^TMG("TMP","XREF",101.43,.1,1) ;"restore screening xref code
|
|---|
| 171 | quit
|
|---|
| 172 |
|
|---|
| 173 |
|
|---|
| 174 | SetXForm(code)
|
|---|
| 175 | ;"Purpose: to remove the old input transform, and replace with code
|
|---|
| 176 |
|
|---|
| 177 | set $piece(^DD(101.43,.1,0),"^",5,99)="" ;"clear out old stuff
|
|---|
| 178 | set $piece(^DD(101.43,.1,0),"^",5)=code
|
|---|
| 179 | ;"zwr ^DD(50.7,.04,0)
|
|---|
| 180 | quit
|
|---|
