source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQALGUI.m@ 623

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1XQALGUI ; SFCIOFO/JLI - KERNEL COMPONENTS FOR ALERTS ;3/15/02 11:24
2 ;;8.0;KERNEL;**207**;Jul 10, 1995
3 ;
4 ; added CURRSURO and SETSURO entry points 3/21/00 jli
5 ;
6 ; All entry is at the ENTRY tag. The type of processing is indicated by the
7 ; variable LOC which contains the name of the tag to be used for processing.
8 ; The following tags currently exist and expect the variable names indicated
9 ;
10 ; SEND
11 ; GETLIST
12 ; ISPEND
13 ; ISNEW
14 ; DELETE
15 ; FORWARD
16 ; CURRSURO
17 ; SETSURO
18 ;
19ENTRY(XQALRSLT,DATA) ;
20 K ^TMP($J) N I,LOC,XQA,XQACTMSG,XQAEND,XQAID,XQALFWD,XQALRSL1,XQAMSG,XQASTART,XQASURO,XQATEXT
21 N NAME,XQALSTO S NAME="" S XQALSTO=$NA(^TMP("XQALXQAL",$J)) K @XQALSTO
22 F S NAME=$O(DATA(NAME)) Q:NAME="" D I $E(NAME)'=U S @("^TMP(""XQALXQAL"",$J,"_NAME1_")")=DATA(NAME)
23 . I $E(NAME)=U S @NAME=DATA(NAME) Q
24 . S NAME1=""""
25 . F I=1:1 S X=$P(NAME,",",I) Q:X="" S NAME1=NAME1_$S(I>1:",""",1:"")_X_""""
26 S NAME="" F S NAME=$O(@XQALSTO@(NAME)) Q:NAME="" D:$D(@XQALSTO@(NAME))>1 I $D(@XQALSTO@(NAME))=1 N @NAME S @NAME=@XQALSTO@(NAME)
27 . N NAME1 S NAME1=""
28 . F S NAME1=$O(@XQALSTO@(NAME,NAME1)) Q:NAME1="" S @(NAME_"("""_NAME1_""")")=^(NAME1)
29 Q:'$D(LOC)
30 ; need to add code here to check key if XQAUSER is defined and not DUZ
31 G @LOC
32 ;
332 ;
34SEND ;
35SETUP ; ENTRY FOR SETUP NEW ALERT
36 I '$D(XQAUSER) S XQAUSER=DUZ
37 Q:($O(XQA(""))="") Q:'$D(XQAMSG)
38 I $D(^TMP($J,"XQAL1")) S XQATEXT=$NA(^TMP($J,"XQAL1"))
39 D SETUP^XQALERT ; Supported Reference
40 Q
41 ;
42GETLIST ; GET LIST OF ALERTS FOR USER
43 I '$D(XQAUSER) S XQAUSER=DUZ
44 S XQALRSLT=$NA(^TMP($J)),XQALRSL1=$NA(^TMP("XQALXQAL",$J)) K @XQALRSL1,@XQALRSLT
45 D GETUSER1^XQALDATA(XQALRSL1,XQAUSER) ;
46 F I=0:0 S I=$O(@XQALRSL1@(I)) Q:I'>0 S X=^(I) K ^(I) S @XQALRSLT@(I)=X
47 Q
48 ;
49ISPEND ;
50 S XQALRSLT=$NA(^TMP($J,"XQALXQAL")) K @XQALRSLT
51 I $O(^XTV(8992,DUZ,"XQA",0))>0 S @XQALRSLT@(1)=1
52 E S @XQALRSLT@(1)=0
53 Q
54 ;
55ISNEW ;
56 S XQALRSLT=$NA(^TMP($J,"XQALXQAL")) K @XQALRSLT
57 S @XQALRSLT@(1)=0
58 F I=0:0 S I=$O(^XTV(8992,DUZ,"XQA",I)) Q:I'>0 I $P($G(^(I,0)),U,4)>0 S @XQALRSLT@(1)=1 Q
59 Q
60 ;
61DELETE ;
62 I '$D(XQAUSER) S XQAUSER=DUZ
63 D DELETE^XQALERT
64 Q
65 ;
66FORWARD ;
67 I '$D(XQAUSER) N XQAUSER S XQAUSER=DUZ
68 S XQALFWD(1)=IEN
69 D FORWARD^XQALFWD(.XQALFWD,.XQA,"A",$G(XQACTMSG))
70 Q
71 ;
72GETSURO ; GET CURRENT SURROGATE INFORMATION (IF ANY)
73 I '$D(XQAUSER) S XQAUSER=DUZ
74 N X S X=$$GETSURO^XQALSURO(XQAUSER) I X'>0 S X="" ; SUPPORTED REFERENCE
75 S XQALRSLT=$NA(^TMP($J,"XQALXQAL")) K @XQALRSLT
76 S @XQALRSLT@(1)=X
77 Q
78 ;
79SETSURO ; SET NEW SURROGATE
80 Q:XQASURO'>0
81 I '$D(XQAUSER) S XQAUSER=DUZ
82 S XQALRSLT=$NA(^TMP("XQALRSLT",$J)) K @XQALRSLT
83 S @XQALRSLT@(1)=$$SETSURO1^XQALSURO(XQAUSER,XQASURO,XQASTART,XQAEND) ; SUPPORTED REFERENCE
84 Q
85 ;
86SUROFOR ;
87 N SUROLIST S XQALRSLT=$NA(^TMP("XQALRSLT",$J)) K @XQALRSLT
88 I '$D(XQAUSER) S XQAUSER=DUZ
89 D SUROFOR^XQALSURO(.SUROLIST,XQAUSER)
90 M @XQALRSLT=SUROLIST
91 Q
92 Q
93 ;
94REMVSURO ; REMOVE SURROGATE
95 I '$D(XQAUSER) S XQAUSER=DUZ
96 D REMVSURO^XQALSURO(XQAUSER) ; SUPPORTED REFERENCE
97 Q
98 ;
99GETDATA ;
100 S XQALRSLT=$NA(^TMP("XQALRSLT",$J)) K @XQALRSLT
101 N IEN S IEN=$O(^XTV(8992,"AXQA",XQAID,DUZ,0)) Q:IEN'>0
102 S @XQALRSLT@(1)=$P(^XTV(8992,DUZ,"XQA",IEN,0),U,7,8)
103 S @XQALRSLT@(2)=$G(^XTV(8992,DUZ,"XQA",IEN,1))
104 S @XQALRSLT@(3)=$G(^XTV(8992,DUZ,"XQA",IEN,3))
105 Q
106 ;
107GETLONG ; TAKE LONG TEXT BACK TO THE CLIENT
108 S XQALRSLT=$NA(^TMP("XQALRSLT",$J)) K @XQALRSLT
109 I '$D(XQAUSER) N XQAUSER S XQAUSER=DUZ
110 N IEN,IENS,XQALTMP S IEN=$O(^XTV(8992,"AXQA",XQAID,XQAUSER,0)) Q:IEN'>0
111 S IENS=IEN_","_XQAUSER_",",XQALTMP=$NA(^TMP($J)) K @XQALTMP
112 D GETS^DIQ(8992.01,(IEN_","_XQAUSER_","),"4","",XQALTMP)
113 F I=0:0 S I=$O(@XQALTMP@(8992.01,IENS,4,I)) Q:I'>0 S @XQALRSLT@(I)=^(I)
114 K @XQALTMP
115 Q
116 ;
117CHKADPAC ; Check for ADPAC or IRM status
118 S XQALRSLT=$NA(^TMP("XQALRSLT",$J)) K @XQALRSLT
119 N XQALVAL,RESULT S XQALVAL=0
120 D OWNSKEY^XUSRB(.RESULT,"XQAL-DELETE") S XQALVAL=RESULT(0)
121 S @XQALRSLT@(1)=XQALVAL
122 Q
123 ;
Note: See TracBrowser for help on using the repository browser.