KIDS Distribution saved on Oct 28, 2016@10:54:21
XU*8*653
**KIDS**:XU*8.0*653^

**INSTALL NAME**
XU*8.0*653
"BLD",8969,0)
XU*8.0*653^KERNEL^0^3161028^y
"BLD",8969,1,0)
^^10^10^3160824^^^^
"BLD",8969,1,1,0)
 
"BLD",8969,1,2,0)
This patch contains a new field ALERT DEFERRED DATE/TIME (.06)
"BLD",8969,1,3,0)
in the ALERT file (8992) on the ALERT DATE/TIME multiple
"BLD",8969,1,4,0)
Code added to the routine XQALDATA to accommodate the new field and
"BLD",8969,1,5,0)
the alerts that will display for a patient. Also, the field length of 
"BLD",8969,1,6,0)
field DISPLAY TEXT (#1.01) of file ALERT TRACKING (#8992.1) has been 
"BLD",8969,1,7,0)
changed from 70 to 95 characters. The API ALERTDAT^XQALBUTL has been 
"BLD",8969,1,8,0)
modified to display the LONG INFO TEXT field that was not displaying in 
"BLD",8969,1,9,0)
the API.  The field length of field(1.03 ) MESSAGE TEXT has been 
"BLD",8969,1,10,0)
increased from 60 to 95.
"BLD",8969,4,0)
^9.64PA^8992.1^2
"BLD",8969,4,8992,0)
8992
"BLD",8969,4,8992,2,0)
^9.641^8992.01^1
"BLD",8969,4,8992,2,8992.01,0)
ALERT DATE/TIME  (sub-file)
"BLD",8969,4,8992,2,8992.01,1,0)
^9.6411^.03^2
"BLD",8969,4,8992,2,8992.01,1,.03,0)
MESSAGE TEXT
"BLD",8969,4,8992,2,8992.01,1,.06,0)
ALERT DEFERRED DATE/TIME
"BLD",8969,4,8992,222)
y^y^p^^^^n^^n
"BLD",8969,4,8992,224)

"BLD",8969,4,8992.1,0)
8992.1
"BLD",8969,4,8992.1,2,0)
^9.641^8992.1^1
"BLD",8969,4,8992.1,2,8992.1,0)
ALERT TRACKING  (File-top level)
"BLD",8969,4,8992.1,2,8992.1,1,0)
^9.6411^1.01^1
"BLD",8969,4,8992.1,2,8992.1,1,1.01,0)
DISPLAY TEXT
"BLD",8969,4,8992.1,222)
y^y^p^^^^n^^n
"BLD",8969,4,8992.1,224)

"BLD",8969,4,"APDD",8992,8992.01)

"BLD",8969,4,"APDD",8992,8992.01,.03)

"BLD",8969,4,"APDD",8992,8992.01,.06)

"BLD",8969,4,"APDD",8992.1,8992.1)

"BLD",8969,4,"APDD",8992.1,8992.1,1.01)

"BLD",8969,4,"B",8992,8992)

"BLD",8969,4,"B",8992.1,8992.1)

"BLD",8969,6)
12^
"BLD",8969,6.3)
37
"BLD",8969,"ABPKG")
n
"BLD",8969,"KRN",0)
^9.67PA^779.2^20
"BLD",8969,"KRN",.4,0)
.4
"BLD",8969,"KRN",.4,"NM",0)
^9.68A^^
"BLD",8969,"KRN",.401,0)
.401
"BLD",8969,"KRN",.401,"NM",0)
^9.68A^^
"BLD",8969,"KRN",.402,0)
.402
"BLD",8969,"KRN",.402,"NM",0)
^9.68A^^
"BLD",8969,"KRN",.403,0)
.403
"BLD",8969,"KRN",.403,"NM",0)
^9.68A^^
"BLD",8969,"KRN",.5,0)
.5
"BLD",8969,"KRN",.84,0)
.84
"BLD",8969,"KRN",3.6,0)
3.6
"BLD",8969,"KRN",3.8,0)
3.8
"BLD",8969,"KRN",9.2,0)
9.2
"BLD",8969,"KRN",9.8,0)
9.8
"BLD",8969,"KRN",9.8,"NM",0)
^9.68A^4^4
"BLD",8969,"KRN",9.8,"NM",1,0)
XQALDATA^^0^B26892102
"BLD",8969,"KRN",9.8,"NM",2,0)
XQALDEL^^0^B61838554
"BLD",8969,"KRN",9.8,"NM",3,0)
XQALSET^^0^B72706141
"BLD",8969,"KRN",9.8,"NM",4,0)
XQALBUTL^^0^B83370145
"BLD",8969,"KRN",9.8,"NM","B","XQALBUTL",4)

"BLD",8969,"KRN",9.8,"NM","B","XQALDATA",1)

"BLD",8969,"KRN",9.8,"NM","B","XQALDEL",2)

"BLD",8969,"KRN",9.8,"NM","B","XQALSET",3)

"BLD",8969,"KRN",19,0)
19
"BLD",8969,"KRN",19,"NM",0)
^9.68A^^
"BLD",8969,"KRN",19.1,0)
19.1
"BLD",8969,"KRN",19.1,"NM",0)
^9.68A^^
"BLD",8969,"KRN",101,0)
101
"BLD",8969,"KRN",101,"NM",0)
^9.68A^^
"BLD",8969,"KRN",409.61,0)
409.61
"BLD",8969,"KRN",409.61,"NM",0)
^9.68A^^
"BLD",8969,"KRN",771,0)
771
"BLD",8969,"KRN",771,"NM",0)
^9.68A^^
"BLD",8969,"KRN",779.2,0)
779.2
"BLD",8969,"KRN",779.2,"NM",0)
^9.68A^^
"BLD",8969,"KRN",870,0)
870
"BLD",8969,"KRN",870,"NM",0)
^9.68A^^
"BLD",8969,"KRN",8989.51,0)
8989.51
"BLD",8969,"KRN",8989.52,0)
8989.52
"BLD",8969,"KRN",8994,0)
8994
"BLD",8969,"KRN","B",.4,.4)

"BLD",8969,"KRN","B",.401,.401)

"BLD",8969,"KRN","B",.402,.402)

"BLD",8969,"KRN","B",.403,.403)

"BLD",8969,"KRN","B",.5,.5)

"BLD",8969,"KRN","B",.84,.84)

"BLD",8969,"KRN","B",3.6,3.6)

"BLD",8969,"KRN","B",3.8,3.8)

"BLD",8969,"KRN","B",9.2,9.2)

"BLD",8969,"KRN","B",9.8,9.8)

"BLD",8969,"KRN","B",19,19)

"BLD",8969,"KRN","B",19.1,19.1)

"BLD",8969,"KRN","B",101,101)

"BLD",8969,"KRN","B",409.61,409.61)

"BLD",8969,"KRN","B",771,771)

"BLD",8969,"KRN","B",779.2,779.2)

"BLD",8969,"KRN","B",870,870)

"BLD",8969,"KRN","B",8989.51,8989.51)

"BLD",8969,"KRN","B",8989.52,8989.52)

"BLD",8969,"KRN","B",8994,8994)

"BLD",8969,"QUES",0)
^9.62^^
"BLD",8969,"REQB",0)
^9.611^1^1
"BLD",8969,"REQB",1,0)
XU*8.0*602^1
"BLD",8969,"REQB","B","XU*8.0*602",1)

"FIA",8992)
ALERT
"FIA",8992,0)
^XTV(8992,
"FIA",8992,0,0)
8992PA
"FIA",8992,0,1)
y^y^p^^^^n^^n
"FIA",8992,0,10)

"FIA",8992,0,11)

"FIA",8992,0,"RLRO")

"FIA",8992,0,"VR")
8.0^XU
"FIA",8992,8992)
1
"FIA",8992,8992.01)
1
"FIA",8992,8992.01,.03)

"FIA",8992,8992.01,.06)

"FIA",8992.1)
ALERT TRACKING
"FIA",8992.1,0)
^XTV(8992.1,
"FIA",8992.1,0,0)
8992.1A
"FIA",8992.1,0,1)
y^y^p^^^^n^^n
"FIA",8992.1,0,10)

"FIA",8992.1,0,11)

"FIA",8992.1,0,"RLRO")

"FIA",8992.1,0,"VR")
8.0^XU
"FIA",8992.1,8992.1)
1
"FIA",8992.1,8992.1,1.01)

"MBREQ")
0
"PKG",163,-1)
1^1
"PKG",163,0)
KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^
"PKG",163,20,0)
^9.402P^2^2
"PKG",163,20,1,0)
200^^XDRM200N
"PKG",163,20,1,1)

"PKG",163,20,2,0)
2^^RGDRM03
"PKG",163,20,2,1)

"PKG",163,20,"B",2,2)

"PKG",163,20,"B",200,1)

"PKG",163,22,0)
^9.49I^1^1
"PKG",163,22,1,0)
8.0^2950703^2951019^1039
"PKG",163,22,1,"PAH",1,0)
653^3161028^10000000411
"PKG",163,22,1,"PAH",1,1,0)
^^10^10^3161028
"PKG",163,22,1,"PAH",1,1,1,0)
 
"PKG",163,22,1,"PAH",1,1,2,0)
This patch contains a new field ALERT DEFERRED DATE/TIME (.06)
"PKG",163,22,1,"PAH",1,1,3,0)
in the ALERT file (8992) on the ALERT DATE/TIME multiple
"PKG",163,22,1,"PAH",1,1,4,0)
Code added to the routine XQALDATA to accommodate the new field and
"PKG",163,22,1,"PAH",1,1,5,0)
the alerts that will display for a patient. Also, the field length of 
"PKG",163,22,1,"PAH",1,1,6,0)
field DISPLAY TEXT (#1.01) of file ALERT TRACKING (#8992.1) has been 
"PKG",163,22,1,"PAH",1,1,7,0)
changed from 70 to 95 characters. The API ALERTDAT^XQALBUTL has been 
"PKG",163,22,1,"PAH",1,1,8,0)
modified to display the LONG INFO TEXT field that was not displaying in 
"PKG",163,22,1,"PAH",1,1,9,0)
the API.  The field length of field(1.03 ) MESSAGE TEXT has been 
"PKG",163,22,1,"PAH",1,1,10,0)
increased from 60 to 95.
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
4
"RTN","XQALBUTL")
0^4^B83370145
"RTN","XQALBUTL",1,0)
XQALBUTL ; ISC-SF/JLI - Utilities for OE/RR notifications ;07/13/12  13:24
"RTN","XQALBUTL",2,0)
 ;;8.0;KERNEL;**114,125,171,285,602,653**;Jul 10, 1995;Build 37
"RTN","XQALBUTL",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified
"RTN","XQALBUTL",4,0)
 ; PROVIDES FUNCTIONALITY USED BY ORBUTL
"RTN","XQALBUTL",5,0)
EN ;
"RTN","XQALBUTL",6,0)
 Q
"RTN","XQALBUTL",7,0)
RECIPURG(XQX) ; SR. ICR #3010 (supported)
"RTN","XQALBUTL",8,0)
 ; Called by option ORB PURG RECIP - purge existing notifs: recipient/DUZ
"RTN","XQALBUTL",9,0)
 N XQK,XQA,XQADAT S XQADAT=$$NOW^XLFDT()
"RTN","XQALBUTL",10,0)
 F XQK=0:0 S XQK=$O(^XTV(8992,XQX,"XQA",XQK)) Q:XQK'>0  S XQA=$P(^(XQK,0),"^",2) D OLDPURG
"RTN","XQALBUTL",11,0)
 Q
"RTN","XQALBUTL",12,0)
 ;
"RTN","XQALBUTL",13,0)
PTPURG(DFN) ; SR. ICR #3010 (supported)
"RTN","XQALBUTL",14,0)
 ; Called by option ORB PURG PATIENT - purge existing notifs: patient
"RTN","XQALBUTL",15,0)
 N XQX,XQK,XQA,XQADAT S XQADAT=$$NOW^XLFDT()
"RTN","XQALBUTL",16,0)
 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
"RTN","XQALBUTL",17,0)
 Q
"RTN","XQALBUTL",18,0)
 ;
"RTN","XQALBUTL",19,0)
NOTIPURG(Y) ; SR. ICR #3010 (supported)
"RTN","XQALBUTL",20,0)
 ; Called by option ORB PURG NOTIF - purge existing notifs: notification
"RTN","XQALBUTL",21,0)
 N XQX,XQK,XQA,XQADAT S XQADAT=$$NOW^XLFDT()
"RTN","XQALBUTL",22,0)
 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
"RTN","XQALBUTL",23,0)
 Q
"RTN","XQALBUTL",24,0)
 ;
"RTN","XQALBUTL",25,0)
OLDPURG ;called by RECIPURG, PTPURG, NOTIPURG - KILLs specified alert entries
"RTN","XQALBUTL",26,0)
 N XQAID S XQAID=XQA D DELA^XQALDEL ; JLI 9-3-99 FIXES NULL SUBSCRIPT IN DELA+1^XQALDEL
"RTN","XQALBUTL",27,0)
 Q
"RTN","XQALBUTL",28,0)
 ;
"RTN","XQALBUTL",29,0)
AHISTORY(XQAID,ROOT) ; SR. ICR #2778 (supported)
"RTN","XQALBUTL",30,0)
 ; 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.
"RTN","XQALBUTL",31,0)
 N X
"RTN","XQALBUTL",32,0)
 K @ROOT
"RTN","XQALBUTL",33,0)
 S X=$O(^XTV(8992.1,"B",XQAID,0)) I X'>0 Q
"RTN","XQALBUTL",34,0)
 M @ROOT=^XTV(8992.1,X)
"RTN","XQALBUTL",35,0)
 Q
"RTN","XQALBUTL",36,0)
 ;
"RTN","XQALBUTL",37,0)
PENDING(XQAUSER,XQAID) ; SR. ICR #2778 (supported)
"RTN","XQALBUTL",38,0)
 ; Returns whether the user specified has the alert indicated by XQAID pending.  (1=YES, 0=NO)
"RTN","XQALBUTL",39,0)
 Q $D(^XTV(8992,"AXQA",XQAID,XQAUSER))/10
"RTN","XQALBUTL",40,0)
 ;
"RTN","XQALBUTL",41,0)
PKGPEND(XQAUSER,XQAPKG) ; SR. ICR #2778 (supported)
"RTN","XQALBUTL",42,0)
 ; 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.
"RTN","XQALBUTL",43,0)
 N I,X
"RTN","XQALBUTL",44,0)
 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
"RTN","XQALBUTL",45,0)
 Q $S(X'="":1,1:0)
"RTN","XQALBUTL",46,0)
 ;
"RTN","XQALBUTL",47,0)
ALERTDAT(XQAID,ROOT) ; SR. ICR #2778 (supported)
"RTN","XQALBUTL",48,0)
 ; Returns information from alert tracking file for alert with XQAID in array XQALERTD.  If the alert is not present, the array is undefined.
"RTN","XQALBUTL",49,0)
 N IEN
"RTN","XQALBUTL",50,0)
 I $G(ROOT)="" S ROOT="XQALERTD"
"RTN","XQALBUTL",51,0)
 K @ROOT
"RTN","XQALBUTL",52,0)
 S IEN=$O(^XTV(8992.1,"B",XQAID,0)) I IEN'>0 S @ROOT="" Q
"RTN","XQALBUTL",53,0)
 D MAKELIST(ROOT,8992.1,(IEN_","))
"RTN","XQALBUTL",54,0)
 Q
"RTN","XQALBUTL",55,0)
 ;
"RTN","XQALBUTL",56,0)
USERLIST(XQAID,ROOT) ; SR. ICR #2778 (supported)
"RTN","XQALBUTL",57,0)
 ; Returns recipients of alert with ID of XQAID from alert tracking file in array XQALUSER
"RTN","XQALBUTL",58,0)
 N IEN,N,I,X
"RTN","XQALBUTL",59,0)
 I $G(ROOT)="" S ROOT="XQALUSRS"
"RTN","XQALBUTL",60,0)
 K @ROOT
"RTN","XQALBUTL",61,0)
 S IEN=$O(^XTV(8992.1,"B",XQAID,0)) I IEN'>0 S @ROOT="" Q
"RTN","XQALBUTL",62,0)
 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
"RTN","XQALBUTL",63,0)
 Q
"RTN","XQALBUTL",64,0)
 ;
"RTN","XQALBUTL",65,0)
USERDATA(XQAID,XQAUSER,ROOT) ; SR. ICR #2778 (supported)
"RTN","XQALBUTL",66,0)
 ; Returns information from alert tracking file related to alert with ID of XQAID for user specified by XQAUSER
"RTN","XQALBUTL",67,0)
 N IEN,IEN2
"RTN","XQALBUTL",68,0)
 I $G(ROOT)="" S ROOT="XQALUSER"
"RTN","XQALBUTL",69,0)
 K @ROOT
"RTN","XQALBUTL",70,0)
 S IEN=$O(^XTV(8992.1,"B",XQAID,0)) I IEN'>0 S @ROOT="" Q
"RTN","XQALBUTL",71,0)
 S IEN2=$O(^XTV(8992.1,IEN,20,"B",XQAUSER,0)) I IEN2'>0 S @ROOT="" Q
"RTN","XQALBUTL",72,0)
 D MAKELIST(ROOT,8992.11,(IEN2_","_IEN_","))
"RTN","XQALBUTL",73,0)
 Q
"RTN","XQALBUTL",74,0)
 ;
"RTN","XQALBUTL",75,0)
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.
"RTN","XQALBUTL",76,0)
 N ROOT,FIELD,X
"RTN","XQALBUTL",77,0)
 K @ARRAY
"RTN","XQALBUTL",78,0)
 S ROOT=$NA(^TMP("XQALMAKELIST",$J))
"RTN","XQALBUTL",79,0)
 K @ROOT
"RTN","XQALBUTL",80,0)
 D GETS^DIQ(FILE,IENS,"*","IE",ROOT)
"RTN","XQALBUTL",81,0)
 F FIELD=0:0 S FIELD=$O(@ROOT@(FILE,IENS,FIELD)) Q:FIELD'>0  D
"RTN","XQALBUTL",82,0)
 . ;patch 653 long infor text.
"RTN","XQALBUTL",83,0)
 . I FIELD'=4 D
"RTN","XQALBUTL",84,0)
 . . S X=^(FIELD,"I") S:X'=^("E") X=X_U_^("E")
"RTN","XQALBUTL",85,0)
 . . S @ARRAY@(FIELD)=X
"RTN","XQALBUTL",86,0)
 . I FIELD=4 D
"RTN","XQALBUTL",87,0)
 . . N XQALX
"RTN","XQALBUTL",88,0)
 . . S:'$D(@ARRAY@(FIELD)) @ARRAY@(FIELD)=""
"RTN","XQALBUTL",89,0)
 . . S XQALX=0 F XQALX=0:0 S XQALX=$O(@ROOT@(FILE,IENS,FIELD,XQALX)) Q:'XQALX  S X=$G(@ROOT@(FILE,IENS,FIELD,XQALX)) S @ARRAY@(FIELD,XQALX)=X
"RTN","XQALBUTL",90,0)
 . . Q 
"RTN","XQALBUTL",91,0)
 . S @ARRAY@(FIELD,$$GET1^DID(FILE,FIELD,"","LABEL"))=""
"RTN","XQALBUTL",92,0)
 K @ROOT
"RTN","XQALBUTL",93,0)
 Q
"RTN","XQALBUTL",94,0)
 ;
"RTN","XQALBUTL",95,0)
 ;;  DELSTAT - For the most recent alert with XQAIDVAL as the PackageID
"RTN","XQALBUTL",96,0)
 ;;  passed in, on return array VALUES contains the DUZ for users in
"RTN","XQALBUTL",97,0)
 ;;  VALUES along with an indicator of whether the alert has been
"RTN","XQALBUTL",98,0)
 ;;  deleted or not, e.g., DUZ^0 if not deleted or DUZ^1 if deleted.
"RTN","XQALBUTL",99,0)
 ;;  Note that contents of VALUES will be killed prior to building the
"RTN","XQALBUTL",100,0)
 ;;  list.
"RTN","XQALBUTL",101,0)
 ;;
"RTN","XQALBUTL",102,0)
 ;;  Example:   D DELSTAT^XQALBUTL("OR;14765;23",.RESULTS)
"RTN","XQALBUTL",103,0)
 ;;
"RTN","XQALBUTL",104,0)
 ;;  Returned:   The value of RESULTS indicates the number of entries in
"RTN","XQALBUTL",105,0)
 ;;              the array.  The entries are then ordered in numerical
"RTN","XQALBUTL",106,0)
 ;;              order in the RESULTS array.
"RTN","XQALBUTL",107,0)
 ;;                  RESULTS = 3
"RTN","XQALBUTL",108,0)
 ;;                  RESULTS(1) = "146^0"   User 146 - not deleted
"RTN","XQALBUTL",109,0)
 ;;                  RESULTS(2) = "297^1"   User 297 - deleted
"RTN","XQALBUTL",110,0)
 ;;                  RESULTS(3) = "673^0"   User 673 - not deleted
"RTN","XQALBUTL",111,0)
 ;;
"RTN","XQALBUTL",112,0)
DELSTAT(XQAIDVAL,VALUES) ; .SR ICR #3197 (supported)
"RTN","XQALBUTL",113,0)
 N XQAX,XQADATE,XQAID,XQAFN,I,X,X1,X
"RTN","XQALBUTL",114,0)
 S XQAX=XQAIDVAL,XQADATE=0,XQAID="" K VALUES S VALUES=0
"RTN","XQALBUTL",115,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
"RTN","XQALBUTL",116,0)
 Q:XQAID=""  S XQAFN=$O(^XTV(8992.1,"B",XQAID,0)) Q:XQAFN'>0
"RTN","XQALBUTL",117,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
"RTN","XQALBUTL",118,0)
 Q
"RTN","XQALBUTL",119,0)
 ;
"RTN","XQALBUTL",120,0)
BKUPREVW ;OPT - SET BACKUP REVIEWER(S) IN PARAMETER FILE - Moved from XQALDEL
"RTN","XQALBUTL",121,0)
 N DIR,DIRUT,XQALBKUP,XQALCASE,XQPARAM,ERR
"RTN","XQALBUTL",122,0)
 S XQPARAM="XQAL BACKUP REVIEWER"
"RTN","XQALBUTL",123,0)
BK1 ; Select NEW PERSON entry as backup reviewer
"RTN","XQALBUTL",124,0)
 F  S XQALBKUP=$$NEWPERSN() Q:$D(DIRUT)  Q:XQALBKUP'>0  D  Q:$D(DIRUT)
"RTN","XQALBUTL",125,0)
 . D LISTCURR(XQALBKUP)
"RTN","XQALBUTL",126,0)
BK2 . ; Select Entity type for backup reviewer - XQALLAST indicates maximum number of choices, last is SYSTEM.
"RTN","XQALBUTL",127,0)
 . N XQALVALS,XQALLAST
"RTN","XQALBUTL",128,0)
 . S XQALLAST=4,XQALVALS(1)="User^200^USER^USR",XQALVALS(2)="Service^49^SERVICE^SRV",XQALVALS(3)="Division^4^DIVISION^DIV",XQALVALS(4)="System^"
"RTN","XQALBUTL",129,0)
 . F  S XQALCASE=$$ENTTYPE(.XQALVALS,XQALLAST) Q:$D(DIRUT)  Q:XQALCASE'>0  D  K:X="" DIRUT Q:$D(DIRUT)
"RTN","XQALBUTL",130,0)
 . . ; Select individual in Entity for backup reviewer
"RTN","XQALBUTL",131,0)
 . . I XQALCASE<XQALLAST D
"RTN","XQALBUTL",132,0)
 . . . 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"
"RTN","XQALBUTL",133,0)
 . . . F  D ^DIR Q:Y'>0  S XQAENT=+Y D CHKCURR($P(XQALVALS(XQALCASE),U,4)_".`"_XQAENT,+XQALBKUP)
"RTN","XQALBUTL",134,0)
 . . . K DIR
"RTN","XQALBUTL",135,0)
 . . . Q
"RTN","XQALBUTL",136,0)
 . . ; Special handling for SYSTEM entity
"RTN","XQALBUTL",137,0)
 . . I XQALCASE=XQALLAST S Y=$$GET1^DIQ(8989.3,"1,",.01,"I") D CHKCURR("SYS.`"_Y,+XQALBKUP)
"RTN","XQALBUTL",138,0)
 . . Q
"RTN","XQALBUTL",139,0)
 . Q
"RTN","XQALBUTL",140,0)
 Q
"RTN","XQALBUTL",141,0)
 ;
"RTN","XQALBUTL",142,0)
NEWPERSN() ;
"RTN","XQALBUTL",143,0)
 ;   Select a Backup Reviewer, then select parameter cases for this Backup
"RTN","XQALBUTL",144,0)
 ;   Reviewer.  You may then select another Backup Reviewer for additional
"RTN","XQALBUTL",145,0)
 ;   parameter cases if necessary.
"RTN","XQALBUTL",146,0)
 ;
"RTN","XQALBUTL",147,0)
 ;   Select NEW PERSON entry to be BACKUP REVIEWER
"RTN","XQALBUTL",148,0)
NEWLOOP ;
"RTN","XQALBUTL",149,0)
 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"
"RTN","XQALBUTL",150,0)
 S DIR("A",2)="Reviewer.  You may then select another Backup Reviewer for additional",DIR("A",3)="parameter cases if necessary.",DIR("A",4)=""
"RTN","XQALBUTL",151,0)
 D ^DIR K DIR I X="" K DIRUT
"RTN","XQALBUTL",152,0)
 I Y>0,'$$ACTIVE^XUSER(+Y) W !,$C(7),"This is not an ACTIVE USER...  Select an Active user",! G NEWLOOP
"RTN","XQALBUTL",153,0)
 Q Y
"RTN","XQALBUTL",154,0)
 ;
"RTN","XQALBUTL",155,0)
ENTTYPE(XQALVALS,XQALLAST) ;
"RTN","XQALBUTL",156,0)
 K DIR("A")
"RTN","XQALBUTL",157,0)
 S XQALCASE="" F I=1:1:XQALLAST S XQALCASE=XQALCASE_I_":"_$P(XQALVALS(I),U)_";"
"RTN","XQALBUTL",158,0)
 S DIR(0)="SO^"_XQALCASE D ^DIR K DIR I X="" K DIRUT
"RTN","XQALBUTL",159,0)
 Q Y
"RTN","XQALBUTL",160,0)
 ;
"RTN","XQALBUTL",161,0)
CHKCURR(ENTITY,XQALBKUP) ;
"RTN","XQALBUTL",162,0)
 S XQAINST=$$GETINST(ENTITY,XQALBKUP)
"RTN","XQALBUTL",163,0)
 I XQAINST>0 D PUT^XPAR(ENTITY,XQPARAM,XQAINST,XQALBKUP,.ERR) W "   ...Done"
"RTN","XQALBUTL",164,0)
 I XQAINST<0 D PUT^XPAR(ENTITY,XQPARAM,-XQAINST,"@",.ERR) W "    ...Done"
"RTN","XQALBUTL",165,0)
 Q
"RTN","XQALBUTL",166,0)
 ;
"RTN","XQALBUTL",167,0)
GETINST(ENTITY,XQALBKUP) ;
"RTN","XQALBUTL",168,0)
 N DIR,DIRUT,I,J,IMAX,XQAA,XQATYP,XQAI,Y,ISELF,IEN,XQAVAL
"RTN","XQALBUTL",169,0)
 D GETLST^XPAR(.XQAA,ENTITY,XQPARAM,"Q",.XQERR) I XQAA=0 Q 1
"RTN","XQALBUTL",170,0)
LOOP ;
"RTN","XQALBUTL",171,0)
 W !,"There "_$S(XQAA=1:"is",1:"are")_" currently "_XQAA_" instance"_$S(XQAA>1:"s",1:"")_" for this entity"
"RTN","XQALBUTL",172,0)
 S ISELF=0
"RTN","XQALBUTL",173,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)
"RTN","XQALBUTL",174,0)
 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
"RTN","XQALBUTL",175,0)
 S XQATYP=Y I XQATYP="a" S J=0 D  Q J
"RTN","XQALBUTL",176,0)
 . F XQAI=1:1 I +$G(XQAA(XQAI))'=XQAI S J=XQAI I J>0 Q
"RTN","XQALBUTL",177,0)
 E  D  Q:Y=0 0
"RTN","XQALBUTL",178,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
"RTN","XQALBUTL",179,0)
 . F XQAI=1:1 Q:'$D(XQAA(XQAI))  I +XQAA(XQAI)=Y Q
"RTN","XQALBUTL",180,0)
 . I '$D(XQAA(XQAI)) S Y=-1
"RTN","XQALBUTL",181,0)
 I Y<0 W $C(7),!!,"To "_$S(XQATYP="r":"REPLACE",1:"DELETE")_" an entry enter an instance number from the list." G LOOP
"RTN","XQALBUTL",182,0)
 S XQAVAL=+Y I XQATYP="d" S XQAVAL=-Y
"RTN","XQALBUTL",183,0)
 Q XQAVAL
"RTN","XQALBUTL",184,0)
 ;
"RTN","XQALBUTL",185,0)
LISTCURR(XQALBKUP) ;
"RTN","XQALBUTL",186,0)
 N XLIST,NVALS,ENT,XQIEN,X,ENTIEN,ENTFIL,FILNAM,FILNUM
"RTN","XQALBUTL",187,0)
 S NVALS=$$LISTGET(+XQALBKUP,.XLIST) I NVALS>0 D
"RTN","XQALBUTL",188,0)
 . W !,"Currently Backup Reviewer for:"
"RTN","XQALBUTL",189,0)
 . S ENT="" F  S ENT=$O(XLIST(ENT)) Q:ENT=""  F XQIEN=0:0 S XQIEN=$O(XLIST(ENT,XQIEN)) Q:XQIEN'>0  D
"RTN","XQALBUTL",190,0)
 . . 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
"RTN","XQALBUTL",191,0)
 . . . W !?10,$S(FILNUM=4:"Division",FILNUM=4.2:"System",FILNUM=49:"Service",FILNUM=200:"User",1:"UNKNOWN???")_":",?25,$$GET1^DIQ(FILNUM,ENTIEN_",",.01)
"RTN","XQALBUTL",192,0)
 . . . Q
"RTN","XQALBUTL",193,0)
 . . Q
"RTN","XQALBUTL",194,0)
 . Q
"RTN","XQALBUTL",195,0)
 Q
"RTN","XQALBUTL",196,0)
 ;
"RTN","XQALBUTL",197,0)
LISTGET(XQALBKUP,XLIST) ;
"RTN","XQALBUTL",198,0)
 N PARAMIEN,ENT,INST,X,IEN,ENT1,CNT
"RTN","XQALBUTL",199,0)
 S PARAMIEN=$$FIND1^DIC(8989.51,"","","XQAL BACKUP REVIEWER"),CNT=0
"RTN","XQALBUTL",200,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
"RTN","XQALBUTL",201,0)
 Q CNT
"RTN","XQALDATA")
0^1^B26892102
"RTN","XQALDATA",1,0)
XQALDATA ;ISC/JLI ISD/HGW - PROVIDE DATA ON ALERTS ;07/05/12  13:08
"RTN","XQALDATA",2,0)
 ;;8.0;KERNEL;**207,285,443,513,602,653**;Jul 10, 1995;Build 37
"RTN","XQALDATA",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified
"RTN","XQALDATA",4,0)
 Q
"RTN","XQALDATA",5,0)
GETUSER(ROOT,XQAUSER,FRSTDATE,LASTDATE) ; SR. ICR #4834 (private OE/RR)
"RTN","XQALDATA",6,0)
 N XREF,XVAL,X,X2,X3,I,NCNT ; P443
"RTN","XQALDATA",7,0)
 S:$G(XQAUSER)'>0 XQAUSER=DUZ
"RTN","XQALDATA",8,0)
 S:$G(FRSTDATE)'>0 FRSTDATE=0
"RTN","XQALDATA",9,0)
 S:$G(LASTDATE)'>0 LASTDATE=0
"RTN","XQALDATA",10,0)
 S NCNT=0 K @ROOT
"RTN","XQALDATA",11,0)
 I FRSTDATE=0 D  Q
"RTN","XQALDATA",12,0)
 . F I=0:0 S I=$O(^XTV(8992,XQAUSER,"XQA",I)) Q:I'>0  S X=^(I,0),X3=$G(^(3)),X2=$G(^(2)) D
"RTN","XQALDATA",13,0)
 . . S NCNT=NCNT+1
"RTN","XQALDATA",14,0)
 . . S @ROOT@(NCNT)=$S($P(X3,U)'="":"G  ",$P(X,U,7,8)="^ ":"I  ",1:"   ")_$P(X,U,3)_U_$P(X,U,2)_$S($P(X2,U,3)'="":U_$P(X2,U,3),1:"") ; P443
"RTN","XQALDATA",15,0)
 . S @ROOT=NCNT
"RTN","XQALDATA",16,0)
 S XREF="R"
"RTN","XQALDATA",17,0)
 S XVAL=XQAUSER
"RTN","XQALDATA",18,0)
 D CHKTRAIL
"RTN","XQALDATA",19,0)
 Q
"RTN","XQALDATA",20,0)
GETPAT(ROOT,PATIENT,FRSTDATE,LASTDATE) ;
"RTN","XQALDATA",21,0)
 N XREF,XVAL,NCNT
"RTN","XQALDATA",22,0)
 S NCNT=0 K @ROOT
"RTN","XQALDATA",23,0)
 I $G(PATIENT)'>0 S @ROOT=0 Q
"RTN","XQALDATA",24,0)
 S XREF="C"
"RTN","XQALDATA",25,0)
 S XVAL=PATIENT
"RTN","XQALDATA",26,0)
 D CHKTRAIL
"RTN","XQALDATA",27,0)
 Q
"RTN","XQALDATA",28,0)
GETPAT2(ROOT,PATIENT,PAGE,LIMIT) ; P653
"RTN","XQALDATA",29,0)
 N XREF,XVAL,NCNT
"RTN","XQALDATA",30,0)
 S NCNT=0 K @ROOT
"RTN","XQALDATA",31,0)
 I $G(PATIENT)'>0 S @ROOT=0 Q
"RTN","XQALDATA",32,0)
 S XREF="C"
"RTN","XQALDATA",33,0)
 S XVAL=PATIENT
"RTN","XQALDATA",34,0)
 D GETPAGE
"RTN","XQALDATA",35,0)
 Q
"RTN","XQALDATA",36,0)
GETPAGE ;P653
"RTN","XQALDATA",37,0)
 N XQ1,XQCNT,XQSTART,XQEND,XQCNTTOT
"RTN","XQALDATA",38,0)
 S XQ1="",XQCNT=0,XQCNTTOT=0
"RTN","XQALDATA",39,0)
 S XQSTART=(PAGE-1)*LIMIT+1
"RTN","XQALDATA",40,0)
 S XQEND=PAGE*LIMIT
"RTN","XQALDATA",41,0)
 F  S XQ1=$O(^XTV(8992.1,XREF,XVAL,XQ1),-1) Q:'XQ1  D
"RTN","XQALDATA",42,0)
 . S XQCNT=XQCNT+1
"RTN","XQALDATA",43,0)
 . I (XQCNT>=XQSTART),(XQCNT<=XQEND) D
"RTN","XQALDATA",44,0)
 . . S XQCNTTOT=XQCNTTOT+1
"RTN","XQALDATA",45,0)
 . . N X,X1,X2,X3
"RTN","XQALDATA",46,0)
 . . S X=$G(^XTV(8992.1,XQ1,0)),X1=$G(^(1)),X3=$G(^(3)),X2=$G(^(2)) Q:X=""
"RTN","XQALDATA",47,0)
 . . S @ROOT@(XQCNT)=$S($P(X3,U)'="":"G  ",$P(X1,U,2,3)="^":"I  ",$P(X1,U,2,3)="":"I  ",1:"   ")_$P(X1,U)_U_$P(X,U)_$S($P(X2,U,3)'="":U_$P(X2,U,3),1:"")
"RTN","XQALDATA",48,0)
 S @ROOT@(0)=PAGE_U_(XQCNT\LIMIT+$S(XQCNT#LIMIT:1,1:0)) ; @ROOT@(0)=PAGE^TOTALPAGES
"RTN","XQALDATA",49,0)
 S @ROOT=XQCNTTOT
"RTN","XQALDATA",50,0)
 Q
"RTN","XQALDATA",51,0)
CHKTRAIL ;
"RTN","XQALDATA",52,0)
 ; ZEXCEPT: FRSTDATE,LASTDATE,NCNT,ROOT,XREF,XVAL  -- from GETPAT or GETUSER
"RTN","XQALDATA",53,0)
 N XQ1,X,X1,X2,X3
"RTN","XQALDATA",54,0)
 F XQ1=0:0 S XQ1=$O(^XTV(8992.1,XREF,XVAL,XQ1)) Q:XQ1'>0  D
"RTN","XQALDATA",55,0)
 . S X=$G(^XTV(8992.1,XQ1,0)),X1=$G(^(1)),X3=$G(^(3)),X2=$G(^(2)) Q:X=""
"RTN","XQALDATA",56,0)
 . I FRSTDATE'>0,'$D(^XTV(8992,"AXQA",$P(X,U))) Q
"RTN","XQALDATA",57,0)
 . I FRSTDATE>0,$P(X,U,2)<FRSTDATE Q
"RTN","XQALDATA",58,0)
 . I FRSTDATE>0,LASTDATE>0,$P(X,U,2)>LASTDATE Q
"RTN","XQALDATA",59,0)
 . S NCNT=NCNT+1
"RTN","XQALDATA",60,0)
 . S @ROOT@(NCNT)=$S($P(X3,U)'="":"G  ",$P(X1,U,2,3)="^":"I  ",$P(X1,U,2,3)="":"I  ",1:"   ")_$P(X1,U)_U_$P(X,U)_$S($P(X2,U,3)'="":U_$P(X2,U,3),1:"") ; P443
"RTN","XQALDATA",61,0)
 S @ROOT=NCNT
"RTN","XQALDATA",62,0)
 Q
"RTN","XQALDATA",63,0)
GETUSER1(ROOT,XQAUSER,FRSTDATE,LASTDATE,FLAG) ;Add FLAG to check for deferred alert. P653
"RTN","XQALDATA",64,0)
 N NCNT,KEY
"RTN","XQALDATA",65,0)
 S:$G(XQAUSER)'>0 XQAUSER=DUZ
"RTN","XQALDATA",66,0)
 S:$G(FRSTDATE)'>0 FRSTDATE=0
"RTN","XQALDATA",67,0)
 S:$G(LASTDATE)'>0 LASTDATE=0
"RTN","XQALDATA",68,0)
 S:$G(FLAG)'>0 FLAG=0 ;P653
"RTN","XQALDATA",69,0)
 I $$ACTVSURO^XQALSURO(XQAUSER)'>0 D RETURN^XQALSUR1(XQAUSER) ; P513
"RTN","XQALDATA",70,0)
 S NCNT=0 K @ROOT
"RTN","XQALDATA",71,0)
 I FRSTDATE=0 D  Q
"RTN","XQALDATA",72,0)
 . N X,X2,X3,X4,XDEF,XCKUSER,I S I="" F  S I=$O(^XTV(8992,XQAUSER,"XQA",I),-1) Q:I'>0  S X=^(I,0),X2=$G(^(2)),X3=$G(^(3)),X4=$D(^(4)) S XDEF=$P($G(X),"^",6) D  ; P653
"RTN","XQALDATA",73,0)
 . . N XNOW,XQUIT S XQUIT=0
"RTN","XQALDATA",74,0)
 . . I $G(FLAG)>0 D  Q:XQUIT=1 
"RTN","XQALDATA",75,0)
 . . . S XNOW=$$NOW^XLFDT()
"RTN","XQALDATA",76,0)
 . . . I XDEF'="" D
"RTN","XQALDATA",77,0)
 . . . . I XNOW<XDEF S XQUIT=1
"RTN","XQALDATA",78,0)
 . . . . Q
"RTN","XQALDATA",79,0)
 . . I $P(X,U,4)'="" D
"RTN","XQALDATA",80,0)
 . . . N XQAID,XQXX,XQXY,XQADAT ; P513, update ALERT TRACKING FILE
"RTN","XQALDATA",81,0)
 . . . S $P(^XTV(8992,XQAUSER,"XQA",I,0),U,4)="" ; P513 - MARK SEEN
"RTN","XQALDATA",82,0)
 . . . S XQAID=$P(X,U,2) ; P513
"RTN","XQALDATA",83,0)
 . . . S XQXX=$O(^XTV(8992.1,"B",XQAID,0)),XQXY=0,XQADAT=$$NOW^XLFDT() ;P513
"RTN","XQALDATA",84,0)
 . . . I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQAUSER,0)) I XQXY>0 D
"RTN","XQALDATA",85,0)
 . . . . I $P(^XTV(8992.1,XQXX,20,XQXY,0),U,2)="" S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,2)=XQADAT
"RTN","XQALDATA",86,0)
 . . . . I $P(^XTV(8992.1,XQXX,20,XQXY,0),U,3)="" S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,3)=XQADAT
"RTN","XQALDATA",87,0)
 . . S NCNT=NCNT+1
"RTN","XQALDATA",88,0)
 . . S KEY=$S($P(X3,U)'="":"G  ",X4>1:"L  ",$P(X,U,7,8)="^ ":"I  ",1:"R  "),@ROOT@(NCNT)=KEY_$P(X,U,3)_U_$P(X,U,2)
"RTN","XQALDATA",89,0)
 . . I X2'="" D
"RTN","XQALDATA",90,0)
 . . . S NCNT=NCNT+1,@ROOT@(NCNT)=KEY_"-----Forwarded by: "_$$GET1^DIQ(200,($P(X2,U)_","),.01)_"   Generated: "_$$DAT8^XQALERT($P(X2,U,2),1)_U_$P(X,U,2)
"RTN","XQALDATA",91,0)
 . . . I $P(X2,U,3)'="" S NCNT=NCNT+1,@ROOT@(NCNT)=KEY_"-----"_$P(X2,U,3)_U_$P(X,U,2)
"RTN","XQALDATA",92,0)
 . . . Q
"RTN","XQALDATA",93,0)
 . S @ROOT=NCNT
"RTN","XQALDATA",94,0)
 . Q
"RTN","XQALDATA",95,0)
 Q
"RTN","XQALDATA",96,0)
DEFALERT(ROOT,XQAUSER1,DEFDATE,ALERTID) ;ADD DEFERRED DATE/TIME TO ALERT; FOR CPRS USE P653
"RTN","XQALDATA",97,0)
 ;ROOT            =Global created to store the information
"RTN","XQALDATA",98,0)
 ;XQAUSER1        =User responsible for the alert
"RTN","XQALDATA",99,0)
 ;DEFDATE         =The date/time the alert is deferred til...user
"RTN","XQALDATA",100,0)
 ;                 responsible sets the date...maximum of 14 days 
"RTN","XQALDATA",101,0)
 ;                 from the date/time deferred.
"RTN","XQALDATA",102,0)
 ;ALERTID         =ALERT ID - the IEN of the alert in file 8992 2nd piece
"RTN","XQALDATA",103,0)
 ;                 of the alert date/time multiple.
"RTN","XQALDATA",104,0)
 ;                 DG,IEN of file;original recipient;date/time of alert
"RTN","XQALDATA",105,0)
 N NCNT,X,X1,X2,%
"RTN","XQALDATA",106,0)
 S NCNT=0 K @ROOT
"RTN","XQALDATA",107,0)
 S:$G(XQAUSER1)'>0 XQAUSER=DUZ
"RTN","XQALDATA",108,0)
 I $G(DEFDATE)'>0 D  Q
"RTN","XQALDATA",109,0)
 . S @ROOT@(1)="-1^No Deferred Date/Time has been entered. The alert will not be deferred!"
"RTN","XQALDATA",110,0)
 . Q
"RTN","XQALDATA",111,0)
 ; Check deferred date can't be over 14 days deferred.
"RTN","XQALDATA",112,0)
 D NOW^%DTC S X1=%,X2=14 D C^%DTC
"RTN","XQALDATA",113,0)
 N XDT,XFLAG S XFLAG=0,XDT=$P(ALERTID,";",3)-.00000001  ;P653
"RTN","XQALDATA",114,0)
 F XDT=XDT:0 S XDT=$O(^XTV(8992,XQAUSER1,"XQA",XDT)) Q:XDT'>0!(XFLAG=1)  I $D(^XTV(8992,XQAUSER1,"XQA",XDT,0)) D  Q:XFLAG=1  ;P653
"RTN","XQALDATA",115,0)
 .I $P(^XTV(8992,XQAUSER1,"XQA",XDT,0),"^",2)=ALERTID S XFLAG=1 Q  ;P653
"RTN","XQALDATA",116,0)
 I DEFDATE>X D  Q
"RTN","XQALDATA",117,0)
 . S @ROOT@(1)="-1^Deferred Date/Time is greater than 14 days in the future. The alert will not be deferred!"
"RTN","XQALDATA",118,0)
 . Q
"RTN","XQALDATA",119,0)
 S DA(1)=XQAUSER1
"RTN","XQALDATA",120,0)
 S DA=XDT
"RTN","XQALDATA",121,0)
 S DIE="^XTV(8992,"_DA(1)_","_"""XQA"""_","
"RTN","XQALDATA",122,0)
 S DR=".06///^S X=DEFDATE"
"RTN","XQALDATA",123,0)
 ;Lock Subentry
"RTN","XQALDATA",124,0)
 L +^XTV(8992,XQAUSER1,"XQA",DA):10
"RTN","XQALDATA",125,0)
 ;Update value
"RTN","XQALDATA",126,0)
 D ^DIE
"RTN","XQALDATA",127,0)
 K DA,DIE,DR
"RTN","XQALDATA",128,0)
 ;Unlock subentry
"RTN","XQALDATA",129,0)
 ;L -^XTV(8992,XQAUSER1,"XQA",DA)
"RTN","XQALDATA",130,0)
 Q
"RTN","XQALDATA",131,0)
 ;. . . I XCKUSER=XQAUSER&(XNOW<XDEF) S XQUIT=1
"RTN","XQALDATA",132,0)
 Q
"RTN","XQALDEL")
0^2^B61838554
"RTN","XQALDEL",1,0)
XQALDEL ;ISC-SF.SEA/JLI - DELETE ALERTS ;07/16/12  11:40
"RTN","XQALDEL",2,0)
 ;;8.0;KERNEL;**6,24,65,114,174,285,443,602,653**;Jul 10, 1995;Build 37
"RTN","XQALDEL",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified
"RTN","XQALDEL",4,0)
 ;;
"RTN","XQALDEL",5,0)
 Q
"RTN","XQALDEL",6,0)
 ;
"RTN","XQALDEL",7,0)
DELETE ;
"RTN","XQALDEL",8,0)
 N XQAFOUND,XQADAT,XQX,XQK,XQXX,XQXY,XQJ,XQAID1
"RTN","XQALDEL",9,0)
 Q:'$D(XQAID)  Q:XQAID=""  S:'$D(XQAKILL) XQAKILL=0 S:$P(XQAID,";")="NO-ID" XQAKILL=1
"RTN","XQALDEL",10,0)
 S XQADAT=$$NOW^XLFDT()
"RTN","XQALDEL",11,0)
 I '$D(XQAUSER) N XQAUSER S XQAUSER=DUZ
"RTN","XQALDEL",12,0)
 S XQAFOUND=0 D
"RTN","XQALDEL",13,0)
 . S XQX=XQAUSER F XQK=0:0 S XQK=$O(^XTV(8992,XQAUSER,"XQA",XQK)) Q:XQK'>0  I $P(^(XQK,0),U,2)=XQAID S XQAFOUND=1 Q
"RTN","XQALDEL",14,0)
 S XQXX=$O(^XTV(8992.1,"B",XQAID,0)) I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQAUSER,0)) I XQXY>0,XQAFOUND,'$G(XQAUSERD) S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,4)=XQADAT
"RTN","XQALDEL",15,0)
 K XQXX,XQXY
"RTN","XQALDEL",16,0)
 I '$D(^XTV(8992,"AXQA",XQAID,XQAUSER)) D KILLOC
"RTN","XQALDEL",17,0)
 F XQX=0:0 S XQX=$O(^XTV(8992,"AXQA",XQAID,XQX)) Q:XQX'>0  D  Q:XQAKILL
"RTN","XQALDEL",18,0)
 . I XQAKILL S XQX=XQAUSER ; Make sure XQAKILL gets only XQAUSER
"RTN","XQALDEL",19,0)
 . F XQK=0:0 S XQK=$O(^XTV(8992,"AXQA",XQAID,XQX,XQK)) Q:XQK'>0  K ^(XQK),^XTV(8992,"AXQAN",$P(XQAID,";"),XQX,XQK) S XQAID1=XQAID D:$D(^XTV(8992,XQX,"XQA",XQK,0)) DELA S XQAID=XQAID1
"RTN","XQALDEL",20,0)
 K XQAID,XQX,XQJ,XQK,XQAID1,XQAKILL
"RTN","XQALDEL",21,0)
 Q
"RTN","XQALDEL",22,0)
 ;
"RTN","XQALDEL",23,0)
DELETEA ;
"RTN","XQALDEL",24,0)
 N XQA1,XQADAT,XQAFOUND,XQX,XQXX,XQXY,XQK,XQJ
"RTN","XQALDEL",25,0)
 Q:'$D(XQAID)  Q:XQAID=""  S XQA1=$P(XQAID,";")
"RTN","XQALDEL",26,0)
 S XQADAT=$$NOW^XLFDT()
"RTN","XQALDEL",27,0)
 I '$D(XQAUSER) N XQAUSER S XQAUSER=DUZ
"RTN","XQALDEL",28,0)
 S:'$D(XQAKILL) XQAKILL=0 G:$P(XQAID,";")="NO-ID" DELETE
"RTN","XQALDEL",29,0)
 S XQAFOUND=0 D
"RTN","XQALDEL",30,0)
 . S XQX=XQAUSER F XQK=0:0 S XQK=$O(^XTV(8992,XQAUSER,"XQA",XQK)) Q:XQK'>0  I $P($G(^(XQK,0)),U,2)=XQAID S XQAFOUND=1 Q
"RTN","XQALDEL",31,0)
 S XQXX=$O(^XTV(8992.1,"B",XQAID,0)) I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQAUSER,0)) I XQXY>0,XQAFOUND,'$G(XQAUSERD) S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,4)=XQADAT
"RTN","XQALDEL",32,0)
 I '$D(^XTV(8992,"AXQAN",XQA1,XQAUSER)) D KILLOC
"RTN","XQALDEL",33,0)
 I $P(XQAID,",",2)'=""!($P(XQAID,";",2)="") F XQX=0:0 S XQX=$O(^XTV(8992,"AXQAN",XQA1,XQX)) Q:XQX'>0  D  Q:XQAKILL
"RTN","XQALDEL",34,0)
 . I XQAKILL S XQX=XQAUSER
"RTN","XQALDEL",35,0)
 . F XQK=0:0 S XQK=$O(^XTV(8992,"AXQAN",XQA1,XQX,XQK)) Q:XQK'>0  K ^(XQK) I $D(^XTV(8992,XQX,"XQA",XQK,0)) D DELA
"RTN","XQALDEL",36,0)
 I $P(XQAID,",",2)=""&($P(XQAID,";",2)'="") F XQX=0:0 S XQX=$O(^XTV(8992,"AXQA",XQAID,XQX)) Q:XQX'>0  D  Q:XQAKILL
"RTN","XQALDEL",37,0)
 . I XQAKILL S XQX=XQAUSER
"RTN","XQALDEL",38,0)
 . S XQK=$O(^XTV(8992,"AXQA",XQAID,XQX,0)) Q:XQK'>0  K ^(XQK),^XTV(8992,"AXQAN",XQA1,XQX,XQK) I $D(^XTV(8992,XQX,"XQA",XQK,0)) D DELA
"RTN","XQALDEL",39,0)
 K XQAID,XQA1,XQX,XQK,XQAKILL
"RTN","XQALDEL",40,0)
 Q
"RTN","XQALDEL",41,0)
DELA ;
"RTN","XQALDEL",42,0)
 N XQDEL11 S XQAID=$P($G(^XTV(8992,XQX,"XQA",XQK,0)),U,2),XQDEL11=$P($G(^(0)),U) K ^XTV(8992,XQX,"XQA",XQK) K:XQAID'="" ^XTV(8992,"AXQA",XQAID,XQX,XQK)
"RTN","XQALDEL",43,0)
 D COUNT(-1,XQX)
"RTN","XQALDEL",44,0)
 K:XQAID'="" ^XTV(8992,"AXQAN",$P(XQAID,";"),XQX,XQK) K:XQDEL11'="" ^XTV(8992,XQX,"XQA","B",XQDEL11,XQK)
"RTN","XQALDEL",45,0)
 S XQXX=$S(XQAID'="":$O(^XTV(8992.1,"B",XQAID,0)),1:0) I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQX,0)) I XQXY>0,$P(^XTV(8992.1,XQXX,20,XQXY,0),U,5)'>0 S $P(^(0),U,5)=XQADAT I $G(XQAUSERD) S $P(^(0),U,9)=DUZ
"RTN","XQALDEL",46,0)
 K XQXX,XQXY
"RTN","XQALDEL",47,0)
 Q
"RTN","XQALDEL",48,0)
 ;
"RTN","XQALDEL",49,0)
COUNT(%1,%2) ;Change the count on the zero node, (amount, user)
"RTN","XQALDEL",50,0)
 Q:$G(%2)'>0
"RTN","XQALDEL",51,0)
 L +^XTV(8992,%2):10
"RTN","XQALDEL",52,0)
 I %1 S %=$P($G(^XTV(8992,%2,"XQA",0)),U,4)+%1 S:%'<0 $P(^(0),U,4)=%
"RTN","XQALDEL",53,0)
 I '%1 D
"RTN","XQALDEL",54,0)
 . N % S %1=0,%=0 F  S %=$O(^XTV(8992,%2,"XQA",%)) Q:%'>0  S %1=%1+1
"RTN","XQALDEL",55,0)
 . S $P(^XTV(8992,%2,"XQA",0),U,4)=%1
"RTN","XQALDEL",56,0)
 L -^XTV(8992,%2)
"RTN","XQALDEL",57,0)
 Q
"RTN","XQALDEL",58,0)
KILLOC ;
"RTN","XQALDEL",59,0)
 N XQX,XQK
"RTN","XQALDEL",60,0)
 S XQX=XQAUSER F XQK=0:0 S XQK=$O(^XTV(8992,XQAUSER,"XQA",XQK)) Q:XQK'>0  I $P(^(XQK,0),U,2)=XQAID D
"RTN","XQALDEL",61,0)
 . N XQAID D DELA
"RTN","XQALDEL",62,0)
 Q
"RTN","XQALDEL",63,0)
 ;
"RTN","XQALDEL",64,0)
OLDDEL ;
"RTN","XQALDEL",65,0)
 N XQADAT,X2,XQDAT,XQDEL1
"RTN","XQALDEL",66,0)
 S XQADAT=$$NOW^XLFDT()
"RTN","XQALDEL",67,0)
 S X2=-15 I $G(ZTQPARAM)>0 S X2=-ZTQPARAM
"RTN","XQALDEL",68,0)
 S XQDAT=$$FMADD^XLFDT(DT,X2)
"RTN","XQALDEL",69,0)
 ;Loop thru users (XQDEL1) levels
"RTN","XQALDEL",70,0)
 F XQDEL1=0:0 S XQDEL1=$O(^XTV(8992,XQDEL1)) Q:XQDEL1'>0  D OLDDEL1
"RTN","XQALDEL",71,0)
 D KILLARCH
"RTN","XQALDEL",72,0)
 K X1,X2,X,XQDEL1,XQDEL2,XQDAT,XQA,XQADAT
"RTN","XQALDEL",73,0)
 Q
"RTN","XQALDEL",74,0)
OLDDEL1 ;Loop thru the Alert (XQDEL2) level
"RTN","XQALDEL",75,0)
 L +^XTV(8992,XQDEL1):10
"RTN","XQALDEL",76,0)
 N XQAGLOB,KILLOLD,XQAZERO,XQAUSER,XQLIST,Y,XQAV,XQPRAMTY,XQDEL2,XQA
"RTN","XQALDEL",77,0)
 S XQAGLOB=$NA(^XTV(8992,XQDEL1,"XQA")),XQAUSER=XQDEL1
"RTN","XQALDEL",78,0)
 F XQDEL2=0:0 S XQDEL2=$O(@XQAGLOB@(XQDEL2)) Q:XQDEL2'>0  S XQAZERO=^(XQDEL2,0) D
"RTN","XQALDEL",79,0)
 . ; CHECK FOR BACKUP REVIEWER TO FORWARD ALERTS NEEDING ACTION -- P174
"RTN","XQALDEL",80,0)
 . I $P($G(XQAZERO),"^",6)]""&($P($G(XQAZERO),"^",6)>XQDAT) Q  ;For CPRS XU*8.0*653 Quit if the alert was deferred and the deferred date is greater than the purge date.
"RTN","XQALDEL",81,0)
 . I $P(XQAZERO,U,15)>0 I $$FMADD^XLFDT(+XQAZERO,+$P(XQAZERO,U,15))\1=DT D  Q:$D(KILLOLD)  ; changed '>DT to =DT so only send once without killing
"RTN","XQALDEL",82,0)
 . . N XQA D GETBKUP(.XQA,XQDEL1)
"RTN","XQALDEL",83,0)
 . . I $D(XQA) S XQALTYPE="BACKUP REVIEWER" D FORWARD^XQALFWD($P(XQAZERO,U,2),.XQA,"A","ALERT NOT PROCESSED BY "_$$GET1^DIQ(200,XQDEL1_",",.01)) S KILLOLD=1
"RTN","XQALDEL",84,0)
 . . Q  ;  End of Backup Reviewer Code -- P174
"RTN","XQALDEL",85,0)
 . I $P(XQAZERO,U,13)>0 I $$FMADD^XLFDT(+XQAZERO,+$P(XQAZERO,U,13))\1=DT D  Q:$D(KILLOLD)  ; P174
"RTN","XQALDEL",86,0)
 . . N XQA,I F I=0:0 S I=$O(^XMB(3.7,XQAUSER,9,I)) Q:I'>0  S XQAV=+^(I,0),XQA(XQAV)=XQAV
"RTN","XQALDEL",87,0)
 . . I $D(XQA) S XQALTYPE="EMAIL SURROGATE" D FORWARD^XQALFWD($P(XQAZERO,U,2),.XQA,"A","ALERT NOT PROCESSED BY "_$$GET1^DIQ(200,XQDEL1_",",.01)) S KILLOLD=1
"RTN","XQALDEL",88,0)
 . . Q
"RTN","XQALDEL",89,0)
 . I $P(XQAZERO,U,14)>0 I $$FMADD^XLFDT(+XQAZERO,+$P(XQAZERO,U,14))\1=DT D  Q:$D(KILLOLD)  ; P174
"RTN","XQALDEL",90,0)
 . . N XQA,I S I=$P($G(^VA(200,XQAUSER,5)),U) I I>0 S I=$P($G(^DIC(49,+I,0)),U,3) I I>0,$D(^VA(200,+I,0)) S XQA(+I)=+I
"RTN","XQALDEL",91,0)
 . . I $D(XQA) S XQALTYPE="CHIEF/SUPERVISOR" D FORWARD^XQALFWD($P(XQAZERO,U,2),.XQA,"A","ALERT NOT PROCESSED BY "_$$GET1^DIQ(200,XQDEL1_",",.01)) S KILLOLD=1
"RTN","XQALDEL",92,0)
 . . Q
"RTN","XQALDEL",93,0)
 . I XQDEL2'>XQDAT  D OLDDEL2
"RTN","XQALDEL",94,0)
 . Q
"RTN","XQALDEL",95,0)
 K:$O(^XTV(8992,XQDEL1,"XQA",0))="" ^XTV(8992,XQDEL1,"XQA")
"RTN","XQALDEL",96,0)
 L -^XTV(8992,XQDEL1)
"RTN","XQALDEL",97,0)
 Q
"RTN","XQALDEL",98,0)
 ;
"RTN","XQALDEL",99,0)
OLDDEL2 ;
"RTN","XQALDEL",100,0)
 N XQA,XQXX,XQXY
"RTN","XQALDEL",101,0)
 S XQA=$P(^XTV(8992,XQDEL1,"XQA",XQDEL2,0),U,2) K ^XTV(8992,XQDEL1,"XQA",XQDEL2) K:XQA'="" ^XTV(8992,"AXQA",XQA,XQDEL1),^XTV(8992,"AXQAN",$P(XQA,";"),XQDEL1)
"RTN","XQALDEL",102,0)
 D COUNT(-1,XQDEL1)
"RTN","XQALDEL",103,0)
 I XQA'="" S XQXX=$O(^XTV(8992.1,"B",XQA,0)) I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQDEL1,0)) I XQXY>0 S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,6)=XQADAT
"RTN","XQALDEL",104,0)
 Q
"RTN","XQALDEL",105,0)
 ;
"RTN","XQALDEL",106,0)
KILLARCH ;
"RTN","XQALDEL",107,0)
 ;  Q  ; turn off deletion from ALERT TRACKING file ; remove from XU*8*285  JLI 040624
"RTN","XQALDEL",108,0)
 N DA,DIK,XQDAT,XQDEL1,X1,X2,DA,DIK
"RTN","XQALDEL",109,0)
 S XQDAT=$$FMADD^XLFDT(DT,-30)
"RTN","XQALDEL",110,0)
 F XQDEL1=0:0 S XQDEL1=$O(^XTV(8992.1,XQDEL1)) Q:XQDEL1'>0  D
"RTN","XQALDEL",111,0)
 . S X1=$P($G(^XTV(8992.1,XQDEL1,0)),U,2),X2=$P($G(^(0)),U,8)
"RTN","XQALDEL",112,0)
 . S DA=XQDEL1 I X2="",X1>XQDAT Q
"RTN","XQALDEL",113,0)
 . I X2>0,DT<X2 Q
"RTN","XQALDEL",114,0)
 . S DIK="^XTV(8992.1," D ^DIK
"RTN","XQALDEL",115,0)
 Q
"RTN","XQALDEL",116,0)
 ;
"RTN","XQALDEL",117,0)
USERDEL ; Delete undesired alerts for a user
"RTN","XQALDEL",118,0)
 N DA,DIC,XQAUSERD
"RTN","XQALDEL",119,0)
 S DIC("A")="Select NEW PERSON entry for deletion of alerts: "
"RTN","XQALDEL",120,0)
 S DIC(0)="AEQM",DIC=200
"RTN","XQALDEL",121,0)
 D ^DIC K DIC Q:Y'>0  S XQAUSER=+Y
"RTN","XQALDEL",122,0)
 S XQALDELE=1
"RTN","XQALDEL",123,0)
 K XQX1
"RTN","XQALDEL",124,0)
 D DOIT^XQALERT1
"RTN","XQALDEL",125,0)
 K XQALDELE S XQAUSERD=1
"RTN","XQALDEL",126,0)
 I $D(XQX1),XQX1>0 D
"RTN","XQALDEL",127,0)
 . F  Q:XQX1=""  S DA=+XQX1,XQX1=$P(XQX1,",",2,99) D  I XQX1="" S Y=$O(XQX1(0)) I Y>0 S XQX1=XQX1(Y) K XQX1(Y)
"RTN","XQALDEL",128,0)
 . . I $P(^TMP("XQ",$J,"XQA1",DA),U,6)]"" N XQADAT S XQADAT=$$NOW^XLFDT() I $P(^TMP("XQ",$J,"XQA1",DA),U,6)>XQADAT D  Q  ;For CPRS P653
"RTN","XQALDEL",129,0)
 . . . N Y S Y=$P(^TMP("XQ",$J,"XQA1",DA),U,1) D DD^%DT W !!,?10,"Alert Deferred - Alert "_Y_" Not Deleted!" Q
"RTN","XQALDEL",130,0)
 . . S XQAID=$P(^TMP("XQ",$J,"XQA1",DA),U,2),XQAKILL=1
"RTN","XQALDEL",131,0)
 . . I XQAID="" K ^XTV(8992,XQAUSER,"XQA",+^TMP("XQ",$J,"XQA1",DA,1))
"RTN","XQALDEL",132,0)
 . . I XQAID'="" D DELETE
"RTN","XQALDEL",133,0)
 . . K ^TMP("XQ",$J,"XQA1",DA),^TMP("XQ",$J,"XQA",(999999-DA))
"RTN","XQALDEL",134,0)
 K XQAUSER,XQX1
"RTN","XQALDEL",135,0)
 Q
"RTN","XQALDEL",136,0)
 ;
"RTN","XQALDEL",137,0)
GETBKUP(XQA,XQAUSER) ;  JLI 030129 - REMOVED TO SEPARATE METHOD
"RTN","XQALDEL",138,0)
 N I,XQORY,XQENTITY,XQPARAM,XQERR,K,XQAV,XQLIST
"RTN","XQALDEL",139,0)
 S XQPARAM="XQAL BACKUP REVIEWER"
"RTN","XQALDEL",140,0)
 D GETLST^XPAR(.XQLIST,"USR.`"_XQAUSER,XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=200 ; USER
"RTN","XQALDEL",141,0)
 I '($D(XQLIST)>1) S I=$$GET1^DIQ(200,XQAUSER_",",29,"I") I I>0 D GETLST^XPAR(.XQLIST,"SRV.`"_I,XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=49 ; SERVICE
"RTN","XQALDEL",142,0)
 I '($D(XQLIST)>1) D GETLST^XPAR(.XQLIST,$$DIVENTIT(XQAUSER),XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=4 ; DIVISION
"RTN","XQALDEL",143,0)
 I '($D(XQLIST)>1) D GETLST^XPAR(.XQLIST,"SYS",XQPARAM,"Q",.XQERR) S:$D(XQLIST)>1 XQPRAMTY=4.2 ; SYSTEM
"RTN","XQALDEL",144,0)
 F I=0:0 S I=$O(XQLIST(I)) Q:I'>0  S XQAV=$P(XQLIST(I),U,2),XQA(XQAV)=XQAV
"RTN","XQALDEL",145,0)
 ; Removed Teams per Curtis Anderson with CPRS
"RTN","XQALDEL",146,0)
 ;I '$D(XQA) D  ; NONE UNDER USER - CHECK FOR ENTRIES IN PARAMETER FILE FOR TEAMS
"RTN","XQALDEL",147,0)
 ;. I $T(TEAMPR^ORQPTQ1)]"" D TEAMPR^ORQPTQ1(.XQORY,XQAUSER) K:+$G(XQORY(1))<1 XQORY ; GET TEAM ID'S IF ANY ; CONTROLLED SUBSCRIPTION
"RTN","XQALDEL",148,0)
 ;. S I=0 F  S I=$O(XQORY(I)) Q:I'>0  K XQLIST D GETLST^XPAR(.XQLIST,$P(XQORY(I),U,2)_";OR(100.21,",XQPARAM,"Q",.ERR) I $D(XQTEAM) D
"RTN","XQALDEL",149,0)
 ;. . N K F K=0:0 S K=$O(XQLIST(K)) Q:K'>0  S XQAV=$P(XQLIST(K),U,2),XQA(XQAV)=XQAV
"RTN","XQALDEL",150,0)
 ;. . Q`
"RTN","XQALDEL",151,0)
 ;. Q
"RTN","XQALDEL",152,0)
 ;I '$D(XQLIST) D  ; NO TEAM ENTRIES, CHECK OTHER ENTITIES (SERVICE,DIVISION,SYSTEM)
"RTN","XQALDEL",153,0)
 ;. S XQENTITY="SYS"
"RTN","XQALDEL",154,0)
 ;. S I=$$GET1^DIQ(200,XQAUSER_",",16,"I") I I>0 S XQENTITY="DIV.`"_I_U_XQENTITY ; DIVISION
"RTN","XQALDEL",155,0)
 ;. S I=$$GET1^DIQ(200,XQAUSER_",",29,"I") I I>0 S XQENTITY="SRV.`"_I_U_XQENTITY ; SERVICE\SECTION
"RTN","XQALDEL",156,0)
 ;. D GETLST^XPAR(.XQLIST,XQENTITY,XQPARAM,"Q",.XQERR) F I=0:0 S I=$O(XQLIST(I)) Q:I'>0  S XQAV=+$P(XQLIST(I),U,2),XQA(XQAV)=XQAV
"RTN","XQALDEL",157,0)
 ;. Q
"RTN","XQALDEL",158,0)
 ;I '$D(XQA) D  ; NO PARAMETERS ENTERED - USE LAST RESORT MAIL GROUP
"RTN","XQALDEL",159,0)
 ;. S XQJ="G.XQAL UNPROCESSED ALERTS" D GROUP^XQALSET1
"RTN","XQALDEL",160,0)
 ;. I '$D(XQA) S XQJ="G.PATCH" D GROUP^XQALSET1 ; REALLY LAST RESORT
"RTN","XQALDEL",161,0)
 ;. F I=0:0 S I=$O(XQA(I)) Q:I'>0  S XQA(I)=I
"RTN","XQALDEL",162,0)
 ;. Q
"RTN","XQALDEL",163,0)
 Q
"RTN","XQALDEL",164,0)
 ;
"RTN","XQALDEL",165,0)
DIVENTIT(XQAUSER) ;
"RTN","XQALDEL",166,0)
 N ENTITY,NCNT,DIVNAM,I
"RTN","XQALDEL",167,0)
 S ENTITY="" I DUZ=XQAUSER S ENTITY="DIV.`"_DUZ(2)
"RTN","XQALDEL",168,0)
 I ENTITY="" D
"RTN","XQALDEL",169,0)
 . K NCNT,DIVNAM S NCNT=0 F I=0:0 S I=$O(^VA(200,XQAUSER,2,I)) Q:I'>0  S NCNT=NCNT+1,DIVNAM(NCNT)=+^(I,0) I $P(^(0),U,2) S DIVNAM=+^(0)
"RTN","XQALDEL",170,0)
 . I NCNT'>0 Q
"RTN","XQALDEL",171,0)
 . I NCNT=1 S ENTITY="DIV.`"_DIVNAM(1) Q
"RTN","XQALDEL",172,0)
 . I $D(DIVNAM)#2 S ENTITY="DIV.`"_DIVNAM Q
"RTN","XQALDEL",173,0)
 . F I=1:1:NCNT S ENTITY="DIV.`"_DIVNAM(I)_$S(ENTITY'="":U,1:"")_ENTITY
"RTN","XQALDEL",174,0)
 I ENTITY="" S ENTITY="DIV.`"_$$GET1^DIQ(8989.3,"1,",217,"I")
"RTN","XQALDEL",175,0)
 Q ENTITY
"RTN","XQALDEL",176,0)
 ;
"RTN","XQALDEL",177,0)
BKUPREVW ;OPT - SET BACKUP REVIEWER(S) IN PARAMETER FILE
"RTN","XQALDEL",178,0)
 G BKUPREVW^XQALBUTL
"RTN","XQALDEL",179,0)
 ;
"RTN","XQALSET")
0^3^B72706141
"RTN","XQALSET",1,0)
XQALSET ;ISC-SF.SEA/JLI - SETUP ALERTS ;4/10/07  14:06
"RTN","XQALSET",2,0)
 ;;8.0;KERNEL;**1,6,65,75,114,125,173,207,285,443,602,653**;Jul 10, 1995;Build 37
"RTN","XQALSET",3,0)
 ;Per VHA Directive 2004-038, this routine should not be modified
"RTN","XQALSET",4,0)
 ;;
"RTN","XQALSET",5,0)
 Q
"RTN","XQALSET",6,0)
 ; Original entry point - throw away return value since no value expected
"RTN","XQALSET",7,0)
SETUP ;
"RTN","XQALSET",8,0)
 N I S I=$$SETUP1() K XQALERR
"RTN","XQALSET",9,0)
 Q
"RTN","XQALSET",10,0)
 ;
"RTN","XQALSET",11,0)
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.
"RTN","XQALSET",12,0)
 ; If not successful XQALERR is defined and contains reason for failure.
"RTN","XQALSET",13,0)
 K XQALERR
"RTN","XQALSET",14,0)
 I $O(XQA(0))="" S XQALERR="No recipient list in XQA array" Q 0
"RTN","XQALSET",15,0)
 I '($D(XQAMSG)#2)!($G(XQAMSG)="") S XQALERR="No valid XQAMSG for display" Q 0
"RTN","XQALSET",16,0)
 N X,XQI,XQJ,XQX,XQK,XQACOMNT,XQARESET,DA,XQADA,XQALTYPE
"RTN","XQALSET",17,0)
 S XQALTYPE="INITIAL RECIPIENT"
"RTN","XQALSET",18,0)
 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_" "
"RTN","XQALSET",19,0)
NOW S XQX=$$NOW^XLFDT()
"RTN","XQALSET",20,0)
 S:$S('$D(XQAID):1,XQAID="":1,1:0) XQAID="NO-ID" S:XQAID[";" XQAID=$P(XQAID,";") S XQA1=XQAID,XQI=XQX
"RTN","XQALSET",21,0)
 S XQAID=$$SETIEN(XQA1,XQX),XQADA=""
"RTN","XQALSET",22,0)
 Q $$REENT()
"RTN","XQALSET",23,0)
 ;
"RTN","XQALSET",24,0)
REENT() ; Entry for forwarding, etc.
"RTN","XQALSET",25,0)
 N RETVAL S RETVAL=1
"RTN","XQALSET",26,0)
 K ^TMP("XQAGROUP",$J) ; P443 - clear location for storage of groups processed
"RTN","XQALSET",27,0)
 N XQADATIM,XQALIST,XQALIST1,XQNRECIP S XQNRECIP=0 S XQADATIM=$$NOW^XLFDT()
"RTN","XQALSET",28,0)
 S XQALIN1=$S($D(XQAID)#2:XQAID,1:"")_U_$E(XQAMSG,1,95)_"^1^"_$S(XQAOPT1=U:"D",1:"R")_U_$S($D(XQACTMSG):$E(XQACTMSG,1,40),1:"")_U_XQAOPT1
"RTN","XQALSET",29,0)
 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
"RTN","XQALSET",30,0)
 S XQALIN=XQX_U_XQALIN1,XQJ=0
"RTN","XQALSET",31,0)
 K XQALIN1 S:$D(XQADATA) XQALIN1=XQADATA
"RTN","XQALSET",32,0)
LOOP1 S XQJ=$O(XQA(" ")) I XQJ'="" K:"G.g."'[$E(XQJ_",,",1,2) XQA(XQJ) D:$D(XQA(XQJ)) GROUP^XQALSET1 G LOOP1
"RTN","XQALSET",33,0)
LOOP2 ; RE-ENTRY FOR FORWARDING IF ALL RECIPIENTS ARE UNDELIVERABLE
"RTN","XQALSET",34,0)
 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
"RTN","XQALSET",35,0)
 ; The following section of code was added to provide a generalized way to handle surrogates
"RTN","XQALSET",36,0)
 F XQJ=0:0 S XQJ=$O(XQA(XQJ)) Q:XQJ=""  D
"RTN","XQALSET",37,0)
 . N X S X=$$ACTVSURO^XQALSURO(XQJ) I X>0 D  ; Modified to get final surrogate if a sequence of them
"RTN","XQALSET",38,0)
 . . S XQA(X)="" K XQA(XQJ) ; Add Surrogate to XQA array, delete XQJ entry
"RTN","XQALSET",39,0)
 . . S XQALIST(X,$O(XQALIST(XQJ,""))_"-SURROGATE")="" ; Add Surrogate to XQALIST with same type as original
"RTN","XQALSET",40,0)
 . . S XQALIST(X,"z AS_SURO",XQJ)="" ; Mark user as in list as a surrogate, subscript for surrogate to
"RTN","XQALSET",41,0)
 . . S XQALIST(XQJ,"z TO_SURO",X)=""
"RTN","XQALSET",42,0)
 . . Q
"RTN","XQALSET",43,0)
 . Q
"RTN","XQALSET",44,0)
 ;
"RTN","XQALSET",45,0)
 S XQJ=0
"RTN","XQALSET",46,0)
LOOP ;
"RTN","XQALSET",47,0)
 S XQJ=$O(XQA(XQJ)) G:XQJ="" WRAP
"RTN","XQALSET",48,0)
 ;
"RTN","XQALSET",49,0)
 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
"RTN","XQALSET",50,0)
 ;
"RTN","XQALSET",51,0)
 I '$D(^XTV(8992,XQJ,0)) D  I '$D(^XTV(8992,XQJ,0)) S ^(0)=XQJ
"RTN","XQALSET",52,0)
 . N FDA,IENS
"RTN","XQALSET",53,0)
 . F  D  Q:'$D(DIERR)  Q:'$D(^TMP("DIERR",$J,"E",110))&'$D(^TMP("DIERR",$J,"E",111))
"RTN","XQALSET",54,0)
 . . K DIERR,^TMP("DIERR",$J)
"RTN","XQALSET",55,0)
 . . S FDA=$NA(^TMP($J,"XQALSET")) K @FDA S @FDA@(8992,"+1,",.01)=XQJ
"RTN","XQALSET",56,0)
 . . S IENS(1)=XQJ
"RTN","XQALSET",57,0)
 . . D UPDATE^DIE("S",FDA,"IENS")
"RTN","XQALSET",58,0)
 . . Q
"RTN","XQALSET",59,0)
 . Q
"RTN","XQALSET",60,0)
 L +^XTV(8992,XQJ):10 S XQXI=XQX S:'$D(^XTV(8992,XQJ,"XQA",0)) ^(0)="^8992.01DA^"
"RTN","XQALSET",61,0)
REP I $D(^XTV(8992,XQJ,"XQA",XQXI,0)) S XQXI=XQXI+.00000001 G REP
"RTN","XQALSET",62,0)
 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)
"RTN","XQALSET",63,0)
 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
"RTN","XQALSET",64,0)
 L -^XTV(8992,XQJ)
"RTN","XQALSET",65,0)
 K XQA(XQJ) S:XQAID'="" ^XTV(8992,"AXQA",XQAID,XQJ,XQXI)="",^XTV(8992,"AXQAN",XQA1,XQJ,XQXI)=""
"RTN","XQALSET",66,0)
 S XQNRECIP=XQNRECIP+1
"RTN","XQALSET",67,0)
 G LOOP
"RTN","XQALSET",68,0)
 ;
"RTN","XQALSET",69,0)
WRAP ;
"RTN","XQALSET",70,0)
 M XQALIST1=XQALIST
"RTN","XQALSET",71,0)
 I XQNRECIP=0,'$$SNDNACTV(XQAID) S RETVAL=0,XQALERR="NO ACTIVE RECIPIENTS - OLDER TIU ALERTS"
"RTN","XQALSET",72,0)
 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
"RTN","XQALSET",73,0)
 . 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))=""
"RTN","XQALSET",74,0)
 . I $D(XQA) D CHEKACTV^XQALSET1(.XQA)
"RTN","XQALSET",75,0)
 . 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
"RTN","XQALSET",76,0)
 . I '$D(XQA) S XQJ="G.PATCHES" D GROUP^XQALSET1 S XQALTYPE="LAST HOPE" ; Last gasp, send it to G.PATCHES
"RTN","XQALSET",77,0)
 . I '$D(XQA) S XQJ="G.PATCH" D GROUP^XQALSET1 S XQALTYPE="LAST HOPE" ; Last gasp, send it to G.PATCH
"RTN","XQALSET",78,0)
 . 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
"RTN","XQALSET",79,0)
 . Q
"RTN","XQALSET",80,0)
 ; END OF JLI 030129 INSERTION P285
"RTN","XQALSET",81,0)
 ; moved recording of users in Alert Tracking file to here to include all of them  030220
"RTN","XQALSET",82,0)
 ; modified code to use FM calls instead of direct global references
"RTN","XQALSET",83,0)
 I RETVAL,$G(XQADA)'>0,XQAID'="" D SETTRACK ; moved to here to avoid tracking entries with no users
"RTN","XQALSET",84,0)
 ;
"RTN","XQALSET",85,0)
 I RETVAL,$G(XQADA)>0 L +^XTV(8992.1,XQADA):10 D  L -^XTV(8992.1,XQADA) ; 030131
"RTN","XQALSET",86,0)
 . F XQJ=0:0 S XQJ=$O(XQALIST1(XQJ)) Q:XQJ'>0  D
"RTN","XQALSET",87,0)
 . . N NCOUNT,SUBSCRPT,SUBSCRPN,KCNT,IENVAL
"RTN","XQALSET",88,0)
 . . S IENVAL=XQADA_",",KCNT=$$FIND1^DIC(8992.11,","_IENVAL,"Q",XQJ)
"RTN","XQALSET",89,0)
 . . S FDA=$NA(^TMP($J,"XQALSET")) K @FDA I KCNT=0 S @FDA@(8992.11,"+1,"_IENVAL,.01)=XQJ,KCNT="+1"
"RTN","XQALSET",90,0)
 . . S IENVAL=","_KCNT_","_IENVAL,NCOUNT=1 S SUBSCRPT="" F  S SUBSCRPT=$O(XQALIST1(XQJ,SUBSCRPT)) Q:SUBSCRPT=""  I $E(SUBSCRPT,1)'="z" D
"RTN","XQALSET",91,0)
 . . . S SUBSCRPN=$$FIND1^DIC(8992.2,"","X",SUBSCRPT) I SUBSCRPN'>0 D
"RTN","XQALSET",92,0)
 . . . . 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))
"RTN","XQALSET",93,0)
 . . . . Q
"RTN","XQALSET",94,0)
 . . . S NCOUNT=NCOUNT+1,@FDA@(8992.111,"+"_NCOUNT_IENVAL,.01)=SUBSCRPN,@FDA@(8992.111,"+"_NCOUNT_IENVAL,.04)=XQADATIM
"RTN","XQALSET",95,0)
 . . . Q
"RTN","XQALSET",96,0)
 . . I $D(XQALIST1(XQJ,"z TO_SURO")) S @FDA@(8992.111,"+"_NCOUNT_IENVAL,.02)=$O(XQALIST1(XQJ,"z TO_SURO",0))
"RTN","XQALSET",97,0)
 . . I $D(XQALIST1(XQJ,"z AS_SURO")) D
"RTN","XQALSET",98,0)
 . . . S @FDA@(8992.111,"+"_NCOUNT_IENVAL,.03)="Y"
"RTN","XQALSET",99,0)
 . . . 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
"RTN","XQALSET",100,0)
 . . . Q
"RTN","XQALSET",101,0)
 . . S SUBSCRPT=$O(XQALIST1(XQJ,"")) I SUBSCRPT'["INITIAL" S SUBSCRPT=$P(SUBSCRPT,"-") D  ; FORWARDING
"RTN","XQALSET",102,0)
 . . . S SUBSCRPN=$$FIND1^DIC(8992.2,"","X",SUBSCRPT) I SUBSCRPN'>0 D
"RTN","XQALSET",103,0)
 . . . . 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))
"RTN","XQALSET",104,0)
 . . . . Q
"RTN","XQALSET",105,0)
 . . . 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
"RTN","XQALSET",106,0)
 . . . I $G(XQAUSER)>0 S @FDA@(8992.112,"+"_NCOUNT_IENVAL,.03)=XQAUSER
"RTN","XQALSET",107,0)
 . . . Q
"RTN","XQALSET",108,0)
 . . N IENSTR D UPDATE^DIE("",FDA,"IENSTR")
"RTN","XQALSET",109,0)
 . . Q
"RTN","XQALSET",110,0)
 . Q
"RTN","XQALSET",111,0)
 ;
"RTN","XQALSET",112,0)
 I RETVAL S RETVAL=RETVAL_U_$G(XQADA)_U_XQAID
"RTN","XQALSET",113,0)
 K:XQAID'="" ^XTV(8992,"AXQA",XQAID,0,0)
"RTN","XQALSET",114,0)
 K ^TMP("XQAGROUP",$J) ; P443 - clear global used to track processing of groups
"RTN","XQALSET",115,0)
 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
"RTN","XQALSET",116,0)
 Q RETVAL
"RTN","XQALSET",117,0)
 ;
"RTN","XQALSET",118,0)
SNDNACTV(XQAID) ; Determine if we go ahead and send alerts addressed only to inactive users to backup reviewers
"RTN","XQALSET",119,0)
 N XVAL
"RTN","XQALSET",120,0)
 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
"RTN","XQALSET",121,0)
 Q 1
"RTN","XQALSET",122,0)
 ;
"RTN","XQALSET",123,0)
SETIEN(XQA1,XQI) ; determine unique XQAID value for alert
"RTN","XQALSET",124,0)
 N XQAID
"RTN","XQALSET",125,0)
 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
"RTN","XQALSET",126,0)
 . I $D(^XTV(8992,"AXQA",XQAID)) Q
"RTN","XQALSET",127,0)
 . S ^XTV(8992,"AXQA",XQAID,0,0)="",XQI=""
"RTN","XQALSET",128,0)
 . Q
"RTN","XQALSET",129,0)
 Q XQAID
"RTN","XQALSET",130,0)
 ;
"RTN","XQALSET",131,0)
SETTRACK ; Setup entry in Alert Tracking file
"RTN","XQALSET",132,0)
 ; Note: if there are error messages or we can't create an entry for some reason, it simply returns and continues
"RTN","XQALSET",133,0)
 N FDA,IENS,XQA2,DIERR
"RTN","XQALSET",134,0)
 S XQADA=0
"RTN","XQALSET",135,0)
 S XQA2=XQA1 I XQA2[",",$P(XQA2,",",3)'="" S XQA2=$P(XQA2,",")_","_$P(XQA2,",",3)
"RTN","XQALSET",136,0)
 F  D  Q:'$D(DIERR)  Q:'$D(^TMP("DIERR",$J,"E",111))
"RTN","XQALSET",137,0)
 . K DIERR,^TMP("DIERR",$J)
"RTN","XQALSET",138,0)
 . S FDA=$NA(^TMP($J,"XQALSET")) K @FDA
"RTN","XQALSET",139,0)
 . S @FDA@(8992.1,"+1,",.01)=XQAID D UPDATE^DIE("",FDA,"IENS")
"RTN","XQALSET",140,0)
 . K @FDA
"RTN","XQALSET",141,0)
 . Q
"RTN","XQALSET",142,0)
 I $D(DIERR) Q  ;S XQDIERR1=DIERR M XQDIERR=^TMP("DIERR",$J) Q
"RTN","XQALSET",143,0)
 Q:IENS(1)'>0  S (DA,XQADA)=IENS(1)
"RTN","XQALSET",144,0)
 S IENS=IENS(1)_",",@FDA@(8992.1,IENS,.02)=XQX,^(.03)=XQA2,^(.05)=DUZ,^(1.01)=XQAMSG
"RTN","XQALSET",145,0)
 I $D(XQAARCH) S X=$$FMADD^XLFDT(DT,XQAARCH) I X>DT S @FDA@(8992.1,IENS,.08)=X
"RTN","XQALSET",146,0)
 I $P(XQA1,",")="OR",$P(XQA1,",",2)>0 S @FDA@(8992.1,IENS,.04)=$P(XQA1,",",2)
"RTN","XQALSET",147,0)
 I $D(ZTQUEUED) S @FDA@(8992.1,IENS,.06)=1
"RTN","XQALSET",148,0)
 I $D(XQAOPT)#2 S @FDA@(8992.1,IENS,1.02)=XQAOPT
"RTN","XQALSET",149,0)
 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)
"RTN","XQALSET",150,0)
 I $D(XQACTMSG) S @FDA@(8992.1,IENS,1.05)=XQACTMSG
"RTN","XQALSET",151,0)
 I $D(XQADATA) S @FDA@(8992.1,IENS,2)=XQADATA
"RTN","XQALSET",152,0)
 I $D(XQAGUID) S @FDA@(8992.1,IENS,3.01)=XQAGUID
"RTN","XQALSET",153,0)
 I $D(XQADFN) S @FDA@(8992.1,IENS,.04)=XQADFN
"RTN","XQALSET",154,0)
 D FILE^DIE("KS",FDA)
"RTN","XQALSET",155,0)
 I $D(XQATEXT) D WP^DIE(8992.1,IENS,4,"","XQATEXT")
"RTN","XQALSET",156,0)
 Q
"RTN","XQALSET",157,0)
 ;
"RTN","XQALSET",158,0)
CHEKUSER(XQAUSER) ; .SR Returns 0 if no valid user or surrogate, otherwise returns IEN of user or surrogate
"RTN","XQALSET",159,0)
 Q $$CHEKUSER^XQALSET1(XQAUSER)
"RTN","XQALSET",160,0)
 ;
"UP",8992,8992.01,-1)
8992^XQA
"UP",8992,8992.01,0)
8992.01
"VER")
8.0^22.2
"^DD",8992,8992.01,.03,0)
MESSAGE TEXT^FJ95I^^0;3^K:$L(X)>95!($L(X)<3) X
"^DD",8992,8992.01,.03,3)
Answer must be 3-95 characters in length.
"^DD",8992,8992.01,.03,21,0)
^.001^4^4^3160803^^^
"^DD",8992,8992.01,.03,21,1,0)
This field contains the text of the message to be presented to the user at
"^DD",8992,8992.01,.03,21,2,0)
the time when he cycles through the menu system the first time after the
"^DD",8992,8992.01,.03,21,3,0)
alert has been filed for the user, and when the user selects the VIEW
"^DD",8992,8992.01,.03,21,4,0)
ALERTS option.
"^DD",8992,8992.01,.03,"DT")
3160803
"^DD",8992,8992.01,.06,0)
ALERT DEFERRED DATE/TIME^D^^0;6^S %DT="ESTX" D ^%DT S X=Y K:Y<1 X
"^DD",8992,8992.01,.06,3)
Enter a date and time that will defer the alert until after the date and time has elapsed.
"^DD",8992,8992.01,.06,21,0)
^.001^4^4^3140804^^^^
"^DD",8992,8992.01,.06,21,1,0)
This field stores the alert deferred date/time. If this field is populated
"^DD",8992,8992.01,.06,21,2,0)
with a date and time,  the alert will not display for the user until
"^DD",8992,8992.01,.06,21,3,0)
after the date/time has passed.
"^DD",8992,8992.01,.06,21,4,0)
 
"^DD",8992,8992.01,.06,23,0)
^.001^1^1^3140804^^^^
"^DD",8992,8992.01,.06,23,1,0)
 
"^DD",8992,8992.01,.06,"DT")
3140804
"^DD",8992.1,8992.1,1.01,0)
DISPLAY TEXT^FJ95I^^1;1^K:$L(X)>95!($L(X)<2) X
"^DD",8992.1,8992.1,1.01,3)
Answer must be 2-95 characters in length.
"^DD",8992.1,8992.1,1.01,"DT")
3160824
**END**
**END**
