source: cprs/branches/tmg-cprs/m_files/TMGNDF4D.m@ 1009

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

Initial upload
File size: 6.4 KB
Line 
1TMGNDF4D ;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
29ActivAll
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
42ActivDate(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
66Activ1(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
96A1Done
97 quit result
98
99
100
101DoFromTMG(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
147DFTMGDone
148 quit result
149
150
151
152XFormOff
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
164XFormOn
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
174SetXForm(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
Note: See TracBrowser for help on using the repository browser.