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