source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XU8P387.m@ 1693

Last change on this file since 1693 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 893 bytes
RevLine 
[613]1XU8P387 ;SFISC/SO- POST INSTALL CLEAN UP XREF AUSER ;5:41 AM 30 Nov 2005
2 ;;8.0;KERNEL;**384**;Jul 10, 1995;Build 8
3 ;
4 D ^XU8P387X ;Install the fixed xref
5 ;
6 ;Clean up AUSER xref
7 ;
8 N IEN S IEN=0
9 N XUDT540 S XUDT540=$$HTFM^XLFDT($H-540,1)
10 F S IEN=$O(^VA(200,IEN)) Q:'IEN D
11 . I IEN<1 Q
12 . N DIK,DA
13 . S DA=IEN
14 . S DIK="^VA(200,",DIK(1)=".01^AUSER"
15 . D EN1^DIK
16 . ;
17 . ;Check to see if DISUERed, But last sign-on is within 540 days
18 . I '$D(^VA(200,IEN,0))#2 Q ;Missing Zeroth node
19 . N NAME,LDATE,DISUER
20 . S NAME=$P(^VA(200,IEN,0),U)
21 . I NAME="" Q ; Entry has null .01 field
22 . S LDATE=$P($G(^VA(200,IEN,1.1)),U) ;Get last sign-on
23 . S DISUSER=$P(^VA(200,IEN,0),U,7) ;DISUER FLAG
24 . I $D(^VA(200,"AUSER",NAME,IEN)) Q ;Entry already indexed
25 . I $D(^XUSEC("XUORES",IEN)) S ^VA(200,"AUSER",NAME,IEN)="" Q
26 . I DISUSER,LDATE'<XUDT540,DISUSER S ^VA(200,"AUSER",NAME,IEN)=""
27 . Q
28 Q
Note: See TracBrowser for help on using the repository browser.