- 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
