- XQALSUR2 ;FO-OAK.SEA/JLI-Continuation of alert surrogate processing ;07/12/12 11:30
- ;;8.0;KERNEL;**366,513,602**;Jul 10, 1995;Build 10
- ;Per VHA Directive 2004-038, this routine should not be modified
- Q
- ; added to handle adjustment for manual or Fileman editing of surrogate on top zero node
- CHEKSUBS(XQAUSER) ;
- N XQA0,XQASTR1,XQANOW,XQB0,XQB1
- S XQANOW=$$NOW^XLFDT()
- S XQA0=$G(^XTV(8992,XQAUSER,0)) I $P(XQA0,U,2)>0 D
- . N XQAFDA,XQAIEN,XQADA
- . S XQASTR1=$P(XQA0,U,3) S:XQASTR1'>0 XQASTR1=XQANOW,XQAFDA(8992,XQAUSER_",",.03)=XQASTR1 D
- . . S XQADA=0 F S XQADA=$O(^XTV(8992,XQAUSER,2,"B",XQASTR1,XQADA)) Q:XQADA'>0 Q:$P(^XTV(8992,XQAUSER,2,XQADA,0),U,2)=$P(XQA0,U,2)
- . . S XQAIEN=$S(XQADA>0:XQADA,1:"+1")_","_XQAUSER_"," S XQAFDA(8992.02,XQAIEN,.01)=XQASTR1
- . . 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)
- . . D:XQADA'>0 UPDATE^DIE("","XQAFDA")
- . . D:XQADA>0 FILE^DIE("","XQAFDA")
- . . Q
- . Q
- Q
- ;
- CHKCRIT(ZERONODE) ;EXTRINSIC - check for critical indication for alert
- ; ZERONODE - input - Value for zero node for alert data
- ; RETURN VALUE - 1 if the alert is indicated as critical
- ; 0 otherwise
- N RESULT,IEN
- S RESULT=0
- F IEN=0:0 S IEN=$O(^XTV(8992.3,IEN)) Q:IEN'>0 D Q:RESULT
- . N IENS,RES,MSG,CRITTEXT,PKGID,ALERTTXT
- . S IENS=IEN_","
- . D GETS^DIQ(8992.3,IENS,".01:.02",,"RES","MSG")
- . S CRITTEXT=$$UP^XLFSTR(RES(8992.3,IENS,.01)),PKGID=$$UP^XLFSTR(RES(8992.3,IENS,.02))
- . I PKGID'="",$$UP^XLFSTR($P(ZERONODE,U,2))'[PKGID Q
- . S ALERTTXT=$$UP^XLFSTR($P(ZERONODE,U,3))
- . I ALERTTXT[CRITTEXT,ALERTTXT'["NOT "_CRITTEXT S RESULT=1
- Q RESULT
- CLEANUP(XQAUSER) ;SR. - clean up expired surrogate info
- N XQAI,XQANOW,XQASUR
- S XQANOW=$$NOW^XLFDT()
- I $P($G(^XTV(8992,XQAUSER,2,0)),U,2)>0 D
- . S XQAI=0 F S XQAI=$O(^XTV(8992,XQAUSER,2,XQAI)) Q:XQAI'>0 D
- . . S XQASUR=$G(^XTV(8992,XQAUSER,2,XQAI,0))
- . . I ($P(XQASUR,U)<XQANOW)&($P(XQASUR,U,4)'=1)&($P(XQASUR,U,3)<XQANOW)&($P(XQASUR,U,3)>0) D
- . . . N XQAIEN S XQAIEN=XQAI_","_XQAUSER_","
- . . . N XQAFDA S XQAFDA(8992.02,XQAIEN,.01)="@" D FILE^DIE("","XQAFDA")
- Q
- XQALSUR2 ;FO-OAK.SEA/JLI-Continuation of alert surrogate processing ;07/12/12 11:30
- +1 ;;8.0;KERNEL;**366,513,602**;Jul 10, 1995;Build 10
- +2 ;Per VHA Directive 2004-038, this routine should not be modified
- +3 QUIT
- +4 ; added to handle adjustment for manual or Fileman editing of surrogate on top zero node
- CHEKSUBS(XQAUSER) ;
- +1 NEW XQA0,XQASTR1,XQANOW,XQB0,XQB1
- +2 SET XQANOW=$$NOW^XLFDT()
- +3 SET XQA0=$GET(^XTV(8992,XQAUSER,0))
- IF $PIECE(XQA0,U,2)>0
- Begin DoDot:1
- +4 NEW XQAFDA,XQAIEN,XQADA
- +5 SET XQASTR1=$PIECE(XQA0,U,3)
- IF XQASTR1'>0
- SET XQASTR1=XQANOW
- SET XQAFDA(8992,XQAUSER_",",.03)=XQASTR1
- Begin DoDot:2
- +6 SET XQADA=0
- FOR
- SET XQADA=$ORDER(^XTV(8992,XQAUSER,2,"B",XQASTR1,XQADA))
- IF XQADA'>0
- QUIT
- IF $PIECE(^XTV(8992,XQAUSER,2,XQADA,0),U,2)=$PIECE(XQA0,U,2)
- QUIT
- +7 SET XQAIEN=$SELECT(XQADA>0:XQADA,1:"+1")_","_XQAUSER_","
- SET XQAFDA(8992.02,XQAIEN,.01)=XQASTR1
- +8 SET XQAFDA(8992.02,XQAIEN,.02)=$PIECE(XQA0,U,2)
- IF $PIECE(XQA0,U,4)>0
- SET XQAFDA(8992.02,XQAIEN,.03)=$PIECE(XQA0,U,4)
- +9 IF XQADA'>0
- DO UPDATE^DIE("","XQAFDA")
- +10 IF XQADA>0
- DO FILE^DIE("","XQAFDA")
- +11 QUIT
- End DoDot:2
- +12 QUIT
- End DoDot:1
- +13 QUIT
- +14 ;
- CHKCRIT(ZERONODE) ;EXTRINSIC - check for critical indication for alert
- +1 ; ZERONODE - input - Value for zero node for alert data
- +2 ; RETURN VALUE - 1 if the alert is indicated as critical
- +3 ; 0 otherwise
- +4 NEW RESULT,IEN
- +5 SET RESULT=0
- +6 FOR IEN=0:0
- SET IEN=$ORDER(^XTV(8992.3,IEN))
- IF IEN'>0
- QUIT
- Begin DoDot:1
- +7 NEW IENS,RES,MSG,CRITTEXT,PKGID,ALERTTXT
- +8 SET IENS=IEN_","
- +9 DO GETS^DIQ(8992.3,IENS,".01:.02",,"RES","MSG")
- +10 SET CRITTEXT=$$UP^XLFSTR(RES(8992.3,IENS,.01))
- SET PKGID=$$UP^XLFSTR(RES(8992.3,IENS,.02))
- +11 IF PKGID'=""
- IF $$UP^XLFSTR($PIECE(ZERONODE,U,2))'[PKGID
- QUIT
- +12 SET ALERTTXT=$$UP^XLFSTR($PIECE(ZERONODE,U,3))
- +13 IF ALERTTXT[CRITTEXT
- IF ALERTTXT'["NOT "_CRITTEXT
- SET RESULT=1
- End DoDot:1
- IF RESULT
- QUIT
- +14 QUIT RESULT
- CLEANUP(XQAUSER) ;SR. - clean up expired surrogate info
- +1 NEW XQAI,XQANOW,XQASUR
- +2 SET XQANOW=$$NOW^XLFDT()
- +3 IF $PIECE($GET(^XTV(8992,XQAUSER,2,0)),U,2)>0
- Begin DoDot:1
- +4 SET XQAI=0
- FOR
- SET XQAI=$ORDER(^XTV(8992,XQAUSER,2,XQAI))
- IF XQAI'>0
- QUIT
- Begin DoDot:2
- +5 SET XQASUR=$GET(^XTV(8992,XQAUSER,2,XQAI,0))
- +6 IF ($PIECE(XQASUR,U)<XQANOW)&($PIECE(XQASUR,U,4)'=1)&($PIECE(XQASUR,U,3)<XQANOW)&($PIECE(XQASUR,U,3)>0)
- Begin DoDot:3
- +7 NEW XQAIEN
- SET XQAIEN=XQAI_","_XQAUSER_","
- +8 NEW XQAFDA
- SET XQAFDA(8992.02,XQAIEN,.01)="@"
- DO FILE^DIE("","XQAFDA")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 QUIT
