source: cprs/branches/tmg-cprs/m_files/TMGSIPH2.m@ 1742

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

replacing soft links with actual files

File size: 8.0 KB
RevLine 
[896]1TMGSIPH2 ;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 ;
27HNDLPTIX(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 ;
46GETPTIN(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 ;
70BAKXREF(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.")
83BXDN QUIT
84 ;
85 ;
86GETXRAGE ;
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 ;
94FLD01(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_")>"
115F1DN QUIT RESULT
116 ;
117 ;
118GET01FLD(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 ;
135HANDIENL(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 ;
160HANDLIENHDR(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 ;
Note: See TracBrowser for help on using the repository browser.