source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUXCTY.m@ 1071

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

initial load of FOIAVistA 6/30/08 version
File size: 2.4 KB
Line 
1XUXCTY ;MJM-SFCIOFO ROUTINE TO ELIMINATE DANGLING COUNTY POINTERS;OCT 30, 1998@11:03
2 ;;8.0;KERNEL;**105**;OCT 30,1998
3FCS ; This line tag will do the THE CORRECTIONS
4 S ^XTMP("XUXTMP",0)=$$FMADD^XLFDT(DT,7)_U_DT
5 ;PATIENT FILE CLEANUP
6 S VEINUM=0,VEICNT=1
7 S ^XTMP("XUXTMP",VEICNT)="PATIENT FILE RECORDS CLEANED"
8 S VEICNT=VEICNT+1
9 F S VEINUM=$O(^DPT(VEINUM)) Q:+VEINUM'>0 D
10 . K VEIARR
11 . S (VEIST,VEICTY,VEITST,VEITCT)=""
12 . S VEIST=+$P($G(^DPT(VEINUM,.11)),"^",5)
13 . S VEICTY=+$P($G(^DPT(VEINUM,.11)),"^",7)
14 . I '$D(^DIC(5,VEIST,1,VEICTY,0)) S ^XTMP("XUXTMP",VEICNT)=(^DPT(VEINUM,0)),VEICNT=VEICNT+1,VEIARR(2,VEINUM_",",.117)="@"
15 . S VEITST=+$P($G(^DPT(VEINUM,.121)),"^",5)
16 . S VEITCT=+$P($G(^DPT(VEINUM,.121)),"^",11)
17 . I '$D(^DIC(5,VEITST,1,VEITCT,0)) S ^XTMP("XUXTMP",VEICNT)=(^DPT(VEINUM,0)),VEICNT=VEICNT+1,VEIARR(2,VEINUM_",",.12111)="@"
18 . I $D(VEIARR) D FILE^DIE("","VEIARR")
19 S ^XTMP("XUXTMP",VEICNT)="",VEICNT=VEICNT+1
20 ;PERSON FILE CLEANUP
21 S VEINUM=.9
22 S ^XTMP("XUXTMP",VEICNT)="PERSON FILE RECORDS CLEANED"
23 S VEICNT=VEICNT+1
24 F S VEINUM=$O(^DIC(16,VEINUM)) Q:+VEINUM'>0 D
25 . K VEIARR
26 . S (VEIST,VEICTY)=""
27 . S VEIST=+$P($G(^DIC(16,VEINUM,.11)),"^",5)
28 . S VEICTY=+$P($G(^DIC(16,VEINUM,.11)),"^",7)
29 . 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")
30 S ^XTMP("XUXTMP",VEICNT)="",VEICNT=VEICNT+1
31 ;FEE BASIS VENDOR FILE CLEANUP
32 S VEINUM=0
33 S ^XTMP("XUXTMP",VEICNT)="FEE BASIS VENDOR RECORDS CLEANED"
34 S VEICNT=VEICNT+1
35 F S VEINUM=$O(^FBAAV(VEINUM)) Q:+VEINUM'>0 D
36 . K VEIARR
37 . S (VEIST,VEICTY)=""
38 . S VEIST=+$P($G(^FBAAV(VEINUM,0)),"^",5)
39 . S VEICTY=+$P($G(^FBAAV(VEINUM,0)),"^",13)
40 . 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")
41 S ^XTMP("XUXTMP",VEICNT)="",VEICNT=VEICNT+1
42 ;HBHC PATIENT FILE CLEANUP
43 S VEINUM=0
44 S ^XTMP("XUXTMP",VEICNT)="HBHC PATIENT FILE RECORDS CLEANED"
45 S VEICNT=VEICNT+1
46 F S VEINUM=$O(^HBHC(631,VEINUM)) Q:+VEINUM'>0 D
47 . K VEIARR
48 . S (VEIST,VEICTY)=""
49 . S VEIST=+$P($G(^HBHC(631,VEINUM,0)),"^",3)
50 . S VEICTY=+$P($G(^HBHC(631,VEINUM,0)),"^",4)
51 . 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")
52 K VEIST,VEICTY,VEITST,VEITCT,VEINUM,VEIARR,VEICNT
53 Q
Note: See TracBrowser for help on using the repository browser.