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

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

Initial upload

File size: 19.5 KB
RevLine 
[796]1TMGRPC6A ;TMG/kst/Support Functions for tmg-messenger ;09/17/09
2 ;;1.0;TMG-LIB;**1**;09/17/09
3 ;
4 ;"TMG RPC FUNCTIONS for TMG-Messenger program
5 ;
6 ;"Kevin Toppenberg MD
7 ;"GNU Lessor General Public License (LGPL) applies
8 ;"9/17/09
9 ;
10 ;"=======================================================================
11 ;" RPC -- Public Functions.
12 ;"=======================================================================
13 ;"GETEMULT(TMGOUT,TMGPARAMS) ;"GET USERS OF EMAIL ADDRESS
14 ;"GETUEMA(TMGOUT,TMGPARAMS) ;"GET MULT USERS EMAIL ADDRESSES
15 ;"SETUEMA(TMGOUT,TMGPARAMS) ;"SET ONE USER'S EMAIL ADDRESS
16 ;"KILLUEMA(TMGOUT,TMGPARAMS) ;"REMOVE ONE EMAIL ADDRESS FROM A USER
17 ;"SETUSEM(TMGOUT,TMGPARAMS) ;"SET MULTIPLE USERS EMAIL ADDRESSES
18 ;"GFLSUBST(TMGOUT,TMGPARAMS) ;"GET FILE SUBSET
19 ;"GETIEN8925(TMGOUT,TMGUID) ;"GET IEN 8925 FOR IMAP UID
20 ;"SETUID(TMGOUT,TMGPARAMS) ;"SET IMAP UID FOR IEN 8925
21 ;"GETEMDOC(TMGOUT,TMGPARAMS) ;"GET IEN OF 'EMAIL' DOC IN 8925.1
22 ;"
23 ;"=======================================================================
24 ;"PRIVATE API FUNCTIONS
25 ;"=======================================================================
26 ;
27 ;"=======================================================================
28 ;"=======================================================================
29 ;"Dependencies:
30 ;" TMGDEBUG
31 ;"=======================================================================
32 ;"=======================================================================
33 ;
34 ;"=======================================================================
35 ;
36GETEMULT(TMGOUT,TMGPARAMS) ;"GET USERS OF EMAIL ADDRESS
37 ;"Purpose: to fill list with users with matching email address
38 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
39 ;" TMGPARAMS -- email address, e.g. 'Someuser@gmail.com'
40 ;"Output: TMGOUT is filled as follows:
41 ;" TMGOUT(0)="#Found^Success" or "-1^Message"
42 ;" e.g. 1^Success --> 1 match found
43 ;" 2^Success --> 2 matches found
44 ;" 0^Success --> no errors, but no matches found.
45 ;" TMGOUT(1)=Name^DOB^IEN2
46 ;" TMGOUT(2)=Name^DOB^IEN2
47 ;"
48 ;"Results: none
49 ;
50 MERGE ^TMG("TMP","RPC","GETEMULT","TMGPARAMS")=TMGPARAMS
51 NEW TMGINDEX SET TMGINDEX=1
52 NEW TMGEMAIL SET TMGEMAIL=$$LOW^XLFSTR($EXTRACT($GET(TMGPARAMS),1,128))
53 IF TMGEMAIL="" DO QUIT
54 . SET TMGOUT(0)="-1^No email address passed for lookup"
55 NEW TMGIEN SET TMGIEN=""
56 KILL TMGOUT
57 FOR SET TMGIEN=$ORDER(^DPT("ATMGEMAIL",TMGEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0) DO
58 . NEW TMGNAME SET TMGNAME=$PIECE($GET(^DPT(TMGIEN,0)),"^",1)
59 . NEW TMGDOB SET TMGDOB=$PIECE($GET(^DPT(TMGIEN,0)),"^",3)
60 . SET TMGDOB=$$FMTE^XLFDT(TMGDOB,"5D") ;"MM/DD/YYY format
61 . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGDOB_"^"_TMGIEN
62 . SET TMGINDEX=TMGINDEX+1
63 FOR SET TMGIEN=$ORDER(^DPT("ATMGALTEMAIL",TMGEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0) DO
64 . NEW TMGNAME SET TMGNAME=$PIECE($GET(^DPT(TMGIEN,0)),"^",1)
65 . NEW TMGDOB SET TMGDOB=$PIECE($GET(^DPT(TMGIEN,0)),"^",3)
66 . SET TMGDOB=$$FMTE^XLFDT(TMGDOB,"5D") ;"MM/DD/YYY format
67 . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGDOB_"^"_TMGIEN
68 . SET TMGINDEX=TMGINDEX+1
69 ;
70 SET TMGOUT(0)=(TMGINDEX-1)_"^Success"
71 ;
72 QUIT
73 ;
74GETUEMA(TMGOUT,TMGPARAMS) ;"GET MULT USERS EMAIL ADDRESSES
75 ;"Purpose: to fill list of email address for requested users.
76 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
77 ;" TMGPARAMS -- list of DFN's e.g. 1234;2345;234
78 ;"Output: TMGOUT is filled as follows:
79 ;" TMGOUT(0)="#Found^Success" or "-1^Message"
80 ;" e.g. 1^Success --> 1 match found
81 ;" 2^Success --> 2 matches found
82 ;" 0^Success --> no errors, but no matches found.
83 ;" TMGOUT(1)=DFN1^EmailAddress
84 ;" TMGOUT(2)=DFN1^;ALT;AltEmail1
85 ;" TMGOUT(3)=DFN1^;ALT;AltEmail2
86 ;" TMGOUT(4)=DFN2^EmailAddress
87 ;" NOTE: So if a user has 1 primary and 2 secondary
88 ;" email addresses, then there will be 3 entries
89 ;" starting with the same DFN
90 ;"
91 ;"Results: none
92 ;
93 MERGE ^TMG("TMP","RPC","GETUEMA","TMGPARAMS")=TMGPARAMS
94 NEW TMGINDEX SET TMGINDEX=1
95 NEW TMGI
96 NEW TMGEMAIL
97 NEW TMGIEN SET TMGIEN=""
98 SET TMGPARAMS=$GET(TMGPARAMS)
99 KILL TMGOUT
100 FOR TMGI=1:1:$LENGTH(TMGPARAMS,";") DO
101 . SET TMGIEN=+$PIECE(TMGPARAMS,";",TMGI)
102 . QUIT:(TMGIEN'>0)
103 . SET TMGEMAIL=$PIECE($GET(^DPT(TMGIEN,.13)),"^",3)
104 . SET TMGOUT(TMGINDEX)=TMGIEN_"^"_TMGEMAIL
105 . SET TMGINDEX=TMGINDEX+1
106 . NEW TMGIEN2 SET TMGIEN2=0
107 . FOR SET TMGIEN2=$ORDER(^DPT(TMGIEN,"TMGALTEMAIL",TMGIEN2)) QUIT:(+TMGIEN2'>0) DO
108 . . NEW TMGALTEMAIL SET TMGALTEMAIL=""
109 . . SET TMGALTEMAIL=$PIECE($GET(^DPT(TMGIEN,"TMGALTEMAIL",TMGIEN2,0)),"^",1)
110 . . SET TMGOUT(TMGINDEX)=TMGIEN_"^;ALT;"_TMGALTEMAIL
111 . . SET TMGINDEX=TMGINDEX+1
112 ;
113 SET TMGOUT(0)=(TMGINDEX-1)_"^Success"
114 ;
115 QUIT
116 ;
117SETUEMA(TMGOUT,TMGPARAMS) ;"SET ONE USER EMAIL ADDRESS
118 ;"Purpose: to store a new email address for 1 user.
119 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
120 ;" TMGPARAMS -- DFN^NewEMailAddress^AltEMail1^AltEMail2^...
121 ;" e.g. 1234^MyEMail@server.com
122 ;" NOTE: NewEMailAddress is optional
123 ;"Output: TMGOUT is filled as follows:
124 ;" TMGOUT(0)="1^Success" or "-1^Message"
125 ;"
126 ;"Results: none
127 ;
128 MERGE ^TMG("TMP","RPC","SETUEMA","TMGPARAMS")=TMGPARAMS
129 KILL TMGOUT
130 SET TMGOUT(0)="1^Success"
131 SET TMGPARAMS=$GET(TMGPARAMS)
132 NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
133 IF +TMGDFN'>0 SET TMGOUT(0)="-1^Patient IEN not provided (Got '"_TMGDFN_"')" QUIT
134 NEW TMGEMAIL SET TMGEMAIL=$PIECE(TMGPARAMS,"^",2)
135 NEW TMGFDA,TMGMSG
136 IF TMGEMAIL'="" do
137 . SET TMGFDA(2,TMGDFN_",",".133")=TMGEMAIL
138 . DO FILE^DIE("EK","TMGFDA","TMGMSG")
139 . IF $DATA(TMGMSG("DIERR")) DO
140 . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
141 NEW TMGI,TMGALTEMAIL
142 FOR TMGI=3:1:$LENGTH(TMGPARAMS,"^") DO QUIT:(TMGALTEMAIL="")
143 . SET TMGALTEMAIL=$PIECE(TMGPARAMS,"^",TMGI)
144 . IF TMGALTEMAIL="" QUIT
145 . IF +$ORDER(^DPT(TMGDFN,"ATMGALTEMAIL",$$LOW^XLFSTR(TMGALTEMAIL),""))>0 QUIT
146 . KILL TMGFDA NEW TMGIEN
147 . SET TMGFDA(2.022703,"+1,"_TMGDFN_",",.01)=TMGALTEMAIL
148 . DO UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
149 . IF $DATA(TMGMSG("DIERR")) DO
150 . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG) ;"Only will store LAST error.
151 ;
152 QUIT
153 ;
154KILLUEMA(TMGOUT,TMGPARAMS) ;"REMOVE ONE EMAIL ADDRESS FROM A USER
155 ;"Purpose: Remove an email address, either primary or alternative
156 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
157 ;" TMGPARAMS -- DFN^BAD-EMailAddress^Bademail2^bademail3^...
158 ;" e.g. 1234^MyBadEMail@server.com
159 ;"Output: TMGOUT is filled as follows:
160 ;" TMGOUT(0)="1^Success" or "-1^Message"
161 ;"
162 ;"Results: none
163 ;
164 MERGE ^TMG("TMP","RPC","KILLUEMA","TMGPARAMS")=TMGPARAMS
165 SET TMGOUT(0)="1^Success"
166 SET TMGPARAMS=$GET(TMGPARAMS)
167 NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
168 IF +TMGDFN'>0 SET TMGOUT(0)="-1^Patient IEN not provided (Got '"_TMGDFN_"')" QUIT
169 NEW TMGI,TMGEMAIL
170 FOR TMGI=2:1:$LENGTH(TMGPARAMS,"^") DO QUIT:(TMGEMAIL="")!(+TMGOUT(0)=-1)
171 . NEW TMGFOUND SET TMGFOUND=0
172 . SET TMGEMAIL=$$LOW^XLFSTR($PIECE(TMGPARAMS,"^",TMGI))
173 . IF TMGEMAIL="" QUIT
174 . NEW TMGIEN SET TMGIEN=""
175 . FOR SET TMGIEN=$ORDER(^DPT("ATMGEMAIL",TMGEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0)!(+TMGOUT(0)=-1) DO
176 . . IF TMGIEN'=TMGDFN QUIT
177 . . SET TMGFOUND=1
178 . . NEW TMGFDA,TMGMSG
179 . . SET TMGFDA(2,TMGDFN_",",".133")="@"
180 . . DO FILE^DIE("EK","TMGFDA","TMGMSG")
181 . . IF $DATA(TMGMSG("DIERR")) DO
182 . . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
183 . SET TMGIEN=""
184 . FOR SET TMGIEN=$ORDER(^DPT(TMGDFN,"TMGALTEMAIL","B",TMGEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0)!(+TMGOUT(0)=-1) DO
185 . . SET TMGFOUND=1
186 . . NEW TMGFDA,TMGMSG
187 . . SET TMGFDA(2.022703,TMGIEN_","_TMGDFN_",",".01")="@"
188 . . DO FILE^DIE("EK","TMGFDA","TMGMSG")
189 . . IF $DATA(TMGMSG("DIERR")) DO
190 . . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
191 . IF TMGFOUND=0 DO ;"only will retain LAST message...
192 . . SET TMGOUT(0)="-1^Couldn't locate email to delete: "+TMGEMAIL
193 ;
194 QUIT
195 ;
196ALTEREMA(TMGOUT,TMGPARAMS) ;"ALTER USER EMAIL ADDRESS
197 ;"Purpose: Change the value for an email address
198 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
199 ;" TMGPARAMS -- DFN^OldEMailAddress^NewEmailAddress
200 ;" e.g. 1234^OldEMail@server.com^NewEmail@server2.com
201 ;" NOTE: If old value is the value for primary email address, then that will be changed
202 ;" Otherwise, alternative emails will be searched. Search is case insensitive
203 ;"Output: TMGOUT is filled as follows:
204 ;" TMGOUT(0)="1^Success" or "-1^Message"
205 ;"
206 ;"Results: none
207 ;
208 MERGE ^TMG("TMP","RPC","ALTEREMA","TMGPARAMS")=TMGPARAMS
209 SET TMGOUT(0)="1^Success"
210 NEW TMGFOUND SET TMGFOUND=0
211 SET TMGPARAMS=$GET(TMGPARAMS)
212 NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
213 IF +TMGDFN'>0 SET TMGOUT(0)="-1^Patient IEN not provided (Got '"_TMGDFN_"')" QUIT
214 NEW TMGI,TMGOLDEMAIL,TMGNEWEMAIL
215 SET TMGOLDEMAIL=$$LOW^XLFSTR($PIECE(TMGPARAMS,"^",2))
216 IF TMGOLDEMAIL="" DO QUIT
217 . SET TMGOUT(0)="-1^Old email value not provided."
218 SET TMGNEWEMAIL=$PIECE(TMGPARAMS,"^",3)
219 IF TMGNEWEMAIL="" DO QUIT
220 . SET TMGOUT(0)="-1^New email value not provided."
221 NEW TMGIEN SET TMGIEN=""
222 FOR SET TMGIEN=$ORDER(^DPT("ATMGEMAIL",TMGOLDEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0) DO
223 . IF TMGIEN'=TMGDFN QUIT
224 . SET TMGFOUND=1
225 . NEW TMGFDA,TMGMSG
226 . SET TMGFDA(2,TMGDFN_",",".133")=TMGNEWEMAIL
227 . DO FILE^DIE("EK","TMGFDA","TMGMSG")
228 . IF $DATA(TMGMSG("DIERR")) DO
229 . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
230 IF TMGFOUND=1 QUIT
231 SET TMGIEN=""
232 FOR SET TMGIEN=$ORDER(^DPT(TMGDFN,"TMGALTEMAIL","B",TMGOLDEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0) DO
233 . NEW TMGFDA,TMGMSG
234 . SET TMGFDA(2.022703,TMGIEN_","_TMGDFN_",",".01")=TMGNEWEMAIL
235 . DO FILE^DIE("EK","TMGFDA","TMGMSG")
236 . IF $DATA(TMGMSG("DIERR")) DO
237 . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
238 ;
239 QUIT
240 ;
241SETUSEM(TMGOUT,TMGPARAMS) ;"SET MULTIPLE USERS EMAIL ADDRESSES
242 ;"Purpose: to store a new email address for more than 1 user.
243 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
244 ;" TMGPARAMS -- DFN=NewEMailAddress;DFN=NewEMailAddress;DFN=NewEMailAddress....
245 ;"Output: TMGOUT is filled as follows:
246 ;" TMGOUT(0)="1^Success" or "-1^Message"
247 ;"
248 ;"Results: none
249 ;"Note: If error encountered, then no further attempts to file others in list tried.
250 ;
251 MERGE ^TMG("TMP","RPC","SETUSEM","TMGPARAMS")=TMGPARAMS
252 KILL TMGOUT
253 SET TMGOUT(0)="1^Success"
254 SET TMGPARAMS=$GET(TMGPARAMS)
255 NEW TMGFDA,TMGMSG,TMGI,TMGERR
256 SET TMGERR=0
257 FOR TMGI=1:1:$LENGTH(TMGPARAMS,";") DO QUIT:TMGERR
258 . KILL TMGFDA,TMGMSG
259 . NEW TMG1PARAM SET TMG1PARAM=$PIECE(TMGPARAMS,";",TMGI)
260 . NEW TMGIEN SET TMGIEN=$PIECE(TMG1PARAM,"=",1)
261 . IF +TMGIEN'>0 SET TMGOUT(0)="-1^Patient IEN not provided (Got '"_TMGIEN_"')" SET TMGERR=1 QUIT
262 . NEW TMGEMAIL SET TMGEMAIL=$PIECE(TMG1PARAM,"=",2)
263 . IF TMGEMAIL="" SET TMGOUT(0)="-1^Email address not provided" SET TMGERR=1 QUIT
264 . SET TMGFDA(2,TMGIEN_",",".133")=TMGEMAIL
265 . DO FILE^DIE("EK","TMGFDA","TMGMSG")
266 . IF $DATA(TMGMSG("DIERR")) DO
267 . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
268 . . SET TMGERR=1
269 ;
270 QUIT
271 ;
272GFLSUBST(TMGOUT,TMGPARAMS) ;"GET FILE SUBSET
273 ;"Purpose: to return a subset of entries a file's .01 names
274 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
275 ;" TMGPARAMS -- FileNum^StartFrom^Direction^maxCount
276 ;" TMGFNUM - filename file to traverse
277 ;" StartFrom -- text to $ORDER() from -- OPTIONAL
278 ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
279 ;" maxCt -- OPTIONAL -- the max number of entries to return.
280 ;"Output: TMGOUT is filled as follows:
281 ;" TMGOUT(0)="1^Success" or "-1^Message"
282 ;" TMGOUT(1)=IEN^Value
283 ;" TMGOUT(2)=IEN^Value
284 ;" ...
285 ;"Results: none
286 ;"NOTE: does NOT work with sub files.
287 ;" Also, originally copied from TMGRPC3B to remove dependancies to that file
288 ;
289 NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
290 IF TMGFILE'>0 DO GOTO GFSDONE
291 . SET TMGOUT(0)="-1^No file number supplied"
292 NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
293 NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
294 IF TMGDIR'=-1 SET TMGDIR=1
295 NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
296 IF TMGMAXCT=0 SET TMGMAXCT=44
297 ;
298 NEW TMGI SET TMGI=0
299 ;"NEW TMGLAST SET TMGLAST=""
300 ;"NEW prev SET prev=""
301 NEW TMGREF SET TMGREF=$GET(^DIC(TMGFILE,0,"GL"))
302 SET TMGREF=$$CREF^DILF(TMGREF) ;"convert open --> closed reference
303 IF TMGREF="" DO GOTO GFSDONE
304 . SET TMGOUT(0)="-1^Unable to obtain global ref for file #"_TMGFILE
305 ;
306 FOR SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI=TMGMAXCT) DO
307 . NEW TMGIEN SET TMGIEN=""
308 . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGFROM,TMGIEN),TMGDIR) QUIT:(+TMGIEN'>0) DO
309 . . SET TMGI=TMGI+1
310 . . SET TMGOUT(TMGI)=TMGIEN_"^"_$$GET1^DIQ(TMGFILE,TMGIEN_",",.01)
311 . . ;"SET TMGOUT(TMGI)=$$GET1^DIQ(TMGFILE,IEN_",",.01)
312 ;
313 SET TMGOUT(0)="1^Success"
314GFSDONE ;
315 QUIT
316 ;
317GETIEN8925(TMGOUT,TMGUID) ;"GET IEN 8925 FOR IMAP UID
318 ;"Purpose: To retrieve the IEN from file 8925 that is linked to UID (if any)
319 ;"Input: TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
320 ;" TMGPARAMS -- UID
321 ;"Output: TMGOUT is filled as follows:
322 ;" TMGOUT(0)="-1^Message" or TMG(0)=IEN or TMG(0)=0 if not found.
323 ;"Results: none
324 NEW TMGIEN
325 IF $GET(TMGUID)="" DO QUIT
326 . SET TMGOUT(0)="-1^No UID passed"
327 SET TMGIEN=+$ORDER(^TIU(8925,"TMGUID",TMGUID,""))
328 SET TMGOUT(0)=TMGIEN
329 ;
330 QUIT
331 ;
332SETUID(TMGOUT,TMGPARAMS) ;"SET IMAP UID FOR IEN 8925
333 ;"Purpose: To store an IMAP UID (identifier) for a given TIU Document
334 ;"Input: TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
335 ;" TMGPARAMS -- IEN8925^UID
336 ;" IEN8925 -- The IEN in file 8925 to be altered.
337 ;" UID -- The UID to be stored in the above document.
338 ;"Output: TMGOUT(0) = 1^Success, or -1^Error Message
339 ;"Results: none
340 SET TMGOUT(0)="1^Success" ;"Default to success
341 NEW TMGIEN,TMGUID,TMGFDA,TMGMSG
342 SET TMGIEN=$PIECE(TMGPARAMS,"^",1)
343 IF +TMGIEN'>0 DO QUIT
344 . SET TMGOUT(0)="-1^Bad IEN passed: "_TMGIEN
345 SET TMGUID=$PIECE(TMGPARAMS,"^",2)
346 IF TMGUID="" DO QUIT
347 . SET TMGOUT(0)="-1^No UID passed."
348 SET TMGFDA(8925,TMGIEN_",",22710)=TMGUID
349 DO FILE^DIE("EK","TMGFDA","TMGMSG")
350 IF $DATA(TMGMSG("DIERR")) DO
351 . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
352 ;
353 QUIT
354 ;
355GETEMDOC(TMGOUT,TMGPARAMS) ;"
356 ;"Purpose: GET IEN OF 'EMAIL' DOC IN 8925.1
357 ;"Input: TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
358 ;" TMGPARAMS -- Not used, so data ignored.
359 ;"Output: TMGOUT is filled as follows:
360 ;" TMGOUT(0)="-1^Message" or TMG(0)=IEN^Name
361 ;"Results: none
362 ;"
363 NEW X,Y,DIC
364 SET DIC=8925.1
365 SET DIC(0)="M"
366 SET X="EMAIL"
367 DO ^DIC
368 IF +Y>0 DO
369 . SET TMGOUT(0)=Y
370 ELSE DO
371 . SET TMGOUT(0)="-1^Unique title EMAIL not found"
372 ;
373 QUIT
374 ;
375GETCONSNT(TMGOUT,TMGPARAMS) ;
376 ;"Purpose: Get status of HIPPA consent documented in patient chart
377 ;"Input: TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
378 ;" TMGPARAMS -- PatientIEN^
379 ;"Results: TMGOUT(0) = 1^Codes, or -1^Error Message
380 ;" Codes are E - Email consented;
381 ;" EC - email & cell msg consented;
382 ;" C - just cell msg consented.
383 ;" N - NOT CONSENTED, or no code found
384 ;"Results : none
385 ;"Note: This field is a multiple, and allows status to change over time
386 ;" This routine will return the status for NOW.
387 NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
388 IF +TMGDFN'>0 DO QUIT
389 . SET TMGOUT(0)="-1^Valid Patient IEN Not Found. Got: "_TMGDFN
390 SET TMGDFN=+TMGDFN
391 NEW TMGDT,%,X
392 DO NOW^%DTC SET TMGDT=% ;"Get NOW into TMGDT
393 NEW TMGLASTDT
394 SET TMGLASTDT=$ORDER(^DPT(TMGDFN,"TMGHIPPA","TMGDATE",TMGDT),-1)
395 IF TMGLASTDT="" DO QUIT
396 . SET TMGOUT(0)="-1^NO Current Status for Current Date-Time"
397 NEW TMGIEN
398 SET TMGIEN=$ORDER(^DPT(TMGDFN,"TMGHIPPA","TMGDATE",TMGLASTDT,""))
399 NEW TMGSTATUS
400 SET TMGSTATUS=$PIECE($GET(^DPT(TMGDFN,"TMGHIPPA",TMGIEN,0)),"^",1)
401 IF TMGSTATUS="" SET TMGSTATUS="N"
402 SET TMGOUT(0)="1^"_TMGSTATUS
403 QUIT
404 ;
405SETCONSNT(TMGOUT,TMGPARAMS) ;
406 ;"PURPOSE: Set status of HIPPA consent documented in patient chart
407 ;"Input TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
408 ;" TMGPARAMS -- PatientIEN^StatusCodes
409 ;" Codes should be E - Email consented;
410 ;" EC - email & cell msg consented;
411 ;" C - just cell msg consented.
412 ;" N - NOT CONSENTED
413 ;" (Note, codes ARE case sensitive)
414 ;"Results: TMGOUT(0) = 1^Success, or -1^Error Message
415 NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
416 IF +TMGDFN'>0 DO QUIT
417 . SET TMGOUT(0)="-1^Valid Patient IEN Not Found. Got: "_TMGDFN
418 SET TMGDFN=+TMGDFN
419 NEW TMGCODE SET TMGCODE=$PIECE(TMGPARAMS,"^",2)
420 NEW TMGVCODES SET TMGVCODES=$PIECE($GET(^DD(2.22704,.01,0)),"^",3)
421 NEW TMGOK,TMGI SET TMGOK=0
422 FOR TMGI=1:1:$LENGTH(TMGVCODES,";") DO QUIT:(TMGOK=1)
423 . NEW ONECODE SET ONECODE=$PIECE(TMGVCODES,";",TMGI)
424 . IF $PIECE(ONECODE,":",1)=TMGCODE SET TMGOK=1 QUIT
425 . ;"IF $PIECE(ONECODE,":",2)=TMGCODE SET TMGOK=1 QUIT
426 IF TMGOK'=1 DO QUIT
427 . SET TMGOUT(0)="-1^Invalid code. Got: "_TMGCODE
428 NEW TMGDT,%,X
429 DO NOW^%DTC SET TMGDT=% ;"Get NOW into TMGDT
430 NEW TMGFDA,TMGMSG,TMGIEN,TMGIENS
431 SET TMGIENS="+1,"_TMGDFN_","
432 SET TMGFDA(2.22704,TMGIENS,.01)=TMGCODE
433 SET TMGFDA(2.22704,TMGIENS,.02)=TMGDT
434 SET TMGFDA(2.22704,TMGIENS,.03)=DUZ
435 DO UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
436 IF $DATA(TMGMSG("DIERR")) DO
437 . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
438 ELSE DO
439 . SET TMGOUT(0)="1^Success"
440 ;
441 QUIT
442 ;
Note: See TracBrowser for help on using the repository browser.