Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXCOPY

PXCOPY.m

Go to the documentation of this file.
  1. PXCOPY ;SLC/PKR - Copy various PCE files. ;05/21/2018
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
  1. ;================================
  1. COPY(FILENUM,IEN) ;Copy an entry of ROOT into a new entry.
  1. N DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,FIELDLEN,FILENAME
  1. N IENN,IENS,MSG,NAME,ORIGNAME,RESULT,ROOT,X,Y
  1. S ROOT=$$ROOT^DILFD(FILENUM)
  1. S FILENAME=$$GET1^DID(FILENUM,"","","NAME")
  1. S FILENAME=$$LOW^XLFSTR(FILENAME)
  1. S ORIGNAME=$$GET1^DIQ(FILENUM,IEN,.01)
  1. ;Get the new name.
  1. S FIELDLEN=$$GET1^DID(FILENUM,.01,"","FIELD LENGTH")
  1. S DIR(0)="F"_U_"3:"_FIELDLEN_U_"K:(X?.N)!'(X'?1P.E) X"
  1. S DIR("A")="Enter a Unique Name"
  1. GETNAM D ^DIR
  1. I $D(DIRUT) Q
  1. S NAME=Y
  1. ;
  1. ;Make sure the new name is valid and unique.
  1. I '$$VNAME^PXINPTR(NAME) G GETNAM
  1. I $$FIND1^DIC(FILENUM,"","BXU",NAME) D G GETNAM
  1. . W !,"There is already an entry with that name!"
  1. ;
  1. ;Set the starting place for additions and do the merge.
  1. D SETSTART(ROOT)
  1. S IENN=$$GETFOIEN(ROOT)
  1. S RESULT=$$MERGE(IENN,IEN,ROOT)
  1. I RESULT=0 W !,"Could not get a lock!" G GETNAM
  1. ;
  1. ;Change to the new name.
  1. S IENS=IENN_","
  1. S FDA(FILENUM,IENS,.01)=NAME
  1. K MSG
  1. D FILE^DIE("","FDA","MSG")
  1. ;Check to make sure the name was not a duplicate.
  1. I $G(MSG("DIERR",1))=740 D G GETNAM
  1. . W !,NAME," is not a unique name!"
  1. ;Change the class to local and delete the sponsor.
  1. D SCAS(FILENUM,IENN,"L","")
  1. ;Initialize the change log.
  1. D INIEH(FILENUM,ROOT,IENN,IEN)
  1. ;
  1. ;Re-index the cross-references.
  1. S DIK=ROOT,DA=IENN
  1. D IX^DIK
  1. ;
  1. ;Tell the user what has happened and allow for editing of the new item.
  1. W !
  1. S DIR(0)="Y"
  1. S DIR("A")="Do you want to edit it now"
  1. S DIR("A",1)="The original "_FILENAME_" "_ORIGNAME_" has been copied into "_NAME_"."
  1. D ^DIR Q:$D(DIRUT)
  1. I Y D EDIT(FILENUM,IENN)
  1. Q
  1. ;
  1. ;================================
  1. EDIT(FILENUM,IEN) ;Call the appropriate editor.
  1. ;The initial version only includes taxonomies.
  1. I FILENUM=9999999.09 D SMANEDIT^PXEDUSM(IEN,0)
  1. I FILENUM=9999999.15 D SMANEDIT^PXEXSM(IEN,0)
  1. I FILENUM=9999999.64 D SMANEDIT^PXHFSM(IEN,0)
  1. Q
  1. ;
  1. ;================================
  1. GETFOIEN(ROOT) ;Return the first open IEN in ROOT. This should be called
  1. ;after a call to SETSTART.
  1. N ENTRY,NIEN,OIEN
  1. S ENTRY=ROOT_0_")"
  1. S OIEN=+$P(@ENTRY,U,3)
  1. S ENTRY=ROOT_OIEN_")"
  1. F S NIEN=$O(@ENTRY) Q:+(NIEN-OIEN)>1 Q:+NIEN'>0 S OIEN=NIEN,ENTRY=ROOT_NIEN_")"
  1. Q OIEN+1
  1. ;
  1. ;================================
  1. INIEH(FILENUM,ROOT,IENN,IEN) ;Initialize the change log after a copy.
  1. ;First delete any existing history entries.
  1. N ENTRY,IND,IENS,FDA,FDAIEN,MSG,SFN,TARGET,WP
  1. D FIELD^DID(FILENUM,"CHANGE LOG","","SPECIFIER","TARGET")
  1. S SFN=+$G(TARGET("SPECIFIER"))
  1. I SFN=0 Q
  1. S ENTRY=ROOT_IENN_",110)"
  1. S IND=0
  1. F S IND=$O(@ENTRY@(IND)) Q:+IND=0 D
  1. . S IENS=IND_","_IENN_","
  1. . S FDA(SFN,IENS,.01)="@"
  1. I $D(FDA(SFN)) D FILE^DIE("K","FDA","MSG")
  1. I $D(MSG) D AWRITE^PXUTIL("MSG")
  1. ;Establish an initial entry in the change log.
  1. K FDA,MSG
  1. S IENS="+1,"_IENN_","
  1. S FDAIEN(IENN)=IENN
  1. S FDA(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1. S FDA(SFN,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
  1. S FDA(SFN,IENS,2)="WP(1,1)"
  1. S WP(1,1,1)="Copied from "_$$GET1^DIQ(FILENUM,IEN,.01)
  1. D UPDATE^DIE("E","FDA","FDAIEN","MSG")
  1. I $D(MSG) D AWRITE^PXUTIL("MSG")
  1. Q
  1. ;
  1. ;================================
  1. MERGE(IENN,IEN,ROOT) ;Use MERGE to copy ROOT(IEN into ROOT(IENN.
  1. N DEST,SOURCE
  1. S DEST=ROOT_IENN_")"
  1. ;Lock the file before merging.
  1. L +@DEST:DILOCKTM
  1. I '$T Q 0
  1. S SOURCE=ROOT_IEN_")"
  1. M @DEST=@SOURCE
  1. ;Unlock the file
  1. L -@DEST
  1. Q 1
  1. ;
  1. ;================================
  1. SCAS(FILENUM,IEN,CLASS,SPONSOR) ;Set the class field to CLASS and the sponsor
  1. ;field to SPONSOR.
  1. N IENS,FDA,MSG
  1. S IENS=IEN_","
  1. S FDA(FILENUM,IENS,100)=CLASS
  1. S FDA(FILENUM,IENS,101)=SPONSOR
  1. D FILE^DIE("K","FDA","MSG")
  1. I $D(MSG) D AWRITE^PXUTIL("MSG")
  1. Q
  1. ;
  1. ;================================
  1. SETSTART(ROOT) ;Set the starting value to add new entries. Start
  1. ;at the beginning so empty spaces are filled in.
  1. N CUR,ENTRY
  1. S ENTRY=ROOT_"0)"
  1. S $P(@ENTRY,U,3)=1
  1. Q
  1. ;