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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUXCTY 2489 printed Nov 22, 2024@17:24:22 Page 2
XUXCTY ;MJM-SFCIOFO ROUTINE TO ELIMINATE DANGLING COUNTY POINTERS;OCT 30, 1998@11:03
+1 ;;8.0;KERNEL;**105**;OCT 30,1998
FCS ; This line tag will do the THE CORRECTIONS
+1 SET ^XTMP("XUXTMP",0)=$$FMADD^XLFDT(DT,7)_U_DT
+2 ;PATIENT FILE CLEANUP
+3 SET VEINUM=0
SET VEICNT=1
+4 SET ^XTMP("XUXTMP",VEICNT)="PATIENT FILE RECORDS CLEANED"
+5 SET VEICNT=VEICNT+1
+6 FOR
SET VEINUM=$ORDER(^DPT(VEINUM))
if +VEINUM'>0
QUIT
Begin DoDot:1
+7 KILL VEIARR
+8 SET (VEIST,VEICTY,VEITST,VEITCT)=""
+9 SET VEIST=+$PIECE($GET(^DPT(VEINUM,.11)),"^",5)
+10 SET VEICTY=+$PIECE($GET(^DPT(VEINUM,.11)),"^",7)
+11 IF '$DATA(^DIC(5,VEIST,1,VEICTY,0))
SET ^XTMP("XUXTMP",VEICNT)=(^DPT(VEINUM,0))
SET VEICNT=VEICNT+1
SET VEIARR(2,VEINUM_",",.117)="@"
+12 SET VEITST=+$PIECE($GET(^DPT(VEINUM,.121)),"^",5)
+13 SET VEITCT=+$PIECE($GET(^DPT(VEINUM,.121)),"^",11)
+14 IF '$DATA(^DIC(5,VEITST,1,VEITCT,0))
SET ^XTMP("XUXTMP",VEICNT)=(^DPT(VEINUM,0))
SET VEICNT=VEICNT+1
SET VEIARR(2,VEINUM_",",.12111)="@"
+15 IF $DATA(VEIARR)
DO FILE^DIE("","VEIARR")
End DoDot:1
+16 SET ^XTMP("XUXTMP",VEICNT)=""
SET VEICNT=VEICNT+1
+17 ;PERSON FILE CLEANUP
+18 SET VEINUM=.9
+19 SET ^XTMP("XUXTMP",VEICNT)="PERSON FILE RECORDS CLEANED"
+20 SET VEICNT=VEICNT+1
+21 FOR
SET VEINUM=$ORDER(^DIC(16,VEINUM))
if +VEINUM'>0
QUIT
Begin DoDot:1
+22 KILL VEIARR
+23 SET (VEIST,VEICTY)=""
+24 SET VEIST=+$PIECE($GET(^DIC(16,VEINUM,.11)),"^",5)
+25 SET VEICTY=+$PIECE($GET(^DIC(16,VEINUM,.11)),"^",7)
+26 IF '$DATA(^DIC(5,VEIST,1,VEICTY,0))
SET ^XTMP("XUXTMP",VEICNT)=^DIC(16,VEINUM,0)
SET VEICNT=VEICNT+1
SET VEIARR(16,VEINUM_",",.117)="@"
DO FILE^DIE("","VEIARR")
End DoDot:1
+27 SET ^XTMP("XUXTMP",VEICNT)=""
SET VEICNT=VEICNT+1
+28 ;FEE BASIS VENDOR FILE CLEANUP
+29 SET VEINUM=0
+30 SET ^XTMP("XUXTMP",VEICNT)="FEE BASIS VENDOR RECORDS CLEANED"
+31 SET VEICNT=VEICNT+1
+32 FOR
SET VEINUM=$ORDER(^FBAAV(VEINUM))
if +VEINUM'>0
QUIT
Begin DoDot:1
+33 KILL VEIARR
+34 SET (VEIST,VEICTY)=""
+35 SET VEIST=+$PIECE($GET(^FBAAV(VEINUM,0)),"^",5)
+36 SET VEICTY=+$PIECE($GET(^FBAAV(VEINUM,0)),"^",13)
+37 IF '$DATA(^DIC(5,VEIST,1,VEICTY,0))
SET ^XTMP("XUXTMP",VEICNT)=(^FBAAV(VEINUM,0))
SET VEICNT=VEICNT+1
SET VEIARR(161.2,VEINUM_",",5.5)="@"
DO FILE^DIE("","VEIARR")
End DoDot:1
+38 SET ^XTMP("XUXTMP",VEICNT)=""
SET VEICNT=VEICNT+1
+39 ;HBHC PATIENT FILE CLEANUP
+40 SET VEINUM=0
+41 SET ^XTMP("XUXTMP",VEICNT)="HBHC PATIENT FILE RECORDS CLEANED"
+42 SET VEICNT=VEICNT+1
+43 FOR
SET VEINUM=$ORDER(^HBHC(631,VEINUM))
if +VEINUM'>0
QUIT
Begin DoDot:1
+44 KILL VEIARR
+45 SET (VEIST,VEICTY)=""
+46 SET VEIST=+$PIECE($GET(^HBHC(631,VEINUM,0)),"^",3)
+47 SET VEICTY=+$PIECE($GET(^HBHC(631,VEINUM,0)),"^",4)
+48 IF '$DATA(^DIC(5,VEIST,1,VEICTY,0))
SET ^XTMP("XUXTMP",VEICNT)=(^HBHC(631,VEINUM,0))
SET VEICNT=VEICNT+1
SET VEIARR(631,VEINUM_",",3)="@"
DO FILE^DIE("","VEIARR")
End DoDot:1
+49 KILL VEIST,VEICTY,VEITST,VEITCT,VEINUM,VEIARR,VEICNT
+50 QUIT
