[623] | 1 | XQALSET1 ;ISC-SF.SEA/JLI - SETUP ALERTS (OVERFLOW) ;10/20/03 15:03
|
---|
| 2 | ;;8.0;KERNEL;**285**;Jul 10, 1995
|
---|
| 3 | ;;
|
---|
| 4 | Q
|
---|
| 5 | GROUP ;
|
---|
| 6 | N XQI,XQL,XQL1,XQL2,XQLIST
|
---|
| 7 | S XQL="" F XQI=3:1:$L(XQJ) S XQL1=$E(XQJ,XQI) S:XQL1?1L XQL1=$C($A(XQL1)-32) S XQL=XQL_XQL1
|
---|
| 8 | ;S XQI=$O(^XMB(3.8,"B",XQL,0)) I XQI'>0 S XQL1=$O(^XMB(3.8,"B",XQL)) I $E(XQL1,1,$L(XQL))=XQL S XQL2=$O(^(XQL1)) I $E(XQL2,1,$L(XQL))'=XQL S XQI=$O(^(XQL1,0))
|
---|
| 9 | ;I XQI>0 F XQL=0:0 S XQL=$O(^XMB(3.8,XQI,1,XQL)) Q:XQL'>0 S XQA(+^(XQL,0))=""
|
---|
| 10 | ; Above code replaced to use Fileman calls, also code added to walk through member groups as well 030203 JLI P285
|
---|
| 11 | S XQI=$$FIND1^DIC(3.8,,"X",XQL) Q:XQI'>0
|
---|
| 12 | N XQLIST D LIST^DIC(3.81,","_XQI_",",".01","I",,,,,,,.XQLIST) I XQLIST("ORDER")>0 D
|
---|
| 13 | . N XQI F XQI=0:0 S XQI=$O(@XQLIST@("ID",XQI)) Q:XQI'>0 S XQA(^(XQI,.01))=""
|
---|
| 14 | . Q
|
---|
| 15 | K @XQLIST,XQLIST D LIST^DIC(3.811,","_XQI_",",".01",,,,,,,,.XQLIST) I XQLIST("ORDER")>0 D
|
---|
| 16 | . N XQI F XQI=0:0 S XQI=$O(@XQLIST@("ID",XQI)) Q:XQI'>0 N XQJ S XQJ="G."_^(XQI,.01) D GROUP
|
---|
| 17 | . Q
|
---|
| 18 | K XQA(XQJ)
|
---|
| 19 | D CHEKACTV(.XQA)
|
---|
| 20 | Q
|
---|
| 21 | ;
|
---|
| 22 | ; Check and remove any entries in array that don't have active surrogates and aren't active
|
---|
| 23 | CHEKACTV(XQARRAY) ;
|
---|
| 24 | N XQJ
|
---|
| 25 | F XQJ=0:0 S XQJ=$O(XQARRAY(XQJ)) Q:XQJ'>0 I $$CHEKUSER(XQJ)'>0 K XQARRAY(XQJ)
|
---|
| 26 | Q
|
---|
| 27 | ;
|
---|
| 28 | CHEKUSER(XQAUSER) ;SR. Returns 0 if no valid user or surrogate, otherwise returns IEN of user or surrogate
|
---|
| 29 | N VALUE
|
---|
| 30 | S VALUE=$$ACTVSURO^XQALSURO(XQAUSER)
|
---|
| 31 | I VALUE'>0 S VALUE=XQAUSER I '$$ACTIVE^XUSER(XQAUSER) Q 0
|
---|
| 32 | Q VALUE
|
---|
| 33 | ;
|
---|