178 lines
8.9 KiB
Mathematica
178 lines
8.9 KiB
Mathematica
XQALBUTL ; slc/CLA,ISC-SF.SEA/JLI - Utilities for OE/RR notifications ;8/26/03 15:21
|
|
;;8.0;KERNEL;**114,125,171,285**;Jul 10, 1995
|
|
; PROVIDES FUNCTIONALITY USED BY ORBUTL
|
|
EN ;
|
|
Q
|
|
RECIPURG(XQX) ;called by option ORB PURG RECIP - purge existing notifs: recipient/DUZ
|
|
N XQK,XQA,XQADAT S XQADAT=$$NOW^XLFDT()
|
|
F XQK=0:0 S XQK=$O(^XTV(8992,XQX,"XQA",XQK)) Q:XQK'>0 S XQA=$P(^(XQK,0),"^",2) D OLDPURG
|
|
Q
|
|
;
|
|
PTPURG(DFN) ;called by option ORB PURG PATIENT - purge existing notifs: patient
|
|
N XQX,XQK,XQA,XQADAT S XQADAT=$$NOW^XLFDT()
|
|
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
|
|
Q
|
|
;
|
|
NOTIPURG(Y) ;called by option ORB PURG NOTIF - purge existing notifs: notification
|
|
N XQX,XQK,XQA,XQADAT S XQADAT=$$NOW^XLFDT()
|
|
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
|
|
Q
|
|
OLDPURG ;called by RECIPURG, PTPURG, NOTIPURG - KILLs specified alert entries
|
|
N XQAID S XQAID=XQA D DELA^XQALDEL ; JLI 9-3-99 FIXES NULL SUBSCRIPT IN DELA+1^XQALDEL
|
|
Q
|
|
;
|
|
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.
|
|
N X
|
|
K @ROOT
|
|
S X=$O(^XTV(8992.1,"B",XQAID,0)) I X'>0 Q
|
|
M @ROOT=^XTV(8992.1,X)
|
|
Q
|
|
;
|
|
PENDING(XQAUSER,XQAID) ; SR. Returns whether the user specified has the alert indicated by XQAID pending. (1=YES, 0=NO)
|
|
Q $D(^XTV(8992,"AXQA",XQAID,XQAUSER))/10
|
|
;
|
|
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.
|
|
N I,X
|
|
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
|
|
Q $S(X'="":1,1:0)
|
|
;
|
|
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.
|
|
N IEN
|
|
I $G(ROOT)="" S ROOT="XQALERTD"
|
|
K @ROOT
|
|
S IEN=$O(^XTV(8992.1,"B",XQAID,0)) I IEN'>0 S @ROOT="" Q
|
|
D MAKELIST(ROOT,8992.1,(IEN_","))
|
|
Q
|
|
USERLIST(XQAID,ROOT) ; SR. Returns recipients of alert with ID of XQAID from alert tracking file in array XQALUSER
|
|
N IEN,N,I,X
|
|
I $G(ROOT)="" S ROOT="XQALUSRS"
|
|
K @ROOT
|
|
S IEN=$O(^XTV(8992.1,"B",XQAID,0)) I IEN'>0 S @ROOT="" Q
|
|
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
|
|
Q
|
|
USERDATA(XQAID,XQAUSER,ROOT) ; SR. returns information from alert tracking file related to alert with ID of XQAID for user specified by XQAUSER
|
|
N IEN,IEN2
|
|
I $G(ROOT)="" S ROOT="XQALUSER"
|
|
K @ROOT
|
|
S IEN=$O(^XTV(8992.1,"B",XQAID,0)) I IEN'>0 S @ROOT="" Q
|
|
S IEN2=$O(^XTV(8992.1,IEN,20,"B",XQAUSER,0)) I IEN2'>0 S @ROOT="" Q
|
|
D MAKELIST(ROOT,8992.11,(IEN2_","_IEN_","))
|
|
Q
|
|
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.
|
|
N ROOT,FIELD,X
|
|
K @ARRAY
|
|
S ROOT=$NA(^TMP("XQALMAKELIST",$J))
|
|
K @ROOT
|
|
D GETS^DIQ(FILE,IENS,"*","IE",ROOT)
|
|
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"))=""
|
|
K @ROOT
|
|
Q
|
|
;
|
|
;; DELSTAT - For the most recent alert with XQAIDVAL as the PackageID
|
|
;; passed in, on return array VALUES contains the DUZ for users in
|
|
;; VALUES along with an indicator of whether the alert has been
|
|
;; deleted or not, e.g., DUZ^0 if not deleted or DUZ^1 if deleted.
|
|
;; Note that contents of VALUES will be killed prior to building the
|
|
;; list.
|
|
;;
|
|
;; Example: D DELSTAT^XQALBUTL("OR;14765;23",.RESULTS)
|
|
;;
|
|
;; Returned: The value of RESULTS indicates the number of entries in
|
|
;; the array. The entries are then ordered in numerical
|
|
;; order in the RESULTS array.
|
|
;; RESULTS = 3
|
|
;; RESULTS(1) = "146^0" User 146 - not deleted
|
|
;; RESULTS(2) = "297^1" User 297 - deleted
|
|
;; RESULTS(3) = "673^0" User 673 - not deleted
|
|
;;
|
|
DELSTAT(XQAIDVAL,VALUES) ; .SR
|
|
N XQAX,XQADATE,XQAID,XQAFN,I,X,X1,X
|
|
S XQAX=XQAIDVAL,XQADATE=0,XQAID="" K VALUES S VALUES=0
|
|
F S XQAX=$O(^XTV(8992.1,"B",XQAX)) Q:XQAX'[XQAIDVAL I XQADATE<$P(XQAX,";",3) S XQADATE=$P(XQAX,";",3),XQAID=XQAX
|
|
Q:XQAID="" S XQAFN=$O(^XTV(8992.1,"B",XQAID,0)) Q:XQAFN'>0
|
|
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
|
|
Q
|
|
;
|
|
BKUPREVW ;OPT - SET BACKUP REVIEWER(S) IN PARAMETER FILE - Moved from XQALDEL
|
|
N DIR,DIRUT,XQALBKUP,XQALCASE,XQPARAM,ERR
|
|
S XQPARAM="XQAL BACKUP REVIEWER"
|
|
BK1 ; Select NEW PERSON entry as backup reviewer
|
|
F S XQALBKUP=$$NEWPERSN() Q:$D(DIRUT) Q:XQALBKUP'>0 D Q:$D(DIRUT)
|
|
. D LISTCURR(XQALBKUP)
|
|
BK2 . ; Select Entity type for backup reviewer - XQALLAST indicates maximum number of choices, last is SYSTEM.
|
|
. N XQALVALS,XQALLAST
|
|
. S XQALLAST=4,XQALVALS(1)="User^200^USER^USR",XQALVALS(2)="Service^49^SERVICE^SRV",XQALVALS(3)="Division^4^DIVISION^DIV",XQALVALS(4)="System^"
|
|
. F S XQALCASE=$$ENTTYPE(.XQALVALS,XQALLAST) Q:$D(DIRUT) Q:XQALCASE'>0 D K:X="" DIRUT Q:$D(DIRUT)
|
|
. . ; Select individual in Entity for backup reviewer
|
|
. . I XQALCASE<XQALLAST D
|
|
. . . 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"
|
|
. . . F D ^DIR Q:Y'>0 S XQAENT=+Y D CHKCURR($P(XQALVALS(XQALCASE),U,4)_".`"_XQAENT,+XQALBKUP)
|
|
. . . K DIR
|
|
. . . Q
|
|
. . ; Special handling for SYSTEM entity
|
|
. . I XQALCASE=XQALLAST S Y=$$GET1^DIQ(8989.3,"1,",.01,"I") D CHKCURR("SYS.`"_Y,+XQALBKUP)
|
|
. . Q
|
|
. Q
|
|
Q
|
|
;
|
|
NEWPERSN() ;
|
|
; Select a Backup Reviewer, then select parameter cases for this Backup
|
|
; Reviewer. You may then select another Backup Reviewer for additional
|
|
; parameter cases if necessary.
|
|
;
|
|
; Select NEW PERSON entry to be BACKUP REVIEWER
|
|
NEWLOOP ;
|
|
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"
|
|
S DIR("A",2)="Reviewer. You may then select another Backup Reviewer for additional",DIR("A",3)="parameter cases if necessary.",DIR("A",4)=""
|
|
D ^DIR K DIR I X="" K DIRUT
|
|
I Y>0,'$$ACTIVE^XUSER(+Y) W !,$C(7),"This is not an ACTIVE USER... Select an Active user",! G NEWLOOP
|
|
Q Y
|
|
;
|
|
ENTTYPE(XQALVALS,XQALLAST) ;
|
|
K DIR("A")
|
|
S XQALCASE="" F I=1:1:XQALLAST S XQALCASE=XQALCASE_I_":"_$P(XQALVALS(I),U)_";"
|
|
S DIR(0)="SO^"_XQALCASE D ^DIR K DIR I X="" K DIRUT
|
|
Q Y
|
|
;
|
|
CHKCURR(ENTITY,XQALBKUP) ;
|
|
S XQAINST=$$GETINST(ENTITY,XQALBKUP)
|
|
I XQAINST>0 D PUT^XPAR(ENTITY,XQPARAM,XQAINST,XQALBKUP,.ERR) W " ...Done"
|
|
I XQAINST<0 D PUT^XPAR(ENTITY,XQPARAM,-XQAINST,"@",.ERR) W " ...Done"
|
|
Q
|
|
;
|
|
GETINST(ENTITY,XQALBKUP) ;
|
|
N DIR,DIRUT,I,J,IMAX,XQAA,XQATYP,XQAI,Y,ISELF,IEN,XQAVAL
|
|
D GETLST^XPAR(.XQAA,ENTITY,XQPARAM,"Q",.XQERR) I XQAA=0 Q 1
|
|
LOOP ;
|
|
W !,"There "_$S(XQAA=1:"is",1:"are")_" currently "_XQAA_" instance"_$S(XQAA>1:"s",1:"")_" for this entity"
|
|
S ISELF=0
|
|
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)
|
|
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
|
|
S XQATYP=Y I XQATYP="a" S J=0 D Q J
|
|
. F XQAI=1:1 I +$G(XQAA(XQAI))'=XQAI S J=XQAI I J>0 Q
|
|
E D Q:Y=0 0
|
|
. 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
|
|
. F XQAI=1:1 Q:'$D(XQAA(XQAI)) I +XQAA(XQAI)=Y Q
|
|
. I '$D(XQAA(XQAI)) S Y=-1
|
|
I Y<0 W $C(7),!!,"To "_$S(XQATYP="r":"REPLACE",1:"DELETE")_" an entry enter an instance number from the list." G LOOP
|
|
S XQAVAL=+Y I XQATYP="d" S XQAVAL=-Y
|
|
Q XQAVAL
|
|
;
|
|
LISTCURR(XQALBKUP) ;
|
|
N XLIST,NVALS,ENT,XQIEN,X,ENTIEN,ENTFIL,FILNAM,FILNUM
|
|
S NVALS=$$LISTGET(+XQALBKUP,.XLIST) I NVALS>0 D
|
|
. W !,"Currently Backup Reviewer for:"
|
|
. S ENT="" F S ENT=$O(XLIST(ENT)) Q:ENT="" F XQIEN=0:0 S XQIEN=$O(XLIST(ENT,XQIEN)) Q:XQIEN'>0 D
|
|
. . 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
|
|
. . . W !?10,$S(FILNUM=4:"Division",FILNUM=4.2:"System",FILNUM=49:"Service",FILNUM=200:"User",1:"UNKNOWN???")_":",?25,$$GET1^DIQ(FILNUM,ENTIEN_",",.01)
|
|
. . . Q
|
|
. . Q
|
|
. Q
|
|
Q
|
|
;
|
|
LISTGET(XQALBKUP,XLIST) ;
|
|
N PARAMIEN,ENT,INST,X,IEN,ENT1,CNT
|
|
S PARAMIEN=$$FIND1^DIC(8989.51,"","","XQAL BACKUP REVIEWER"),CNT=0
|
|
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
|
|
Q CNT
|