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

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

initial load of FOIAVistA 6/30/08 version

File size: 1.4 KB
Line 
1XQALSET1 ;ISC-SF.SEA/JLI - SETUP ALERTS (OVERFLOW) ;4/9/07 10:26
2 ;;8.0;KERNEL;**285,443**;Jul 10, 1995;Build 4
3 ;;
4 Q
5GROUP ;
6 N XQI,XQL,XQL1,XQL2,XQLIST
7 S XQL=$E(XQJ,3,$L(XQJ)) ; P443 - changed from code that forced upper case
8 I $D(^TMP("XQAGROUP",$J,XQL)) Q ; P443 group has already been processed - prevent cycling
9 S ^TMP("XQAGROUP",$J,XQL)="" ; P443 mark that the group has been seen
10 S XQI=$$FIND1^DIC(3.8,,"X",XQL) Q:XQI'>0
11 N XQLIST D LIST^DIC(3.81,","_XQI_",",".01","I",,,,,,,.XQLIST) I XQLIST("ORDER")>0 D
12 . N XQI F XQI=0:0 S XQI=$O(@XQLIST@("ID",XQI)) Q:XQI'>0 S XQA(^(XQI,.01))=""
13 . Q
14 K @XQLIST,XQLIST D LIST^DIC(3.811,","_XQI_",",".01",,,,,,,,.XQLIST) I XQLIST("ORDER")>0 D
15 . N XQAGROUP M XQAGROUP=@XQLIST@("ID") ; P443 - store group list data locally so it is not over written by recursive call to LIST^DIC
16 . N XQI F XQI=0:0 S XQI=$O(XQAGROUP(XQI)) Q:XQI'>0 N XQJ S XQJ="G."_XQAGROUP(XQI,.01) D GROUP ; P443 - change to reference XQAGROUP
17 . Q
18 K @XQLIST,XQLIST
19 K XQA(XQJ)
20 D CHEKACTV(.XQA)
21 Q
22 ;
23 ; Check and remove any entries in array that don't have active surrogates and aren't active
24CHEKACTV(XQARRAY) ;
25 N XQJ
26 F XQJ=0:0 S XQJ=$O(XQARRAY(XQJ)) Q:XQJ'>0 I $$CHEKUSER(XQJ)'>0 K XQARRAY(XQJ)
27 Q
28 ;
29CHEKUSER(XQAUSER) ; Returns 0 if no valid user or surrogate, otherwise returns IEN of user or surrogate
30 N VALUE
31 S VALUE=$$ACTVSURO^XQALSURO(XQAUSER)
32 I VALUE'>0 S VALUE=XQAUSER I '$$ACTIVE^XUSER(XQAUSER) Q 0
33 Q VALUE
34 ;
Note: See TracBrowser for help on using the repository browser.