- XUXCTY ;MJM-SFCIOFO ROUTINE TO ELIMINATE DANGLING COUNTY POINTERS;OCT 30, 1998@11:03 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1005,1007**;APR 1, 2003
- ;;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
- XUXCTY ;MJM-SFCIOFO ROUTINE TO ELIMINATE DANGLING COUNTY POINTERS;OCT 30, 1998@11:03 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1005,1007**;APR 1, 2003
- +2 ;;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
