| 1 | XQALSET1 ;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
|
|---|
| 5 | GROUP ;
|
|---|
| 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
|
|---|
| 24 | CHEKACTV(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 | ;
|
|---|
| 29 | CHEKUSER(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 | ;
|
|---|
