- 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 Feb 18, 2025@23:36:55 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 ;