XQALDATA ;ISC/JLI ISD/HGW - PROVIDE DATA ON ALERTS ;07/05/12 13:08
;;8.0;KERNEL;**207,285,443,513,602**;Jul 10, 1995;Build 10
;Per VHA Directive 2004-038, this routine should not be modified
Q
GETUSER(ROOT,XQAUSER,FRSTDATE,LASTDATE) ; SR. ICR #4834 (private OE/RR)
N XREF,XVAL,X,X2,X3,I,NCNT ; P443
S:$G(XQAUSER)'>0 XQAUSER=DUZ
S:$G(FRSTDATE)'>0 FRSTDATE=0
S:$G(LASTDATE)'>0 LASTDATE=0
S NCNT=0 K @ROOT
I FRSTDATE=0 D Q
. 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
. . S NCNT=NCNT+1
. . 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
. S @ROOT=NCNT
S XREF="R"
S XVAL=XQAUSER
D CHKTRAIL
Q
GETPAT(ROOT,PATIENT,FRSTDATE,LASTDATE) ;
N XREF,XVAL,NCNT
S NCNT=0 K @ROOT
I $G(PATIENT)'>0 S @ROOT=0 Q
S XREF="C"
S XVAL=PATIENT
D CHKTRAIL
Q
CHKTRAIL ;
; ZEXCEPT: FRSTDATE,LASTDATE,NCNT,ROOT,XREF,XVAL -- from GETPAT or GETUSER
N XQ1,X,X1,X2,X3
F XQ1=0:0 S XQ1=$O(^XTV(8992.1,XREF,XVAL,XQ1)) Q:XQ1'>0 D
. S X=$G(^XTV(8992.1,XQ1,0)),X1=$G(^(1)),X3=$G(^(3)),X2=$G(^(2)) Q:X=""
. I FRSTDATE'>0,'$D(^XTV(8992,"AXQA",$P(X,U))) Q
. I FRSTDATE>0,$P(X,U,2)<FRSTDATE Q
. I FRSTDATE>0,LASTDATE>0,$P(X,U,2)>LASTDATE Q
. S NCNT=NCNT+1
. 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
S @ROOT=NCNT
Q
GETUSER1(ROOT,XQAUSER,FRSTDATE,LASTDATE) ;
N NCNT,KEY
S:$G(XQAUSER)'>0 XQAUSER=DUZ
S:$G(FRSTDATE)'>0 FRSTDATE=0
S:$G(LASTDATE)'>0 LASTDATE=0
I $$ACTVSURO^XQALSURO(XQAUSER)'>0 D RETURN^XQALSUR1(XQAUSER) ; P513
S NCNT=0 K @ROOT
I FRSTDATE=0 D Q
. N X,X2,X3,X4,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)) D
. . I $P(X,U,4)'="" D
. . . N XQAID,XQXX,XQXY,XQADAT ; P513, update ALERT TRACKING FILE
. . . S $P(^XTV(8992,XQAUSER,"XQA",I,0),U,4)="" ; P513 - MARK SEEN
. . . S XQAID=$P(X,U,2) ; P513
. . . S XQXX=$O(^XTV(8992.1,"B",XQAID,0)),XQXY=0,XQADAT=$$NOW^XLFDT() ; P513
. . . I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",XQAUSER,0)) I XQXY>0 D
. . . . I $P(^XTV(8992.1,XQXX,20,XQXY,0),U,2)="" S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,2)=XQADAT
. . . . I $P(^XTV(8992.1,XQXX,20,XQXY,0),U,3)="" S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,3)=XQADAT
. . S NCNT=NCNT+1
. . 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)
. . I X2'="" D
. . . 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)
. . . I $P(X2,U,3)'="" S NCNT=NCNT+1,@ROOT@(NCNT)=KEY_"-----"_$P(X2,U,3)_U_$P(X,U,2)
. . . Q
. S @ROOT=NCNT
. Q
Q
XQALDATA ;ISC/JLI ISD/HGW - PROVIDE DATA ON ALERTS ;07/05/12 13:08
+1 ;;8.0;KERNEL;**207,285,443,513,602**;Jul 10, 1995;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
GETUSER(ROOT,XQAUSER,FRSTDATE,LASTDATE) ; SR. ICR #4834 (private OE/RR)
+1 ; P443
NEW XREF,XVAL,X,X2,X3,I,NCNT
+2 IF $GET(XQAUSER)'>0
SET XQAUSER=DUZ
+3 IF $GET(FRSTDATE)'>0
SET FRSTDATE=0
+4 IF $GET(LASTDATE)'>0
SET LASTDATE=0
+5 SET NCNT=0
KILL @ROOT
+6 IF FRSTDATE=0
Begin DoDot:1
+7 FOR I=0:0
SET I=$ORDER(^XTV(8992,XQAUSER,"XQA",I))
IF I'>0
QUIT
SET X=^(I,0)
SET X3=$GET(^(3))
SET X2=$GET(^(2))
Begin DoDot:2
+8 SET NCNT=NCNT+1
+9 ; P443
SET @ROOT@(NCNT)=$SELECT($PIECE(X3,U)'="":"G ",$PIECE(X,U,7,8)="^ ":"I ",1:" ")_$PIECE(X,U,3)_U_$PIECE(X,U,2)_$SELECT($PIECE(X2,U,3)'="":U_$PIECE(X2,U,3),1:"")
End DoDot:2
+10 SET @ROOT=NCNT
End DoDot:1
QUIT
+11 SET XREF="R"
+12 SET XVAL=XQAUSER
+13 DO CHKTRAIL
+14 QUIT
GETPAT(ROOT,PATIENT,FRSTDATE,LASTDATE) ;
+1 NEW XREF,XVAL,NCNT
+2 SET NCNT=0
KILL @ROOT
+3 IF $GET(PATIENT)'>0
SET @ROOT=0
QUIT
+4 SET XREF="C"
+5 SET XVAL=PATIENT
+6 DO CHKTRAIL
+7 QUIT
CHKTRAIL ;
+1 ; ZEXCEPT: FRSTDATE,LASTDATE,NCNT,ROOT,XREF,XVAL -- from GETPAT or GETUSER
+2 NEW XQ1,X,X1,X2,X3
+3 FOR XQ1=0:0
SET XQ1=$ORDER(^XTV(8992.1,XREF,XVAL,XQ1))
IF XQ1'>0
QUIT
Begin DoDot:1
+4 SET X=$GET(^XTV(8992.1,XQ1,0))
SET X1=$GET(^(1))
SET X3=$GET(^(3))
SET X2=$GET(^(2))
IF X=""
QUIT
+5 IF FRSTDATE'>0
IF '$DATA(^XTV(8992,"AXQA",$PIECE(X,U)))
QUIT
+6 IF FRSTDATE>0
IF $PIECE(X,U,2)<FRSTDATE
QUIT
+7 IF FRSTDATE>0
IF LASTDATE>0
IF $PIECE(X,U,2)>LASTDATE
QUIT
+8 SET NCNT=NCNT+1
+9 ; P443
SET @ROOT@(NCNT)=$SELECT($PIECE(X3,U)'="":"G ",$PIECE(X1,U,2,3)="^":"I ",$PIECE(X1,U,2,3)="":"I ",1:" ")_$PIECE(X1,U)_U_$PIECE(X,U)_$SELECT($PIECE(X2,U,3)'="":U_$PIECE(X2,U,3),1:"")
End DoDot:1
+10 SET @ROOT=NCNT
+11 QUIT
GETUSER1(ROOT,XQAUSER,FRSTDATE,LASTDATE) ;
+1 NEW NCNT,KEY
+2 IF $GET(XQAUSER)'>0
SET XQAUSER=DUZ
+3 IF $GET(FRSTDATE)'>0
SET FRSTDATE=0
+4 IF $GET(LASTDATE)'>0
SET LASTDATE=0
+5 ; P513
IF $$ACTVSURO^XQALSURO(XQAUSER)'>0
DO RETURN^XQALSUR1(XQAUSER)
+6 SET NCNT=0
KILL @ROOT
+7 IF FRSTDATE=0
Begin DoDot:1
+8 NEW X,X2,X3,X4,I
SET I=""
FOR
SET I=$ORDER(^XTV(8992,XQAUSER,"XQA",I),-1)
IF I'>0
QUIT
SET X=^(I,0)
SET X2=$GET(^(2))
SET X3=$GET(^(3))
SET X4=$DATA(^(4))
Begin DoDot:2
+9 IF $PIECE(X,U,4)'=""
Begin DoDot:3
+10 ; P513, update ALERT TRACKING FILE
NEW XQAID,XQXX,XQXY,XQADAT
+11 ; P513 - MARK SEEN
SET $PIECE(^XTV(8992,XQAUSER,"XQA",I,0),U,4)=""
+12 ; P513
SET XQAID=$PIECE(X,U,2)
+13 ; P513
SET XQXX=$ORDER(^XTV(8992.1,"B",XQAID,0))
SET XQXY=0
SET XQADAT=$$NOW^XLFDT()
+14 IF XQXX>0
SET XQXY=$ORDER(^XTV(8992.1,XQXX,20,"B",XQAUSER,0))
IF XQXY>0
Begin DoDot:4
+15 IF $PIECE(^XTV(8992.1,XQXX,20,XQXY,0),U,2)=""
SET $PIECE(^XTV(8992.1,XQXX,20,XQXY,0),U,2)=XQADAT
+16 IF $PIECE(^XTV(8992.1,XQXX,20,XQXY,0),U,3)=""
SET $PIECE(^XTV(8992.1,XQXX,20,XQXY,0),U,3)=XQADAT
End DoDot:4
End DoDot:3
+17 SET NCNT=NCNT+1
+18 SET KEY=$SELECT($PIECE(X3,U)'="":"G ",X4>1:"L ",$PIECE(X,U,7,8)="^ ":"I ",1:"R ")
SET @ROOT@(NCNT)=KEY_$PIECE(X,U,3)_U_$PIECE(X,U,2)
+19 IF X2'=""
Begin DoDot:3
+20 SET NCNT=NCNT+1
SET @ROOT@(NCNT)=KEY_"-----Forwarded by: "_$$GET1^DIQ(200,($PIECE(X2,U)_","),.01)_" Generated: "_$$DAT8^XQALERT($PIECE(X2,U,2),1)_U_$PIECE(X,U,2)
+21 IF $PIECE(X2,U,3)'=""
SET NCNT=NCNT+1
SET @ROOT@(NCNT)=KEY_"-----"_$PIECE(X2,U,3)_U_$PIECE(X,U,2)
+22 QUIT
End DoDot:3
End DoDot:2
+23 SET @ROOT=NCNT
+24 QUIT
End DoDot:1
QUIT
+25 QUIT
