XUMF567 ;BP/RAM - INSTITUTION DUP FIX ;06/28/00
;;8.0;KERNEL;**567**;Jul 10, 1995;Build 8
;
;
Q
;
MAIN ;
;
Q:$$KSP^XUPARAM("INST")=12000
;
M ^TMP("XUMF 04",$$NOW^XLFDT,$J,4)=^DIC(4)
;
S XUMF=1
;
D DUP,BK
;
Q
;
KT ; -- kill temp node / file backup
;
K ^TMP("XUMF 04")
;
Q
;
BK ; -- background job to kill temp node in 30 days
;
N ZTRTN,ZTDESC,ZTDTH
;
S ZTRTN="KT^XUMF567"
S ZTDESC="XUMF kill temp backup of file 4 - patch xu549"
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,30,0,0,0)
S ZTIO=""
;
D ^%ZTLOAD
;
Q
;
DUP ; RESOLVE DUPLICATE RECORDS
;
N NAME,IEN,IENS,FDA,XUMF,STA
;
S STA=""
F S STA=$O(^DIC(4,"D",STA)) Q:STA="" D
.S IEN=$O(^DIC(4,"D",STA,0)) Q:'$O(^DIC(4,"D",STA,IEN))
.F S IEN=$O(^DIC(4,"D",STA,IEN)) Q:'IEN D
..S XUMF=1
..S NAME=$P(^DIC(4,IEN,0),U)
..S IENS=IEN_","
..K FDA
..S FDA(4,IENS,.01)=$E("ZZ DUP "_NAME,1,30)
..S FDA(4,IENS,101)="INACTIVE"
..S FDA(4,IENS,99)="@"
..D FILE^DIE("E","FDA")
;
Q
;
EXIT ; -- cleanup, and quit
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMF567 1057 printed Dec 13, 2024@02:10:29 Page 2
XUMF567 ;BP/RAM - INSTITUTION DUP FIX ;06/28/00
+1 ;;8.0;KERNEL;**567**;Jul 10, 1995;Build 8
+2 ;
+3 ;
+4 QUIT
+5 ;
MAIN ;
+1 ;
+2 if $$KSP^XUPARAM("INST")=12000
QUIT
+3 ;
+4 MERGE ^TMP("XUMF 04",$$NOW^XLFDT,$JOB,4)=^DIC(4)
+5 ;
+6 SET XUMF=1
+7 ;
+8 DO DUP
DO BK
+9 ;
+10 QUIT
+11 ;
KT ; -- kill temp node / file backup
+1 ;
+2 KILL ^TMP("XUMF 04")
+3 ;
+4 QUIT
+5 ;
BK ; -- background job to kill temp node in 30 days
+1 ;
+2 NEW ZTRTN,ZTDESC,ZTDTH
+3 ;
+4 SET ZTRTN="KT^XUMF567"
+5 SET ZTDESC="XUMF kill temp backup of file 4 - patch xu549"
+6 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,30,0,0,0)
+7 SET ZTIO=""
+8 ;
+9 DO ^%ZTLOAD
+10 ;
+11 QUIT
+12 ;
DUP ; RESOLVE DUPLICATE RECORDS
+1 ;
+2 NEW NAME,IEN,IENS,FDA,XUMF,STA
+3 ;
+4 SET STA=""
+5 FOR
SET STA=$ORDER(^DIC(4,"D",STA))
if STA=""
QUIT
Begin DoDot:1
+6 SET IEN=$ORDER(^DIC(4,"D",STA,0))
if '$ORDER(^DIC(4,"D",STA,IEN))
QUIT
+7 FOR
SET IEN=$ORDER(^DIC(4,"D",STA,IEN))
if 'IEN
QUIT
Begin DoDot:2
+8 SET XUMF=1
+9 SET NAME=$PIECE(^DIC(4,IEN,0),U)
+10 SET IENS=IEN_","
+11 KILL FDA
+12 SET FDA(4,IENS,.01)=$EXTRACT("ZZ DUP "_NAME,1,30)
+13 SET FDA(4,IENS,101)="INACTIVE"
+14 SET FDA(4,IENS,99)="@"
+15 DO FILE^DIE("E","FDA")
End DoDot:2
End DoDot:1
+16 ;
+17 QUIT
+18 ;
EXIT ; -- cleanup, and quit
+1 ;
+2 QUIT
+3 ;
