source: FOIAVistA/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQALBUTL.m@ 1427

Last change on this file since 1427 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 8.9 KB
Line 
1XQALBUTL ; 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
4EN ;
5 Q
6RECIPURG(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 ;
11PTPURG(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 ;
16NOTIPURG(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
20OLDPURG ;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 ;
24AHISTORY(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 ;
31PENDING(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 ;
34PKGPEND(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 ;
39ALERTDAT(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
46USERLIST(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
53USERDATA(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
61MAKELIST(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 ;;
88DELSTAT(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 ;
96BKUPREVW ;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"
99BK1 ; 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)
102BK2 . ; 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 ;
118NEWPERSN() ;
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
124NEWLOOP ;
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 ;
131ENTTYPE(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 ;
137CHKCURR(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 ;
143GETINST(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
146LOOP ;
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 ;
161LISTCURR(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 ;
173LISTGET(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
Note: See TracBrowser for help on using the repository browser.