ABSVIPST  ;VAMC ALTOONA/CTB PRE/POST INIT ;4/30/02  3:27 PM
V ;;4.0;VOLUNTARY TIMEKEEPING;**7,18,22,29**;JULY 6, 1994
 ;;LOOP BY NAME
 S NAME="" F  S NAME=$O(^ABS(503330,"B",NAME)) Q:NAME=""  S DA=0 F  S DA=$O(^ABS(503330,"B",NAME,DA)) Q:'DA  D
 . Q:'$D(^ABS(503330,DA,4))
 . S STANUM=0 F  S STANUM=$O(^ABS(503330,DA,4,STANUM)) Q:STANUM=""  D
 . . S X=$G(^ABS(503330,DA,4,STANUM,0)) Q:X=""
 . . S TERMDATE=$P(X,"^",8) Q:TERMDATE=""
 . . I TERMDATE<2971001,$P(X,"^",11)="" S $P(X,"^",11)=TERMDATE,$P(X,"^",10)="Y",^ABS(503330,DA,4,STANUM,0)=X W !,NAME," - ","  ",STANUM,"  ",TERMDATE
 . . QUIT
 .
 ;;GET TERMINATION DATE
 ;;I TERMINATION DATE < 2971001 SET PURGED DATE = TERM DATE AND PURGED? = YES
 Q
PRE ;PRE INIT TO DELETE DATA IN NATIONAL OFFICIALS FILE
 N X,DIU
 S DIU=503340,DIU(0)="TE" D EN^DIU2
 S X=$G(^ABS(503334.1,0)) Q:X=""
 K ^ABS(503334.1)
 S ^ABS(503334.1,0)=$P(X,"^",1,2)
 QUIT
POST ;POST INIT TO REINDEX THE .01 FIELD ON FILE 503340 FOR ALL ENTRIES
 N DIK
 S DIK="^ABS(503340,",DIK(1)=.01 D ENALL^DIK
 QUIT