Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XQALDATA

XQALDATA.m

Go to the documentation of this file.
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 9
 ;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