1 | TMGNDF4G ;TMG/kst/FDA Import -- Fix OQV Problems;10/15/07
|
---|
2 | ;;1.0;TMG-LIB;**1**;10/15/07
|
---|
3 |
|
---|
4 | ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS
|
---|
5 | ;" Fixing problems with ORDER QUICK VIEW
|
---|
6 | ;"Kevin Toppenberg MD
|
---|
7 | ;"GNU General Public License (GPL) applies
|
---|
8 | ;"10-15-2007
|
---|
9 |
|
---|
10 | ;"=======================================================================
|
---|
11 | ;" API -- Public Functions.
|
---|
12 | ;"=======================================================================
|
---|
13 | ;"(No menu -- called from ^TMGNDF4F)
|
---|
14 | ;"AskFix1TMG -- ask user for entry in 22706.9 and allow editing.
|
---|
15 | ;"=======================================================================
|
---|
16 |
|
---|
17 | ;"=======================================================================
|
---|
18 | ;" Private Functions.
|
---|
19 | ;"=======================================================================
|
---|
20 | ;"FixOQVMissing -- fix a missing ORDER QUICK VIEW.
|
---|
21 | ;"FindOQV(Prefix,RxName,RxSet,SrchRec) -- Search ORDER QUICk VIEW for RxName, and return if found
|
---|
22 | ;"FindTMG(Prefix,RxName,RxSet,SrchRec,IgnoreSkipped) -- Scan 22706.9 for RxName, and return if found
|
---|
23 | ;"DoFind(Prefix,RxName,FileNum,Field,SrchRec,index) -- Scam file for RxName, and return if found
|
---|
24 | ;"HandleChain(array) -- Show chain and alow user editing etc. from input entry towards final part of chain (Order Quick View)
|
---|
25 | ;"HandleOne(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9,GorT) -- show the user a drug chain and allow manipulation of it
|
---|
26 | ;"Hndl22706d9(IEN,RxSet,OutArray,array1,GorT) -- A brief subroutine to format 22706.9 input
|
---|
27 | ;"Fmt101d43(IEN,RxSet) -- add an entry from file 101.43 to output string
|
---|
28 | ;"Fmt50d7(IEN,RxSet) -- add an entry from file 50.7 to output string
|
---|
29 | ;"Fmt50(IEN,RxSet) -- add an entry from file 50 to output string
|
---|
30 | ;"Fmt22706d9(IEN,RxSet,s) -- add an entry from file 22706.9 to output string
|
---|
31 | ;"EditTMG(IEN) -- to edit the TMG entry in 22706.9
|
---|
32 | ;"FullEDTMG(IEN) -- allow editing of any field in TMG 22706.9
|
---|
33 |
|
---|
34 | ;"=======================================================================
|
---|
35 |
|
---|
36 | FixOQVMissing
|
---|
37 | ;"Purpose: to fix a missing ORDER QUICK VIEW. I.e. add entry and
|
---|
38 | ;" and interviening entries needed.
|
---|
39 | ;"Input: none.
|
---|
40 |
|
---|
41 | new RxSet
|
---|
42 | set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto FOQVDone
|
---|
43 |
|
---|
44 | new RxName,SrchRec
|
---|
45 | read "Enter DRUG NAME to FIND/ADD (may be partial name): ",RxName:$get(DTIME,3600),!
|
---|
46 | if (RxName="")!(RxName="^") goto FOQVDone
|
---|
47 |
|
---|
48 | ;"do FindOQV("A. (101.44): ",RxName,RxSet,.SrchRec) ;"ORDER QUICK VIEW
|
---|
49 | ;"do DoFind("B. (101.43): ",RxName,101.43,.01,.SrchRec,"B") ;"ORDERABLE ITEM
|
---|
50 | ;"do DoFind("C. (50.7): ",RxName,50.7,.01,.SrchRec,"B") ;"PHARMACY ORDERABLE ITEM
|
---|
51 | ;"do DoFind("D. (50): ",RxName,50,.01,.SrchRec,"B") ;"DRUG file
|
---|
52 | ;"do DoFind("E. (22706.9): ",RxName,22706.9,.04,.SrchRec,"LN^C") ;"TMG FDA IMPORT COMPILED (22706.9)
|
---|
53 | ;"do DoFind("",RxName,22706.9,.04,.SrchRec,"B^C^D^E^LN") ;"TMG FDA IMPORT COMPILED (22706.9)
|
---|
54 |
|
---|
55 | new % set %=1
|
---|
56 | write "Ignore drugs marked to be SKIPPED"
|
---|
57 | do YN^DICN write !
|
---|
58 | if %=-1 goto FOQVDone
|
---|
59 | do FindTMG("",RxName,RxSet,.SrchRec,(%=1))
|
---|
60 |
|
---|
61 | write !,"Next, select one or more drugs that are ",!
|
---|
62 | write "examples of a drug that is missing.",!
|
---|
63 | do PressToCont^TMGUSRIF
|
---|
64 |
|
---|
65 | new Results
|
---|
66 | do Slctor2^TMGUSRIF("SrchRec","Results","Pick Example(s) of Missing Drugs. [ESC][ESC] when done.")
|
---|
67 |
|
---|
68 | set %=1
|
---|
69 | write "Automatically Refreshing Selected Before Editing"
|
---|
70 | do YN^DICN write !
|
---|
71 | if %=-1 goto FOQVDone
|
---|
72 | if %=1 do RefreshChain(.Results)
|
---|
73 |
|
---|
74 | do HandleChain(.Results) ;"Show forward array
|
---|
75 |
|
---|
76 | write "Done.",!
|
---|
77 | do PressToCont^TMGUSRIF
|
---|
78 |
|
---|
79 | FOQVDone
|
---|
80 | quit
|
---|
81 |
|
---|
82 |
|
---|
83 | AskFix1TMG
|
---|
84 | ;"Purpose: ask user for entry in 22706.9 and allow editing.
|
---|
85 |
|
---|
86 | new DIC,X,Y,IEN22706d9
|
---|
87 |
|
---|
88 | set DIC=22706.9,DIC(0)="MAEQ"
|
---|
89 | do ^DIC
|
---|
90 | if +Y>0 do
|
---|
91 | . new array
|
---|
92 | . set array($piece(Y,"^",2),+Y_"^22706.9")=""
|
---|
93 | . do HandleChain(.array)
|
---|
94 |
|
---|
95 | quit
|
---|
96 |
|
---|
97 |
|
---|
98 | FindOQV(Prefix,RxName,RxSet,SrchRec)
|
---|
99 | ;"Purpose: look through ORDER QUICk VIEW for RxName, and return if found
|
---|
100 | ;"Input: Prefix -- a string to prefix name with in index.
|
---|
101 | ;" RxName -- the string of the Rx name to look for (may be a partial name)
|
---|
102 | ;" RxSet -- IEN of 'ORWDSET O RX' in 101.44
|
---|
103 | ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format:
|
---|
104 | ;" SrchRec(NameFound)=IEN^File#
|
---|
105 | ;" SrchRec(NameFound)=IEN^File#
|
---|
106 | ;"Output: SrchRec is filled.
|
---|
107 | ;"Result: none
|
---|
108 |
|
---|
109 | new TMGDATA,TMGERR
|
---|
110 | do FIND^DIC(101.442,","_RxSet_",","","M",RxName,"*","B","","","TMGDATA","TMGERR")
|
---|
111 |
|
---|
112 | if +$get(TMGDATA("DILIST",0))>0 do
|
---|
113 | . new j,IEN,Name
|
---|
114 | . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do
|
---|
115 | . . set IEN=$get(TMGDATA("DILIST",2,j))
|
---|
116 | . . set name=Prefix_$$GET1^DIQ(101.442,IEN_","_RxSet_",",".01")
|
---|
117 | . . set SrchRec(name,IEN_","_RxSet_",^101.442")=""
|
---|
118 |
|
---|
119 | quit
|
---|
120 |
|
---|
121 |
|
---|
122 | FindTMG(Prefix,RxName,RxSet,SrchRec,IgnoreSkipped)
|
---|
123 | ;"Purpose: look through 22706.9 for RxName, and return if found
|
---|
124 | ;"Input: Prefix -- a string to prefix name with in index.
|
---|
125 | ;" RxName -- the string of the Rx name to look for (may be a partial name)
|
---|
126 | ;" RxSet -- IEN of 'ORWDSET O RX' in 101.44
|
---|
127 | ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format:
|
---|
128 | ;" SrchRec(NameFound,IEN^File#)=""
|
---|
129 | ;" SrchRec(NameFound,IEN^File#)=""
|
---|
130 | ;" IgnoreSkipped -- if 1 then only show drugs not marked to be SKIPPED
|
---|
131 | ;"Output: SrchRec is filled.
|
---|
132 | ;"Result: none
|
---|
133 |
|
---|
134 | new TMGDATA,TMGERR
|
---|
135 | ;"do FIND^DIC(22706.9,"","","M",RxName,"*","B^C^D^E^LN","","","TMGDATA","TMGERR")
|
---|
136 | do FIND^DIC(22706.9,"","","M",RxName,"*","B^C^D^LN","","","TMGDATA","TMGERR")
|
---|
137 |
|
---|
138 | if +$get(TMGDATA("DILIST",0))>0 do
|
---|
139 | . new j,IEN,IENS,name,name1,name2,name3,TMGARRAY
|
---|
140 | . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do
|
---|
141 | . . set IEN=$get(TMGDATA("DILIST",2,j)),IENS=IEN_","
|
---|
142 | . . do GETS^DIQ(22706.9,IENS,".05;.07;6;.04",,"TMGARRAY","TMGMSG")
|
---|
143 | . . if IgnoreSkipped,($get(TMGARRAY(22706.9,IENS,"6"))="SKIP") quit
|
---|
144 | . . set name1=$get(TMGARRAY(22706.9,IENS,".05"))
|
---|
145 | . . set name2=$get(TMGARRAY(22706.9,IENS,".07"))
|
---|
146 | . . set name3=$get(TMGARRAY(22706.9,IENS,".04"))
|
---|
147 | . . set name=name1_" | "_name2_" | "_name3
|
---|
148 | . . set name=$extract(name,1,75)
|
---|
149 | . . set SrchRec(name,IENS_"^"_"22706.9")=""
|
---|
150 |
|
---|
151 | quit
|
---|
152 |
|
---|
153 |
|
---|
154 | DoFind(Prefix,RxName,FileNum,Field,SrchRec,index)
|
---|
155 | ;"Purpose: look through file for RxName, and return if found
|
---|
156 | ;"Input: Prefix -- a string to prefix name with in index.
|
---|
157 | ;" RxName -- the string of the Rx name to look for (may be a partial name)
|
---|
158 | ;" FileNum -- The file number to look in.
|
---|
159 | ;" Field -- OPTIONAL. Field to return value in. Default=.01
|
---|
160 | ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format:
|
---|
161 | ;" SrchRec(NameFound)=IEN^File#
|
---|
162 | ;" SrchRec(NameFound)=IEN^File#
|
---|
163 | ;" --NOTE: if Name has already been found, it will NOT be overwritten here.
|
---|
164 | ;" index -- OPTIONAL. Index to search. Default="B"
|
---|
165 | ;"Output: SrchRec is filled.
|
---|
166 | ;"Result: none
|
---|
167 |
|
---|
168 | set Field=$get(Field,".01")
|
---|
169 | set index=$get(index,"B")
|
---|
170 |
|
---|
171 | new TMGDATA,TMGERR
|
---|
172 | do FIND^DIC(FileNum,"","","M",RxName,"*",index,"","","TMGDATA","TMGERR")
|
---|
173 |
|
---|
174 | if +$get(TMGDATA("DILIST",0))>0 do
|
---|
175 | . new j,IEN,Name
|
---|
176 | . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do
|
---|
177 | . . set IEN=$get(TMGDATA("DILIST",2,j))
|
---|
178 | . . set name=Prefix_$$GET1^DIQ(FileNum,IEN,Field)
|
---|
179 | . . set SrchRec(name,IEN_"^"_FileNum)=""
|
---|
180 |
|
---|
181 | quit
|
---|
182 |
|
---|
183 |
|
---|
184 | RefreshChain(array)
|
---|
185 | ;"Purpose: Refresh entries in 22706.9
|
---|
186 | ;"Input: -- array: PASS BY REFERENCE. Format:
|
---|
187 | ;" array(DrugName,IEN^File#)=""
|
---|
188 | ;" array(DrugName,IEN^File#)=""
|
---|
189 | ;" Note: it is expected that File# will be:
|
---|
190 | ;" 101.44, 101.43, 50.7, 50, or 22706.9
|
---|
191 |
|
---|
192 | new name,IENArray
|
---|
193 | set name=""
|
---|
194 | for set name=$order(array(name)) quit:(name="") do
|
---|
195 | . new fInfo set fInfo=""
|
---|
196 | . for set fInfo=$order(array(name,fInfo)) quit:(fInfo="") do
|
---|
197 | . . new IEN,FileNum
|
---|
198 | . . set FileNum=$piece(fInfo,"^",2)
|
---|
199 | . . if FileNum'=22706.9 quit
|
---|
200 | . . set IEN=$piece(fInfo,"^",1)
|
---|
201 | . . set IENArray(+IEN)=""
|
---|
202 |
|
---|
203 | new Option set Option("FIX CHAIN")=1
|
---|
204 | set Option("QUIET")=1
|
---|
205 | do RefreshBatch^TMGNDF3C(.IENArray,.Option)
|
---|
206 |
|
---|
207 | quit
|
---|
208 |
|
---|
209 |
|
---|
210 | HandleChain(array) ;"Show forward array
|
---|
211 | ;"Purpose: Show chain from input entry towards final part of chain (Order Quick View)
|
---|
212 | ;"Input: -- array: PASS BY REFERENCE. Format:
|
---|
213 | ;" array(DrugName,IEN^File#)=""
|
---|
214 | ;" array(DrugName,IEN^File#)=""
|
---|
215 | ;" Note: it is expected that File# will be:
|
---|
216 | ;" 101.44, 101.43, 50.7, 50, or 22706.9
|
---|
217 |
|
---|
218 | new output,RxSet,OutArray
|
---|
219 |
|
---|
220 | set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto HCnDone
|
---|
221 | new IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9
|
---|
222 | new array1,array2,num
|
---|
223 | new abort,rescan
|
---|
224 | new name
|
---|
225 | HC1
|
---|
226 | kill output,array2,array1
|
---|
227 | set name=""
|
---|
228 | for set name=$order(array(name)) quit:(name="") do
|
---|
229 | . new fInfo set fInfo=""
|
---|
230 | . for set fInfo=$order(array(name,fInfo)) quit:(fInfo="") do
|
---|
231 | . . new IEN,FileNum
|
---|
232 | . . set IEN=$piece(fInfo,"^",1)
|
---|
233 | . . set FileNum=$piece(fInfo,"^",2)
|
---|
234 | . . if FileNum=101.44 set output=IEN
|
---|
235 | . . else if FileNum=101.43 set output=$$Fmt101d43(IEN,RxSet)
|
---|
236 | . . else if FileNum=50.7 set output=$$Fmt50d7(IEN,RxSet)
|
---|
237 | . . else if FileNum=50 set output=$$Fmt50(IEN,RxSet)
|
---|
238 | . . else if FileNum=22706.9 do
|
---|
239 | . . . do Hndl22706d9(IEN,RxSet,.OutArray,.array1,"T")
|
---|
240 | . . . set output=$$Fmt22706d9(IEN,RxSet,"G")
|
---|
241 | . . set IEN10144=+$piece(output,"^",1)
|
---|
242 | . . set IEN10143=+$piece(output,"^",2)
|
---|
243 | . . set IEN50d7=+$piece(output,"^",3)
|
---|
244 | . . set IEN50=+$piece(output,"^",4)
|
---|
245 | . . set IEN22706d9=+$piece(output,"^",5)
|
---|
246 | . . if IEN22706d9=0 quit
|
---|
247 | . . set OutArray(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9)="G"
|
---|
248 | . . set array1(IEN22706d9,IEN10144_"^"_IEN10143_"^"_IEN50d7_"^"_IEN50_"^"_IEN22706d9_"^"_"G")=""
|
---|
249 |
|
---|
250 | ;"Now rearrange into a numbered array
|
---|
251 | set num=0,IEN22706d9=""
|
---|
252 | for set IEN22706d9=$order(array1(IEN22706d9)) quit:(IEN22706d9="") do
|
---|
253 | . new s set s=""
|
---|
254 | . for set s=$order(array1(IEN22706d9,s)) quit:(s="") do
|
---|
255 | . . set num=num+1
|
---|
256 | . . set array2(num)=s
|
---|
257 |
|
---|
258 | ;"Now display array -- this setup will allow user to back up in list
|
---|
259 | set abort=0,rescan=0,num=0
|
---|
260 | for set num=$order(array2(num)) quit:(num="")!(abort=1)!(rescan=1) do
|
---|
261 | . new s set s=$get(array2(num))
|
---|
262 | . new result
|
---|
263 | . set result=$$HandleOne($piece(s,"^",1),$piece(s,"^",2),$piece(s,"^",3),$piece(s,"^",4),$piece(s,"^",5),$piece(s,"^",6))
|
---|
264 | . if result="^" set abort=1 quit
|
---|
265 | . else if result=-3 kill array2(num) quit
|
---|
266 | . else if result=-4 set rescan=1 quit
|
---|
267 | . else if result=-1 do quit
|
---|
268 | . . set num=$order(array2(num),-1)
|
---|
269 | . . if num>0 set num=$order(array2(num),-1)
|
---|
270 |
|
---|
271 | if rescan=1 goto HC1
|
---|
272 |
|
---|
273 | HCnDone
|
---|
274 | quit
|
---|
275 |
|
---|
276 |
|
---|
277 | HandleOne(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9,GorT)
|
---|
278 | ;"Purpose: to show the user a drug chain and allow manipulation of it
|
---|
279 | ;"Input: IEN's
|
---|
280 | ;" GorT -- G or T
|
---|
281 | ;"NOTE: makes use of RxSet (a variable globally scoped here)
|
---|
282 | ;"Results: 1: go to next,
|
---|
283 | ;" -1: go back one,
|
---|
284 | ;" ^: abort,
|
---|
285 | ;" -3: delete this record
|
---|
286 | ;" -4: Rescan and re-setup array
|
---|
287 |
|
---|
288 | new input
|
---|
289 | new result set result=1
|
---|
290 | H1L1
|
---|
291 | write #
|
---|
292 | write "-- TMG FDA IMPORT COMPILED (22706.9) file, Record# ",IEN22706d9," [",GorT,"] -----------",!
|
---|
293 | new tabCol set tabCol=50
|
---|
294 | ;"write $extract($$GET1^DIQ(22706.9,IEN22706d9_",",.04),1,48),?50," [.04;22706.9:#",IEN22706d9,"]",!
|
---|
295 | write "1. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.04),?tabCol," [.04; Long]",!
|
---|
296 | write "2. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.05),?tabCol," [.05; Trade (inclds Frm)]",!
|
---|
297 | write "3. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.055),?tabCol," [.055; Trade&Frm]",!
|
---|
298 | write "4. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),?tabCol," [.056; Trade,Frm,Dose,Unit]",!
|
---|
299 | write "5. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.07),?tabCol," [.07; Generic]",!
|
---|
300 | write "6. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.075),?tabCol," [.075; Genrc&Frm]",!
|
---|
301 | write "7. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.076),?tabCol," [.076; Generc,Frm,Dose,Unit]",!
|
---|
302 | write "8. +-> [",GorT,"] ",$$GET1^DIQ(50,IEN50_",",.01),?tabCol," [50:#",IEN50,"]",!
|
---|
303 | new vapIEN set vapIEN=+$piece($get(^PSDRUG(IEN50,"ND")),"^",3)
|
---|
304 | if vapIEN>0 write "9. +~~~> 50.68: ",$$GET1^DIQ(50.68,vapIEN_",",.01),!
|
---|
305 | write "10. +->",$$GET1^DIQ(50.7,IEN50d7_",",.01),?tabCol," [50.7:#",IEN50d7,"]",!
|
---|
306 | write "11. +->",$$GET1^DIQ(101.43,IEN10143_",",.01),?tabCol," [101.43:#",IEN10143,"]",!
|
---|
307 | write "12. +->",$$GET1^DIQ(101.442,IEN10144_","_RxSet_",",.01),?tabCol," [101.44:#",IEN10144,"]",!
|
---|
308 | write !
|
---|
309 | write "'-'=Backward; '+'=Forward; '^'=quit;",!
|
---|
310 | write "F=show FDA source; T=show Compiled record dump",!
|
---|
311 | write "S=mark import to be SKIPPED'",!
|
---|
312 | write "FE=Full edit of Compiled",!
|
---|
313 | write "1..7=Edit Compiled, 8=Edit DRUG (50) record",!
|
---|
314 | write "RC=Recompile; N=Alt Names setup; RDL=Refresh DRUG link",!
|
---|
315 | read "Enter option: +// ",input,!
|
---|
316 | if input="" set input="+"
|
---|
317 | set input=$$UP^XLFSTR(input)
|
---|
318 | if input="^" set result="^" goto HODone
|
---|
319 | if input="-" set result=-1 goto HODone
|
---|
320 | if input="+" set result=1 goto HODone
|
---|
321 | if input="FE" do
|
---|
322 | . do FullEDTMG(IEN22706d9)
|
---|
323 | . set input="RDL"
|
---|
324 | if (+input>0)&(+input<8) do
|
---|
325 | . do EditTMG(IEN22706d9)
|
---|
326 | . set input="RDL"
|
---|
327 | if input="8" do
|
---|
328 | . do Edit50^TMGNDFUT(IEN50)
|
---|
329 | . set input="RDL"
|
---|
330 | if input="9" do
|
---|
331 | . do EditVAP(IEN22706d9)
|
---|
332 | . set input="RDL"
|
---|
333 | if input="F" do goto H1L1
|
---|
334 | . do Show1Source^TMGNDF1A(IEN22706d9)
|
---|
335 | . do PressToCont^TMGUSRIF
|
---|
336 | if input="T" do goto H1L1
|
---|
337 | . do DumpRec2^TMGDEBUG(22706.9,IEN22706d9,0)
|
---|
338 | . do PressToCont^TMGUSRIF
|
---|
339 | if input="S" do goto HODone
|
---|
340 | . new Option
|
---|
341 | . set Option("FIX CHAIN")=1
|
---|
342 | . set Option("FIX CHAIN","IEN22706d9")=IEN22706d9
|
---|
343 | . set Option("DELETING")=1
|
---|
344 | . set Option("QUIET")=1
|
---|
345 | . do Refresh1^TMGNDF3C(IEN22706d9,.Option)
|
---|
346 | . new TMGFDA,TMGMSG
|
---|
347 | . set TMGFDA(22706.9,IEN22706d9,6)=1
|
---|
348 | . do FILE^DIE("","TMGFDA","TMGMSG")
|
---|
349 | . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
|
---|
350 | . ;"set $piece(^TMG(22706.9,IEN22706d9,1),"^",4)=1 ;"set SKIP=true
|
---|
351 | . set result=-3
|
---|
352 | if input="RC" do goto H1L1
|
---|
353 | . new Option set Option("FIX CHAIN")=1
|
---|
354 | . do ReCompOne^TMGNDF1A(IEN22706d9,.Option)
|
---|
355 | . do PressToCont^TMGUSRIF
|
---|
356 | if input="N" do goto H1L1
|
---|
357 | . new Option set Option("FIX CHAIN")=1
|
---|
358 | . do Make1Alt^TMGNDF2G(IEN22706d9,.Option)
|
---|
359 | . do PressToCont^TMGUSRIF
|
---|
360 | if input="RDL" do goto HODone
|
---|
361 | . new Option set Option("FIX CHAIN")=1
|
---|
362 | . set Option("FIX CHAIN","IEN22706d9")=IEN22706d9
|
---|
363 | . do Refresh1^TMGNDF3C(IEN22706d9,.Option)
|
---|
364 | . set result=-4
|
---|
365 | . write "Will now rescan and setup array to detect possible changes.",!
|
---|
366 | . do PressToCont^TMGUSRIF
|
---|
367 |
|
---|
368 | HODone
|
---|
369 | quit result
|
---|
370 |
|
---|
371 | Hndl22706d9(IEN,RxSet,OutArray,array1,GorT)
|
---|
372 | ;"Purpose: A brief subroutine to format 22706.9 input
|
---|
373 |
|
---|
374 | new output
|
---|
375 | new IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9
|
---|
376 | set output=$$Fmt22706d9(IEN,RxSet,GorT)
|
---|
377 | set IEN10144=+$piece(output,"^",1)
|
---|
378 | set IEN10143=+$piece(output,"^",2)
|
---|
379 | set IEN50d7=+$piece(output,"^",3)
|
---|
380 | set IEN50=+$piece(output,"^",4)
|
---|
381 | set IEN22706d9=+$piece(output,"^",5)
|
---|
382 | if IEN22706d9=0 quit
|
---|
383 | set OutArray(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9)=GorT
|
---|
384 | set array1(IEN22706d9,IEN10144_"^"_IEN10143_"^"_IEN50d7_"^"_IEN50_"^"_IEN22706d9_"^"_GorT)=""
|
---|
385 | quit
|
---|
386 |
|
---|
387 |
|
---|
388 |
|
---|
389 | Fmt101d43(IEN,RxSet)
|
---|
390 | ;"Purpose: to add an entry from file 101.43 to output string
|
---|
391 | ;"Input: IEN -- an IEN from file 101.43
|
---|
392 | ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record
|
---|
393 | ;"Result: IEN101.44^IEN101.43
|
---|
394 |
|
---|
395 | new parentIEN
|
---|
396 | set IEN=+$get(IEN)
|
---|
397 | if IEN>0 do
|
---|
398 | . set parentIEN=+$order(^ORD(101.44,RxSet,20,"B",IEN,""))
|
---|
399 | else set parentIEN=0
|
---|
400 |
|
---|
401 | quit parentIEN_"^"_IEN
|
---|
402 |
|
---|
403 |
|
---|
404 | Fmt50d7(IEN,RxSet)
|
---|
405 | ;"Purpose: to add an entry from file 50.7 to output string
|
---|
406 | ;"Input: IEN -- an IEN from file 50.7
|
---|
407 | ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record
|
---|
408 | ;"Result: IEN101.44^IEN101.43^IEN50.7
|
---|
409 |
|
---|
410 | new parentIEN
|
---|
411 | set IEN=+$get(IEN)
|
---|
412 | if IEN>0 do
|
---|
413 | . set parentIEN=$order(^ORD(101.43,"ID",IEN_";99PSP",""))
|
---|
414 | else set parentIEN=0
|
---|
415 |
|
---|
416 | quit $$Fmt101d43(parentIEN,RxSet)_"^"_IEN
|
---|
417 |
|
---|
418 |
|
---|
419 | Fmt50(IEN,RxSet)
|
---|
420 | ;"Purpose: to add an entry from file 50 to output string
|
---|
421 | ;"Input: IEN -- an IEN from file 50
|
---|
422 | ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record
|
---|
423 | ;"Result: IEN101.44^IEN101.43^IEN50.7^IEN50
|
---|
424 |
|
---|
425 | new parentIEN
|
---|
426 | set IEN=+$get(IEN)
|
---|
427 | if IEN>0 do
|
---|
428 | . set parentIEN=+$piece($get(^PSDRUG(IEN,2)),"^",1)
|
---|
429 | else set parentIEN=0
|
---|
430 |
|
---|
431 | quit $$Fmt50d7(parentIEN,RxSet)_"^"_IEN
|
---|
432 |
|
---|
433 |
|
---|
434 | Fmt22706d9(IEN,RxSet,s)
|
---|
435 | ;"Purpose: to add an entry from file 22706.9 to output string
|
---|
436 | ;"Input: IEN -- an IEN from file 22706.9
|
---|
437 | ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record
|
---|
438 | ;" s -- "G" or "T" for Generic or Trade
|
---|
439 | ;"Result: IEN101.44^IEN101.43^IEN50.7^IEN50^IEN22706.9
|
---|
440 |
|
---|
441 | new parentIEN set parentIEN=0
|
---|
442 | new parentS
|
---|
443 | set IEN=+$get(IEN)
|
---|
444 | if IEN>0 do
|
---|
445 | . if $get(s)="T" do
|
---|
446 | . . set parentIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) ;" 7;1 DRUG TRADENAME LINK
|
---|
447 | . else do
|
---|
448 | . . set parentIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",2) ;" 7;2 DRUG GENERIC LINK
|
---|
449 |
|
---|
450 | if parentIEN>0 do
|
---|
451 | . set parentS=$$Fmt50(parentIEN,RxSet)
|
---|
452 | else do
|
---|
453 | . set parentS="???"
|
---|
454 |
|
---|
455 | quit parentS_"^"_IEN
|
---|
456 |
|
---|
457 |
|
---|
458 | ;"============================================================
|
---|
459 |
|
---|
460 | EditTMG(IEN)
|
---|
461 | ;"Purpose: to edit the TMG
|
---|
462 |
|
---|
463 | ;"do Edit1^TMGNDF1D(IEN)
|
---|
464 |
|
---|
465 | new Options,IENlist
|
---|
466 | set IENlist(IEN)=""
|
---|
467 | set Options("FILE")=22706.9
|
---|
468 | set Options("FIELDS",1)=.04
|
---|
469 | set Options("FIELDS",2)=.05
|
---|
470 | set Options("FIELDS",3)=.055
|
---|
471 | set Options("FIELDS",4)=.056
|
---|
472 | set Options("FIELDS",5)=.07
|
---|
473 | set Options("FIELDS",6)=.075
|
---|
474 | set Options("FIELDS",7)=.076
|
---|
475 | set Options("FIELDS",8)=6
|
---|
476 | set Options("FIELDS","MAX NUM")=8
|
---|
477 |
|
---|
478 | new temp set temp=$$EditRecs^TMGSELED("IENlist",.Options)
|
---|
479 |
|
---|
480 | quit
|
---|
481 |
|
---|
482 |
|
---|
483 | FullEDTMG(IEN)
|
---|
484 | ;"Purpose: allow editing of any field in TMG
|
---|
485 |
|
---|
486 | new Options
|
---|
487 | set Options("FILE")=22706.9
|
---|
488 | if $$GetFields^TMGSELED(.Options)=0 goto FETDone
|
---|
489 |
|
---|
490 | new list set list(IEN)=""
|
---|
491 | new temp set temp=$$EditRecs^TMGSELED("list",.Options)
|
---|
492 |
|
---|
493 | FETDone quit
|
---|
494 |
|
---|
495 |
|
---|
496 |
|
---|
497 | EditVAP(IEN)
|
---|
498 | ;"Purpose: to edit the TMG
|
---|
499 | ;"Input: IEN -- IEN in 22706.9
|
---|
500 |
|
---|
501 | new Options,IENlist
|
---|
502 | set IENlist(IEN)=""
|
---|
503 | set Options("FILE")=22706.9
|
---|
504 | set Options("FIELDS",1)=.04
|
---|
505 | set Options("FIELDS",1,"NO EDIT")=1
|
---|
506 | set Options("FIELDS",2)=.055
|
---|
507 | set Options("FIELDS",2,"NO EDIT")=1
|
---|
508 | set Options("FIELDS",3)=.075
|
---|
509 | set Options("FIELDS",3,"NO EDIT")=1
|
---|
510 | set Options("FIELDS",4)=.076
|
---|
511 | set Options("FIELDS",4,"NO EDIT")=1
|
---|
512 | set Options("FIELDS",5)=5.5
|
---|
513 | set Options("FIELDS","MAX NUM")=5
|
---|
514 |
|
---|
515 | new temp set temp=$$EditRecs^TMGSELED("IENlist",.Options)
|
---|
516 |
|
---|
517 | quit
|
---|
518 |
|
---|
519 |
|
---|