| [613] | 1 | XQALBUTL ; slc/CLA,ISC-SF.SEA/JLI - Utilities for OE/RR notifications ;8/26/03 15:21
|
|---|
| 2 | ;;8.0;KERNEL;**114,125,171,285**;Jul 10, 1995
|
|---|
| 3 | ; PROVIDES FUNCTIONALITY USED BY ORBUTL
|
|---|
| 4 | EN ;
|
|---|
| 5 | Q
|
|---|
| 6 | RECIPURG(XQX) ;called by option ORB PURG RECIP - purge existing notifs: recipient/DUZ
|
|---|
| 7 | N XQK,XQA,XQADAT S XQADAT=$$NOW^XLFDT()
|
|---|
| 8 | F XQK=0:0 S XQK=$O(^XTV(8992,XQX,"XQA",XQK)) Q:XQK'>0 S XQA=$P(^(XQK,0),"^",2) D OLDPURG
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | PTPURG(DFN) ;called by option ORB PURG PATIENT - purge existing notifs: patient
|
|---|
| 12 | N XQX,XQK,XQA,XQADAT S XQADAT=$$NOW^XLFDT()
|
|---|
| 13 | F XQX=0:0 S XQX=$O(^XTV(8992,XQX)) Q:XQX'>0 F XQK=0:0 S XQK=$O(^XTV(8992,XQX,"XQA",XQK)) Q:XQK'>0 S XQA=$P(^(XQK,0),"^",2) I $P($P(XQA,";"),",",2)=DFN D OLDPURG
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | NOTIPURG(Y) ;called by option ORB PURG NOTIF - purge existing notifs: notification
|
|---|
| 17 | N XQX,XQK,XQA,XQADAT S XQADAT=$$NOW^XLFDT()
|
|---|
| 18 | F XQX=0:0 S XQX=$O(^XTV(8992,XQX)) Q:XQX'>0 F XQK=0:0 S XQK=$O(^XTV(8992,XQX,"XQA",XQK)) Q:XQK'>0 S XQA=$P(^(XQK,0),"^",2) I $P($P(XQA,";"),",",3)=+Y D OLDPURG
|
|---|
| 19 | Q
|
|---|
| 20 | OLDPURG ;called by RECIPURG, PTPURG, NOTIPURG - KILLs specified alert entries
|
|---|
| 21 | N XQAID S XQAID=XQA D DELA^XQALDEL ; JLI 9-3-99 FIXES NULL SUBSCRIPT IN DELA+1^XQALDEL
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | AHISTORY(XQAID,ROOT) ; SR Returns information from alert tracking file for alert with XQAID as its alert ID. The data is returned desendent from the closed root passed in ROOT.
|
|---|
| 25 | N X
|
|---|
| 26 | K @ROOT
|
|---|
| 27 | S X=$O(^XTV(8992.1,"B",XQAID,0)) I X'>0 Q
|
|---|
| 28 | M @ROOT=^XTV(8992.1,X)
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | PENDING(XQAUSER,XQAID) ; SR. Returns whether the user specified has the alert indicated by XQAID pending. (1=YES, 0=NO)
|
|---|
| 32 | Q $D(^XTV(8992,"AXQA",XQAID,XQAUSER))/10
|
|---|
| 33 | ;
|
|---|
| 34 | PKGPEND(XQAUSER,XQAPKG) ; SR. Returns 1 if the user indicated by XQAUSER has any pending alerts with the first ';'-piece of XQAID contains the package identifier indicated by XQAPKG.
|
|---|
| 35 | N I,X
|
|---|
| 36 | F I=0:0 S X="",I=$O(^XTV(8992,XQAUSER,"XQA",I)) Q:I'>0 S X=$P($P(^(I,0),U,2),";") I X[XQAPKG Q
|
|---|
| 37 | Q $S(X'="":1,1:0)
|
|---|
| 38 | ;
|
|---|
| 39 | ALERTDAT(XQAID,ROOT) ; SR. Returns information from alert tracking file for alert with XQAID in array XQALERTD. If the alert is not present, the array is undefined.
|
|---|
| 40 | N IEN
|
|---|
| 41 | I $G(ROOT)="" S ROOT="XQALERTD"
|
|---|
| 42 | K @ROOT
|
|---|
| 43 | S IEN=$O(^XTV(8992.1,"B",XQAID,0)) I IEN'>0 S @ROOT="" Q
|
|---|
| 44 | D MAKELIST(ROOT,8992.1,(IEN_","))
|
|---|
| 45 | Q
|
|---|
| 46 | USERLIST(XQAID,ROOT) ; SR. Returns recipients of alert with ID of XQAID from alert tracking file in array XQALUSER
|
|---|
| 47 | N IEN,N,I,X
|
|---|
| 48 | I $G(ROOT)="" S ROOT="XQALUSRS"
|
|---|
| 49 | K @ROOT
|
|---|
| 50 | S IEN=$O(^XTV(8992.1,"B",XQAID,0)) I IEN'>0 S @ROOT="" Q
|
|---|
| 51 | S N=0 F I=0:0 S I=$O(^XTV(8992.1,IEN,20,I)) Q:I'>0 S N=N+1,X=+^(I,0),X=X_U_$$GET1^DIQ(8992.11,(I_","_IEN_","),.01),@ROOT@(N)=X
|
|---|
| 52 | Q
|
|---|
| 53 | USERDATA(XQAID,XQAUSER,ROOT) ; SR. returns information from alert tracking file related to alert with ID of XQAID for user specified by XQAUSER
|
|---|
| 54 | N IEN,IEN2
|
|---|
| 55 | I $G(ROOT)="" S ROOT="XQALUSER"
|
|---|
| 56 | K @ROOT
|
|---|
| 57 | S IEN=$O(^XTV(8992.1,"B",XQAID,0)) I IEN'>0 S @ROOT="" Q
|
|---|
| 58 | S IEN2=$O(^XTV(8992.1,IEN,20,"B",XQAUSER,0)) I IEN2'>0 S @ROOT="" Q
|
|---|
| 59 | D MAKELIST(ROOT,8992.11,(IEN2_","_IEN_","))
|
|---|
| 60 | Q
|
|---|
| 61 | MAKELIST(ARRAY,FILE,IENS) ; Makes a list of fields as subscripts in ARRAY with the values of the fields as the value. If internal and external differ, the value is given as internal^external.
|
|---|
| 62 | N ROOT,FIELD,X
|
|---|
| 63 | K @ARRAY
|
|---|
| 64 | S ROOT=$NA(^TMP("XQALMAKELIST",$J))
|
|---|
| 65 | K @ROOT
|
|---|
| 66 | D GETS^DIQ(FILE,IENS,"*","IE",ROOT)
|
|---|
| 67 | F FIELD=0:0 S FIELD=$O(@ROOT@(FILE,IENS,FIELD)) Q:FIELD'>0 S X=^(FIELD,"I") S:X'=^("E") X=X_U_^("E") S @ARRAY@(FIELD)=X,@ARRAY@(FIELD,$$GET1^DID(FILE,FIELD,"","LABEL"))=""
|
|---|
| 68 | K @ROOT
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | ;; DELSTAT - For the most recent alert with XQAIDVAL as the PackageID
|
|---|
| 72 | ;; passed in, on return array VALUES contains the DUZ for users in
|
|---|
| 73 | ;; VALUES along with an indicator of whether the alert has been
|
|---|
| 74 | ;; deleted or not, e.g., DUZ^0 if not deleted or DUZ^1 if deleted.
|
|---|
| 75 | ;; Note that contents of VALUES will be killed prior to building the
|
|---|
| 76 | ;; list.
|
|---|
| 77 | ;;
|
|---|
| 78 | ;; Example: D DELSTAT^XQALBUTL("OR;14765;23",.RESULTS)
|
|---|
| 79 | ;;
|
|---|
| 80 | ;; Returned: The value of RESULTS indicates the number of entries in
|
|---|
| 81 | ;; the array. The entries are then ordered in numerical
|
|---|
| 82 | ;; order in the RESULTS array.
|
|---|
| 83 | ;; RESULTS = 3
|
|---|
| 84 | ;; RESULTS(1) = "146^0" User 146 - not deleted
|
|---|
| 85 | ;; RESULTS(2) = "297^1" User 297 - deleted
|
|---|
| 86 | ;; RESULTS(3) = "673^0" User 673 - not deleted
|
|---|
| 87 | ;;
|
|---|
| 88 | DELSTAT(XQAIDVAL,VALUES) ; .SR
|
|---|
| 89 | N XQAX,XQADATE,XQAID,XQAFN,I,X,X1,X
|
|---|
| 90 | S XQAX=XQAIDVAL,XQADATE=0,XQAID="" K VALUES S VALUES=0
|
|---|
| 91 | F S XQAX=$O(^XTV(8992.1,"B",XQAX)) Q:XQAX'[XQAIDVAL I XQADATE<$P(XQAX,";",3) S XQADATE=$P(XQAX,";",3),XQAID=XQAX
|
|---|
| 92 | Q:XQAID="" S XQAFN=$O(^XTV(8992.1,"B",XQAID,0)) Q:XQAFN'>0
|
|---|
| 93 | F I=0:0 S I=$O(^XTV(8992.1,XQAFN,20,I)) Q:I'>0 S X=^(I,0),X1=+X,X2=($P(X,U,5)>0!($P(X,U,6)>0)),VALUES=VALUES+1,VALUES(VALUES)=X1_U_X2
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | BKUPREVW ;OPT - SET BACKUP REVIEWER(S) IN PARAMETER FILE - Moved from XQALDEL
|
|---|
| 97 | N DIR,DIRUT,XQALBKUP,XQALCASE,XQPARAM,ERR
|
|---|
| 98 | S XQPARAM="XQAL BACKUP REVIEWER"
|
|---|
| 99 | BK1 ; Select NEW PERSON entry as backup reviewer
|
|---|
| 100 | F S XQALBKUP=$$NEWPERSN() Q:$D(DIRUT) Q:XQALBKUP'>0 D Q:$D(DIRUT)
|
|---|
| 101 | . D LISTCURR(XQALBKUP)
|
|---|
| 102 | BK2 . ; Select Entity type for backup reviewer - XQALLAST indicates maximum number of choices, last is SYSTEM.
|
|---|
| 103 | . N XQALVALS,XQALLAST
|
|---|
| 104 | . S XQALLAST=4,XQALVALS(1)="User^200^USER^USR",XQALVALS(2)="Service^49^SERVICE^SRV",XQALVALS(3)="Division^4^DIVISION^DIV",XQALVALS(4)="System^"
|
|---|
| 105 | . F S XQALCASE=$$ENTTYPE(.XQALVALS,XQALLAST) Q:$D(DIRUT) Q:XQALCASE'>0 D K:X="" DIRUT Q:$D(DIRUT)
|
|---|
| 106 | . . ; Select individual in Entity for backup reviewer
|
|---|
| 107 | . . I XQALCASE<XQALLAST D
|
|---|
| 108 | . . . S DIR(0)="PO^"_$P(XQALVALS(XQALCASE),U,2)_":AEQM",DIR("A")="Select "_$P(XQALVALS(XQALCASE),U,3)_" to set "_$P(XQALBKUP,U,2)_" as BACKUP REVIEWER for"
|
|---|
| 109 | . . . F D ^DIR Q:Y'>0 S XQAENT=+Y D CHKCURR($P(XQALVALS(XQALCASE),U,4)_".`"_XQAENT,+XQALBKUP)
|
|---|
| 110 | . . . K DIR
|
|---|
| 111 | . . . Q
|
|---|
| 112 | . . ; Special handling for SYSTEM entity
|
|---|
| 113 | . . I XQALCASE=XQALLAST S Y=$$GET1^DIQ(8989.3,"1,",.01,"I") D CHKCURR("SYS.`"_Y,+XQALBKUP)
|
|---|
| 114 | . . Q
|
|---|
| 115 | . Q
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
| 118 | NEWPERSN() ;
|
|---|
| 119 | ; Select a Backup Reviewer, then select parameter cases for this Backup
|
|---|
| 120 | ; Reviewer. You may then select another Backup Reviewer for additional
|
|---|
| 121 | ; parameter cases if necessary.
|
|---|
| 122 | ;
|
|---|
| 123 | ; Select NEW PERSON entry to be BACKUP REVIEWER
|
|---|
| 124 | NEWLOOP ;
|
|---|
| 125 | W ! S DIR(0)="PO^200:AEQM",DIR("A")="Select NEW PERSON entry to be BACKUP REVIEWER",DIR("A",1)="Select a Backup Reviewer, then select parameter cases for this Backup"
|
|---|
| 126 | S DIR("A",2)="Reviewer. You may then select another Backup Reviewer for additional",DIR("A",3)="parameter cases if necessary.",DIR("A",4)=""
|
|---|
| 127 | D ^DIR K DIR I X="" K DIRUT
|
|---|
| 128 | I Y>0,'$$ACTIVE^XUSER(+Y) W !,$C(7),"This is not an ACTIVE USER... Select an Active user",! G NEWLOOP
|
|---|
| 129 | Q Y
|
|---|
| 130 | ;
|
|---|
| 131 | ENTTYPE(XQALVALS,XQALLAST) ;
|
|---|
| 132 | K DIR("A")
|
|---|
| 133 | S XQALCASE="" F I=1:1:XQALLAST S XQALCASE=XQALCASE_I_":"_$P(XQALVALS(I),U)_";"
|
|---|
| 134 | S DIR(0)="SO^"_XQALCASE D ^DIR K DIR I X="" K DIRUT
|
|---|
| 135 | Q Y
|
|---|
| 136 | ;
|
|---|
| 137 | CHKCURR(ENTITY,XQALBKUP) ;
|
|---|
| 138 | S XQAINST=$$GETINST(ENTITY,XQALBKUP)
|
|---|
| 139 | I XQAINST>0 D PUT^XPAR(ENTITY,XQPARAM,XQAINST,XQALBKUP,.ERR) W " ...Done"
|
|---|
| 140 | I XQAINST<0 D PUT^XPAR(ENTITY,XQPARAM,-XQAINST,"@",.ERR) W " ...Done"
|
|---|
| 141 | Q
|
|---|
| 142 | ;
|
|---|
| 143 | GETINST(ENTITY,XQALBKUP) ;
|
|---|
| 144 | N DIR,DIRUT,I,J,IMAX,XQAA,XQATYP,XQAI,Y,ISELF,IEN,XQAVAL
|
|---|
| 145 | D GETLST^XPAR(.XQAA,ENTITY,XQPARAM,"Q",.XQERR) I XQAA=0 Q 1
|
|---|
| 146 | LOOP ;
|
|---|
| 147 | W !,"There "_$S(XQAA=1:"is",1:"are")_" currently "_XQAA_" instance"_$S(XQAA>1:"s",1:"")_" for this entity"
|
|---|
| 148 | S ISELF=0
|
|---|
| 149 | F I=0:0 S I=$O(XQAA(I)) Q:I'>0 S IEN=+$P(XQAA(I),U,2) W !,?5,+XQAA(I),?10,$$GET1^DIQ(200,IEN_",",.01) S IMAX=+XQAA(I) I IEN=XQALBKUP S ISELF=+XQAA(I)
|
|---|
| 150 | S DIR(0)="S^"_$S(ISELF=0:";a:Add an instance;r:Replace an instance;",1:"")_"d:Delete an instance;q:Quit",DIR("A")="Select Action" D ^DIR K DIR I $D(DIRUT)!(Y="q") K DIRUT Q 0
|
|---|
| 151 | S XQATYP=Y I XQATYP="a" S J=0 D Q J
|
|---|
| 152 | . F XQAI=1:1 I +$G(XQAA(XQAI))'=XQAI S J=XQAI I J>0 Q
|
|---|
| 153 | E D Q:Y=0 0
|
|---|
| 154 | . S Y=IMAX I XQAA>1 S DIR(0)="N^1:"_IMAX,DIR("A")="Select Instance number to "_$S(XQATYP="r":"REPLACE",1:"DELETE") D ^DIR K DIR I $D(DIRUT) K DIRUT S Y=0 Q
|
|---|
| 155 | . F XQAI=1:1 Q:'$D(XQAA(XQAI)) I +XQAA(XQAI)=Y Q
|
|---|
| 156 | . I '$D(XQAA(XQAI)) S Y=-1
|
|---|
| 157 | I Y<0 W $C(7),!!,"To "_$S(XQATYP="r":"REPLACE",1:"DELETE")_" an entry enter an instance number from the list." G LOOP
|
|---|
| 158 | S XQAVAL=+Y I XQATYP="d" S XQAVAL=-Y
|
|---|
| 159 | Q XQAVAL
|
|---|
| 160 | ;
|
|---|
| 161 | LISTCURR(XQALBKUP) ;
|
|---|
| 162 | N XLIST,NVALS,ENT,XQIEN,X,ENTIEN,ENTFIL,FILNAM,FILNUM
|
|---|
| 163 | S NVALS=$$LISTGET(+XQALBKUP,.XLIST) I NVALS>0 D
|
|---|
| 164 | . W !,"Currently Backup Reviewer for:"
|
|---|
| 165 | . S ENT="" F S ENT=$O(XLIST(ENT)) Q:ENT="" F XQIEN=0:0 S XQIEN=$O(XLIST(ENT,XQIEN)) Q:XQIEN'>0 D
|
|---|
| 166 | . . S X=$$GET1^DIQ(8989.5,XQIEN_",",.01,"I"),ENTIEN=$P(X,";"),ENTFIL=$P(X,";",2),FILNAM=$P(@(U_ENTFIL_"0)"),U),FILNUM=+$P(@(U_ENTFIL_"0)"),U,2) I FILNUM>0 D
|
|---|
| 167 | . . . W !?10,$S(FILNUM=4:"Division",FILNUM=4.2:"System",FILNUM=49:"Service",FILNUM=200:"User",1:"UNKNOWN???")_":",?25,$$GET1^DIQ(FILNUM,ENTIEN_",",.01)
|
|---|
| 168 | . . . Q
|
|---|
| 169 | . . Q
|
|---|
| 170 | . Q
|
|---|
| 171 | Q
|
|---|
| 172 | ;
|
|---|
| 173 | LISTGET(XQALBKUP,XLIST) ;
|
|---|
| 174 | N PARAMIEN,ENT,INST,X,IEN,ENT1,CNT
|
|---|
| 175 | S PARAMIEN=$$FIND1^DIC(8989.51,"","","XQAL BACKUP REVIEWER"),CNT=0
|
|---|
| 176 | S ENT="" F S ENT=$O(^XTV(8989.5,"AC",PARAMIEN,ENT)) Q:ENT="" F INST=0:0 S INST=$O(^XTV(8989.5,"AC",PARAMIEN,ENT,INST)) Q:INST'>0 S IEN=^(INST),X=$O(^(INST,"")) I IEN=XQALBKUP S ENT1=$P(ENT,";",2),XLIST(ENT1,X)="",CNT=CNT+1
|
|---|
| 177 | Q CNT
|
|---|
