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

XQALSUR2.m

Go to the documentation of this file.
  1. XQALSUR2 ;FO-OAK.SEA/JLI-Continuation of alert surrogate processing ; September 6, 2023@14:28
  1. ;;8.0;KERNEL;**366,513,602,690,730,754,790**;Jul 10, 1995;Build 2
  1. ;Per VHA VA Directive 6402, this routine should not be modified
  1. Q
  1. ; added to handle adjustment for manual or Fileman editing of surrogate on top zero node
  1. CHEKSUBS(XQAUSER) ;
  1. N XQA0,XQASTR1,XQANOW,XQB0,XQB1
  1. S XQANOW=$$NOW^XLFDT()
  1. S XQA0=$G(^XTV(8992,XQAUSER,0)) I $P(XQA0,U,2)>0 D
  1. . N XQAFDA,XQAIEN,XQADA
  1. . S XQASTR1=$P(XQA0,U,3) S:XQASTR1'>0 XQASTR1=XQANOW,XQAFDA(8992,XQAUSER_",",.03)=XQASTR1 D
  1. . . S XQADA=0 F S XQADA=$O(^XTV(8992,XQAUSER,2,"B",XQASTR1,XQADA)) Q:XQADA'>0 D Q:$P($G(^XTV(8992,XQAUSER,2,XQADA,0)),U,2)=$P(XQA0,U,2) ; p754
  1. . . . K:'$D(^XTV(8992,XQAUSER,2,XQADA,0)) ^XTV(8992,XQAUSER,2,"B",XQASTR1,XQADA) ;p754 somebody removed surr by gbl kill, cleanup
  1. . . S XQAIEN=$S(XQADA>0:XQADA,1:"+1")_","_XQAUSER_"," S XQAFDA(8992.02,XQAIEN,.01)=XQASTR1
  1. . . S XQAFDA(8992.02,XQAIEN,.02)=$P(XQA0,U,2) S:$P(XQA0,U,4)>0 XQAFDA(8992.02,XQAIEN,.03)=$P(XQA0,U,4)
  1. . . D:XQADA'>0 UPDATE^DIE("","XQAFDA")
  1. . . D:XQADA>0 FILE^DIE("","XQAFDA")
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. CHKCRIT(ZERONODE) ;EXTRINSIC - check for critical indication for alert
  1. ; ZERONODE - input - Value for zero node for alert data
  1. ; RETURN VALUE - 1 if the alert is indicated as critical
  1. ; 0 otherwise
  1. N RESULT,IEN
  1. S RESULT=0
  1. F IEN=0:0 S IEN=$O(^XTV(8992.3,IEN)) Q:IEN'>0 D Q:RESULT
  1. . N IENS,RES,MSG,CRITTEXT,PKGID,ALERTTXT
  1. . S IENS=IEN_","
  1. . D GETS^DIQ(8992.3,IENS,".01:.02",,"RES","MSG")
  1. . S CRITTEXT=$$UP^XLFSTR(RES(8992.3,IENS,.01)),PKGID=$$UP^XLFSTR(RES(8992.3,IENS,.02))
  1. . I PKGID'="",$$UP^XLFSTR($P(ZERONODE,U,2))'[PKGID Q
  1. . S ALERTTXT=$$UP^XLFSTR($P(ZERONODE,U,3))
  1. . I ALERTTXT[CRITTEXT,ALERTTXT'["NOT "_CRITTEXT,ALERTTXT'["NON "_CRITTEXT S RESULT=1 ;;XU*8*690 - Added check for "NON" critical text
  1. Q RESULT
  1. ;
  1. CLEANUP(XQAUSER) ;SR. - clean up expired surrogate info
  1. N XQAI,XQARETD,XQASUR
  1. I $P($G(^XTV(8992,XQAUSER,2,0)),U,2)'>0 Q ;p790
  1. S XQARETD=$$FMADD^XLFDT($$NOW^XLFDT(),-1825) ;p790 retention date for 5 years in the past
  1. S XQAI=0 F S XQAI=$O(^XTV(8992,XQAUSER,2,XQAI)) Q:XQAI'>0 D
  1. . S XQASUR=$G(^XTV(8992,XQAUSER,2,XQAI,0))
  1. . I $$EXPIRED(XQASUR,XQARETD) D DELSUR(XQAI,XQAUSER) ;P790
  1. Q
  1. ; p730
  1. DISPSUR(XQAUSER,XQASLIST) ; Prints and returns current list of surrogate periods for a user
  1. ; usage: N LIST D DISPSUR^XQAUSER(DUZ,.LIST)
  1. N XQAI
  1. D SUROLIST^XQALSUR1(XQAUSER,.XQASLIST)
  1. I $G(XQASLIST)<1 W !!," No current surrogates",! Q
  1. W !!,"Current Surrogate(s):",?33,"START DATE",?58,"END DATE" ; p754 shortened
  1. F XQAI=0:0 S XQAI=$O(XQASLIST(XQAI)) Q:XQAI'>0 D
  1. . W !,XQAI," ",$P(XQASLIST(XQAI),U,2),?33,$$FMTE^XLFDT($P(XQASLIST(XQAI),U,3)),?58,$$FMTE^XLFDT($P(XQASLIST(XQAI),U,4))
  1. W !
  1. Q
  1. ;P790
  1. DELSUR(XQAI,XQAUSER) ;Purge surrogate
  1. N XQAIEN,XQAFDA
  1. S XQAIEN=XQAI_","_XQAUSER_","
  1. S XQAFDA(8992.02,XQAIEN,.01)="@" D FILE^DIE("","XQAFDA")
  1. Q
  1. ;p790
  1. EXPIRED(XQASUR,RETDATE) ; called by CLEANUP. SURROGATE return 1 if expired or 0 if not
  1. ; RETDATE, retention date, is greater than start (P1) and end (P3) dates
  1. ; end date (P3) is not empty (otherwise still active)
  1. ; alerts don't need to be returned (P4=0) (alerts already returned)
  1. Q ($P(XQASUR,U)<RETDATE)&($P(XQASUR,U,4)'=1)&($P(XQASUR,U,3)<RETDATE)&($P(XQASUR,U,3)>0)
  1. ;