| 1 | TMGSRCH0 ;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 | ;
|
|---|
| 34 | ARRYSRCH(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 | ;
|
|---|
| 99 | USRPGFN(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 | ;
|
|---|
| 106 | SAMEFILE(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 | ;
|
|---|
| 135 | COMPEXPR(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 | ;
|
|---|
| 178 | FIXCOMB(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 | ;
|
|---|
| 184 | COMP1XP(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 | ;
|
|---|
| 216 | CP1DN QUIT RESULT
|
|---|
| 217 | ;
|
|---|
| 218 | FMSRCH(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)
|
|---|
| 295 | FMSDN QUIT TMGRESULT
|
|---|
| 296 | ;
|
|---|
| 297 | ;
|
|---|
| 298 | FIXSET(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 | ;
|
|---|
| 329 | RESOLV(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
|
|---|
| 355 | RLVDN QUIT RESULT
|
|---|
| 356 | ;
|
|---|
| 357 | DOCOMB(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 |
|
|---|
