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/XQALSET.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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/XQALSET.m
r613 r623 1 XQALSET ;ISC-SF.SEA/JLI - SETUP ALERTS ;4/10/07 14:06 2 ;;8.0;KERNEL;**1,6,65,75,114,125,173,207,285,443**;Jul 10, 1995;Build 4 3 ;; 4 Q 5 ; Original entry point - throw away return value since no value expected 6 SETUP ; 7 N I S I=$$SETUP1() K XQALERR 8 Q 9 ; 10 SETUP1() ; .SR Returns a string beginning with 1 if successful, 0 if not successful, the second piece is the IEN in the Alert Tracking File and the third piece is the value of XQAID. 11 ; If not successful XQALERR is defined and contains reason for failure. 12 K XQALERR 13 I $O(XQA(0))="" S XQALERR="No recipient list in XQA array" Q 0 14 I '($D(XQAMSG)#2)!($G(XQAMSG)="") S XQALERR="No valid XQAMSG for display" Q 0 15 N X,XQI,XQJ,XQX,XQK,XQACOMNT,XQARESET,DA,XQADA,XQALTYPE 16 S XQALTYPE="INITIAL RECIPIENT" 17 S XQAOPT1=$S('($D(XQAROU)#2):U,XQAROU'[U:U_XQAROU,1:XQAROU),XQAOPT1=$S(XQAOPT1'=U:XQAOPT1,$D(XQAOPT)#2:XQAOPT_U,1:XQAOPT1) S:XQAOPT1=U XQAOPT1=U_" " 18 NOW S XQX=$$NOW^XLFDT() 19 S:$S('$D(XQAID):1,XQAID="":1,1:0) XQAID="NO-ID" S:XQAID[";" XQAID=$P(XQAID,";") S XQA1=XQAID,XQI=XQX 20 S XQAID=$$SETIEN(XQA1,XQX),XQADA="" 21 Q $$REENT() 22 ; 23 REENT() ; Entry for forwarding, etc. 24 N RETVAL S RETVAL=1 25 K ^TMP("XQAGROUP",$J) ; P443 - clear location for storage of groups processed 26 N XQADATIM,XQALIST,XQALIST1,XQNRECIP S XQNRECIP=0 S XQADATIM=$$NOW^XLFDT() 27 S XQALIN1=$S($D(XQAID)#2:XQAID,1:"")_U_$E(XQAMSG,1,80)_"^1^"_$S(XQAOPT1=U:"D",1:"R")_U_$S($D(XQACTMSG):$E(XQACTMSG,1,40),1:"")_U_XQAOPT1 28 S:$D(XQACNDEL) $P(XQALIN1,U,9)=1 S:$D(XQASURO) $P(XQALIN1,U,12)=XQASURO S:$D(XQASUPV) $P(XQALIN1,U,13)=XQASUPV S:$D(XQAREVUE) $P(XQALIN1,U,14)=XQAREVUE 29 S XQALIN=XQX_U_XQALIN1,XQJ=0 30 K XQALIN1 S:$D(XQADATA) XQALIN1=XQADATA 31 LOOP1 S XQJ=$O(XQA(" ")) I XQJ'="" K:"G.g."'[$E(XQJ_",,",1,2) XQA(XQJ) D:$D(XQA(XQJ)) GROUP^XQALSET1 G LOOP1 32 LOOP2 ; RE-ENTRY FOR FORWARDING IF ALL RECIPIENTS ARE UNDELIVERABLE 33 N:'$D(XQAUSER) XQAUSER M XQALIST=XQA F I=0:0 S I=$O(XQALIST(I)) Q:I'>0 S XQALIST(I,XQALTYPE)="" I '$D(XQAUSER) S XQAUSER=I ; SAVE ORIGINAL LIST OF RECIPIENTS AND REASON 34 ; The following section of code was added to provide a generalized way to handle surrogates 35 F XQJ=0:0 S XQJ=$O(XQA(XQJ)) Q:XQJ="" D 36 . N X S X=$$ACTVSURO^XQALSURO(XQJ) I X>0 D ; Modified to get final surrogate if a sequence of them 37 . . S XQA(X)="" K XQA(XQJ) ; Add Surrogate to XQA array, delete XQJ entry 38 . . S XQALIST(X,$O(XQALIST(XQJ,""))_"-SURROGATE")="" ; Add Surrogate to XQALIST with same type as original 39 . . S XQALIST(X,"z AS_SURO",XQJ)="" ; Mark user as in list as a surrogate, subscript for surrogate to 40 . . S XQALIST(XQJ,"z TO_SURO",X)="" 41 . . Q 42 . Q 43 ; 44 S XQJ=0 45 LOOP ; 46 S XQJ=$O(XQA(XQJ)) G:XQJ="" WRAP 47 ; 48 I '(+$$ACTIVE^XUSER(XQJ)) K XQA(XQJ) N XX S XX=$O(XQALIST(XQJ,"")) K XQALIST(XQJ,XX) S XQALIST(XQJ,XX_"-UNDELIVERABLE")="" G LOOP ;Don't send to users that can't sign-on 49 ; 50 I '$D(^XTV(8992,XQJ,0)) D I '$D(^XTV(8992,XQJ,0)) S ^(0)=XQJ 51 . N FDA,IENS 52 . F D Q:'$D(DIERR) Q:'$D(^TMP("DIERR",$J,"E",110))&'$D(^TMP("DIERR",$J,"E",111)) 53 . . K DIERR,^TMP("DIERR",$J) 54 . . S FDA=$NA(^TMP($J,"XQALSET")) K @FDA S @FDA@(8992,"+1,",.01)=XQJ 55 . . S IENS(1)=XQJ 56 . . D UPDATE^DIE("S",FDA,"IENS") 57 . . Q 58 . Q 59 L +^XTV(8992,XQJ):10 S XQXI=XQX S:'$D(^XTV(8992,XQJ,"XQA",0)) ^(0)="^8992.01DA^" 60 REP I $D(^XTV(8992,XQJ,"XQA",XQXI,0)) S XQXI=XQXI+.00000001 G REP 61 S ^XTV(8992,XQJ,"XQA",XQXI,0)=XQALIN S:$D(XQALIN1) ^(1)=XQALIN1 S:$D(XQAGUID)!$D(XQADFN) ^(3)=$G(XQAGUID)_U_$G(XQADFN) S:$D(XQARESET) ^(2)=XQAUSER_U_XQX_U_$G(XQACOMNT) S ^(0)=$P(^XTV(8992,XQJ,"XQA",0),U,1,2)_U_XQXI_U_($P(^(0),U,4)+1) 62 I $D(XQATEXT) S:($D(XQATEXT)#2) XQATEXT(.1)=XQATEXT D WP^DIE(8992.01,(XQXI_","_XQJ_","),4,"","XQATEXT") ; P443 PUT DATA IN XQATEXT INTO ARRAY 63 L -^XTV(8992,XQJ) 64 K XQA(XQJ) S:XQAID'="" ^XTV(8992,"AXQA",XQAID,XQJ,XQXI)="",^XTV(8992,"AXQAN",XQA1,XQJ,XQXI)="" 65 S XQNRECIP=XQNRECIP+1 66 G LOOP 67 ; 68 WRAP ; 69 M XQALIST1=XQALIST 70 I XQNRECIP=0,'$$SNDNACTV(XQAID) S RETVAL=0,XQALERR="NO ACTIVE RECIPIENTS - OLDER TIU ALERTS" 71 E I XQNRECIP=0 D I $D(XQA) S XQACOMNT=$E("None of recipients were active users. "_$G(XQACOMNT),1,245),XQNRECIP=1,XQARESET=1 K XQALIST G LOOP2 ; SET NUMBER OF RECIPIENTS TO 1 SO WE WON'T COME HERE AGAIN 72 . N XQAA,XQJ F XQI=0:0 S XQI=$O(XQALIST(XQI)) Q:XQI'>0 D GETBKUP^XQALDEL(.XQAA,XQI) S XQALTYPE="BACKUP REVIEWER" F XQJ=0:0 S XQJ=$O(XQAA(XQJ)) Q:XQJ'>0 S XQA(XQAA(XQJ))="" 73 . I $D(XQA) D CHEKACTV^XQALSET1(.XQA) 74 . I '$D(XQA) S XQJ="G.XQAL UNPROCESSED ALERTS" D GROUP^XQALSET1 S XQALTYPE="UNPROCESSED ALERTS MAIL GROUP" ;D GETMLGRP(.XQA,XQI) ; COULDN'T FIND ANY BACKUP, GET A MAILGROUP AND MEMBERS TO SEND IT TO 75 . I '$D(XQA) S XQJ="G.PATCHES" D GROUP^XQALSET1 S XQALTYPE="LAST HOPE" ; Last gasp, send it to G.PATCHES 76 . I '$D(XQA) S XQJ="G.PATCH" D GROUP^XQALSET1 S XQALTYPE="LAST HOPE" ; Last gasp, send it to G.PATCH 77 . I '$D(XQA) S RETVAL=0,XQALERR="Could not find any active user to send it to" ; Should not get here, this is only if all backups and mail groups tried don't have any active users 78 . Q 79 ; END OF JLI 030129 INSERTION P285 80 ; moved recording of users in Alert Tracking file to here to include all of them 030220 81 ; modified code to use FM calls instead of direct global references 82 I RETVAL,$G(XQADA)'>0,XQAID'="" D SETTRACK ; moved to here to avoid tracking entries with no users 83 ; 84 I RETVAL,$G(XQADA)>0 L +^XTV(8992.1,XQADA):10 D L -^XTV(8992.1,XQADA) ; 030131 85 . F XQJ=0:0 S XQJ=$O(XQALIST1(XQJ)) Q:XQJ'>0 D 86 . . N NCOUNT,SUBSCRPT,SUBSCRPN,KCNT,IENVAL 87 . . S IENVAL=XQADA_",",KCNT=$$FIND1^DIC(8992.11,","_IENVAL,"Q",XQJ) 88 . . S FDA=$NA(^TMP($J,"XQALSET")) K @FDA I KCNT=0 S @FDA@(8992.11,"+1,"_IENVAL,.01)=XQJ,KCNT="+1" 89 . . S IENVAL=","_KCNT_","_IENVAL,NCOUNT=1 S SUBSCRPT="" F S SUBSCRPT=$O(XQALIST1(XQJ,SUBSCRPT)) Q:SUBSCRPT="" I $E(SUBSCRPT,1)'="z" D 90 . . . S SUBSCRPN=$$FIND1^DIC(8992.2,"","X",SUBSCRPT) I SUBSCRPN'>0 D 91 . . . . N FDA1,IENROOT S FDA1=$NA(^TMP($J,"XQALSET1")) K @FDA1 S @FDA1@(8992.2,"+1,",.01)=SUBSCRPT D UPDATE^DIE("",FDA1,"IENROOT") S SUBSCRPN=$G(IENROOT(1)) 92 . . . . Q 93 . . . S NCOUNT=NCOUNT+1,@FDA@(8992.111,"+"_NCOUNT_IENVAL,.01)=SUBSCRPN,@FDA@(8992.111,"+"_NCOUNT_IENVAL,.04)=XQADATIM 94 . . . Q 95 . . I $D(XQALIST1(XQJ,"z TO_SURO")) S @FDA@(8992.111,"+"_NCOUNT_IENVAL,.02)=$O(XQALIST1(XQJ,"z TO_SURO",0)) 96 . . I $D(XQALIST1(XQJ,"z AS_SURO")) D 97 . . . S @FDA@(8992.111,"+"_NCOUNT_IENVAL,.03)="Y" 98 . . . N XQK S NCOUNT=NCOUNT+1 F XQK=0:0 S XQK=$O(XQALIST1(XQJ,"z AS_SURO",XQK)) Q:XQK'>0 S @FDA@(8992.113,"+"_NCOUNT_IENVAL,.01)=XQK,@FDA@(8992.113,"+"_NCOUNT_IENVAL,.02)=XQADATIM 99 . . . Q 100 . . S SUBSCRPT=$O(XQALIST1(XQJ,"")) I SUBSCRPT'["INITIAL" S SUBSCRPT=$P(SUBSCRPT,"-") D ; FORWARDING 101 . . . S SUBSCRPN=$$FIND1^DIC(8992.2,"","X",SUBSCRPT) I SUBSCRPN'>0 D 102 . . . . N FDA1,IENROOT S FDA1=$NA(^TMP($J,"XQALSET1")) K @FDA1 S @FDA1@(8992.2,"+1,",.01)=SUBSCRPT D UPDATE^DIE("",FDA1,"IENROOT") S SUBSCRPN=$G(IENROOT(1)) 103 . . . . Q 104 . . . S NCOUNT=NCOUNT+1,@FDA@(8992.112,"+"_NCOUNT_IENVAL,.01)=XQADATIM,@FDA@(8992.112,"+"_NCOUNT_IENVAL,.02)=SUBSCRPN I $G(XQACOMNT)'="" S @FDA@(8992.112,"+"_NCOUNT_IENVAL,1.01)=XQACOMNT 105 . . . I $G(XQAUSER)>0 S @FDA@(8992.112,"+"_NCOUNT_IENVAL,.03)=XQAUSER 106 . . . Q 107 . . N IENSTR D UPDATE^DIE("",FDA,"IENSTR") 108 . . Q 109 . Q 110 ; 111 I RETVAL S RETVAL=RETVAL_U_$G(XQADA)_U_XQAID 112 K:XQAID'="" ^XTV(8992,"AXQA",XQAID,0,0) 113 K ^TMP("XQAGROUP",$J) ; P443 - clear global used to track processing of groups 114 K XQA,XQALIN,XQALIN1,XQAMSG,XQAID,XQAFLG,XQAOPT,XQAOPT1,XQAROU,XQADATA,XQI,XQX,XQJ,XQK,XQA1,XQACTMSG,XQJ,XQXI,XQAARCH,XQACNDEL,XQAREVUE,XQASUPV,XQASURO,XQATEXT 115 Q RETVAL 116 ; 117 SNDNACTV(XQAID) ; Determine if we go ahead and send alerts addressed only to inactive users to backup reviewers 118 N XVAL 119 I $E(XQAID,1,3)="TIU" S XVAL=$E($P(XQAID,";"),4,99),XVAL=$$GET1^DIQ(8925,XVAL_",",1201,"I") I XVAL>0,$$FMDIFF^XLFDT(DT,XVAL)>60 Q 0 120 Q 1 121 ; 122 SETIEN(XQA1,XQI) ; determine unique XQAID value for alert 123 N XQAID 124 S:$G(XQA1)="" XQA1="NO-ID" F S XQAID=XQA1_";"_DUZ_";"_XQI L +^XTV(8992,"AXQA",XQAID):10 D L -^XTV(8992,"AXQA",XQAID) Q:XQI="" S XQI=XQI+.00000001 125 . I $D(^XTV(8992,"AXQA",XQAID)) Q 126 . S ^XTV(8992,"AXQA",XQAID,0,0)="",XQI="" 127 . Q 128 Q XQAID 129 ; 130 SETTRACK ; Setup entry in Alert Tracking file 131 ; Note: if there are error messages or we can't create an entry for some reason, it simply returns and continues 132 N FDA,IENS,XQA2,DIERR 133 S XQADA=0 134 S XQA2=XQA1 I XQA2[",",$P(XQA2,",",3)'="" S XQA2=$P(XQA2,",")_","_$P(XQA2,",",3) 135 F D Q:'$D(DIERR) Q:'$D(^TMP("DIERR",$J,"E",111)) 136 . K DIERR,^TMP("DIERR",$J) 137 . S FDA=$NA(^TMP($J,"XQALSET")) K @FDA 138 . S @FDA@(8992.1,"+1,",.01)=XQAID D UPDATE^DIE("",FDA,"IENS") 139 . K @FDA 140 . Q 141 I $D(DIERR) Q ;S XQDIERR1=DIERR M XQDIERR=^TMP("DIERR",$J) Q 142 Q:IENS(1)'>0 S (DA,XQADA)=IENS(1) 143 S IENS=IENS(1)_",",@FDA@(8992.1,IENS,.02)=XQX,^(.03)=XQA2,^(.05)=DUZ,^(1.01)=XQAMSG 144 I $D(XQAARCH) S X=$$FMADD^XLFDT(DT,XQAARCH) I X>DT S @FDA@(8992.1,IENS,.08)=X 145 I $P(XQA1,",")="OR",$P(XQA1,",",2)>0 S @FDA@(8992.1,IENS,.04)=$P(XQA1,",",2) 146 I $D(ZTQUEUED) S @FDA@(8992.1,IENS,.06)=1 147 I $D(XQAOPT)#2 S @FDA@(8992.1,IENS,1.02)=XQAOPT 148 I $D(XQAROU)#2 N XQAXX S XQAXX=$S(XQAROU[U:XQAROU,1:U_XQAROU) I $P(XQAXX,U,2)'="" S:$P(XQAXX,U)'="" @FDA@(8992.1,IENS,1.03)=$P(XQAXX,U) S @FDA@(8992.1,IENS,1.04)=$P(XQAXX,U,2) 149 I $D(XQACTMSG) S @FDA@(8992.1,IENS,1.05)=XQACTMSG 150 I $D(XQADATA) S @FDA@(8992.1,IENS,2)=XQADATA 151 I $D(XQAGUID) S @FDA@(8992.1,IENS,3.01)=XQAGUID 152 I $D(XQADFN) S @FDA@(8992.1,IENS,.04)=XQADFN 153 D FILE^DIE("KS",FDA) 154 I $D(XQATEXT) D WP^DIE(8992.1,IENS,4,"","XQATEXT") 155 Q 156 ; 157 CHEKUSER(XQAUSER) ; .SR Returns 0 if no valid user or surrogate, otherwise returns IEN of user or surrogate 158 Q $$CHEKUSER^XQALSET1(XQAUSER) 159 ; 1 XQALSET ;ISC-SF.SEA/JLI - SETUP ALERTS ;6/24/04 13:46 2 ;;8.0;KERNEL;**1,6,65,75,114,125,173,207,285**;Jul 10, 1995 3 ;; 4 Q 5 ; Original entry point - throw away return value since no value expected 6 SETUP ; 7 N I S I=$$SETUP1() K XQALERR 8 Q 9 ; 10 SETUP1() ; .SR Returns a string beginning with 1 if successful, 0 if not successful, the second piece is the IEN in the Alert Tracking File and the third piece is the value of XQAID. 11 ; If not successful XQALERR is defined and contains reason for failure. 12 K XQALERR 13 I $O(XQA(0))="" S XQALERR="No recipient list in XQA array" Q 0 14 I '($D(XQAMSG)#2)!($G(XQAMSG)="") S XQALERR="No valid XQAMSG for display" Q 0 15 N X,XQI,XQJ,XQX,XQK,XQACOMNT,XQARESET,DA,XQADA,XQALTYPE 16 S XQALTYPE="INITIAL RECIPIENT" 17 S XQAOPT1=$S('($D(XQAROU)#2):U,XQAROU'[U:U_XQAROU,1:XQAROU),XQAOPT1=$S(XQAOPT1'=U:XQAOPT1,$D(XQAOPT)#2:XQAOPT_U,1:XQAOPT1) S:XQAOPT1=U XQAOPT1=U_" " 18 NOW S XQX=$$NOW^XLFDT() 19 S:$S('$D(XQAID):1,XQAID="":1,1:0) XQAID="NO-ID" S:XQAID[";" XQAID=$P(XQAID,";") S XQA1=XQAID,XQI=XQX 20 S XQAID=$$SETIEN(XQA1,XQX),XQADA="" 21 Q $$REENT() 22 ; 23 REENT() ; Entry for forwarding, etc. 24 N RETVAL S RETVAL=1 25 N XQADATIM,XQALIST,XQALIST1,XQNRECIP S XQNRECIP=0 S XQADATIM=$$NOW^XLFDT() 26 S XQALIN1=$S($D(XQAID)#2:XQAID,1:"")_U_$E(XQAMSG,1,80)_"^1^"_$S(XQAOPT1=U:"D",1:"R")_U_$S($D(XQACTMSG):$E(XQACTMSG,1,40),1:"")_U_XQAOPT1 27 S:$D(XQACNDEL) $P(XQALIN1,U,9)=1 S:$D(XQASURO) $P(XQALIN1,U,12)=XQASURO S:$D(XQASUPV) $P(XQALIN1,U,13)=XQASUPV S:$D(XQAREVUE) $P(XQALIN1,U,14)=XQAREVUE 28 S XQALIN=XQX_U_XQALIN1,XQJ=0 29 K XQALIN1 S:$D(XQADATA) XQALIN1=XQADATA 30 LOOP1 S XQJ=$O(XQA(" ")) I XQJ'="" K:"G.g."'[$E(XQJ_",,",1,2) XQA(XQJ) D:$D(XQA(XQJ)) GROUP^XQALSET1 G LOOP1 31 LOOP2 ; RE-ENTRY FOR FORWARDING IF ALL RECIPIENTS ARE UNDELIVERABLE 32 N:'$D(XQAUSER) XQAUSER M XQALIST=XQA F I=0:0 S I=$O(XQALIST(I)) Q:I'>0 S XQALIST(I,XQALTYPE)="" I '$D(XQAUSER) S XQAUSER=I ; SAVE ORIGINAL LIST OF RECIPIENTS AND REASON 33 ; The following section of code was added to provide a generalized way to handle surrogates 34 F XQJ=0:0 S XQJ=$O(XQA(XQJ)) Q:XQJ="" D 35 . N X S X=$$ACTVSURO^XQALSURO(XQJ) I X>0 D ; Modified to get final surrogate if a sequence of them 36 . . S XQA(X)="" K XQA(XQJ) ; Add Surrogate to XQA array, delete XQJ entry 37 . . S XQALIST(X,$O(XQALIST(XQJ,""))_"-SURROGATE")="" ; Add Surrogate to XQALIST with same type as original 38 . . S XQALIST(X,"z AS_SURO",XQJ)="" ; Mark user as in list as a surrogate, subscript for surrogate to 39 . . S XQALIST(XQJ,"z TO_SURO",X)="" 40 . . Q 41 . Q 42 ; 43 S XQJ=0 44 LOOP ; 45 S XQJ=$O(XQA(XQJ)) G:XQJ="" WRAP 46 ; 47 I '(+$$ACTIVE^XUSER(XQJ)) K XQA(XQJ) N XX S XX=$O(XQALIST(XQJ,"")) K XQALIST(XQJ,XX) S XQALIST(XQJ,XX_"-UNDELIVERABLE")="" G LOOP ;Don't send to users that can't sign-on 48 ; 49 I '$D(^XTV(8992,XQJ,0)) D I '$D(^XTV(8992,XQJ,0)) S ^(0)=XQJ 50 . N FDA,IENS 51 . F D Q:'$D(DIERR) Q:'$D(^TMP("DIERR",$J,"E",110))&'$D(^TMP("DIERR",$J,"E",111)) 52 . . K DIERR,^TMP("DIERR",$J) 53 . . S FDA=$NA(^TMP($J,"XQALSET")) K @FDA S @FDA@(8992,"+1,",.01)=XQJ 54 . . S IENS(1)=XQJ 55 . . D UPDATE^DIE("S",FDA,"IENS") 56 . . Q 57 . Q 58 L +^XTV(8992,XQJ):10 S XQXI=XQX S:'$D(^XTV(8992,XQJ,"XQA",0)) ^(0)="^8992.01DA^" 59 REP I $D(^XTV(8992,XQJ,"XQA",XQXI,0)) S XQXI=XQXI+.00000001 G REP 60 S ^XTV(8992,XQJ,"XQA",XQXI,0)=XQALIN S:$D(XQALIN1) ^(1)=XQALIN1 S:$D(XQAGUID)!$D(XQADFN) ^(3)=$G(XQAGUID)_U_$G(XQADFN) S:$D(XQARESET) ^(2)=XQAUSER_U_XQX_U_$G(XQACOMNT) S ^(0)=$P(^XTV(8992,XQJ,"XQA",0),U,1,2)_U_XQXI_U_($P(^(0),U,4)+1) 61 I $D(XQATEXT) D WP^DIE(8992.01,(XQXI_","_XQJ_","),4,"","XQATEXT") 62 L -^XTV(8992,XQJ) 63 K XQA(XQJ) S:XQAID'="" ^XTV(8992,"AXQA",XQAID,XQJ,XQXI)="",^XTV(8992,"AXQAN",XQA1,XQJ,XQXI)="" 64 S XQNRECIP=XQNRECIP+1 65 G LOOP 66 ; 67 WRAP ; 68 M XQALIST1=XQALIST 69 I XQNRECIP=0,'$$SNDNACTV(XQAID) S RETVAL=0,XQALERR="NO ACTIVE RECIPIENTS - OLDER TIU ALERTS" 70 E I XQNRECIP=0 D I $D(XQA) S XQACOMNT=$E("None of recipients were active users. "_$G(XQACOMNT),1,245),XQNRECIP=1,XQARESET=1 K XQALIST G LOOP2 ; SET NUMBER OF RECIPIENTS TO 1 SO WE WON'T COME HERE AGAIN 71 . N XQAA,XQJ F XQI=0:0 S XQI=$O(XQALIST(XQI)) Q:XQI'>0 D GETBKUP^XQALDEL(.XQAA,XQI) S XQALTYPE="BACKUP REVIEWER" F XQJ=0:0 S XQJ=$O(XQAA(XQJ)) Q:XQJ'>0 S XQA(XQAA(XQJ))="" 72 . I $D(XQA) D CHEKACTV^XQALSET1(.XQA) 73 . I '$D(XQA) S XQJ="G.XQAL UNPROCESSED ALERTS" D GROUP^XQALSET1 S XQALTYPE="UNPROCESSED ALERTS MAIL GROUP" ;D GETMLGRP(.XQA,XQI) ; COULDN'T FIND ANY BACKUP, GET A MAILGROUP AND MEMBERS TO SEND IT TO 74 . I '$D(XQA) S XQJ="G.PATCHES" D GROUP^XQALSET1 S XQALTYPE="LAST HOPE" ; Last gasp, send it to G.PATCHES 75 . I '$D(XQA) S XQJ="G.PATCH" D GROUP^XQALSET1 S XQALTYPE="LAST HOPE" ; Last gasp, send it to G.PATCH 76 . I '$D(XQA) S RETVAL=0,XQALERR="Could not find any active user to send it to" ; Should not get here, this is only if all backups and mail groups tried don't have any active users 77 . Q 78 ; END OF JLI 030129 INSERTION P285 79 ; moved recording of users in Alert Tracking file to here to include all of them 030220 80 ; modified code to use FM calls instead of direct global references 81 I RETVAL,$G(XQADA)'>0,XQAID'="" D SETTRACK ; moved to here to avoid tracking entries with no users 82 ; 83 I RETVAL,$G(XQADA)>0 L +^XTV(8992.1,XQADA):10 D L -^XTV(8992.1,XQADA) ; 030131 84 . F XQJ=0:0 S XQJ=$O(XQALIST1(XQJ)) Q:XQJ'>0 D 85 . . N NCOUNT,SUBSCRPT,SUBSCRPN,KCNT,IENVAL 86 . . S IENVAL=XQADA_",",KCNT=$$FIND1^DIC(8992.11,","_IENVAL,"Q",XQJ) 87 . . S FDA=$NA(^TMP($J,"XQALSET")) K @FDA I KCNT=0 S @FDA@(8992.11,"+1,"_IENVAL,.01)=XQJ,KCNT="+1" 88 . . S IENVAL=","_KCNT_","_IENVAL,NCOUNT=1 S SUBSCRPT="" F S SUBSCRPT=$O(XQALIST1(XQJ,SUBSCRPT)) Q:SUBSCRPT="" I $E(SUBSCRPT,1)'="z" D 89 . . . S SUBSCRPN=$$FIND1^DIC(8992.2,"","X",SUBSCRPT) I SUBSCRPN'>0 D 90 . . . . N FDA1,IENROOT S FDA1=$NA(^TMP($J,"XQALSET1")) K @FDA1 S @FDA1@(8992.2,"+1,",.01)=SUBSCRPT D UPDATE^DIE("",FDA1,"IENROOT") S SUBSCRPN=$G(IENROOT(1)) 91 . . . . Q 92 . . . S NCOUNT=NCOUNT+1,@FDA@(8992.111,"+"_NCOUNT_IENVAL,.01)=SUBSCRPN,@FDA@(8992.111,"+"_NCOUNT_IENVAL,.04)=XQADATIM 93 . . . Q 94 . . I $D(XQALIST1(XQJ,"z TO_SURO")) S @FDA@(8992.111,"+"_NCOUNT_IENVAL,.02)=$O(XQALIST1(XQJ,"z TO_SURO",0)) 95 . . I $D(XQALIST1(XQJ,"z AS_SURO")) D 96 . . . S @FDA@(8992.111,"+"_NCOUNT_IENVAL,.03)="Y" 97 . . . N XQK S NCOUNT=NCOUNT+1 F XQK=0:0 S XQK=$O(XQALIST1(XQJ,"z AS_SURO",XQK)) Q:XQK'>0 S @FDA@(8992.113,"+"_NCOUNT_IENVAL,.01)=XQK,@FDA@(8992.113,"+"_NCOUNT_IENVAL,.02)=XQADATIM 98 . . . Q 99 . . S SUBSCRPT=$O(XQALIST1(XQJ,"")) I SUBSCRPT'["INITIAL" S SUBSCRPT=$P(SUBSCRPT,"-") D ; FORWARDING 100 . . . S SUBSCRPN=$$FIND1^DIC(8992.2,"","X",SUBSCRPT) I SUBSCRPN'>0 D 101 . . . . N FDA1,IENROOT S FDA1=$NA(^TMP($J,"XQALSET1")) K @FDA1 S @FDA1@(8992.2,"+1,",.01)=SUBSCRPT D UPDATE^DIE("",FDA1,"IENROOT") S SUBSCRPN=$G(IENROOT(1)) 102 . . . . Q 103 . . . S NCOUNT=NCOUNT+1,@FDA@(8992.112,"+"_NCOUNT_IENVAL,.01)=XQADATIM,@FDA@(8992.112,"+"_NCOUNT_IENVAL,.02)=SUBSCRPN I $G(XQACOMNT)'="" S @FDA@(8992.112,"+"_NCOUNT_IENVAL,1.01)=XQACOMNT 104 . . . I $G(XQAUSER)>0 S @FDA@(8992.112,"+"_NCOUNT_IENVAL,.03)=XQAUSER 105 . . . Q 106 . . N IENSTR D UPDATE^DIE("",FDA,"IENSTR") 107 . . Q 108 . Q 109 ; 110 I RETVAL S RETVAL=RETVAL_U_$G(XQADA)_U_XQAID 111 K:XQAID'="" ^XTV(8992,"AXQA",XQAID,0,0) 112 K XQA,XQALIN,XQALIN1,XQAMSG,XQAID,XQAFLG,XQAOPT,XQAOPT1,XQAROU,XQADATA,XQI,XQX,XQJ,XQK,XQA1,XQACTMSG,XQJ,XQXI,XQAARCH,XQACNDEL,XQAREVUE,XQASUPV,XQASURO,XQATEXT 113 Q RETVAL 114 ; 115 SNDNACTV(XQAID) ; Determine if we go ahead and send alerts addressed only to inactive users to backup reviewers 116 N XVAL 117 I $E(XQAID,1,3)="TIU" S XVAL=$E($P(XQAID,";"),4,99),XVAL=$$GET1^DIQ(8925,XVAL_",",1201,"I") I XVAL>0,$$FMDIFF^XLFDT(DT,XVAL)>60 Q 0 118 Q 1 119 ; 120 SETIEN(XQA1,XQI) ; determine unique XQAID value for alert 121 N XQAID 122 S:$G(XQA1)="" XQA1="NO-ID" F S XQAID=XQA1_";"_DUZ_";"_XQI L +^XTV(8992,"AXQA",XQAID):10 D L -^XTV(8992,"AXQA",XQAID) Q:XQI="" S XQI=XQI+.00000001 123 . I $D(^XTV(8992,"AXQA",XQAID)) Q 124 . S ^XTV(8992,"AXQA",XQAID,0,0)="",XQI="" 125 . Q 126 Q XQAID 127 ; 128 SETTRACK ; Setup entry in Alert Tracking file 129 ; Note: if there are error messages or we can't create an entry for some reason, it simply returns and continues 130 N FDA,IENS,XQA2,DIERR 131 S XQADA=0 132 S XQA2=XQA1 I XQA2[",",$P(XQA2,",",3)'="" S XQA2=$P(XQA2,",")_","_$P(XQA2,",",3) 133 F D Q:'$D(DIERR) Q:'$D(^TMP("DIERR",$J,"E",111)) 134 . K DIERR,^TMP("DIERR",$J) 135 . S FDA=$NA(^TMP($J,"XQALSET")) K @FDA 136 . S @FDA@(8992.1,"+1,",.01)=XQAID D UPDATE^DIE("",FDA,"IENS") 137 . K @FDA 138 . Q 139 I $D(DIERR) Q ;S XQDIERR1=DIERR M XQDIERR=^TMP("DIERR",$J) Q 140 Q:IENS(1)'>0 S (DA,XQADA)=IENS(1) 141 S IENS=IENS(1)_",",@FDA@(8992.1,IENS,.02)=XQX,^(.03)=XQA2,^(.05)=DUZ,^(1.01)=XQAMSG 142 I $D(XQAARCH) S X=$$FMADD^XLFDT(DT,XQAARCH) I X>DT S @FDA@(8992.1,IENS,.08)=X 143 I $P(XQA1,",")="OR",$P(XQA1,",",2)>0 S @FDA@(8992.1,IENS,.04)=$P(XQA1,",",2) 144 I $D(ZTQUEUED) S @FDA@(8992.1,IENS,.06)=1 145 I $D(XQAOPT)#2 S @FDA@(8992.1,IENS,1.02)=XQAOPT 146 I $D(XQAROU)#2 N XQAXX S XQAXX=$S(XQAROU[U:XQAROU,1:U_XQAROU) I $P(XQAXX,U,2)'="" S:$P(XQAXX,U)'="" @FDA@(8992.1,IENS,1.03)=$P(XQAXX,U) S @FDA@(8992.1,IENS,1.04)=$P(XQAXX,U,2) 147 I $D(XQACTMSG) S @FDA@(8992.1,IENS,1.05)=XQACTMSG 148 I $D(XQADATA) S @FDA@(8992.1,IENS,2)=XQADATA 149 I $D(XQAGUID) S @FDA@(8992.1,IENS,3.01)=XQAGUID 150 I $D(XQADFN) S @FDA@(8992.1,IENS,.04)=XQADFN 151 D FILE^DIE("KS",FDA) 152 I $D(XQATEXT) D WP^DIE(8992.1,IENS,4,"","XQATEXT") 153 Q 154 ; 155 CHEKUSER(XQAUSER) ; .SR Returns 0 if no valid user or surrogate, otherwise returns IEN of user or surrogate 156 Q $$CHEKUSER^XQALSET1(XQAUSER) 157 ;
Note:
See TracChangeset
for help on using the changeset viewer.
