XUXCTY ;MJM-SFCIOFO ROUTINE TO ELIMINATE DANGLING COUNTY POINTERS;OCT 30, 1998@11:03
 ;;8.0;KERNEL;**105**;OCT  30,1998
FCS ; This line tag will do the THE CORRECTIONS
 S ^XTMP("XUXTMP",0)=$$FMADD^XLFDT(DT,7)_U_DT
 ;PATIENT FILE CLEANUP
 S VEINUM=0,VEICNT=1
 S ^XTMP("XUXTMP",VEICNT)="PATIENT FILE RECORDS CLEANED"
 S VEICNT=VEICNT+1
 F  S VEINUM=$O(^DPT(VEINUM)) Q:+VEINUM'>0  D
 . K VEIARR
 . S (VEIST,VEICTY,VEITST,VEITCT)=""
 . S VEIST=+$P($G(^DPT(VEINUM,.11)),"^",5)
 . S VEICTY=+$P($G(^DPT(VEINUM,.11)),"^",7)
 . I '$D(^DIC(5,VEIST,1,VEICTY,0)) S ^XTMP("XUXTMP",VEICNT)=(^DPT(VEINUM,0)),VEICNT=VEICNT+1,VEIARR(2,VEINUM_",",.117)="@"
 . S VEITST=+$P($G(^DPT(VEINUM,.121)),"^",5)
 . S VEITCT=+$P($G(^DPT(VEINUM,.121)),"^",11)
 . I '$D(^DIC(5,VEITST,1,VEITCT,0)) S ^XTMP("XUXTMP",VEICNT)=(^DPT(VEINUM,0)),VEICNT=VEICNT+1,VEIARR(2,VEINUM_",",.12111)="@"
 . I $D(VEIARR) D FILE^DIE("","VEIARR")
 S ^XTMP("XUXTMP",VEICNT)="",VEICNT=VEICNT+1
 ;PERSON FILE CLEANUP
 S VEINUM=.9
 S ^XTMP("XUXTMP",VEICNT)="PERSON FILE RECORDS CLEANED"
 S VEICNT=VEICNT+1
 F  S VEINUM=$O(^DIC(16,VEINUM)) Q:+VEINUM'>0  D
 . K VEIARR
 . S (VEIST,VEICTY)=""
 . S VEIST=+$P($G(^DIC(16,VEINUM,.11)),"^",5)
 . S VEICTY=+$P($G(^DIC(16,VEINUM,.11)),"^",7)
 . I '$D(^DIC(5,VEIST,1,VEICTY,0)) S ^XTMP("XUXTMP",VEICNT)=^DIC(16,VEINUM,0),VEICNT=VEICNT+1,VEIARR(16,VEINUM_",",.117)="@" D FILE^DIE("","VEIARR")
 S ^XTMP("XUXTMP",VEICNT)="",VEICNT=VEICNT+1
 ;FEE BASIS VENDOR FILE CLEANUP
 S VEINUM=0
 S ^XTMP("XUXTMP",VEICNT)="FEE BASIS VENDOR RECORDS CLEANED"
 S VEICNT=VEICNT+1
 F  S VEINUM=$O(^FBAAV(VEINUM)) Q:+VEINUM'>0  D
 . K VEIARR
 . S (VEIST,VEICTY)=""
 . S VEIST=+$P($G(^FBAAV(VEINUM,0)),"^",5)
 . S VEICTY=+$P($G(^FBAAV(VEINUM,0)),"^",13)
 . I '$D(^DIC(5,VEIST,1,VEICTY,0)) S ^XTMP("XUXTMP",VEICNT)=(^FBAAV(VEINUM,0)),VEICNT=VEICNT+1,VEIARR(161.2,VEINUM_",",5.5)="@" D FILE^DIE("","VEIARR")
 S ^XTMP("XUXTMP",VEICNT)="",VEICNT=VEICNT+1
 ;HBHC PATIENT FILE CLEANUP
 S VEINUM=0
 S ^XTMP("XUXTMP",VEICNT)="HBHC PATIENT FILE RECORDS CLEANED"
 S VEICNT=VEICNT+1
 F  S VEINUM=$O(^HBHC(631,VEINUM)) Q:+VEINUM'>0  D
 . K VEIARR
 . S (VEIST,VEICTY)=""              
 . S VEIST=+$P($G(^HBHC(631,VEINUM,0)),"^",3)  
 . S VEICTY=+$P($G(^HBHC(631,VEINUM,0)),"^",4) 
 . I '$D(^DIC(5,VEIST,1,VEICTY,0)) S ^XTMP("XUXTMP",VEICNT)=(^HBHC(631,VEINUM,0)),VEICNT=VEICNT+1,VEIARR(631,VEINUM_",",3)="@" D FILE^DIE("","VEIARR")
 K VEIST,VEICTY,VEITST,VEITCT,VEINUM,VEIARR,VEICNT
 Q