source: cprs/branches/tmg-cprs/m_files/TMGSRCH0.m@ 1420

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

Initial upload
File size: 19.5 KB
Line 
1TMGSRCH0 ;TMG/kst/Search API ;05/19/10 ; 6/4/10
2 ;;1.0;TMG-LIB;**1**;05/19/10
3 ;
4 ;"TMG FILEMAN SEARCH API
5 ;
6 ;"Copyright Kevin Toppenberg MD 5/19/10
7 ;"Released under GNU General Public License (GPL)
8 ;"
9 ;"NOTE: this function depends on new version of LIST^DIC, from G. Timpson Patch
10 ;"=======================================================================
11 ;" RPC -- Public Functions.
12 ;"=======================================================================
13 ;"FMSRCH(OUT,FILENUM,COMPEXPR) --A wrapper for Fileman search call
14 ;"ARRYSRCH(FILENUM,PRESULT,ARRAY) -- Process parsed array, doing search
15 ;"=======================================================================
16 ;"PRIVATE API FUNCTIONS
17 ;"=======================================================================
18 ;"USRPGFN(TMGPGFN,TMGSTAT) -- Do user Progress Function, if any.
19 ;"SAMEFILE(PARRAY,STARTNUM,CURFILE) --Return range of search terms that are all in the same Fileman file
20 ;"COMPEXPR(FILENUM,PARRAY,STARTN,ENDN,SRCHFILE,FIELDS) -- prepair a FILEMAN COMPUTED EXPRSSION from elements in ARRAY
21 ;"FIXCOMB(COMB) -- Fix COMBINER term
22 ;"COMP1XP(PARRAY,FIELDS) -- prepair 1 FILEMAN COMPUTED EXPRSSION from elements in ARRAY
23 ;"FIXSET(TMGRSLT,TARGETFILE,SRCHFILE,FLDS,TMGSET) -- Change output of FMSRCH into needed format.
24 ;"RESOLV(FILE,FLDSTR,IEN,ERR) -- follow pointer path to final value.
25 ;"DOCOMB(COMB,TMG1SET,PRESULT) -- combine TMG1SET with @PRESULT based on logical operation COMBiner
26 ;"=======================================================================
27 ;"=======================================================================
28 ;"Dependencies:
29 ;" DIC (custom version), TMGDEBUG, TMGMISC, TMGSTUTL
30 ;"=======================================================================
31 ;"=======================================================================
32 ;
33 ;
34ARRYSRCH(FILENUM,PRESULT,TMGARRAY,TMGPGFN) ;
35 ;"Purpose: Process parsed array, doing search on terms, and combining them.
36 ;"Input: FILENUM -- This is the target file
37 ;" PRESULT-- Pass by NAME. AN OUT PARAMETER. (see output below)
38 ;" TMGARRAY -- Pass by reference. Contains search terms. Format
39 ;" TMGARRAY("FILE")=FileNumber (This is target output file)
40 ;" TMGARRAY(index,"FLD")=Field to search
41 ;" TMGARRAY(index,"FNUMPTR")=FileNum:FLD[:FLD[:FLD...]]
42 ;" TMGARRAY(index,"SRCH")=Value to search for
43 ;" TMGARRAY(index,"LOGIC",num)=...
44 ;" TMGARRAY(index,"WP")=1 if field is a WP field
45 ;" TMGARRAY(index,"COMP")=comparator Allowed Comparators: =, '=, '<, '>, [, IN
46 ;" TMGARRAY(index,"SUBTERMS")=1 if has subterms
47 ;" TMGARRAY(index,indexB,...)...
48 ;" TMGPGFN -- OPTIONAL. Mumps code that will be called periodically
49 ;" to allow display of progress of slow searches.
50 ;" Code may depend on the following variables:
51 ;" TMGSTAT -- The most recent status text
52 ;" TMGPCT -- a very gross estimate of % done (0-100%)
53 ;"Output: PRESULT is filled in. Format:
54 ;" @PRESULT@(0)=-1^Error Message, if needed
55 ;" -or-
56 ;" @PRESULT@(IEN)=""
57 ;" @PRESULT@(IEN)=""
58 ;"Result: Returns number of matches found.
59 NEW ENTRYNUM,ENDNUM,TEMP,TMGEXPR,TMGFLDS,TMGFILE,MAXNUM
60 NEW CT
61 KILL @PRESULT
62 NEW ERR SET ERR=0
63 NEW DONE SET DONE=0
64 SET MAXNUM=+$ORDER(TMGARRAY("@"),-1)
65 IF MAXNUM<1 SET MAXNUM=1 ;"Avoid any divide by zero error
66 SET ENTRYNUM=1
67 FOR DO QUIT:(DONE=1)!(+ERR=-1)
68 . SET TEMP=$$SAMEFILE("TMGARRAY",ENTRYNUM)
69 . SET ENDNUM=$PIECE(TEMP,"^",2)
70 . IF ENDNUM<ENTRYNUM SET DONE=1 QUIT
71 . SET TMGEXPR=$$COMPEXPR(FILENUM,"TMGARRAY",ENTRYNUM,ENDNUM,.TMGFILE,.TMGFLDS)
72 . IF +TMGEXPR=-1 SET ERR=TMGEXPR QUIT
73 . NEW COMB SET COMB=$PIECE($GET(TMGARRAY(ENTRYNUM,"LOGIC")),"^",2)
74 . DO FIXCOMB(.COMB)
75 . NEW TMGOUT,TMGOPT
76 . IF TMGFLDS'="" SET TMGOPT("FIELDS")="@;"_+TMGFLDS_"I"
77 . DO USRPGFN(.TMGPGFN,"Searching file #"_TMGFILE_" for: "_TMGEXPR_" ...")
78 . SET CT=$$FMSRCH(TMGFILE,TMGEXPR,.TMGOUT,.TMGOPT)
79 . IF $DATA(TMGOUT("ERR")) SET ERR="-1^FILEMAN ERROR^"_$GET(TMGOUT("ERR",0)) QUIT
80 . DO USRPGFN(.TMGPGFN,"Organizing "_CT_" search results so far...")
81 . NEW TMG1SET
82 . SET ERR=$$FIXSET(.TMGOUT,FILENUM,TMGFILE,TMGFLDS,.TMG1SET)
83 . IF +ERR=-1 QUIT
84 . DO USRPGFN(.TMGPGFN,"Combining search term with net results...")
85 . IF COMB="" MERGE @PRESULT=TMG1SET
86 . ELSE DO DOCOMB(COMB,.TMG1SET,PRESULT)
87 . SET ENTRYNUM=ENDNUM+1
88 IF +ERR=-1 DO
89 . KILL @PRESULT
90 . SET @PRESULT@(0)=ERR
91 . SET CT=0
92 ELSE DO
93 . SET TMGSTAT="Counting search results..."
94 . DO USRPGFN(.TMGPGFN)
95 . SET CT=$$LISTCT^TMGMISC(PRESULT)
96 . SET CT=CT-1 ;"Remove count of "DETAILS" node
97 QUIT CT
98 ;
99USRPGFN(TMGPGFN,TMGSTAT) ;"Do user Progress Function, if any.
100 IF $GET(TMGPGFN)'="" DO
101 . NEW $ETRAP SET $ETRAP="S $ETRAP="""",$ECODE="""""
102 . NEW TMGPCT SET TMGPCT=(((ENTRYNUM-1)/MAXNUM)*100)\1
103 . XECUTE TMGPGFN ;"Run user's progress function code
104 QUIT
105 ;
106SAMEFILE(PARRAY,STARTNUM,CURFILE) ;
107 ;"Purpose: Return range of search terms that are all in the same Fileman file
108 ;" OLD-> NOTE: if WP field is encountered, this is kicked out as NOT
109 ;" in same file, to overcome LIST^DIC limitation. (REMOVED AFTER LIMITATION FIXED)
110 ;"Input: PARRAY -- PASS BY NAME. This is ARRAY as passed to DOSRCH
111 ;" STARTNUM -- OPTIONAL. The index to start consideration of. Default=1
112 ;" CURFILE -- OPTIONAL. Used when calling self reiteratively. Leave blank first time.
113 ;"Result: StartIndex^EndIndex of entries dealing with same file.
114 ;
115 SET STARTNUM=$GET(STARTNUM,1)
116 NEW RESULT SET RESULT=STARTNUM_"^-1"
117 NEW I SET I=STARTNUM-1
118 SET CURFILE=+$GET(CURFILE)
119 NEW DONE SET DONE=0
120 FOR SET I=$ORDER(@PARRAY@(I)) QUIT:(+I'>0)!(DONE=1) DO
121 . NEW THISFNUM SET THISFNUM=+$GET(@PARRAY@(I,"FNUMPTR"))
122 . IF $GET(@PARRAY@(I,"SUBTERMS"))=1 DO QUIT:DONE=1
123 . . SET THISFNUM=CURFILE
124 . . NEW TEMP SET TEMP=$$SAMEFILE($NAME(@PARRAY@(I)),1,.THISFNUM)
125 . . NEW NUM2 SET NUM2=$PIECE(TEMP,"^",2)
126 . . IF NUM2=-1 SET DONE=1 QUIT
127 . . IF +$ORDER(@PARRAY@(I,NUM2))>0 SET DONE=1
128 . IF (CURFILE>0) DO QUIT:DONE=1
129 . . IF (THISFNUM'=CURFILE) SET DONE=1 QUIT
130 . . ;"IF $GET(@PARRAY@(I,"WP"))=1 SET DONE=1 QUIT
131 . SET CURFILE=THISFNUM
132 . SET $PIECE(RESULT,"^",2)=I
133 QUIT RESULT
134 ;
135COMPEXPR(FILENUM,PARRAY,STARTN,ENDN,SRCHFILE,FIELDS) ;
136 ;"Purpose: to prepair a FILEMAN COMPUTED EXPRSSION from elements in ARRAY
137 ;"Input: ARRAY -- Pass by reference. Contains search terms. Format
138 ;" @PARRAY@("FILE")=FileNumber (This is target output file)
139 ;" @PARRAY@(index,"FLD")=Field to search
140 ;" @PARRAY@(index,"FNUMPTR")=FileNum:FLD[:FLD[:FLD...]]
141 ;" @PARRAY@(index,"SRCH")=Value to search for
142 ;" @PARRAY@(index,"COMP")=comparator Allowed Comparators: =, '=, '<, '>, [, IN
143 ;" @PARRAY@(index,"SUBTERMS")=1 if has subterms
144 ;" STARTN -- The starting index to consider
145 ;" ENDN -- the ending index to consider
146 ;" SRCHFILE --PASS BY REFERENCE. This is the file to search for fields in
147 ;" FIELDS -- Pass by reference. This is the desired output fields.
148 ;"Results: Will return a COMPUTED EXPRESSION, or -1^Message
149 ;"
150 NEW RESULT SET RESULT=""
151 NEW I,CURFIL
152 SET CURFIL=0
153 FOR I=STARTN:1:ENDN DO QUIT:(+RESULT=-1)
154 . IF RESULT'="" DO
155 . . NEW COMB SET COMB=$PIECE($GET(@PARRAY@(I,"LOGIC")),"^",2)
156 . . DO FIXCOMB(.COMB)
157 . . SET RESULT=RESULT_COMB
158 . IF $GET(@PARRAY@(I,"SUBTERMS"))=1 DO QUIT
159 . . NEW ENUM SET ENUM=+$ORDER(@PARRAY@(I,"@"),-1)
160 . . NEW TEMP SET TEMP=$$COMPEXPR(FILENUM,$NAME(@PARRAY@(I)),1,ENUM,.SRCHFILE,.FIELDS)
161 . . IF +TEMP=-1 SET RESULT=TEMP
162 . . SET RESULT=RESULT_TEMP
163 . NEW PRIOREXP SET PRIOREXP=$GET(@PARRAY@(I,"FM COMP EXPR"))
164 . IF PRIOREXP'="" SET RESULT=RESULT_PRIOREXP QUIT
165 . NEW FNUMPTR SET FNUMPTR=$GET(@PARRAY@(I,"FNUMPTR"))
166 . IF FNUMPTR="" DO QUIT
167 . . SET RESULT="-1^No FNUMPTR found in array. Can't create computed expression"
168 . IF CURFIL=0 SET CURFIL=+FNUMPTR
169 . IF CURFIL'=+FNUMPTR DO QUIT
170 . . SET RESULT="-1^Can't make computed expression involving different files."
171 . SET SRCHFILE=CURFIL
172 . NEW EXPR SET EXPR=$$COMP1XP($NAME(@PARRAY@(I)),.FIELDS)
173 . IF +EXPR=-1 SET RESULT=EXPR QUIT
174 . SET @PARRAY@(I,"FM COMP EXPR")=EXPR
175 . SET RESULT=RESULT_EXPR
176 QUIT RESULT
177 ;
178FIXCOMB(COMB) ; "Fix COMBINER terms
179 IF COMB="AND" SET COMB="&"
180 ELSE IF COMB="OR" SET COMB="!"
181 ELSE IF COMB="NOT" SET COMB="&'"
182 QUIT
183 ;
184COMP1XP(PARRAY,FIELDS) ;
185 ;"Purpose: to prepair ONE FILEMAN COMPUTED EXPRSSION from elements in ARRAY
186 ;"Input: PARRAY -- Pass by NAME. Contains search terms. Format
187 ;" @PARRAY@("FLD")=Field to search
188 ;" @PARRAY@("FNUMPTR")=FileNum:FLD[:FLD[:FLD...]]
189 ;" @PARRAY@("SRCH")=Value to search for (or Value..Value2 if IN comparator)
190 ;" @PARRAY@("COMP")=comparator Allowed Comparators: =, '=, '<, '>, [, IN
191 ;" FIELDS -- Pass by reference. This is the desired output fields.
192 ;"Results: Will return a COMPUTED EXPRESSION, or -1^Message
193 ;
194 NEW RESULT SET RESULT=""
195 NEW FLD SET FLD=$GET(@PARRAY@("FLD"))
196 IF +FLD=0 DO GOTO CP1DN
197 . SET RESULT="-1^No field number found"
198 SET FIELDS=$PIECE($GET(@PARRAY@("FNUMPTR")),":",2,999)
199 NEW COMP SET COMP=$GET(@PARRAY@("COMP"))
200 IF COMP="" DO GOTO CP1DN
201 . SET RESULT="-1^No comparator found"
202 NEW VALUE SET VALUE=$GET(@PARRAY@("SRCH"))
203 IF VALUE="" DO GOTO CP1DN
204 . SET RESULT="-1^No value to search for found."
205 IF COMP'="IN" DO
206 . SET RESULT="(#"_FLD_COMP_""""_VALUE_""")"
207 ELSE DO ;"Handle .01IN"5..10"
208 . NEW V1,V2
209 . SET V1=$PIECE(VALUE,"..",1)
210 . SET V2=$PIECE(VALUE,"..",2)
211 . IF (V1="")!(V2="") DO QUIT
212 . . SET RESULT="-1^Range values (e.g. V1..V2) not found for IN comparator."
213 . SET RESULT="((#"_FLD_"'<"""_V1_""")&(#"_FLD_"'>"""_V2_"""))"
214 IF +RESULT=-1 GOTO CP1DN
215 ;
216CP1DN QUIT RESULT
217 ;
218FMSRCH(TMGFILE,TMGCOMPEXPR,TMGOUT,TMGOPTION) ;
219 ;"Purpose: This is a wrapper for new Fileman search call LIST^DIC
220 ;"Input: TMGFILE -- File name or number to search in.
221 ;" TMGFILE(0) -- If FILE refers to a subfile, then FILE(0) must be set to
222 ;" the IENS that identifies which subfile to search.
223 ;" If supplied, then FILE should be PASSED BY REFERENCE
224 ;" TMGCOMPEXPR -- This is a FILEMAN COMPUTED EXPRESSION used for search.
225 ;" TMGOUT -- PASS BY REFERENCE. an OUT PARAMETER. Pre-existing data killed.
226 ;" This is array that will be filled with results.
227 ;" e.g. OUT(IEN)=IEN^FieldValue(s)
228 ;" If OPTION("BYROOT")=1, then OUT must hold the *name* of a variable to be filled.
229 ;" e.g. @OUT@(IEN)=IEN^FieldValue(s)
230 ;" TMGOUT("ERR") -- will be filled with error messages, if encountered
231 ;" TMGOPTION -- (OPTIONAL) -- Used to past customizations to LIST^DIC.
232 ;" TMGOPTION("BYROOT") If 1, then TMGOUT holds name of variable to be filled with results.
233 ;" ** See details in documentation for LIST^DIC for items below **
234 ;" TMGOPTION("FIELDS") -- Optional. Fields to return with each entry.
235 ;" TMGOPTION("FLAGS") -- Optional. Default="PX" Note: "X" will always be passed to LIST^DIC
236 ;" TMGOPTION("NUMBER") -- Optional. Max number of entries to return. Default is "*" (all)
237 ;" TMGOPTION("FROM") -- Optional. Index entry from which to begin the list.
238 ;" TMGOPTION("PART") -- Optional. A partial match restriction.
239 ;" TMGOPTION("SCREEN") -- Optional. Screening code to apply to each potential entry.
240 ;" TMGOPTION("ID") -- Optional. Identifier: text to accompany each entry returned in the list.
241 ;"Results: returns # of matches.
242 NEW TMGRESULT SET TMGRESULT=0
243 SET TMGFILE=$GET(TMGFILE)
244 IF +TMGFILE'=TMGFILE DO
245 . NEW X,Y,DIC
246 . SET DIC=1,DIC(0)="M"
247 . SET X=TMGFILE
248 . DO ^DIC
249 . SET TMGFILE=+Y
250 NEW TMGIENS SET TMGIENS=$GET(FILE(0))
251 NEW TMGFLDS SET TMGFLDS=$GET(TMGOPTION("FIELDS"),"@;")
252 NEW TMGFLAGS SET TMGFLAGS=$GET(TMGOPTION("FLAGS"),"P")
253 IF TMGFLAGS'["X" SET TMGFLAGS=TMGFLAGS_"X"
254 NEW TMGMAX SET TMGMAX=$GET(TMGOPTION("NUMBER"),"*")
255 NEW TMGFROM MERGE TMGFROM=TMGOPTION("FROM")
256 NEW TMGPART MERGE TMGPART=TMGOPTION("PART")
257 NEW TMGSCR SET TMGSCR=$GET(TMGOPTION("SCREEN"))
258 NEW TMGID SET TMGID=$GET(TMGOPTION("ID"))
259 SET TMGCOMPEXPR=$GET(TMGCOMPEXPR)
260 NEW TMGRSLT,TMGMSG
261 NEW TMGDB,TMGX SET TMGDB=0 ;"Can be changed when stepping through code.
262 IF TMGDB=1 DO
263 . SET TMGX="DO LIST^DIC("_TMGFILE_","
264 . IF $GET(TMGIENS)'="" SET TMGX=TMGX_""""_TMGIENS_""""
265 . SET TMGX=TMGX_","""_TMGFLDS_""","
266 . SET TMGX=TMGX_""""_TMGFLAGS_""","""_TMGMAX_""","
267 . IF $DATA(TMGFROM) SET TMGX=TMGX_".TMGFROM"
268 . SET TMGX=TMGX_","
269 . IF $DATA(TMGPART) SET TMGX=TMGX_".TMGPART"
270 . SET TMGX=TMGX_","""_$$QTPROTECT^TMGSTUTL(TMGCOMPEXPR)_""","
271 . IF $GET(TMGSCR)'="" SET TMGMAX=TMGMAX_""""_TMGSCR_""""
272 . SET TMGX=TMGX_","
273 . IF $GET(TMGID)'="" SET TMGMAX=TMGMAX_""""_TMGID_""""
274 . SET TMGX=TMGX_","
275 . SET TMGX=TMGX_"""TMGRSLT"",""TMGMSG"")"
276 DO LIST^DIC(TMGFILE,TMGIENS,TMGFLDS,TMGFLAGS,TMGMAX,.TMGFROM,.TMGPART,TMGCOMPEXPR,TMGSCR,TMGID,"TMGRSLT","TMGMSG")
277 NEW BYROOT SET BYROOT=+$GET(TMGOPTION("BYROOT"))
278 NEW OUTROOT
279 IF BYROOT SET OUTROOT=TMGOUT
280 ELSE SET OUTROOT="TMGOUT"
281 KILL @OUTROOT
282 IF $DATA(TMGMSG("DIERR")) DO GOTO FMSDN
283 . MERGE @OUTROOT@("ERR")=TMGMSG("DIERR") ;"copy in errors, if any
284 . SET TMGRESULT=0
285 MERGE @OUTROOT@(0)=TMGRSLT("DILIST",0)
286 NEW I SET I=0
287 NEW IENPCE SET IENPCE=0
288 FOR I=1:1:999 IF $PIECE(TMGRSLT("DILIST",0,"MAP"),"^",I)="IEN" SET IENPCE=I QUIT
289 SET I=0 FOR SET I=$ORDER(TMGRSLT("DILIST",I)) QUIT:(+I'>0) DO
290 . NEW VALUE SET VALUE=$GET(TMGRSLT("DILIST",I,0))
291 . NEW IEN SET IEN=$PIECE(VALUE,"^",IENPCE)
292 . SET @OUTROOT@(IEN)=VALUE
293 MERGE @OUTROOT@("ID")=TMGRSLT("ID") ;"Copy in identifiers, if any
294 SET TMGRESULT=+$PIECE(TMGRSLT("DILIST",0),"^",1)
295FMSDN QUIT TMGRESULT
296 ;
297 ;
298FIXSET(TMGIN,TARGETFN,SRCHFILE,FLDS,TMG1SET) ;
299 ;"Purpose: Change output of FMSRCH into needed format.
300 ;" Note: FMSRCH() won't allow ouput fields in format of .02:.01:.1 etc.
301 ;"Input: TMGIN -- PASS BY REFERENCE. The results of FMSRCH. Format:
302 ;" TMGIN(SrchFileIEN)=SrchFileIEN^FieldValue <-- FieldValue is a pointer/IEN
303 ;" TARGETFN -- The this the target file number.
304 ;" SRCHFILE -- The file that the results are from.
305 ;" FLDS -- The desired fields. e.g. .02, or .02:.01 etc.
306 ;" TMG1SET -- PASS BY REFERENCE. AN OUT PARAMETER. Prior results killed
307 ;" TMG1SET(SrchFileIEN)=""
308 ;" TMG1SET(SrchFileIEN)=""
309 ;" TMG1SET("DETAILS",TargetFileIEN,SrchFileNum,SrchFileIEN)
310 ;" TMG1SET("DETAILS",TargetFileIEN,SrchFileNum,SrchFileIEN)
311 ;"Results: 0 if OK, or -1^Message if error.
312 KILL TMG1SET
313 NEW RESULT SET RESULT=0
314 NEW VALUE
315 NEW ERR SET ERR=0
316 NEW IEN SET IEN=0
317 FOR SET IEN=$ORDER(TMGIN(IEN)) QUIT:(+IEN'>0)!(+RESULT=-1) DO
318 . IF SRCHFILE'=TARGETFN DO
319 . . SET VALUE=$PIECE($GET(TMGIN(IEN)),"^",2) QUIT:(+VALUE'>0)
320 . . IF FLDS[":" SET VALUE=$$RESOLV(SRCHFILE,FLDS,VALUE,.ERR)
321 . ELSE DO
322 . . SET VALUE=+$GET(TMGIN(IEN))
323 . QUIT:(+VALUE'>0)
324 . IF +ERR=-1 SET RESULT=ERR QUIT
325 . SET TMG1SET(VALUE)=""
326 . SET TMG1SET("DETAILS",VALUE,SRCHFILE,IEN)="" ;"<-- Value=IEN in target file, IEN=IEN in SRCHFILE
327 QUIT RESULT
328 ;
329RESOLV(FILE,FLDSTR,IEN,ERR) ;" NOTE: THIS NEEDS TO BE COMPILED. INEFFECIENT TO DO EACH TIME.
330 ;"Purpose: To follow pointer path to final value.
331 ;"Input: FILE -- File that IEN is in.
332 ;" FLDSTR -- e.g. ".02:.01:10:.01"
333 ;" IEN -- This is the value in FILE of the first field in FLDSTR (e.g. ".02")
334 ;" ERR -- PASS BY REFERENCE. AN OUT PARAMETER. -1^Err Msg, if any
335 ;"Result: Returns resolved value (INTERNAL FORMAT)
336 NEW P2FILE,INFO
337 SET ERR=""
338 NEW RESULT SET RESULT=""
339 IF FLDSTR[":" DO GOTO:(+ERR=-1) RLVDN
340 . NEW ZNODE SET ZNODE=$GET(^DD(FILE,+FLDSTR,0))
341 . IF ZNODE="" DO QUIT
342 . . SET ERR="-1^Can't find declaration in DD for File #"_FILE_", FLD #"_+FLDSTR
343 . SET INFO=$PIECE(ZNODE,"^",2)
344 . SET P2FILE=+$PIECE(INFO,"P",2)
345 . IF P2FILE'>0 DO QUIT
346 . . SET ERR="-1^File #"_FILE_", FLD #"_+FLDSTR_" is not a pointer field."
347 . NEW ROOT SET ROOT="^"_$PIECE(ZNODE,"^",3)_IEN_")"
348 . NEW NEXTFLDS SET NEXTFLDS=$PIECE(FLDSTR,":",2,999)
349 . SET ZNODE=$GET(^DD(P2FILE,+NEXTFLDS,0))
350 . NEW NODE SET NODE=$PIECE($PIECE(ZNODE,"^",4),";",1)
351 . NEW PCE SET PCE=$PIECE($PIECE(ZNODE,"^",4),";",2)
352 . NEW NEXTIEN SET NEXTIEN=$PIECE($GET(@ROOT@(NODE)),"^",PCE)
353 . SET RESULT=$$RESOLV(P2FILE,NEXTFLDS,NEXTIEN,.ERR)
354 ELSE SET RESULT=IEN
355RLVDN QUIT RESULT
356 ;
357DOCOMB(COMB,TMG1SET,PRESULT) ;
358 ;"Purpose: combine TMG1SET with @PRESULT based on logical operation COMBiner
359 ;"Input: COMB= &, !, &'
360 ;" TMG1SET -- PASS BY REFERENCE.
361 ;" PRESULT -- PASS BY NAME.
362 IF COMB="!" MERGE @PRESULT=TMG1SET
363 ELSE IF COMB="&" DO
364 . NEW TEMPSET
365 . NEW I SET I=0
366 . FOR SET I=$ORDER(TMG1SET(I)) QUIT:(+I'>0) DO
367 . . IF $DATA(@PRESULT@(I))=0 QUIT
368 . . SET TEMPSET(I)=""
369 . . MERGE TEMPSET("DETAILS",I)=TMG1SET("DETAILS",I)
370 . . MERGE TEMPSET("DETAILS",I)=@PRESULT@("DETAILS",I)
371 . KILL @PRESULT MERGE @PRESULT=TEMPSET
372 ELSE IF COMB="&'" DO
373 . NEW I SET I=0
374 . FOR SET I=$ORDER(TMG1SET(I)) QUIT:(+I'>0) DO
375 . . KILL @PRESULT@(I) ;"Remove any entry in TMG1SET from @PRESULT@
376 . KILL @PRESULT MERGE @PRESULT=TEMPSET
377 QUIT
378
Note: See TracBrowser for help on using the repository browser.