XU8P387.m

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 ---XU8P387   921     printed  Apr 09, 2024@21:06:59                                                                                                                                                                                                      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