Changeset 623 for 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/XQALSET1.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• 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/XQALSET1.m (modified) (1 diff)

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/XQALSET1.m

@@ -1 @@
-XQALSET1        ;ISC-SF.SEA/JLI - SETUP ALERTS (OVERFLOW) ;4/9/07  10:26
-        ;;8.0;KERNEL;**285,443**;Jul 10, 1995;Build 4
-        ;;
-        Q
-GROUP   ;
-        N XQI,XQL,XQL1,XQL2,XQLIST
-        S XQL=$E(XQJ,3,$L(XQJ)) ; P443 - changed from code that forced upper case
-        I $D(^TMP("XQAGROUP",$J,XQL)) Q  ; P443 group has already been processed - prevent cycling
-        S ^TMP("XQAGROUP",$J,XQL)="" ; P443 mark that the group has been seen
-        S XQI=$$FIND1^DIC(3.8,,"X",XQL) Q:XQI'>0
-        N XQLIST D LIST^DIC(3.81,","_XQI_",",".01","I",,,,,,,.XQLIST) I XQLIST("ORDER")>0 D
-        . N XQI F XQI=0:0 S XQI=$O(@XQLIST@("ID",XQI)) Q:XQI'>0  S XQA(^(XQI,.01))=""
-        . Q
-        K @XQLIST,XQLIST D LIST^DIC(3.811,","_XQI_",",".01",,,,,,,,.XQLIST) I XQLIST("ORDER")>0 D
-        . N XQAGROUP M XQAGROUP=@XQLIST@("ID") ; P443 - store group list data locally so it is not over written by recursive call to LIST^DIC
-        . 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
-        . Q
-        K @XQLIST,XQLIST
-        K XQA(XQJ)
-        D CHEKACTV(.XQA)
-        Q
-        ;
-        ; Check and remove any entries in array that don't have active surrogates and aren't active
-CHEKACTV(XQARRAY)       ;
-        N XQJ
-        F XQJ=0:0 S XQJ=$O(XQARRAY(XQJ)) Q:XQJ'>0  I $$CHEKUSER(XQJ)'>0 K XQARRAY(XQJ)
-        Q
-        ;
-CHEKUSER(XQAUSER)       ; Returns 0 if no valid user or surrogate, otherwise returns IEN of user or surrogate
-        N VALUE
-        S VALUE=$$ACTVSURO^XQALSURO(XQAUSER)
-        I VALUE'>0 S VALUE=XQAUSER I '$$ACTIVE^XUSER(XQAUSER) Q 0
-        Q VALUE
-        ;
+XQALSET1 ;ISC-SF.SEA/JLI - SETUP ALERTS (OVERFLOW) ;10/20/03  15:03
+ ;;8.0;KERNEL;**285**;Jul 10, 1995
+ ;;
+ Q
+GROUP ; 
+ N XQI,XQL,XQL1,XQL2,XQLIST
+ 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
+ ;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))
+ ;I XQI>0 F XQL=0:0 S XQL=$O(^XMB(3.8,XQI,1,XQL)) Q:XQL'>0  S XQA(+^(XQL,0))=""
+ ;  Above code replaced to use Fileman calls, also code added to walk through member groups as well  030203 JLI P285
+ S XQI=$$FIND1^DIC(3.8,,"X",XQL) Q:XQI'>0
+ N XQLIST D LIST^DIC(3.81,","_XQI_",",".01","I",,,,,,,.XQLIST) I XQLIST("ORDER")>0 D
+ . N XQI F XQI=0:0 S XQI=$O(@XQLIST@("ID",XQI)) Q:XQI'>0  S XQA(^(XQI,.01))=""
+ . Q
+ K @XQLIST,XQLIST D LIST^DIC(3.811,","_XQI_",",".01",,,,,,,,.XQLIST) I XQLIST("ORDER")>0 D
+ . N XQI F XQI=0:0 S XQI=$O(@XQLIST@("ID",XQI)) Q:XQI'>0  N XQJ S XQJ="G."_^(XQI,.01) D GROUP
+ . Q
+ K XQA(XQJ)
+ D CHEKACTV(.XQA)
+ Q
+ ;
+ ; Check and remove any entries in array that don't have active surrogates and aren't active
+CHEKACTV(XQARRAY) ;
+ N XQJ
+ F XQJ=0:0 S XQJ=$O(XQARRAY(XQJ)) Q:XQJ'>0  I $$CHEKUSER(XQJ)'>0 K XQARRAY(XQJ)
+ Q
+ ;
+CHEKUSER(XQAUSER) ;SR. Returns 0 if no valid user or surrogate, otherwise returns IEN of user or surrogate
+ N VALUE
+ S VALUE=$$ACTVSURO^XQALSURO(XQAUSER)
+ I VALUE'>0 S VALUE=XQAUSER I '$$ACTIVE^XUSER(XQAUSER) Q 0
+ Q VALUE
+ ;