| [796] | 1 | TMGSRCH1 ;TMG/kst/Search API ; 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 | ;"FNPTR(FNUMPTR) -- Resolve a FNUMPTR, finding ultimate target file
|
|---|
| 14 | ;"PATHTO(FROMFILE,TOFILE,COUNT) -- Find a 'path' of fields that gets from file A -->B
|
|---|
| 15 | ;"FLDNUM(TMGFILE,TMGNAME) --Turn a field name into number, and change FILE to pointed-to-file
|
|---|
| 16 | ;"=======================================================================
|
|---|
| 17 | ;"PRIVATE API FUNCTIONS
|
|---|
| 18 | ;"=======================================================================
|
|---|
| 19 | ;"GETFLD(STR) -- Separate field name from comparator
|
|---|
| 20 | ;"FIXCOMP(COMP,ERR) --Standardize value comparators, e.g. <> becomes '=
|
|---|
| 21 | ;"FIXCOMB(COMB,ERR) --Standardize expression combiners, e.g. | becomes OR
|
|---|
| 22 | ;"STDDATE(TMGDATE,ERR) --Standardized date, or report error
|
|---|
| 23 | ;"=======================================================================
|
|---|
| 24 | ;"=======================================================================
|
|---|
| 25 | ;"Dependencies:
|
|---|
| 26 | ;" ^DIC, TMGSTUTL, XLFSTR, %DT, XLFDT
|
|---|
| 27 | ;"=======================================================================
|
|---|
| 28 | ;"=======================================================================
|
|---|
| 29 | ;
|
|---|
| 30 | ;
|
|---|
| 31 | FNPTR(FNUMPTR) ;
|
|---|
| 32 | ;"Puprose: To resolve a FNUMPTR, finding ultimate target file
|
|---|
| 33 | ;"Input: FNUMPTR: Format: FNUM:FLDA[:FLDB[:FLDC...]] FNUM is filenumber that
|
|---|
| 34 | ;" contain search field, and then fields used to point to *TARGET* FILENUM
|
|---|
| 35 | ;"Results: -1^Error message if error, otherwise returns pointed to file
|
|---|
| 36 | NEW RESULT,FILE,FLD,I,DONE
|
|---|
| 37 | SET FILE=+$GET(FNUMPTR)
|
|---|
| 38 | SET RESULT=0
|
|---|
| 39 | SET DONE=0
|
|---|
| 40 | FOR I=2:1:999 DO QUIT:(+RESULT=-1)!(DONE=1)
|
|---|
| 41 | . SET FLD=$PIECE(FNUMPTR,":",I)
|
|---|
| 42 | . IF FLD="" SET DONE=1 QUIT
|
|---|
| 43 | . IF $DATA(^DD(FILE,FLD,0))=0 DO QUIT
|
|---|
| 44 | . . SET RESULT="-1^Field ["_FLD_"] was not found in file ["_FILE_"]"
|
|---|
| 45 | . NEW FLDTYPE SET FLDTYPE=$PIECE(^DD(+FILE,+FLD,0),"^",2)
|
|---|
| 46 | . IF FLDTYPE'["P" DO QUIT
|
|---|
| 47 | . . SET RESULT="-1^Field ["_FLD_"] does not point to another file."
|
|---|
| 48 | . SET FILE=+$PIECE(FLDTYPE,"P",2)
|
|---|
| 49 | SET RESULT=FILE
|
|---|
| 50 | QUIT RESULT
|
|---|
| 51 | ;
|
|---|
| 52 | PATHTO(FROMFILE,TOFILE,COUNT) ;
|
|---|
| 53 | ;"Purpose: to find a "path" of fields that gets from file A -->B (if possible)
|
|---|
| 54 | ;" E.g. From TIU DOCUMENT to PATIENT would yield ".01:.01", meaning
|
|---|
| 55 | ;" that the .01 field of TIU DOCUMENT-->IHS PATIENT, and
|
|---|
| 56 | ;" .01 field of IHS PATIEN-->PATIENT
|
|---|
| 57 | ;"Input: FROMFILE -- The starting file number
|
|---|
| 58 | ;" TOFILE -- The target file number
|
|---|
| 59 | ;" COUNT -- used when calling self reiteratively. Leave blank on first call.
|
|---|
| 60 | ;"Note: This fill only allow the length of the path to be 3 links long.
|
|---|
| 61 | ;" Also, the search is stopped after the first link is found.
|
|---|
| 62 | ;" NOTE: If the file link is changed to be longer than 3, then
|
|---|
| 63 | ;" GETAFSUB() must also be changed
|
|---|
| 64 | ;"Results: Returns field link, e.g. ".01;2;.01"
|
|---|
| 65 | SET COUNT=+$GET(COUNT)
|
|---|
| 66 | NEW RESULT SET RESULT=""
|
|---|
| 67 | SET FROMFILE=+$GET(FROMFILE)
|
|---|
| 68 | NEW FLD SET FLD=0
|
|---|
| 69 | FOR SET FLD=$ORDER(^DD(FROMFILE,FLD)) QUIT:(+FLD'>0)!(RESULT'="") DO
|
|---|
| 70 | . NEW INFO SET INFO=$PIECE($GET(^DD(FROMFILE,FLD,0)),"^",2)
|
|---|
| 71 | . IF INFO'["P" QUIT
|
|---|
| 72 | . NEW PT SET PT=+$PIECE(INFO,"P",2)
|
|---|
| 73 | . IF PT=FROMFILE QUIT ;"ignore pointers to self
|
|---|
| 74 | . IF PT=TOFILE SET RESULT=FROMFILE_":"_FLD_"->"_TOFILE QUIT
|
|---|
| 75 | . IF COUNT>2 QUIT
|
|---|
| 76 | . NEW TEMP SET TEMP=$$PATHTO(PT,TOFILE,COUNT+1)
|
|---|
| 77 | . IF TEMP'="" SET RESULT=FROMFILE_":"_FLD_"->"_TEMP
|
|---|
| 78 | IF COUNT=0 DO
|
|---|
| 79 | . NEW TEMP,I
|
|---|
| 80 | . SET TEMP=""
|
|---|
| 81 | . FOR I=1:1:$LENGTH(RESULT,"->") DO
|
|---|
| 82 | . . NEW PART SET PART=$PIECE(RESULT,"->",I)
|
|---|
| 83 | . . NEW PART2 SET PART2=$PIECE(PART,":",2)
|
|---|
| 84 | . . IF PART2="" QUIT
|
|---|
| 85 | . . IF TEMP'="" SET TEMP=TEMP_":"
|
|---|
| 86 | . . SET TEMP=TEMP_PART2
|
|---|
| 87 | . SET RESULT=FROMFILE_":"_TEMP_"^"_RESULT
|
|---|
| 88 | QUIT RESULT
|
|---|
| 89 | ;
|
|---|
| 90 | ;
|
|---|
| 91 | GETFLD(STR) ;
|
|---|
| 92 | ;"Purpose: To separate field name from comparator
|
|---|
| 93 | ;"Input: STR -- PASS BY REFERENCE -- the string to pull field from
|
|---|
| 94 | ;"Results: returns extracted field.
|
|---|
| 95 | NEW FLD
|
|---|
| 96 | IF +STR>0 DO
|
|---|
| 97 | . SET FLD=+STR
|
|---|
| 98 | . SET STR=$PIECE(STR,FLD,2,999)
|
|---|
| 99 | ELSE DO
|
|---|
| 100 | . IF $EXTRACT(STR,1)="""" DO
|
|---|
| 101 | . . SET FLD=$$MATCHXTR^TMGSTUTL(STR,"""",,,"""")
|
|---|
| 102 | . . IF FLD'="" SET STR=$EXTRACT(STR,$LENGTH(FLD)+3,9999)
|
|---|
| 103 | . ELSE DO
|
|---|
| 104 | . . SET FLD=""
|
|---|
| 105 | . . NEW P FOR P=1:1:$LENGTH(STR) QUIT:"'<>=[:{"[$EXTRACT(STR,P) DO
|
|---|
| 106 | . . . SET FLD=FLD_$EXTRACT(STR,P)
|
|---|
| 107 | . . IF FLD'="" SET STR=$EXTRACT(STR,$LENGTH(FLD)+1,9999)
|
|---|
| 108 | QUIT FLD
|
|---|
| 109 | ;
|
|---|
| 110 | FLDNUM(TMGFILE,TMGNAME) ;
|
|---|
| 111 | ;"Purpose: To turn a field name into number, and change FILE to pointed-to-file
|
|---|
| 112 | ;"Input: TMGFILE -- PASS BY REFERENCE. Input is current file. Output is new pointed-to-file
|
|---|
| 113 | ;" TMGNAME -- PASS BY REFERENCE. The field name to look up. Name will be cleaned up.
|
|---|
| 114 | NEW DIC,X,Y SET Y=0
|
|---|
| 115 | IF TMGNAME="" SET TMGFILE=0 GOTO FLDNDN
|
|---|
| 116 | SET DIC="^DD("_+TMGFILE_","
|
|---|
| 117 | SET TMGNAME=$$TRIM^XLFSTR(TMGNAME,," ")
|
|---|
| 118 | SET TMGNAME=$$TRIM^XLFSTR(TMGNAME,,"""")
|
|---|
| 119 | SET X=TMGNAME
|
|---|
| 120 | DO ^DIC
|
|---|
| 121 | IF +Y'>0 GOTO FLDNDN
|
|---|
| 122 | NEW INFO SET INFO=$PIECE($GET(^DD(+TMGFILE,+Y,0)),"^",2)
|
|---|
| 123 | IF INFO'["P" SET TMGFILE=0 GOTO FLDNDN
|
|---|
| 124 | SET TMGFILE=+$PIECE(INFO,"P",2)
|
|---|
| 125 | FLDNDN QUIT +Y
|
|---|
| 126 | ;
|
|---|
| 127 | FIXCOMP(COMP,ERR) ;
|
|---|
| 128 | ;"Purpose: to standardize value comparators, e.g. <> becomes '=
|
|---|
| 129 | NEW RESULT SET RESULT=""
|
|---|
| 130 | IF COMP="=" SET RESULT=COMP GOTO FCDN
|
|---|
| 131 | NEW COMPSAV SET COMPSAV=COMP
|
|---|
| 132 | SET COMP=$$UP^XLFSTR(COMP)
|
|---|
| 133 | IF (COMP="<>") SET COMP="'="
|
|---|
| 134 | ELSE IF (COMP=">=") SET COMP="'<"
|
|---|
| 135 | ELSE IF (COMP="<=") SET COMP="'>"
|
|---|
| 136 | ELSE IF (COMP="{") SET COMP="IN"
|
|---|
| 137 | NEW NOT
|
|---|
| 138 | SET NOT=$EXTRACT(COMP,1) IF NOT="'" SET COMP=$EXTRACT(COMP,2,999)
|
|---|
| 139 | ELSE SET NOT=""
|
|---|
| 140 | IF (COMP="=")!(COMP="[")!(COMP="IN")!(COMP="<")!(COMP=">") DO
|
|---|
| 141 | . SET RESULT=NOT_COMP
|
|---|
| 142 | ELSE SET ERR="-1^'"_COMPSAV_"' is not a valid comparator."
|
|---|
| 143 | FCDN QUIT RESULT
|
|---|
| 144 | ;
|
|---|
| 145 | FIXCOMB(COMB,ERR) ;
|
|---|
| 146 | ;"Purpose: to standardize expression combiners, e.g. | becomes OR
|
|---|
| 147 | NEW COMBSAV SET COMBSAV=COMB
|
|---|
| 148 | IF (COMB="|")!(COMB="||")!(COMB="!") SET COMB="OR"
|
|---|
| 149 | ELSE IF (COMB="&")!(COMB="&&") SET COMB="AND"
|
|---|
| 150 | ELSE IF (COMB="'")!(COMB="ANDNOT") SET COMB="NOT"
|
|---|
| 151 | IF (COMB'="AND")&(COMB'="OR")&(COMB'="NOT") SET COMB=""
|
|---|
| 152 | IF COMB="" SET ERR="-1^'"_COMBSAV_"' is not a valid set combiner."
|
|---|
| 153 | QUIT COMB
|
|---|
| 154 | ;
|
|---|
| 155 | STDDATE(TMGDATE,ERR) ;
|
|---|
| 156 | ;"Purpose: return a standardized date, or report error
|
|---|
| 157 | NEW X,Y,%DT
|
|---|
| 158 | NEW RESULT SET RESULT=""
|
|---|
| 159 | SET %DT="T"
|
|---|
| 160 | SET X=TMGDATE
|
|---|
| 161 | DO ^%DT
|
|---|
| 162 | IF Y=-1 SET ERR="-1^Invalid date: ["_X_"]"
|
|---|
| 163 | ELSE SET RESULT=$$FMTE^XLFDT(Y,5)
|
|---|
| 164 | QUIT RESULT
|
|---|
| 165 | ;
|
|---|
| 166 | GETAFSUB(TMGOUT,TMGPARAMS) ;"GET ALLOW FILES SUBSET
|
|---|
| 167 | ;"Purpose: For a given file to be searched, return sublist of allowed
|
|---|
| 168 | ;" related files which can be used as search terms. NOTE: only
|
|---|
| 169 | ;" files that point back to the original search file are allowed.
|
|---|
| 170 | ;" NOTE: This function will return not only files that point
|
|---|
| 171 | ;" directly back to search file, but also files that point to
|
|---|
| 172 | ;" other files that point to search file. In fact, there can
|
|---|
| 173 | ;" be a distance of 3 files between returned file and search file.
|
|---|
| 174 | ;" If this allowed distance of 3 files is changed, then PATHTO()
|
|---|
| 175 | ;" must also be changed.
|
|---|
| 176 | ;" NOTE: Subfiles not currently supported
|
|---|
| 177 | ;"Input: TMGPARAMS -- FileNum^ListStartValue^direction^MaxCount(optional, def=44)^Simple
|
|---|
| 178 | ;" FileNum -- this is the search file, results must point back to this
|
|---|
| 179 | ;" ListStartValue -- OPTIONAL -- text to $ORDER() from
|
|---|
| 180 | ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
|
|---|
| 181 | ;" MaxCount -- OPTIONAL. Default is 44 values returned.
|
|---|
| 182 | ;" Simple -- OPTIONAL Default is 0 (false). If 1, then
|
|---|
| 183 | ;" a very limited list of files returned, with
|
|---|
| 184 | ;" more user-friendly pseudo names
|
|---|
| 185 | ;"Output: TMGRESULTS is filled as follows.
|
|---|
| 186 | ;" TMGRESULT(0)="1^Success" or "-1^Message"
|
|---|
| 187 | ;" TMGRESULT(1)=IEN^FileName
|
|---|
| 188 | ;" TMGRESULT(2)=IEN^FileName
|
|---|
| 189 | ;"NOTE: Any files that don't have data are excluded.
|
|---|
| 190 | NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
|
|---|
| 191 | IF TMGFILE'>0 DO GOTO GAFSDN
|
|---|
| 192 | . SET TMGOUT(0)="-1^No file number supplied"
|
|---|
| 193 | NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
|
|---|
| 194 | NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
|
|---|
| 195 | IF TMGDIR'=-1 SET TMGDIR=1
|
|---|
| 196 | NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
|
|---|
| 197 | IF TMGMAXCT=0 SET TMGMAXCT=44
|
|---|
| 198 | NEW TMGSIMPLE SET TMGSIMPLE=+$PIECE(TMGPARAMS,"^",5)
|
|---|
| 199 | ;
|
|---|
| 200 | IF (TMGFILE=2),(TMGSIMPLE=1) DO GOTO GAFS0
|
|---|
| 201 | . SET TMGOUT(1)="2^1. PATIENT INFO"
|
|---|
| 202 | . SET TMGOUT(2)="8925^2. NOTES"
|
|---|
| 203 | . SET TMGOUT(3)="120.5^3. VITALS"
|
|---|
| 204 | . SET TMGOUT(4)="9000010^4. VISIT"
|
|---|
| 205 | . SET TMGOUT(5)="9000010.18^5. LINKED CPT CODE"
|
|---|
| 206 | ;
|
|---|
| 207 | NEW TMGREF SET TMGREF=$NAME(^TMP("TMG","TMGSRCH",$J,"ALLOWED FILES",TMGFILE))
|
|---|
| 208 | IF $DATA(@TMGREF)=0 DO
|
|---|
| 209 | . DO SETUPLS(TMGREF,TMGFILE)
|
|---|
| 210 | NEW TMGSTARTIEN SET TMGSTARTIEN=""
|
|---|
| 211 | NEW TMGI SET TMGI=0
|
|---|
| 212 | FOR SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI'<TMGMAXCT) DO
|
|---|
| 213 | . NEW TMGIEN SET TMGIEN=TMGSTARTIEN
|
|---|
| 214 | . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGFROM,TMGIEN),TMGDIR) QUIT:(+TMGIEN'>0)!(TMGI'<TMGMAXCT) DO
|
|---|
| 215 | . . SET TMGI=TMGI+1
|
|---|
| 216 | . . ;"SET TMGOUT(TMGI)=TMGIEN_"^"_TMGFROM_"^"_$GET(@TMGREF@("B",TMGFROM,TMGIEN))
|
|---|
| 217 | . . SET TMGOUT(TMGI)=TMGIEN_"^"_TMGFROM
|
|---|
| 218 | ;
|
|---|
| 219 | GAFS0 SET TMGOUT(0)="1^Success"
|
|---|
| 220 | GAFSDN MERGE ^TMG("TMP","RPC",1)=TMGOUT
|
|---|
| 221 | QUIT
|
|---|
| 222 | ;
|
|---|
| 223 | SETUPLS(POUT,FILENUM,CT) ;
|
|---|
| 224 | ;"Purpose: to return a list of pointers in to file
|
|---|
| 225 | ;"Input: POUT -- PASS BY NAME, An OUT PARAMETER
|
|---|
| 226 | ;" FILE -- The file for which pointers IN should be added.
|
|---|
| 227 | ;" CT -- This is used when passing self reiteratively. Leave blank first time.
|
|---|
| 228 | ;"NOTE: Any files that don't have data are excluded.
|
|---|
| 229 | SET CT=$GET(CT,1)
|
|---|
| 230 | NEW NAME
|
|---|
| 231 | SET NAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
|
|---|
| 232 | IF NAME'="",$DATA(@POUT@("B",NAME,FILENUM))=0 DO
|
|---|
| 233 | . SET @POUT@("B",NAME,FILENUM)=""
|
|---|
| 234 | NEW AFILE SET AFILE=0
|
|---|
| 235 | FOR SET AFILE=$ORDER(^DD(FILENUM,0,"PT",AFILE)) QUIT:(+AFILE'>0) DO
|
|---|
| 236 | . SET NAME=$PIECE($GET(^DIC(AFILE,0)),"^",1) QUIT:NAME=""
|
|---|
| 237 | . SET GL=$GET(^DIC(AFILE,0,"GL")) QUIT:(GL="")
|
|---|
| 238 | . SET GL=GL_"0)" NEW INFO SET INFO=$GET(@GL)
|
|---|
| 239 | . NEW NUMRECS SET NUMRECS=+$PIECE(INFO,"^",4) QUIT:NUMRECS'>0
|
|---|
| 240 | . SET @POUT@("B",NAME,AFILE)=""
|
|---|
| 241 | . IF CT<3 DO SETUPLS(POUT,AFILE,CT+1)
|
|---|
| 242 | QUIT
|
|---|
| 243 | ;
|
|---|
| 244 | GETFLDSB(TMGOUT,TMGPARAMS) ;
|
|---|
| 245 | ;"Purpose: Get FIELD list subset, for file
|
|---|
| 246 | ;"Input: TMGPARAMS -- FileNum^ListStartValue^direction^MaxCount(optional, def=44)^Simple
|
|---|
| 247 | ;" FileNum -- this is the file to get fields in
|
|---|
| 248 | ;" ListStartValue -- OPTIONAL -- text to $ORDER() from
|
|---|
| 249 | ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
|
|---|
| 250 | ;" MaxCount -- OPTIONAL. Default is 44 values returned.
|
|---|
| 251 | ;" Simple -- OPTIONAL Default is 0 (false). If 1, then
|
|---|
| 252 | ;" a very limited list of files returned, with
|
|---|
| 253 | ;" more user-friendly pseudo names
|
|---|
| 254 | ;"Output: TMGRESULTS is filled as follows.
|
|---|
| 255 | ;" TMGRESULT(0)="1^Success" or "-1^Message"
|
|---|
| 256 | ;" TMGRESULT(1)=FldNum^Name^InfoNodes2-4
|
|---|
| 257 | ;" TMGRESULT(2)=FldNum^Name^InfoNodes2-4
|
|---|
| 258 | ;"NOTE: Any files that don't have data are excluded. Subfiles also excluded
|
|---|
| 259 | NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
|
|---|
| 260 | IF TMGFILE'>0 DO GOTO GFSBDN
|
|---|
| 261 | . SET TMGOUT(0)="-1^No file number supplied"
|
|---|
| 262 | NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
|
|---|
| 263 | NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
|
|---|
| 264 | IF TMGDIR'=-1 SET TMGDIR=1
|
|---|
| 265 | NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
|
|---|
| 266 | IF TMGMAXCT=0 SET TMGMAXCT=44
|
|---|
| 267 | NEW TMGSIMPLE SET TMGSIMPLE=+$PIECE(TMGPARAMS,"^",5)
|
|---|
| 268 | ;
|
|---|
| 269 | NEW TMGI SET TMGI=0
|
|---|
| 270 | NEW HANDLED SET HANDLED=0
|
|---|
| 271 | IF TMGSIMPLE DO
|
|---|
| 272 | . IF TMGFILE=2 DO ;"2^PATIENT INFO"
|
|---|
| 273 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^NAME"
|
|---|
| 274 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".02^SEX"
|
|---|
| 275 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".03^DATE OF BIRTH"
|
|---|
| 276 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".033^AGE"
|
|---|
| 277 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".05^MARITAL STATUS"
|
|---|
| 278 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".07^OCCUPATION"
|
|---|
| 279 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".09^SOCIAL SECURITY NUMBER"
|
|---|
| 280 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".114^CITY"
|
|---|
| 281 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".115^STATE"
|
|---|
| 282 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".116^ZIP CODE"
|
|---|
| 283 | . . SET HANDLED=1
|
|---|
| 284 | . IF TMGFILE=8925 DO ;"8925^NOTES"
|
|---|
| 285 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^TYPE OF NOTE"
|
|---|
| 286 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".05^STATUS"
|
|---|
| 287 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".07^BEGINNING DATE"
|
|---|
| 288 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".08^ENDING DATE"
|
|---|
| 289 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="2^NOTE TEXT"
|
|---|
| 290 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1201^CREATION DATE"
|
|---|
| 291 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1202^AUTHOR/DICTATOR"
|
|---|
| 292 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1204^EXPECTED SIGNER"
|
|---|
| 293 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1211^VISIT LOCATION"
|
|---|
| 294 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1502^SIGNED BY"
|
|---|
| 295 | . . SET HANDLED=1
|
|---|
| 296 | . IF TMGFILE=120.5 DO ;"120.5^VITALS"
|
|---|
| 297 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^DATE/TIME TAKEN"
|
|---|
| 298 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".03^VITAL TYPE"
|
|---|
| 299 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".05^LOCATION"
|
|---|
| 300 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1.2^VALUE"
|
|---|
| 301 | . . SET HANDLED=1
|
|---|
| 302 | . IF TMGFILE=9000010 DO ;"9000010^VISIT"
|
|---|
| 303 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^DATE/TIME"
|
|---|
| 304 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".03^TYPE"
|
|---|
| 305 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".22^LOCATION"
|
|---|
| 306 | . . SET HANDLED=1
|
|---|
| 307 | . IF TMGFILE=9000010.18 DO ;"9000010.18^LINKED CPT CODE"
|
|---|
| 308 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".01^CPT NAME"
|
|---|
| 309 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".04^PROVIDER NARRATIVE"
|
|---|
| 310 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".05^DIAGNOSIS"
|
|---|
| 311 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)=".07^PRINCIPLE PROCEDURE"
|
|---|
| 312 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="1204^ENCOUNTER PROVIDER"
|
|---|
| 313 | . . SET TMGI=TMGI+1 SET TMGOUT(TMGI)="80201^CATEGORY"
|
|---|
| 314 | . . SET HANDLED=1
|
|---|
| 315 | IF HANDLED DO ADDINFO(TMGFILE,.TMGOUT) GOTO GFSB0
|
|---|
| 316 | ;
|
|---|
| 317 | NEW TMGREF SET TMGREF=$NAME(^DD(TMGFILE))
|
|---|
| 318 | FOR SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI'<TMGMAXCT) DO
|
|---|
| 319 | . NEW TMGFLD SET TMGFLD=""
|
|---|
| 320 | . FOR SET TMGFLD=$ORDER(@TMGREF@("B",TMGFROM,TMGFLD),TMGDIR) QUIT:(+TMGFLD'>0)!(TMGI'<TMGMAXCT) DO
|
|---|
| 321 | . . NEW INFO SET INFO=$PIECE($GET(^DD(TMGFILE,TMGFLD,0)),"^",2,4)
|
|---|
| 322 | . . IF +INFO>0,($$ISWPFLD^TMGDBAPI(TMGFILE,TMGFLD)=0) QUIT ;"Don't return subfile fields (for now)
|
|---|
| 323 | . . SET TMGI=TMGI+1
|
|---|
| 324 | . . SET TMGOUT(TMGI)=TMGFLD_"^"_TMGFROM_"^"_INFO
|
|---|
| 325 | ;
|
|---|
| 326 | GFSB0 SET TMGOUT(0)="1^Success"
|
|---|
| 327 | GFSBDN QUIT
|
|---|
| 328 | ;
|
|---|
| 329 | ADDINFO(TMGFILE,TMGOUT);
|
|---|
| 330 | ;"Purpose: To add INFO to field entries, as created in GETFLDSB
|
|---|
| 331 | NEW I SET I=0
|
|---|
| 332 | FOR SET I=$ORDER(TMGOUT(I)) QUIT:(+I'>0) DO
|
|---|
| 333 | . NEW ENTRY SET ENTRY=$GET(TMGOUT(I)) QUIT:(ENTRY="")
|
|---|
| 334 | . NEW TMGFLD SET TMGFLD=+ENTRY
|
|---|
| 335 | . NEW INFO SET INFO=$PIECE($GET(^DD(TMGFILE,TMGFLD,0)),"^",2,4)
|
|---|
| 336 | . SET TMGOUT(I)=ENTRY_"^"_INFO
|
|---|
| 337 | QUIT
|
|---|
