XUMF567.m

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 ---XUMF567   1057     printed  Apr 09, 2024@21:18:33                                                                                                                                                                                                     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       ;