PXCOPY ;SLC/PKR - Copy various PCE files. ;05/21/2018
;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
;================================
COPY(FILENUM,IEN) ;Copy an entry of ROOT into a new entry.
N DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,FIELDLEN,FILENAME
N IENN,IENS,MSG,NAME,ORIGNAME,RESULT,ROOT,X,Y
S ROOT=$$ROOT^DILFD(FILENUM)
S FILENAME=$$GET1^DID(FILENUM,"","","NAME")
S FILENAME=$$LOW^XLFSTR(FILENAME)
S ORIGNAME=$$GET1^DIQ(FILENUM,IEN,.01)
;Get the new name.
S FIELDLEN=$$GET1^DID(FILENUM,.01,"","FIELD LENGTH")
S DIR(0)="F"_U_"3:"_FIELDLEN_U_"K:(X?.N)!'(X'?1P.E) X"
S DIR("A")="Enter a Unique Name"
GETNAM D ^DIR
I $D(DIRUT) Q
S NAME=Y
;
;Make sure the new name is valid and unique.
I '$$VNAME^PXINPTR(NAME) G GETNAM
I $$FIND1^DIC(FILENUM,"","BXU",NAME) D G GETNAM
. W !,"There is already an entry with that name!"
;
;Set the starting place for additions and do the merge.
D SETSTART(ROOT)
S IENN=$$GETFOIEN(ROOT)
S RESULT=$$MERGE(IENN,IEN,ROOT)
I RESULT=0 W !,"Could not get a lock!" G GETNAM
;
;Change to the new name.
S IENS=IENN_","
S FDA(FILENUM,IENS,.01)=NAME
K MSG
D FILE^DIE("","FDA","MSG")
;Check to make sure the name was not a duplicate.
I $G(MSG("DIERR",1))=740 D G GETNAM
. W !,NAME," is not a unique name!"
;Change the class to local and delete the sponsor.
D SCAS(FILENUM,IENN,"L","")
;Initialize the change log.
D INIEH(FILENUM,ROOT,IENN,IEN)
;
;Re-index the cross-references.
S DIK=ROOT,DA=IENN
D IX^DIK
;
;Tell the user what has happened and allow for editing of the new item.
W !
S DIR(0)="Y"
S DIR("A")="Do you want to edit it now"
S DIR("A",1)="The original "_FILENAME_" "_ORIGNAME_" has been copied into "_NAME_"."
D ^DIR Q:$D(DIRUT)
I Y D EDIT(FILENUM,IENN)
Q
;
;================================
EDIT(FILENUM,IEN) ;Call the appropriate editor.
;The initial version only includes taxonomies.
I FILENUM=9999999.09 D SMANEDIT^PXEDUSM(IEN,0)
I FILENUM=9999999.15 D SMANEDIT^PXEXSM(IEN,0)
I FILENUM=9999999.64 D SMANEDIT^PXHFSM(IEN,0)
Q
;
;================================
GETFOIEN(ROOT) ;Return the first open IEN in ROOT. This should be called
;after a call to SETSTART.
N ENTRY,NIEN,OIEN
S ENTRY=ROOT_0_")"
S OIEN=+$P(@ENTRY,U,3)
S ENTRY=ROOT_OIEN_")"
F S NIEN=$O(@ENTRY) Q:+(NIEN-OIEN)>1 Q:+NIEN'>0 S OIEN=NIEN,ENTRY=ROOT_NIEN_")"
Q OIEN+1
;
;================================
INIEH(FILENUM,ROOT,IENN,IEN) ;Initialize the change log after a copy.
;First delete any existing history entries.
N ENTRY,IND,IENS,FDA,FDAIEN,MSG,SFN,TARGET,WP
D FIELD^DID(FILENUM,"CHANGE LOG","","SPECIFIER","TARGET")
S SFN=+$G(TARGET("SPECIFIER"))
I SFN=0 Q
S ENTRY=ROOT_IENN_",110)"
S IND=0
F S IND=$O(@ENTRY@(IND)) Q:+IND=0 D
. S IENS=IND_","_IENN_","
. S FDA(SFN,IENS,.01)="@"
I $D(FDA(SFN)) D FILE^DIE("K","FDA","MSG")
I $D(MSG) D AWRITE^PXUTIL("MSG")
;Establish an initial entry in the change log.
K FDA,MSG
S IENS="+1,"_IENN_","
S FDAIEN(IENN)=IENN
S FDA(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
S FDA(SFN,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
S FDA(SFN,IENS,2)="WP(1,1)"
S WP(1,1,1)="Copied from "_$$GET1^DIQ(FILENUM,IEN,.01)
D UPDATE^DIE("E","FDA","FDAIEN","MSG")
I $D(MSG) D AWRITE^PXUTIL("MSG")
Q
;
;================================
MERGE(IENN,IEN,ROOT) ;Use MERGE to copy ROOT(IEN into ROOT(IENN.
N DEST,SOURCE
S DEST=ROOT_IENN_")"
;Lock the file before merging.
L +@DEST:DILOCKTM
I '$T Q 0
S SOURCE=ROOT_IEN_")"
M @DEST=@SOURCE
;Unlock the file
L -@DEST
Q 1
;
;================================
SCAS(FILENUM,IEN,CLASS,SPONSOR) ;Set the class field to CLASS and the sponsor
;field to SPONSOR.
N IENS,FDA,MSG
S IENS=IEN_","
S FDA(FILENUM,IENS,100)=CLASS
S FDA(FILENUM,IENS,101)=SPONSOR
D FILE^DIE("K","FDA","MSG")
I $D(MSG) D AWRITE^PXUTIL("MSG")
Q
;
;================================
SETSTART(ROOT) ;Set the starting value to add new entries. Start
;at the beginning so empty spaces are filled in.
N CUR,ENTRY
S ENTRY=ROOT_"0)"
S $P(@ENTRY,U,3)=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCOPY 4142 printed Sep 23, 2025@20:04:34 Page 2
PXCOPY ;SLC/PKR - Copy various PCE files. ;05/21/2018
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
+2 ;================================
COPY(FILENUM,IEN) ;Copy an entry of ROOT into a new entry.
+1 NEW DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,FIELDLEN,FILENAME
+2 NEW IENN,IENS,MSG,NAME,ORIGNAME,RESULT,ROOT,X,Y
+3 SET ROOT=$$ROOT^DILFD(FILENUM)
+4 SET FILENAME=$$GET1^DID(FILENUM,"","","NAME")
+5 SET FILENAME=$$LOW^XLFSTR(FILENAME)
+6 SET ORIGNAME=$$GET1^DIQ(FILENUM,IEN,.01)
+7 ;Get the new name.
+8 SET FIELDLEN=$$GET1^DID(FILENUM,.01,"","FIELD LENGTH")
+9 SET DIR(0)="F"_U_"3:"_FIELDLEN_U_"K:(X?.N)!'(X'?1P.E) X"
+10 SET DIR("A")="Enter a Unique Name"
GETNAM DO ^DIR
+1 IF $DATA(DIRUT)
QUIT
+2 SET NAME=Y
+3 ;
+4 ;Make sure the new name is valid and unique.
+5 IF '$$VNAME^PXINPTR(NAME)
GOTO GETNAM
+6 IF $$FIND1^DIC(FILENUM,"","BXU",NAME)
Begin DoDot:1
+7 WRITE !,"There is already an entry with that name!"
End DoDot:1
GOTO GETNAM
+8 ;
+9 ;Set the starting place for additions and do the merge.
+10 DO SETSTART(ROOT)
+11 SET IENN=$$GETFOIEN(ROOT)
+12 SET RESULT=$$MERGE(IENN,IEN,ROOT)
+13 IF RESULT=0
WRITE !,"Could not get a lock!"
GOTO GETNAM
+14 ;
+15 ;Change to the new name.
+16 SET IENS=IENN_","
+17 SET FDA(FILENUM,IENS,.01)=NAME
+18 KILL MSG
+19 DO FILE^DIE("","FDA","MSG")
+20 ;Check to make sure the name was not a duplicate.
+21 IF $GET(MSG("DIERR",1))=740
Begin DoDot:1
+22 WRITE !,NAME," is not a unique name!"
End DoDot:1
GOTO GETNAM
+23 ;Change the class to local and delete the sponsor.
+24 DO SCAS(FILENUM,IENN,"L","")
+25 ;Initialize the change log.
+26 DO INIEH(FILENUM,ROOT,IENN,IEN)
+27 ;
+28 ;Re-index the cross-references.
+29 SET DIK=ROOT
SET DA=IENN
+30 DO IX^DIK
+31 ;
+32 ;Tell the user what has happened and allow for editing of the new item.
+33 WRITE !
+34 SET DIR(0)="Y"
+35 SET DIR("A")="Do you want to edit it now"
+36 SET DIR("A",1)="The original "_FILENAME_" "_ORIGNAME_" has been copied into "_NAME_"."
+37 DO ^DIR
if $DATA(DIRUT)
QUIT
+38 IF Y
DO EDIT(FILENUM,IENN)
+39 QUIT
+40 ;
+41 ;================================
EDIT(FILENUM,IEN) ;Call the appropriate editor.
+1 ;The initial version only includes taxonomies.
+2 IF FILENUM=9999999.09
DO SMANEDIT^PXEDUSM(IEN,0)
+3 IF FILENUM=9999999.15
DO SMANEDIT^PXEXSM(IEN,0)
+4 IF FILENUM=9999999.64
DO SMANEDIT^PXHFSM(IEN,0)
+5 QUIT
+6 ;
+7 ;================================
GETFOIEN(ROOT) ;Return the first open IEN in ROOT. This should be called
+1 ;after a call to SETSTART.
+2 NEW ENTRY,NIEN,OIEN
+3 SET ENTRY=ROOT_0_")"
+4 SET OIEN=+$PIECE(@ENTRY,U,3)
+5 SET ENTRY=ROOT_OIEN_")"
+6 FOR
SET NIEN=$ORDER(@ENTRY)
if +(NIEN-OIEN)>1
QUIT
if +NIEN'>0
QUIT
SET OIEN=NIEN
SET ENTRY=ROOT_NIEN_")"
+7 QUIT OIEN+1
+8 ;
+9 ;================================
INIEH(FILENUM,ROOT,IENN,IEN) ;Initialize the change log after a copy.
+1 ;First delete any existing history entries.
+2 NEW ENTRY,IND,IENS,FDA,FDAIEN,MSG,SFN,TARGET,WP
+3 DO FIELD^DID(FILENUM,"CHANGE LOG","","SPECIFIER","TARGET")
+4 SET SFN=+$GET(TARGET("SPECIFIER"))
+5 IF SFN=0
QUIT
+6 SET ENTRY=ROOT_IENN_",110)"
+7 SET IND=0
+8 FOR
SET IND=$ORDER(@ENTRY@(IND))
if +IND=0
QUIT
Begin DoDot:1
+9 SET IENS=IND_","_IENN_","
+10 SET FDA(SFN,IENS,.01)="@"
End DoDot:1
+11 IF $DATA(FDA(SFN))
DO FILE^DIE("K","FDA","MSG")
+12 IF $DATA(MSG)
DO AWRITE^PXUTIL("MSG")
+13 ;Establish an initial entry in the change log.
+14 KILL FDA,MSG
+15 SET IENS="+1,"_IENN_","
+16 SET FDAIEN(IENN)=IENN
+17 SET FDA(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+18 SET FDA(SFN,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
+19 SET FDA(SFN,IENS,2)="WP(1,1)"
+20 SET WP(1,1,1)="Copied from "_$$GET1^DIQ(FILENUM,IEN,.01)
+21 DO UPDATE^DIE("E","FDA","FDAIEN","MSG")
+22 IF $DATA(MSG)
DO AWRITE^PXUTIL("MSG")
+23 QUIT
+24 ;
+25 ;================================
MERGE(IENN,IEN,ROOT) ;Use MERGE to copy ROOT(IEN into ROOT(IENN.
+1 NEW DEST,SOURCE
+2 SET DEST=ROOT_IENN_")"
+3 ;Lock the file before merging.
+4 LOCK +@DEST:DILOCKTM
+5 IF '$TEST
QUIT 0
+6 SET SOURCE=ROOT_IEN_")"
+7 MERGE @DEST=@SOURCE
+8 ;Unlock the file
+9 LOCK -@DEST
+10 QUIT 1
+11 ;
+12 ;================================
SCAS(FILENUM,IEN,CLASS,SPONSOR) ;Set the class field to CLASS and the sponsor
+1 ;field to SPONSOR.
+2 NEW IENS,FDA,MSG
+3 SET IENS=IEN_","
+4 SET FDA(FILENUM,IENS,100)=CLASS
+5 SET FDA(FILENUM,IENS,101)=SPONSOR
+6 DO FILE^DIE("K","FDA","MSG")
+7 IF $DATA(MSG)
DO AWRITE^PXUTIL("MSG")
+8 QUIT
+9 ;
+10 ;================================
SETSTART(ROOT) ;Set the starting value to add new entries. Start
+1 ;at the beginning so empty spaces are filled in.
+2 NEW CUR,ENTRY
+3 SET ENTRY=ROOT_"0)"
+4 SET $PIECE(@ENTRY,U,3)=1
+5 QUIT
+6 ;
