XU8P387 ;SFISC/SO- POST INSTALL CLEAN UP XREF AUSER ;5:41 AM 30 Nov 2005
;;8.0;KERNEL;**384**;Jul 10, 1995;Build 8
;
D ^XU8P387X ;Install the fixed xref
;
;Clean up AUSER xref
;
N IEN S IEN=0
N XUDT540 S XUDT540=$$HTFM^XLFDT($H-540,1)
F S IEN=$O(^VA(200,IEN)) Q:'IEN D
. I IEN<1 Q
. N DIK,DA
. S DA=IEN
. S DIK="^VA(200,",DIK(1)=".01^AUSER"
. D EN1^DIK
. ;
. ;Check to see if DISUERed, But last sign-on is within 540 days
. I '$D(^VA(200,IEN,0))#2 Q ;Missing Zeroth node
. N NAME,LDATE,DISUER
. S NAME=$P(^VA(200,IEN,0),U)
. I NAME="" Q ; Entry has null .01 field
. S LDATE=$P($G(^VA(200,IEN,1.1)),U) ;Get last sign-on
. S DISUSER=$P(^VA(200,IEN,0),U,7) ;DISUER FLAG
. I $D(^VA(200,"AUSER",NAME,IEN)) Q ;Entry already indexed
. I $D(^XUSEC("XUORES",IEN)) S ^VA(200,"AUSER",NAME,IEN)="" Q
. I DISUSER,LDATE'<XUDT540,DISUSER S ^VA(200,"AUSER",NAME,IEN)=""
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P387 921 printed Nov 22, 2024@17:17:40 Page 2
XU8P387 ;SFISC/SO- POST INSTALL CLEAN UP XREF AUSER ;5:41 AM 30 Nov 2005
+1 ;;8.0;KERNEL;**384**;Jul 10, 1995;Build 8
+2 ;
+3 ;Install the fixed xref
DO ^XU8P387X
+4 ;
+5 ;Clean up AUSER xref
+6 ;
+7 NEW IEN
SET IEN=0
+8 NEW XUDT540
SET XUDT540=$$HTFM^XLFDT($HOROLOG-540,1)
+9 FOR
SET IEN=$ORDER(^VA(200,IEN))
if 'IEN
QUIT
Begin DoDot:1
+10 IF IEN<1
QUIT
+11 NEW DIK,DA
+12 SET DA=IEN
+13 SET DIK="^VA(200,"
SET DIK(1)=".01^AUSER"
+14 DO EN1^DIK
+15 ;
+16 ;Check to see if DISUERed, But last sign-on is within 540 days
+17 ;Missing Zeroth node
IF '$DATA(^VA(200,IEN,0))#2
QUIT
+18 NEW NAME,LDATE,DISUER
+19 SET NAME=$PIECE(^VA(200,IEN,0),U)
+20 ; Entry has null .01 field
IF NAME=""
QUIT
+21 ;Get last sign-on
SET LDATE=$PIECE($GET(^VA(200,IEN,1.1)),U)
+22 ;DISUER FLAG
SET DISUSER=$PIECE(^VA(200,IEN,0),U,7)
+23 ;Entry already indexed
IF $DATA(^VA(200,"AUSER",NAME,IEN))
QUIT
+24 IF $DATA(^XUSEC("XUORES",IEN))
SET ^VA(200,"AUSER",NAME,IEN)=""
QUIT
+25 IF DISUSER
IF LDATE'<XUDT540
IF DISUSER
SET ^VA(200,"AUSER",NAME,IEN)=""
+26 QUIT
End DoDot:1
+27 QUIT
