PXRMDLGBREPAIR ;SLC/PKR - Utilities for correcting dialog duplicates. ;05/31/2024
;;2.0;CLINICAL REMINDERS;**88**;Feb 04, 2005;Build 13
Q
;
;===============================
CORRUPTED(IEN) ;Handle corrupted entries.
N INBINDEX,MSG,NAME,NREFS,TESTIEN,TEXT
K ^TMP("PXRMMSG",$J)
S MSG=$NA(^TMP("PXRMMSG",$J))
;Find the number of references to this entry.
D CHKPT^DIUTL(801.41,IEN,MSG,0)
S NREFS=^TMP("PXRMMSG",$J,0)
K ^TMP("PXRMMSG",$J)
I NREFS>0 D Q
. S TEXT(1)=""
. S TEXT(2)="File #801.41 IEN="_IEN
. S TEXT(3)="is corrupted, it is referenced "_NREFS_$S(NREFS=1:" time.",1:" times.")
. S TEXT(4)="Therefore it needs to be repaired by hand."
. S TEXT(5)="If you need help repairing it, enter a ticket."
. D BMES^XPDUTL(.TEXT)
;
;See if this entry is in the "B" index.
S INBINDEX=0,NAME=""
F Q:(INBINDEX=1) S NAME=$O(^PXRMD(801.41,"B",NAME)) Q:NAME="" D
. S TESTIEN=$O(^PXRMD(801.41,"B",NAME,""))
. I TESTIEN=IEN S INBINDEX=1
;
I NREFS=0 D
. K ^PXRMD(801.41,IEN)
. I INBINDEX K ^PXRMD(801.41,"B",NAME,IEN)
. K TEXT
. S TEXT(1)=""
. S TEXT(2)="File #801.41 IEN="_IEN
. S TEXT(3)="was corrupted, and was not being used."
. S TEXT(4)="It has been deleted."
. D BMES^XPDUTL(.TEXT)
Q
;
;===============================
DUPFIX ;Check for duplicates and resolve them.
N CHAR,CLOGSFN,CLOGTEXT,DIK,DUPLIST,FDA,IEN,IND
N KEEPIEN,KEEPNAME,LASTEDITDATE,LEN,MSG,NAME,NDUP,NENTRIES
N NL,NLC,NREFS,NTYPE,NUMRPT,NUSED,QUOTE
N REPLACENAME,REPOINTLIST,RPTLIST,TEXT,TYPE,TYPECOUNT,TYPELIST
S QUOTE=$C(34)
S CLOGSFN=$$GETCLOGSFN^PXRMCLEH(801.41)
S TEXT(1)="Checking for and resolving Reminder Dialog duplicates."
S TEXT(2)="The first step is to search for and remove trailing non-printing characters"
S TEXT(3)="in the .01s."
D BMES^XPDUTL(.TEXT)
;Search for and remove trailing non-printing characters in the .01.
S (IEN,NENTRIES)=0
F S IEN=+$O(^PXRMD(801.41,IEN)) Q:IEN=0 D
. S NAME=$P($G(^PXRMD(801.41,IEN,0)),U,1)
. I NAME="" D CORRUPTED(IEN) Q
. S LEN=$L(NAME)
. S CHAR=$E(NAME,LEN)
. I $A(CHAR)<33 D
.. K CLOGTEXT,TEXT
.. S TEXT(1)=""
.. S TEXT(2)="Removing trailing non-printing characters from:"
.. S TEXT(3)=" "_QUOTE_NAME_QUOTE_" ("_IEN_")"
.. S CLOGTEXT(1)="PXRM*2.0*88 renamed:"
.. S CLOGTEXT(2)=QUOTE_NAME_QUOTE
.. D BMES^XPDUTL(.TEXT)
.. S NAME=$$RMTRNPC(NAME)
.. S CLOGTEXT(3)="To: "_QUOTE_NAME_QUOTE
.. S $P(^PXRMD(801.41,IEN,0),U,1)=NAME
.. D CHANGELOG^PXRMCLEH(CLOGSFN,IEN,.CLOGTEXT)
.. S NENTRIES=NENTRIES+1
I NENTRIES>0 D
. K TEXT
. S TEXT=NENTRIES_" entries had trailing non-printing characters removed."
. D BMES^XPDUTL(TEXT)
;Rebuild the .01 indexes. Need to make sure the 'B' index is correct so all duplicates are checked.
S DIK="^PXRMD(801.41,"
S DIK(1)=".01"
D BMES^XPDUTL("Rebuilding the .01 indexes so all duplicates are found.")
K ^PXRMD(801.41,"B")
D ENALL^DIK
;
D BMES^XPDUTL("Searching for duplicates.")
S NAME="",NDUP=0
F S NAME=$O(^PXRMD(801.41,"B",NAME)) Q:NAME="" D
. K DUPLIST,TYPECOUNT,TYPELIST
. S (IEN,NENTRIES)=0
. F S IEN=+$O(^PXRMD(801.41,"B",NAME,IEN)) Q:IEN=0 D
.. S NENTRIES=NENTRIES+1
.. S DUPLIST(NENTRIES)=IEN
. I NENTRIES>1 D
.. S NDUP=NDUP+1
.. D MES^XPDUTL("Found "_NENTRIES_" entries for: "_QUOTE_NAME_QUOTE)
..;Determine if the duplicate entries all the same type.
.. F IND=1:1:NENTRIES D
... S IEN=DUPLIST(IND)
... S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
... I TYPE="" S TYPE="M"
... S TYPECOUNT(TYPE)=+$G(TYPECOUNT(TYPE))+1
... S TYPELIST(TYPE,IEN)=""
.. S NTYPE=0,TYPE=""
.. F S TYPE=$O(TYPELIST(TYPE)) Q:TYPE="" S NTYPE=NTYPE+1
..;If there are multiple types, remove the duplication by appending
..;-TYPE to the name.
.. I NTYPE>1 D
... S TYPE=""
... F S TYPE=$O(TYPELIST(TYPE)) Q:TYPE="" D
.... S IEN=""
.... F S IEN=$O(TYPELIST(TYPE,IEN)) Q:IEN="" D
..... S NAME=$P(^PXRMD(801.41,IEN,0),U,1)
..... K CLOGTEXT,TEXT
..... S TEXT(1)=""
..... S TEXT(2)="Renaming: "_QUOTE_NAME_QUOTE_" ("_IEN_")"
..... S TEXT(3)="by appending -"_TYPE
..... S CLOGTEXT(1)="PXRM*2.0*88 renamed:"
..... S CLOGTEXT(2)=QUOTE_NAME_QUOTE
..... D BMES^XPDUTL(.TEXT)
..... S NAME=$E(NAME,1,62)_"-"_TYPE
..... S CLOGTEXT(3)="To: "_QUOTE_NAME_QUOTE
..... D RENAMEIEN(801.41,IEN,NAME)
..... D CHANGELOG^PXRMCLEH(CLOGSFN,IEN,.CLOGTEXT)
...;If there are multiple entries for the same TYPE put them on
...;the repoint list.
... S TYPE=""
... F S TYPE=$O(TYPECOUNT(TYPE)) Q:TYPE="" D
.... I TYPECOUNT(TYPE)=1 Q
.... S IEN=$O(TYPELIST(TYPE,""))
.... S NAME=$P(^PXRMD(801.41,IEN,0),U,1)
.... S RPTLIST(NAME)=TYPECOUNT(TYPE)
.... S LASTEDITDATE=$$LASTEDITDATE(IEN)
.... S RPTLIST(NAME,LASTEDITDATE,IEN)=""
.... F S IEN=$O(TYPELIST(TYPE,IEN)) Q:IEN="" D
..... S LASTEDITDATE=$$LASTEDITDATE(IEN)
..... S RPTLIST(NAME,LASTEDITDATE,IEN)=""
..;
.. I NTYPE=1 D
... S RPTLIST(NAME)=NENTRIES
... F IND=1:1:NENTRIES D
.... S IEN=DUPLIST(IND)
.... S LASTEDITDATE=$$LASTEDITDATE(IEN)
.... S RPTLIST(NAME,LASTEDITDATE,IEN)=""
D BMES^XPDUTL(NDUP_" duplicated entries were found.")
;Process the repoint list.
I $D(RPTLIST)>0 D
. K TEXT
. S TEXT(1)="When the repointing is done:"
. S TEXT(2)=" KEEPIEN-This entry will be kept in file #801.41."
. S TEXT(3)=" REPLACEIEN-This entry will be repointed to KEEPIEN and REPLACEIEN"
. S TEXT(4)=" will be deleted from file #801.41."
. D BMES^XPDUTL(.TEXT)
S NAME="",NUMRPT=0
F S NAME=$O(RPTLIST(NAME)) Q:NAME="" D
. K CLOGTEXT
. S CLOGTEXT(1)="PXRM*2.0*88 repointed the following IENs to this entry:"
. S NLC=1
. S NENTRIES=RPTLIST(NAME)-1
. K TEXT
. S KEEPNAME=QUOTE_NAME_QUOTE
. S LASTEDITDATE=$O(RPTLIST(NAME,""),-1)
. S KEEPIEN=$O(RPTLIST(NAME,LASTEDITDATE,""))
. S TEXT(1)=""
. I NENTRIES=1 S TEXT(2)="Repointing "_(NENTRIES)_" duplicate entry for "_KEEPNAME
. I NENTRIES>1 S TEXT(2)="Repointing "_(NENTRIES)_" duplicate entries for "_KEEPNAME
. S TEXT(3)=" KEEPIEN="_KEEPIEN
. S NL=3
. S LASTEDITDATE=""
. F S LASTEDITDATE=$O(RPTLIST(NAME,LASTEDITDATE)) Q:LASTEDITDATE="" D
.. S IEN=""
.. F S IEN=$O(RPTLIST(NAME,LASTEDITDATE,IEN)) Q:IEN="" D
... I IEN=KEEPIEN Q
... S NUMRPT=NUMRPT+1,REPOINTLIST(NUMRPT)=IEN_U_KEEPIEN
... S NL=NL+1,TEXT(NL)=" REPLACEIEN="_IEN
... S NLC=NLC+1,CLOGTEXT(NLC)=" "_IEN
. D BMES^XPDUTL(.TEXT)
. D CHANGELOG^PXRMCLEH(CLOGSFN,KEEPIEN,.CLOGTEXT)
D BMES^XPDUTL(NUMRPT_" repoints will be done.")
;Do the repoints.
D EN^DITP(801.41,.REPOINTLIST)
;Delete the entries that have been repointed.
F IND=1:1:NUMRPT D
. K FDA,MSG
. S IEN=$P(REPOINTLIST(IND),U,1)
. S FDA(801.41,IEN_",",.01)="@"
. D FILE^DIE("","FDA","MSG")
. I $D(MSG) D
.. D BMES^XPDUTL("DUPFIX^PXRMDLGBREPAIR, delete failed.")
.. D AWRITE^PXUTIL("MSG")
.. D MES^XPDUTL("")
.. D AWRITE^PXUTIL("FDA")
Q
;
;===============================
LASTEDITDATE(IEN) ;Return the last edited date from the Change Log.
N DATE,LASTENTRY
S LASTENTRY=$O(^PXRMD(801.41,IEN,110,"B"),-1)
S DATE=$S(LASTENTRY>0:$P(^PXRMD(801.41,IEN,110,LASTENTRY,0),U,1),1:0)
Q DATE
;
;===============================
RENAMEIEN(FILENUM,IEN,NEWNAME) ;Rename IEN to NEWNAME in
;file number FILENUM. Ignore the key and input transform.
;Any resulting duplicates will be cleaned up by repointing.
N FDA,MSG,PXRMINST,PXNAT
S (PXRMINST,PXNAT)=1
S FDA(FILENUM,IEN_",",.01)=NEWNAME
D FILE^DIE("U","FDA","MSG")
I $D(MSG) D
. D BMES^XPDUTL("RENAMEIEN^PXRMDLGBREPAIR, rename failed.")
. D AWRITE^PXRMUTIL("MSG")
. D MES^XPDUTL("")
. D AWRITE^PXRMUTIL("FDA")
Q
;
;===============================
RMTRNPC(STRING) ;Remove trailing non-printing characters from STRING.
N CHAR,DONE,IND,LEN
S LEN=$L(STRING)
S CHAR=$E(STRING,LEN)
I $A(CHAR)>33 Q STRING
S DONE=0,IND=LEN-1
F Q:DONE D
. S CHAR=$E(STRING,IND)
. I $A(CHAR)>33 S DONE=1,STRING=$E(STRING,1,IND) Q
. S IND=IND-1
. I IND=0 S DONE=1,STRING=""
Q STRING
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLGBREPAIR 8046 printed Oct 16, 2024@17:44:50 Page 2
PXRMDLGBREPAIR ;SLC/PKR - Utilities for correcting dialog duplicates. ;05/31/2024
+1 ;;2.0;CLINICAL REMINDERS;**88**;Feb 04, 2005;Build 13
+2 QUIT
+3 ;
+4 ;===============================
CORRUPTED(IEN) ;Handle corrupted entries.
+1 NEW INBINDEX,MSG,NAME,NREFS,TESTIEN,TEXT
+2 KILL ^TMP("PXRMMSG",$JOB)
+3 SET MSG=$NAME(^TMP("PXRMMSG",$JOB))
+4 ;Find the number of references to this entry.
+5 DO CHKPT^DIUTL(801.41,IEN,MSG,0)
+6 SET NREFS=^TMP("PXRMMSG",$JOB,0)
+7 KILL ^TMP("PXRMMSG",$JOB)
+8 IF NREFS>0
Begin DoDot:1
+9 SET TEXT(1)=""
+10 SET TEXT(2)="File #801.41 IEN="_IEN
+11 SET TEXT(3)="is corrupted, it is referenced "_NREFS_$SELECT(NREFS=1:" time.",1:" times.")
+12 SET TEXT(4)="Therefore it needs to be repaired by hand."
+13 SET TEXT(5)="If you need help repairing it, enter a ticket."
+14 DO BMES^XPDUTL(.TEXT)
End DoDot:1
QUIT
+15 ;
+16 ;See if this entry is in the "B" index.
+17 SET INBINDEX=0
SET NAME=""
+18 FOR
if (INBINDEX=1)
QUIT
SET NAME=$ORDER(^PXRMD(801.41,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+19 SET TESTIEN=$ORDER(^PXRMD(801.41,"B",NAME,""))
+20 IF TESTIEN=IEN
SET INBINDEX=1
End DoDot:1
+21 ;
+22 IF NREFS=0
Begin DoDot:1
+23 KILL ^PXRMD(801.41,IEN)
+24 IF INBINDEX
KILL ^PXRMD(801.41,"B",NAME,IEN)
+25 KILL TEXT
+26 SET TEXT(1)=""
+27 SET TEXT(2)="File #801.41 IEN="_IEN
+28 SET TEXT(3)="was corrupted, and was not being used."
+29 SET TEXT(4)="It has been deleted."
+30 DO BMES^XPDUTL(.TEXT)
End DoDot:1
+31 QUIT
+32 ;
+33 ;===============================
DUPFIX ;Check for duplicates and resolve them.
+1 NEW CHAR,CLOGSFN,CLOGTEXT,DIK,DUPLIST,FDA,IEN,IND
+2 NEW KEEPIEN,KEEPNAME,LASTEDITDATE,LEN,MSG,NAME,NDUP,NENTRIES
+3 NEW NL,NLC,NREFS,NTYPE,NUMRPT,NUSED,QUOTE
+4 NEW REPLACENAME,REPOINTLIST,RPTLIST,TEXT,TYPE,TYPECOUNT,TYPELIST
+5 SET QUOTE=$CHAR(34)
+6 SET CLOGSFN=$$GETCLOGSFN^PXRMCLEH(801.41)
+7 SET TEXT(1)="Checking for and resolving Reminder Dialog duplicates."
+8 SET TEXT(2)="The first step is to search for and remove trailing non-printing characters"
+9 SET TEXT(3)="in the .01s."
+10 DO BMES^XPDUTL(.TEXT)
+11 ;Search for and remove trailing non-printing characters in the .01.
+12 SET (IEN,NENTRIES)=0
+13 FOR
SET IEN=+$ORDER(^PXRMD(801.41,IEN))
if IEN=0
QUIT
Begin DoDot:1
+14 SET NAME=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,1)
+15 IF NAME=""
DO CORRUPTED(IEN)
QUIT
+16 SET LEN=$LENGTH(NAME)
+17 SET CHAR=$EXTRACT(NAME,LEN)
+18 IF $ASCII(CHAR)<33
Begin DoDot:2
+19 KILL CLOGTEXT,TEXT
+20 SET TEXT(1)=""
+21 SET TEXT(2)="Removing trailing non-printing characters from:"
+22 SET TEXT(3)=" "_QUOTE_NAME_QUOTE_" ("_IEN_")"
+23 SET CLOGTEXT(1)="PXRM*2.0*88 renamed:"
+24 SET CLOGTEXT(2)=QUOTE_NAME_QUOTE
+25 DO BMES^XPDUTL(.TEXT)
+26 SET NAME=$$RMTRNPC(NAME)
+27 SET CLOGTEXT(3)="To: "_QUOTE_NAME_QUOTE
+28 SET $PIECE(^PXRMD(801.41,IEN,0),U,1)=NAME
+29 DO CHANGELOG^PXRMCLEH(CLOGSFN,IEN,.CLOGTEXT)
+30 SET NENTRIES=NENTRIES+1
End DoDot:2
End DoDot:1
+31 IF NENTRIES>0
Begin DoDot:1
+32 KILL TEXT
+33 SET TEXT=NENTRIES_" entries had trailing non-printing characters removed."
+34 DO BMES^XPDUTL(TEXT)
End DoDot:1
+35 ;Rebuild the .01 indexes. Need to make sure the 'B' index is correct so all duplicates are checked.
+36 SET DIK="^PXRMD(801.41,"
+37 SET DIK(1)=".01"
+38 DO BMES^XPDUTL("Rebuilding the .01 indexes so all duplicates are found.")
+39 KILL ^PXRMD(801.41,"B")
+40 DO ENALL^DIK
+41 ;
+42 DO BMES^XPDUTL("Searching for duplicates.")
+43 SET NAME=""
SET NDUP=0
+44 FOR
SET NAME=$ORDER(^PXRMD(801.41,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+45 KILL DUPLIST,TYPECOUNT,TYPELIST
+46 SET (IEN,NENTRIES)=0
+47 FOR
SET IEN=+$ORDER(^PXRMD(801.41,"B",NAME,IEN))
if IEN=0
QUIT
Begin DoDot:2
+48 SET NENTRIES=NENTRIES+1
+49 SET DUPLIST(NENTRIES)=IEN
End DoDot:2
+50 IF NENTRIES>1
Begin DoDot:2
+51 SET NDUP=NDUP+1
+52 DO MES^XPDUTL("Found "_NENTRIES_" entries for: "_QUOTE_NAME_QUOTE)
+53 ;Determine if the duplicate entries all the same type.
+54 FOR IND=1:1:NENTRIES
Begin DoDot:3
+55 SET IEN=DUPLIST(IND)
+56 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+57 IF TYPE=""
SET TYPE="M"
+58 SET TYPECOUNT(TYPE)=+$GET(TYPECOUNT(TYPE))+1
+59 SET TYPELIST(TYPE,IEN)=""
End DoDot:3
+60 SET NTYPE=0
SET TYPE=""
+61 FOR
SET TYPE=$ORDER(TYPELIST(TYPE))
if TYPE=""
QUIT
SET NTYPE=NTYPE+1
+62 ;If there are multiple types, remove the duplication by appending
+63 ;-TYPE to the name.
+64 IF NTYPE>1
Begin DoDot:3
+65 SET TYPE=""
+66 FOR
SET TYPE=$ORDER(TYPELIST(TYPE))
if TYPE=""
QUIT
Begin DoDot:4
+67 SET IEN=""
+68 FOR
SET IEN=$ORDER(TYPELIST(TYPE,IEN))
if IEN=""
QUIT
Begin DoDot:5
+69 SET NAME=$PIECE(^PXRMD(801.41,IEN,0),U,1)
+70 KILL CLOGTEXT,TEXT
+71 SET TEXT(1)=""
+72 SET TEXT(2)="Renaming: "_QUOTE_NAME_QUOTE_" ("_IEN_")"
+73 SET TEXT(3)="by appending -"_TYPE
+74 SET CLOGTEXT(1)="PXRM*2.0*88 renamed:"
+75 SET CLOGTEXT(2)=QUOTE_NAME_QUOTE
+76 DO BMES^XPDUTL(.TEXT)
+77 SET NAME=$EXTRACT(NAME,1,62)_"-"_TYPE
+78 SET CLOGTEXT(3)="To: "_QUOTE_NAME_QUOTE
+79 DO RENAMEIEN(801.41,IEN,NAME)
+80 DO CHANGELOG^PXRMCLEH(CLOGSFN,IEN,.CLOGTEXT)
End DoDot:5
End DoDot:4
+81 ;If there are multiple entries for the same TYPE put them on
+82 ;the repoint list.
+83 SET TYPE=""
+84 FOR
SET TYPE=$ORDER(TYPECOUNT(TYPE))
if TYPE=""
QUIT
Begin DoDot:4
+85 IF TYPECOUNT(TYPE)=1
QUIT
+86 SET IEN=$ORDER(TYPELIST(TYPE,""))
+87 SET NAME=$PIECE(^PXRMD(801.41,IEN,0),U,1)
+88 SET RPTLIST(NAME)=TYPECOUNT(TYPE)
+89 SET LASTEDITDATE=$$LASTEDITDATE(IEN)
+90 SET RPTLIST(NAME,LASTEDITDATE,IEN)=""
+91 FOR
SET IEN=$ORDER(TYPELIST(TYPE,IEN))
if IEN=""
QUIT
Begin DoDot:5
+92 SET LASTEDITDATE=$$LASTEDITDATE(IEN)
+93 SET RPTLIST(NAME,LASTEDITDATE,IEN)=""
End DoDot:5
End DoDot:4
End DoDot:3
+94 ;
+95 IF NTYPE=1
Begin DoDot:3
+96 SET RPTLIST(NAME)=NENTRIES
+97 FOR IND=1:1:NENTRIES
Begin DoDot:4
+98 SET IEN=DUPLIST(IND)
+99 SET LASTEDITDATE=$$LASTEDITDATE(IEN)
+100 SET RPTLIST(NAME,LASTEDITDATE,IEN)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+101 DO BMES^XPDUTL(NDUP_" duplicated entries were found.")
+102 ;Process the repoint list.
+103 IF $DATA(RPTLIST)>0
Begin DoDot:1
+104 KILL TEXT
+105 SET TEXT(1)="When the repointing is done:"
+106 SET TEXT(2)=" KEEPIEN-This entry will be kept in file #801.41."
+107 SET TEXT(3)=" REPLACEIEN-This entry will be repointed to KEEPIEN and REPLACEIEN"
+108 SET TEXT(4)=" will be deleted from file #801.41."
+109 DO BMES^XPDUTL(.TEXT)
End DoDot:1
+110 SET NAME=""
SET NUMRPT=0
+111 FOR
SET NAME=$ORDER(RPTLIST(NAME))
if NAME=""
QUIT
Begin DoDot:1
+112 KILL CLOGTEXT
+113 SET CLOGTEXT(1)="PXRM*2.0*88 repointed the following IENs to this entry:"
+114 SET NLC=1
+115 SET NENTRIES=RPTLIST(NAME)-1
+116 KILL TEXT
+117 SET KEEPNAME=QUOTE_NAME_QUOTE
+118 SET LASTEDITDATE=$ORDER(RPTLIST(NAME,""),-1)
+119 SET KEEPIEN=$ORDER(RPTLIST(NAME,LASTEDITDATE,""))
+120 SET TEXT(1)=""
+121 IF NENTRIES=1
SET TEXT(2)="Repointing "_(NENTRIES)_" duplicate entry for "_KEEPNAME
+122 IF NENTRIES>1
SET TEXT(2)="Repointing "_(NENTRIES)_" duplicate entries for "_KEEPNAME
+123 SET TEXT(3)=" KEEPIEN="_KEEPIEN
+124 SET NL=3
+125 SET LASTEDITDATE=""
+126 FOR
SET LASTEDITDATE=$ORDER(RPTLIST(NAME,LASTEDITDATE))
if LASTEDITDATE=""
QUIT
Begin DoDot:2
+127 SET IEN=""
+128 FOR
SET IEN=$ORDER(RPTLIST(NAME,LASTEDITDATE,IEN))
if IEN=""
QUIT
Begin DoDot:3
+129 IF IEN=KEEPIEN
QUIT
+130 SET NUMRPT=NUMRPT+1
SET REPOINTLIST(NUMRPT)=IEN_U_KEEPIEN
+131 SET NL=NL+1
SET TEXT(NL)=" REPLACEIEN="_IEN
+132 SET NLC=NLC+1
SET CLOGTEXT(NLC)=" "_IEN
End DoDot:3
End DoDot:2
+133 DO BMES^XPDUTL(.TEXT)
+134 DO CHANGELOG^PXRMCLEH(CLOGSFN,KEEPIEN,.CLOGTEXT)
End DoDot:1
+135 DO BMES^XPDUTL(NUMRPT_" repoints will be done.")
+136 ;Do the repoints.
+137 DO EN^DITP(801.41,.REPOINTLIST)
+138 ;Delete the entries that have been repointed.
+139 FOR IND=1:1:NUMRPT
Begin DoDot:1
+140 KILL FDA,MSG
+141 SET IEN=$PIECE(REPOINTLIST(IND),U,1)
+142 SET FDA(801.41,IEN_",",.01)="@"
+143 DO FILE^DIE("","FDA","MSG")
+144 IF $DATA(MSG)
Begin DoDot:2
+145 DO BMES^XPDUTL("DUPFIX^PXRMDLGBREPAIR, delete failed.")
+146 DO AWRITE^PXUTIL("MSG")
+147 DO MES^XPDUTL("")
+148 DO AWRITE^PXUTIL("FDA")
End DoDot:2
End DoDot:1
+149 QUIT
+150 ;
+151 ;===============================
LASTEDITDATE(IEN) ;Return the last edited date from the Change Log.
+1 NEW DATE,LASTENTRY
+2 SET LASTENTRY=$ORDER(^PXRMD(801.41,IEN,110,"B"),-1)
+3 SET DATE=$SELECT(LASTENTRY>0:$PIECE(^PXRMD(801.41,IEN,110,LASTENTRY,0),U,1),1:0)
+4 QUIT DATE
+5 ;
+6 ;===============================
RENAMEIEN(FILENUM,IEN,NEWNAME) ;Rename IEN to NEWNAME in
+1 ;file number FILENUM. Ignore the key and input transform.
+2 ;Any resulting duplicates will be cleaned up by repointing.
+3 NEW FDA,MSG,PXRMINST,PXNAT
+4 SET (PXRMINST,PXNAT)=1
+5 SET FDA(FILENUM,IEN_",",.01)=NEWNAME
+6 DO FILE^DIE("U","FDA","MSG")
+7 IF $DATA(MSG)
Begin DoDot:1
+8 DO BMES^XPDUTL("RENAMEIEN^PXRMDLGBREPAIR, rename failed.")
+9 DO AWRITE^PXRMUTIL("MSG")
+10 DO MES^XPDUTL("")
+11 DO AWRITE^PXRMUTIL("FDA")
End DoDot:1
+12 QUIT
+13 ;
+14 ;===============================
RMTRNPC(STRING) ;Remove trailing non-printing characters from STRING.
+1 NEW CHAR,DONE,IND,LEN
+2 SET LEN=$LENGTH(STRING)
+3 SET CHAR=$EXTRACT(STRING,LEN)
+4 IF $ASCII(CHAR)>33
QUIT STRING
+5 SET DONE=0
SET IND=LEN-1
+6 FOR
if DONE
QUIT
Begin DoDot:1
+7 SET CHAR=$EXTRACT(STRING,IND)
+8 IF $ASCII(CHAR)>33
SET DONE=1
SET STRING=$EXTRACT(STRING,1,IND)
QUIT
+9 SET IND=IND-1
+10 IF IND=0
SET DONE=1
SET STRING=""
End DoDot:1
+11 QUIT STRING
+12 ;
