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

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

Initial upload

File size: 10.0 KB
Line 
1TMGRPC3B ;TMG/kst/Support Functions for GUI_Config ;08/31/08 ; 5/29/10 6:40pm
2 ;;1.0;TMG-LIB;**1**;08/31/08
3 ;
4 ;"TMG RPC FUNCTIONS for a GUI config program
5 ;
6 ;"Kevin Toppenberg MD
7 ;"GNU Lessor General Public License (LGPL) applies
8 ;"7/20/08
9 ;
10 ;"=======================================================================
11 ;" RPC -- Public Functions.
12 ;"=======================================================================
13 ;" <none>
14 ;"=======================================================================
15 ;"PRIVATE API FUNCTIONS
16 ;"=======================================================================
17 ;"GETUSRLT(TMGOUT,TMGPARAMS) -- fill list with users on the system.
18 ;"GETRECLT(TMGOUT,TMGPARAMS) -- fill list with records in file on the system
19 ;"GET1USER(TMGOUT,TMGIEN) -- Get one user's record
20 ;"GET1REC(TMGOUT,TMGPARAMS) -- get one record in file
21 ;"XTRCTFLD(TMGOUT,TMGARRAY,TMGFLAG) -- convert output from GETS^DIQ into another format
22 ;"GFLSUBST(TMGOUT,TMGPARAMS) -- return a subset of entries a file's .01 names
23 ;
24 ;"=======================================================================
25 ;"=======================================================================
26 ;"Dependencies:
27 ;" TMGRPC3* only
28 ;
29 ;"=======================================================================
30 ;"=======================================================================
31 ;
32 ;"=======================================================================
33 ;
34GETUSRLT(TMGOUT,TMGPARAMS) ;"GET USER LIST
35 ;"Purpose: to fill list with users on the system.
36 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
37 ;" TMGPARAMS -- either "" or "NODISUSER" if not to return DISUSER=YES users
38 ;"Output: TMGOUT is filled as follows:
39 ;" TMGOUT(0)="1^Success" or "-1^Message"
40 ;" TMGOUT(1)=Name^IEN^200^DISUSER DISUSER will be 1 for "Y" or 0 for "N"
41 ;" TMGOUT(2)=Name^IEN^200^DISUSER
42 ;"Results: none
43 ;
44 NEW TMGACTIVEONLY SET TMGACTIVEONLY=($GET(TMGPARAMS)="NODISUSER")
45 NEW TMGINDEX SET TMGINDEX=1
46 NEW TMGNAME SET TMGNAME=""
47 FOR SET TMGNAME=$ORDER(^VA(200,"B",TMGNAME)) QUIT:(TMGNAME="") DO
48 . NEW TMGIEN SET TMGIEN=""
49 . FOR SET TMGIEN=$ORDER(^VA(200,"B",TMGNAME,TMGIEN)) QUIT:(+TMGIEN'>0) DO
50 . . NEW TMGDISUSER SET TMGDISUSER=$PIECE($GET(^VA(200,TMGIEN,0)),"^",7)
51 . . IF (TMGACTIVEONLY)&(TMGDISUSER) QUIT
52 . . NEW TMGNAME SET TMGNAME=$PIECE($GET(^VA(200,TMGIEN,0)),"^",1)
53 . . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGIEN_"^200^"_TMGDISUSER
54 . . SET TMGINDEX=TMGINDEX+1
55 ;
56 SET TMGOUT(0)="1^Success"
57 ;
58 QUIT
59 ;
60GETRECLT(TMGOUT,TMGPARAMS) ;"GET RECS LIST
61 ;"Purpose: to fill list with records in file on the system.
62 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
63 ;" TMGPARAMS -- Filenumber
64 ;"Output: TMGOUT is filled as follows:
65 ;" TMGOUT(0)="1^Success" or "-1^Message"
66 ;" TMGOUT(1)=.01Value^IEN^FileNum
67 ;" TMGOUT(2)=.01Value^IEN^FileNum
68 ;"Results: none
69 ;
70 NEW TMGINDEX SET TMGINDEX=1
71 NEW TMGNAME SET TMGNAME=""
72 NEW TMGFNUM SET TMGFNUM=+$GET(TMGPARAMS)
73 IF TMGFNUM'>0 DO GOTO GRLDONE
74 . SET TMGOUT(0)="-1^Valid file number not found"
75 NEW TMGREF SET TMGREF=$GET(^DIC(TMGFNUM,0,"GL"))
76 SET TMGREF=$$CREF^DILF(TMGREF)
77 IF TMGREF="" DO GOTO GRLDONE
78 . SET TMGOUT(0)="-1^Unable to find global reference for file: "_TMGFNUM
79 NEW TMGLOC,TMGPIECE
80 SET TMGLOC=$PIECE(^DD(TMGFNUM,.01,0),"^",4)
81 SET TMGPIECE=$PIECE(TMGLOC,";",2)
82 SET TMGLOC=$PIECE(TMGLOC,";",1)
83 FOR SET TMGNAME=$ORDER(@TMGREF@("B",TMGNAME)) QUIT:(TMGNAME="") DO
84 . NEW TMGIEN SET TMGIEN=""
85 . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGNAME,TMGIEN)) QUIT:(+TMGIEN'>0) DO
86 . . NEW TMGNAME SET TMGNAME=$PIECE($GET(@TMGREF@(TMGIEN,TMGLOC)),"^",TMGPIECE)
87 . . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGIEN_"^"_TMGFNUM
88 . . SET TMGINDEX=TMGINDEX+1
89 ;
90 SET TMGOUT(0)="1^Success"
91GRLDONE ;
92 QUIT
93 ;
94GET1USER(TMGOUT,TMGIEN) ;"GET ONE USER
95 ;"Purpose: to get record of one user
96 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
97 ;" TMGIEN -- the IEN in file 200 to get
98 ;"Output: TMGOUT is filled as follows:
99 ;" TMGOUT(0)="1^Success" or "-1^Message"
100 ;" TMGOUT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
101 ;" TMGOUT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
102 ;"Note: the fields to return are decided HERE
103 ;"Results: none
104 ;
105 NEW TMGIENS SET TMGIENS=+$GET(TMGIEN)_","
106 DO GET1REC(.TMGOUT,"200^"_TMGIENS)
107 QUIT
108 ;
109 ;
110GET1REC(TMGOUT,TMGPARAMS) ;
111 ;"Purpose: to get one record in file
112 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
113 ;" TMGPARAMS: File^IENS
114 ;" File -- the file or subfile to retrieve from
115 ;" IENS -- if File is a subfile, then IENS should be full IENS to get (e.g. '2,103,')
116 ;" if File is not a subfile, then IENS can be just IEN or IEN_","
117 ;"Output: TMGOUT is filled as follows:
118 ;" TMGOUT(0)="1^Success" or "-1^Message"
119 ;" TMGOUT(1)=File^IENS^FieldNum^ExternalValue^DDInfo...
120 ;" TMGOUT(2)=File^IENS^FieldNum^ExternalValue^DDInfo...
121 ;"Note: the fields to return are decided HERE
122 ;"Results: none
123 ;
124 SET TMGOUT(0)="1^Success" ;"default to success
125 NEW TMGARRAY,TMGMSG
126 NEW TMGREF SET TMGREF="TMGARRAY"
127 SET TMGPARAMS=$GET(TMGPARAMS)
128 SET ^TMG("TMP","RPC","GET1REC")=TMGPARAMS
129 NEW TMGFILE SET TMGFILE=$PIECE(TMGPARAMS,"^",1)
130 IF +TMGFILE'>0 DO GOTO GORDONE
131 . SET TMGOUT(0)="-1^No file number supplied"
132 NEW TMGIENS SET TMGIENS=$PIECE(TMGPARAMS,"^",2)
133 IF TMGIENS="" DO GOTO GORDONE
134 . SET TMGOUT(0)="-1^No IENS supplied"
135 ;
136 DO GETS^DIQ(TMGFILE,TMGIENS,"**","IE",TMGREF,"TMGMSG")
137 ;
138 IF $DATA(TMGMSG("DIERR")) DO GOTO GORDONE
139 . SET TMGOUT(0)="-1^See Fileman message"
140 . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
141 ;
142 DO XTRCTFLD(.TMGOUT,.TMGARRAY,"E")
143 ;
144GORDONE ;
145 QUIT
146 ;
147 ;
148XTRCTFLD(TMGOUT,TMGARRAY,TMGFLAG) ;"EXTRACT FIELDS
149 ;"Purpose: convert output from GETS^DIQ into another format
150 ;
151 NEW TMGINDEX SET TMGINDEX=1
152 NEW TMGFILE,TMGFIELD,TMGIENS
153 SET TMGFILE=""
154 FOR SET TMGFILE=$ORDER(TMGARRAY(TMGFILE)) QUIT:(TMGFILE="") DO
155 . SET TMGIENS=""
156 . FOR SET TMGIENS=$ORDER(TMGARRAY(TMGFILE,TMGIENS)) QUIT:(TMGIENS="") DO
157 . . SET TMGFIELD=0
158 . . FOR SET TMGFIELD=$ORDER(^DD(TMGFILE,TMGFIELD)) QUIT:(+TMGFIELD'>0) DO
159 . . . IF $GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG))="" DO
160 . . . . SET TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG)=""
161 . . SET TMGFIELD=""
162 . . FOR SET TMGFIELD=$ORDER(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD)) QUIT:(TMGFIELD="") DO
163 . . . NEW TMGVALUE SET TMGVALUE=$GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,TMGFLAG))
164 . . . NEW TMGDDINFO SET TMGDDINFO=$PIECE($GET(^DD(TMGFILE,TMGFIELD,0)),"^",1,4)
165 . . . IF $PIECE(TMGDDINFO,"^",2)["D" DO ;"convert data format to one Delphi can use
166 . . . . IF TMGFLAG="I" QUIT
167 . . . . NEW X SET X=$GET(TMGARRAY(TMGFILE,TMGIENS,TMGFIELD,"I"))
168 . . . . SET TMGVALUE=$$FMTE^XLFDT(X,5)
169 . . . SET TMGOUT(TMGINDEX)=TMGFILE_"^"_TMGIENS_"^"_TMGFIELD_"^"_TMGVALUE
170 . . . SET TMGOUT(TMGINDEX)=TMGOUT(TMGINDEX)_"^"_TMGDDINFO
171 . . . SET TMGINDEX=TMGINDEX+1
172 ;
173 QUIT
174 ;
175GFLSUBST(TMGOUT,TMGPARAMS) ;"GET FILE SUBSET
176 ;"Purpose: to return a subset of entries a file's .01 names
177 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
178 ;" TMGPARAMS -- FileNum^StartFrom^Direction^maxCount
179 ;" TMGFNUM - filename file to traverse
180 ;" StartFrom -- text to $ORDER() from -- OPTIONAL
181 ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
182 ;" maxCt -- OPTIONAL -- the max number of entries to return.
183 ;"Output: TMGOUT is filled as follows:
184 ;" TMGOUT(0)="1^Success" or "-1^Message"
185 ;" TMGOUT(1)=IEN^Value
186 ;" TMGOUT(2)=IEN^Value
187 ;" ...
188 ;"Results: none
189 ;"NOTE: does NOT work with sub files.
190 ;
191 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
192 IF TMGFILE'>0 DO GOTO GFSDONE
193 . SET TMGOUT(0)="-1^No file number supplied"
194 NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
195 NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
196 IF TMGDIR'=-1 SET TMGDIR=1
197 NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
198 IF TMGMAXCT=0 SET TMGMAXCT=44
199 NEW TMGISPTR SET TMGISPTR=($PIECE($GET(^DD(TMGFILE,.01,0)),"^",2)["P")
200 NEW TMGSTARTIEN SET TMGSTARTIEN=""
201 IF TMGISPTR DO
202 . IF $LENGTH(TMGFROM,";")>2 SET TMGSTARTIEN=+$PIECE(TMGFROM,";",2)
203 . IF TMGFROM?1.N1";".E SET TMGFROM=+TMGFROM
204 ;
205 NEW TMGI SET TMGI=0
206 ;"NEW TMGLAST SET TMGLAST=""
207 ;"NEW prev SET prev=""
208 NEW TMGREF SET TMGREF=$GET(^DIC(TMGFILE,0,"GL"))
209 SET TMGREF=$$CREF^DILF(TMGREF) ;"convert open --> closed reference
210 IF TMGREF="" DO GOTO GFSDONE
211 . SET TMGOUT(0)="-1^Unable to obtain global ref for file #"_TMGFILE
212 ;
213 FOR SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI'<TMGMAXCT) DO
214 . NEW TMGIEN SET TMGIEN=TMGSTARTIEN
215 . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGFROM,TMGIEN),TMGDIR) QUIT:(+TMGIEN'>0)!(TMGI'<TMGMAXCT) DO
216 . . SET TMGI=TMGI+1
217 . . SET TMGOUT(TMGI)=TMGIEN_"^"
218 . . IF TMGISPTR SET TMGOUT(TMGI)=TMGOUT(TMGI)_TMGFROM_";"_TMGIEN_";"
219 . . SET TMGOUT(TMGI)=TMGOUT(TMGI)_$$GET1^DIQ(TMGFILE,TMGIEN_",",.01)
220 . . ;"SET TMGOUT(TMGI)=$$GET1^DIQ(TMGFILE,IEN_",",.01)
221 ;
222 SET TMGOUT(0)="1^Success"
223GFSDONE ;
224 QUIT
225 ;
226 ;
Note: See TracBrowser for help on using the repository browser.