VIAATRI ;ALB/CR - RTLS Triggers General Utility ;5/4/16 10:06am
;;1.0;RTLS;**3,6**;April 22, 2013;Build 1
;
Q
; Engineering call to this routine covered by IA #6069
;
; ------- collect record changes for RTLS -------
; this tag is called from multiple fields in files #6914 and #6928
; to capture data changes as they happen, a record ID is added in
; file #6930 (PENDING RTLS EVENTS) for the queue process
;
; ============================================================
WC(FILE,ENTRY) ; FILE = either #6914 or #6928, ENTRY = IEN of the record
;
; All the triggered fields in files #6914 and #6928 have been added
; the 'NOREINDEX' flag to prevent flooding file #6930 if re-indexing
; of any of the M X-Refs is attempted.
;
I $G(FILE)=""!($G(ENTRY)="") Q
N DA,DATA,DIC,DO,D0,DLAYGO,IEN,FDA,MATCH,X,Y
N DEFSITE,SITE,SITEIEN,TMSTMP
; don't store the same record multiple times
S MATCH=0
S IEN="" F S IEN=$O(^VIAA(6930,IEN)) Q:IEN="" D Q:MATCH
. S DATA=$G(^VIAA(6930,IEN,0))
. I $P(DATA,U,2)=FILE,$P(DATA,U,3)=ENTRY S MATCH=1
I MATCH Q
;
S TMSTMP=$$NOW^XLFDT
; get station number for equipment or space
I FILE=6914!(FILE=6928) S SITE=$P($G(^DIC(6910,1,0)),U,2)
S DIC(0)="L",DLAYGO=6930,DIC="^VIAA(6930,",X=SITE
D FILE^DICN
Q:+Y<1 ;*6 don't run UPDATE^DIE if FILE^DICN failed.
; Refiring of the triggers allows process to complete, so file 6930 does get updated.
S DA=+Y
L +^VIAA(6930,DA):5 I '$T D EN^DDIOL("File is in use - try again later.","","!") Q
S FDA(6930,DA_",",1)=FILE
S FDA(6930,DA_",",2)=ENTRY
S FDA(6930,DA_",",3)=TMSTMP
D UPDATE^DIE(,"FDA")
L -^VIAA(6930,DA)
Q
;
; =============================================================
DEL(COUNT) ; clean up file PENDING RTLS EVENTS after transmission to Mule
; called from VIAAQUE after transmission of a record
N DA,DIK
S DIK="^VIAA(6930,"
S DA=COUNT D ^DIK
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIAATRI 1923 printed Oct 16, 2024@18:34:04 Page 2
VIAATRI ;ALB/CR - RTLS Triggers General Utility ;5/4/16 10:06am
+1 ;;1.0;RTLS;**3,6**;April 22, 2013;Build 1
+2 ;
+3 QUIT
+4 ; Engineering call to this routine covered by IA #6069
+5 ;
+6 ; ------- collect record changes for RTLS -------
+7 ; this tag is called from multiple fields in files #6914 and #6928
+8 ; to capture data changes as they happen, a record ID is added in
+9 ; file #6930 (PENDING RTLS EVENTS) for the queue process
+10 ;
+11 ; ============================================================
WC(FILE,ENTRY) ; FILE = either #6914 or #6928, ENTRY = IEN of the record
+1 ;
+2 ; All the triggered fields in files #6914 and #6928 have been added
+3 ; the 'NOREINDEX' flag to prevent flooding file #6930 if re-indexing
+4 ; of any of the M X-Refs is attempted.
+5 ;
+6 IF $GET(FILE)=""!($GET(ENTRY)="")
QUIT
+7 NEW DA,DATA,DIC,DO,D0,DLAYGO,IEN,FDA,MATCH,X,Y
+8 NEW DEFSITE,SITE,SITEIEN,TMSTMP
+9 ; don't store the same record multiple times
+10 SET MATCH=0
+11 SET IEN=""
FOR
SET IEN=$ORDER(^VIAA(6930,IEN))
if IEN=""
QUIT
Begin DoDot:1
+12 SET DATA=$GET(^VIAA(6930,IEN,0))
+13 IF $PIECE(DATA,U,2)=FILE
IF $PIECE(DATA,U,3)=ENTRY
SET MATCH=1
End DoDot:1
if MATCH
QUIT
+14 IF MATCH
QUIT
+15 ;
+16 SET TMSTMP=$$NOW^XLFDT
+17 ; get station number for equipment or space
+18 IF FILE=6914!(FILE=6928)
SET SITE=$PIECE($GET(^DIC(6910,1,0)),U,2)
+19 SET DIC(0)="L"
SET DLAYGO=6930
SET DIC="^VIAA(6930,"
SET X=SITE
+20 DO FILE^DICN
+21 ;*6 don't run UPDATE^DIE if FILE^DICN failed.
if +Y<1
QUIT
+22 ; Refiring of the triggers allows process to complete, so file 6930 does get updated.
+23 SET DA=+Y
+24 LOCK +^VIAA(6930,DA):5
IF '$TEST
DO EN^DDIOL("File is in use - try again later.","","!")
QUIT
+25 SET FDA(6930,DA_",",1)=FILE
+26 SET FDA(6930,DA_",",2)=ENTRY
+27 SET FDA(6930,DA_",",3)=TMSTMP
+28 DO UPDATE^DIE(,"FDA")
+29 LOCK -^VIAA(6930,DA)
+30 QUIT
+31 ;
+32 ; =============================================================
DEL(COUNT) ; clean up file PENDING RTLS EVENTS after transmission to Mule
+1 ; called from VIAAQUE after transmission of a record
+2 NEW DA,DIK
+3 SET DIK="^VIAA(6930,"
+4 SET DA=COUNT
DO ^DIK
+5 QUIT
+6 ;
