| [896] | 1 | TMGSIPH2 ;TMG/kst/SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCES ;11/27/09
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;11/27/09
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG SIPHON PROGRAM, FOR TRANSFERRING VISTA INSTANCE
|
|---|
| 5 | ;"----===== SERVER-SIDE CODE ====------
|
|---|
| 6 | ;"Especially functions for working with the data dictionaries, POINTERS IN.
|
|---|
| 7 | ;"Kevin Toppenberg MD
|
|---|
| 8 | ;"GNU General Public License (GPL) applies
|
|---|
| 9 | ;"11/27/09
|
|---|
| 10 | ;
|
|---|
| 11 | ;"=======================================================================
|
|---|
| 12 | ;" API -- Public Functions.
|
|---|
| 13 | ;"=======================================================================
|
|---|
| 14 | ;"HNDLPTIX(FILENUM) --prepair PT XREF for all records pointing INTO specified file.
|
|---|
| 15 | ;"GETPTIN(PARAMS) --get a listing of all pointers INTO requested record
|
|---|
| 16 | ;"BAKXREF(PARAMS) --Make a xref of cross-references (a backward xref)
|
|---|
| 17 | ;"GETXRAGE --Return, in HOURS, the time since the ^TMG("PTXREF") array has had any modification
|
|---|
| 18 | ;"FLD01(PARAMS) -- return .01 field of a record. Gets INTERNAL value, and doesn't support subfiles.
|
|---|
| 19 | ;"GET01FLD(PARAMS) --To SEND .01 field of a record. Gets INTERNAL value, and doesn't support subfiles.
|
|---|
| 20 |
|
|---|
| 21 | ;"=======================================================================
|
|---|
| 22 | ;"Dependancies
|
|---|
| 23 | ;"=======================================================================
|
|---|
| 24 | ;"TMGKERN2, TMGUSRIF, TMGFMUT2
|
|---|
| 25 | ;"=======================================================================
|
|---|
| 26 | ;
|
|---|
| 27 | HNDLPTIX(FILENUM,CLSIDE) ;
|
|---|
| 28 | ;"Purpose: To prepair PT XREF for all records pointing INTO specified file.
|
|---|
| 29 | ;"Input: FILENUM -- The fileman file number to get pointers INTO.
|
|---|
| 30 | ;" CLSIDE -- OPTIONAL. If =1, then will be running on client side, and will work differently
|
|---|
| 31 | ;"Result: None
|
|---|
| 32 | SET FILENUM=+$GET(FILENUM) IF FILENUM'>0 QUIT
|
|---|
| 33 | SET CLSIDE=+$GET(CLSIDE,0)
|
|---|
| 34 | NEW TMGSTIME SET TMGSTIME=$H
|
|---|
| 35 | NEW PGFN,LIMITS
|
|---|
| 36 | IF 'CLSIDE SET PGFN="DO SEND^TMGKERN2(""#THINKING#|Organizing pointers for ""_TMGFNAME_"": ""_TMGIEN_"" of ""_TMGMAX)"
|
|---|
| 37 | ELSE DO
|
|---|
| 38 | . SET PGFN="WRITE ""Organizing pointers for ""_TMGFNAME_"": ""_TMGIEN_"" of ""_TMGMAX"
|
|---|
| 39 | . SET LIMITS("REF")=$NAME(^TMG("TMGSIPH","DOWNLOADED"))
|
|---|
| 40 | DO SETPTOUT^TMGFMUT2(FILENUM,$NAME(^TMG("PTXREF")),PGFN,3000,.LIMITS)
|
|---|
| 41 | SET ^TMG("PTXREF","IN",FILENUM)=$H
|
|---|
| 42 | SET ^TMG("PTXREF")=$H
|
|---|
| 43 | QUIT
|
|---|
| 44 | ;
|
|---|
| 45 | ;
|
|---|
| 46 | GETPTIN(PARAMS,CLSIDE)
|
|---|
| 47 | ;"Purpose: To get a listing of all pointers INTO requested record
|
|---|
| 48 | ;"Input: PARAMS -- this is FILENUM^IEN
|
|---|
| 49 | ;" CLSIDE -- PASS BY REFERNCE. OPTIONAL. If =1, then will be running on client side, and will work differently
|
|---|
| 50 | ;" Will also be used as an OUT PARAMETER when CLSIDE=1. Format:
|
|---|
| 51 | ;" CLSIDE(1)=FROMFILE^FROMIENS^FROMFLD
|
|---|
| 52 | ;" CLSIDE(2)=FROMFILE^FROMIENS^FROMFLD
|
|---|
| 53 | ;" ...
|
|---|
| 54 | ;"Output: Will return data to client. Format:
|
|---|
| 55 | ;" FROMFILE^FROMIENS^FROMFLD
|
|---|
| 56 | ;" FROMFILE^FROMIENS^FROMFLD
|
|---|
| 57 | ;" FROMFILE^FROMIENS^FROMFLD (e.g. one line for every pointer in)
|
|---|
| 58 | ;"Result: None.
|
|---|
| 59 | NEW FILENUM SET FILENUM=+$PIECE(PARAMS,"^",1)
|
|---|
| 60 | IF $DATA(^TMG("PTXREF","IN",FILENUM))'>0 DO HNDLPTIX(FILENUM,.CLSIDE)
|
|---|
| 61 | DO GETPTIN^TMGFMUT2(PARAMS,.CLSIDE) ;
|
|---|
| 62 | SET CLSIDE=+$GET(CLSIDE,0) IF CLSIDE QUIT
|
|---|
| 63 | NEW TMGCT SET TMGCT=0
|
|---|
| 64 | FOR SET TMGCT=$ORDER(CLSIDE(TMGCT)) QUIT:(TMGCT="") DO
|
|---|
| 65 | . NEW TEMP SET TEMP=$GET(CLSIDE(TMGCT)) QUIT:(TEMP="")
|
|---|
| 66 | . DO SEND^TMGKERN2(TEMP)
|
|---|
| 67 | QUIT
|
|---|
| 68 | ;
|
|---|
| 69 | ;
|
|---|
| 70 | BAKXREF(PARAMS) ;
|
|---|
| 71 | ;"Purpose: Make a xref of cross-references (a backward xref)
|
|---|
| 72 | ;"Input: PARAMS -- This is FILENUM^[KEEP]
|
|---|
| 73 | ;" FILENUM -- The fileman file to work with
|
|---|
| 74 | ;" KEEP -- optional. DEFAULT=0; If '1', then nothing done if xref already exists.
|
|---|
| 75 | ;"Output: ^TMG("PTXREF","XREFS",FILENUM,IEN,REF)=<xref value>
|
|---|
| 76 | ;" e.g. ^TMG("PTXREF","XREFS",FILENUM,113,"^VA(200,""A"",8870804679,113)")=6188
|
|---|
| 77 | ;"Result: none.
|
|---|
| 78 | ;"DO SEND^TMGKERN2("#THINKING#|Organizing server cross-reference enteries...")
|
|---|
| 79 | NEW PGFN
|
|---|
| 80 | SET PGFN="DO SEND^TMGKERN2(""#THINKING#|Processing index: ""_INDEX_"" for file #""_FILENUM)"
|
|---|
| 81 | DO BAKXREF^TMGFMUT2(PARAMS,PGFN)
|
|---|
| 82 | ;"DO SEND^TMGKERN2("#THINKING#|Completed.")
|
|---|
| 83 | BXDN QUIT
|
|---|
| 84 | ;
|
|---|
| 85 | ;
|
|---|
| 86 | GETXRAGE ;
|
|---|
| 87 | ;"Purpose: Return, in HOURS, the time since the ^TMG("PTXREF") array has had any modification
|
|---|
| 88 | ;"OUTPUT: Sends 0 if not currently defined, otherwise number of HOURS since setup.
|
|---|
| 89 | ;"Results: None
|
|---|
| 90 | DO SEND^TMGKERN2($$GETXRAGE^TMGFMUT2)
|
|---|
| 91 | QUIT
|
|---|
| 92 | ;
|
|---|
| 93 | ;
|
|---|
| 94 | FLD01(PARAMS) ;
|
|---|
| 95 | ;"Purpose: To return .01 field of a record.
|
|---|
| 96 | ;"Input: PARAMS -- this is FILENUM^IEN
|
|---|
| 97 | ;" Note: FILENUM can be in format of subfilenum{parentfilenum{grandparentnum
|
|---|
| 98 | ;" In this case, IEN must be an IENS to be passed to $$GET1^DIQ
|
|---|
| 99 | ;"Result: returns .01 value. Internal format (for speed), or External format if subfile.
|
|---|
| 100 | NEW FILENUM SET FILENUM=$PIECE(PARAMS,"^",1)
|
|---|
| 101 | NEW RESULT SET RESULT=""
|
|---|
| 102 | IF FILENUM["{" DO
|
|---|
| 103 | . SET FILENUM=+FILENUM
|
|---|
| 104 | . NEW IENS SET IENS=$PIECE(PARAMS,"^",2)
|
|---|
| 105 | . SET RESULT=$$GET1^DIQ(FILENUM,IENS,.01,"E")
|
|---|
| 106 | ELSE DO
|
|---|
| 107 | . SET FILENUM=+FILENUM
|
|---|
| 108 | . NEW IEN SET IEN=+$PIECE(PARAMS,"^",2)
|
|---|
| 109 | . NEW GREF SET GREF=$GET(^DIC(FILENUM,0,"GL"))
|
|---|
| 110 | . IF GREF="" SET RESULT="<ERROR>" GOTO F1DN
|
|---|
| 111 | . NEW CGREF SET CGREF=$$CREF^DILF(GREF)
|
|---|
| 112 | . NEW VALUE SET VALUE=$GET(@CGREF@(IEN,0))
|
|---|
| 113 | . SET RESULT=$PIECE(VALUE,"^",1)
|
|---|
| 114 | . IF RESULT="" SET RESULT="<NONE FOUND AT "_CGREF_"("_IEN_")>"
|
|---|
| 115 | F1DN QUIT RESULT
|
|---|
| 116 | ;
|
|---|
| 117 | ;
|
|---|
| 118 | GET01FLD(PARAMS) ;
|
|---|
| 119 | ;"Purpose: To get .01 field of a record.
|
|---|
| 120 | ;"Input: PARAMS -- this is FILENUM^IEN
|
|---|
| 121 | ;" FILENUM can be File number, or SubFileNum{ParentFileNum{Grandparent...
|
|---|
| 122 | ;" IEN can be a record number, or IENS (e.g. '1,2456,')
|
|---|
| 123 | ;"Output: Will return data to client. Format:
|
|---|
| 124 | ;" <.01 value>
|
|---|
| 125 | ;"Result: None.
|
|---|
| 126 | NEW VALUE
|
|---|
| 127 | DO DEBUGMSG^TMGKERN2("In GET01FLD. PARAMS="_PARAMS)
|
|---|
| 128 | SET VALUE=$$FLD01(.PARAMS)
|
|---|
| 129 | DO DEBUGMSG^TMGKERN2("In GET01FLD. VALUE="_VALUE)
|
|---|
| 130 | DO SEND^TMGKERN2(VALUE)
|
|---|
| 131 | DO DEBUGMSG^TMGKERN2("Leaving GET01FLD.")
|
|---|
| 132 | QUIT
|
|---|
| 133 | ;
|
|---|
| 134 | ;
|
|---|
| 135 | HANDIENL(PARAMS) ;
|
|---|
| 136 | ;"Purpose: To return a listing of all records (IEN's) in specified file.
|
|---|
| 137 | ;"Input : PARAMS -- this is FILENUM (Subfiles not supported)
|
|---|
| 138 | ;"Output: Will return data to client. Format:
|
|---|
| 139 | ;" <IEN>^.01 Value (internal format)
|
|---|
| 140 | ;" <IEN2>^.01 Value (internal format)
|
|---|
| 141 | ;" <IEN3>^.01 Value (internal format) ...
|
|---|
| 142 | ;"Results: None
|
|---|
| 143 | SET PARAMS=$GET(PARAMS)
|
|---|
| 144 | NEW FILENUM SET FILENUM=$PIECE(PARAMS,"^",1)
|
|---|
| 145 | IF +FILENUM'>0 QUIT
|
|---|
| 146 | NEW GREF SET GREF=$GET(^DIC(FILENUM,0,"GL"))
|
|---|
| 147 | IF GREF="" QUIT
|
|---|
| 148 | NEW CGREF SET CGREF=$$CREF^DILF(GREF)
|
|---|
| 149 | NEW TMGCT SET TMGCT=1
|
|---|
| 150 | NEW IEN SET IEN=0
|
|---|
| 151 | FOR SET IEN=$ORDER(@CGREF@(IEN)) QUIT:(+IEN'>0) DO
|
|---|
| 152 | . NEW VALUE SET VALUE=$PIECE($GET(@CGREF@(IEN,0)),"^",1)
|
|---|
| 153 | . DO SEND^TMGKERN2(IEN_"^"_VALUE)
|
|---|
| 154 | . SET TMGCT=TMGCT+1
|
|---|
| 155 | . IF TMGCT>5000 DO
|
|---|
| 156 | . . DO SEND^TMGKERN2("#THINKING#|Processing IEN: "_IEN_" for file #"_FILENUM)
|
|---|
| 157 | . . SET TMGCT=0
|
|---|
| 158 | QUIT
|
|---|
| 159 | ;
|
|---|
| 160 | HANDLIENHDR(PARAMS) ;
|
|---|
| 161 | ;"Purpose: Return the Fileman records of the last record added, and highest IEN number from File
|
|---|
| 162 | ;"Input : PARAMS -- this is FILENUM (Subfiles not supported)
|
|---|
| 163 | ;"Output: Will return data to client. Format:
|
|---|
| 164 | ;" LastIEN^NumIENs
|
|---|
| 165 | ;"Results: None
|
|---|
| 166 | SET PARAMS=$GET(PARAMS)
|
|---|
| 167 | NEW FILENUM SET FILENUM=$PIECE(PARAMS,"^",1)
|
|---|
| 168 | IF +FILENUM'>0 QUIT
|
|---|
| 169 | NEW GREF SET GREF=$GET(^DIC(FILENUM,0,"GL"))
|
|---|
| 170 | IF GREF="" QUIT
|
|---|
| 171 | NEW NODE SET NODE=$GET(@(GREF_"0)"))
|
|---|
| 172 | NEW LASTIEN SET LASTIEN=$PIECE(NODE,"^",3)
|
|---|
| 173 | NEW TOTIENS SET TOTIENS=$PIECE(NODE,"^",4)
|
|---|
| 174 | DO SEND^TMGKERN2(LASTIEN_"^"_TOTIENS)
|
|---|
| 175 | QUIT
|
|---|
| 176 | ;
|
|---|
| 177 | ; |
|---|
