source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTPUA.m@ 1639

Last change on this file since 1639 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 1.0 KB
RevLine 
[623]1ORWTPUA ; SLC/STAFF Personal Preference - Utility Alerts ;5/22/00 09:58
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85**;Oct 24, 2000
3 ;
4START(USER) ; $$(user) -> user's surrogate start date/time
5 Q $P($G(^XTV(8992,+$G(USER),0)),U,3)
6 ;
7STOP(USER) ; $$(user) -> user's surrogate stop date/time
8 Q $P($G(^XTV(8992,+$G(USER),0)),U,4)
9 ;
10CHKSURR(USER,SURR) ; $$(user,surrogate) -> 1 if ok else 0^reason for reject
11 N OK,START
12 S USER=+$G(USER),SURR=+$G(SURR)
13 I USER=SURR Q "0^You cannot specify yourself as your own surrogate!"
14 S START=$$GET1^DIQ(8992,(SURR_","),.02,"I")
15 I START<.5 Q 1
16 I START=USER Q "0^You are designated as the surrogate for this user - can't do it!"
17 S OK=1 F S START=$$GET1^DIQ(8992,(START_","),.02,"I") Q:START'>0 I START=USER S OK=0 Q
18 I 'OK Q "0^This forms a circle which leads back to you - can't do it!"
19 Q 1
20 ;
21GETSURR(USER) ; $$(user ien) -> surrogate ien
22 Q $$CURRSURO^XQALSURO(+$G(USER))
23 ;
24SAVESURR(USER,SURR,START,STOP) ; save user's surrogate info
25 D REMVSURO^XQALSURO(USER)
26 D SETSURO^XQALSURO(USER,SURR,START,STOP)
27 Q
Note: See TracBrowser for help on using the repository browser.