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

TIUFHA5.m

Go to the documentation of this file. 
  1. TIUFHA5 ; SLC/MAM - COPYFDA(FILEDA,ITEMFLG,PFILEDA,CFILEDA,CNODE0,VCNTAJ), CREATE(NAME,FILEDA), CP0,etc. ;7/1/97  14:02
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**2,14,43,77,1001**;Jun 20, 1997
  1.  ;IHS/ITSC/LJF 01/07/2005 PATCH 1001 allow non-programmers to copy object method
  1.  ;
  1. COPYFDA(FILEDA,ITEMFLG,PFILEDA,CFILEDA,CNODE0,VCNTAJ) ; Copy entry FILEDA into
  1.  ;CFILEDA; Update Template A,J if TIUFTMPL="A","J".
  1.  ; Requires TIUFSHAR from COPYENTY
  1.  ; Requires FILEDA, TIUFTMPL, ITEMFLG
  1.  ; Requires PFILEDA if entry being copied has a parent
  1.  ; Returns CFILEDA; =0 if unsuccessfull.
  1.  ; Returns CNODE0.
  1.  ; I TIUFTMPL="A"or "J", Requires VCNTAJ = VALMCNT for Template A or J, Updates VCNTAJ.
  1.  ; Requires ITEMFLG=0 or 1. 1 if called by CP10 (i.e. currently copying Item of entry rather than entry selected by user.)
  1.  ; If the entry selected for copy is nonSHARED (TIUFSHAR=0) and
  1.  ;module is CURRENTLY copying a SHARED ancestor, module does not copy
  1.  ;FILEDA into a new IFN but sets CFILEDA and CNODE0 to FILEDA and NODE0,
  1.  ;so that FILEDA (rather than a copy) is added to the parent.
  1.  N NODE0,PGM,NAME,DIR,X,Y,SHARED,TIUJ,CNTCHNG,TIUFIMSG
  1.  N TIUFTLST,TIUFTMSG
  1.  S CFILEDA=0
  1.  L +^TIU(8925.1,FILEDA):1 I '$T W !!," Entry accessed by another user; Please try again later.",! H 2 G COPYFDX
  1.  S NODE0=^TIU(8925.1,FILEDA,0),SHARED=$P(NODE0,U,10),PFILEDA=+$G(PFILEDA)
  1.  I ITEMFLG,'TIUFSHAR,SHARED S CFILEDA=FILEDA,CNODE0=NODE0 G COPYFDX
  1. READNM I '$G(TIUFFULL) D FULL^VALM1 S TIUFFULL=1 K DIRUT
  1.  S NAME=$P(NODE0,U),DIR(0)="8925.1,.01",DIR("A")="Copy into (different) Name",DIR("B")=NAME D ^DIR G:$D(DIRUT) COPYFDX
  1.  I Y=NAME W !," Name of copy must be different from original name.  Original is provided as the",!,"default since it may be similar to new name, but original must be changed.",!," Enter ^ to exit." G READNM
  1.  S NAME=Y K DIR,X,Y
  1.  I PFILEDA,$$DUPITEM^TIUFLF7(NAME,PFILEDA) S NAME=$P(NODE0,U) W !!,TIUFIMSG,! G READNM
  1.  I $D(DIRUT) S CFILEDA=0 Q
  1.  D TYPELIST^TIUFLF7(NAME,0,PFILEDA,.TIUFTMSG,.TIUFTLST) G:$D(DTOUT) COPYFDX
  1.  I $D(TIUFTMSG("T")) W !!,TIUFTMSG("T"),!,"Can't Copy entry",! D PAUSE^TIUFXHLX S CFILEDA=0 G COPYFDX
  1.  I TIUFTLST'[$P(NODE0,U,4) W !!," Please enter a different Name; File already has entry of that Type with that",!,"Name",! G READNM
  1.  D CREATE(NAME,.CFILEDA) G:'CFILEDA COPYFDX
  1.  L +^TIU(8925.1,CFILEDA):1 I '$T W !!," Copy accessed by another user; Please recopy" D PAUSE^TIUFXHLX G COPYFDX
  1.  D CP0(FILEDA,CFILEDA,NODE0)
  1.  D STUFFLDS^TIUFLF4(CFILEDA) ;Do NOT send parent to STUFFLDS or it will
  1.  ;stuff SHARED
  1.  K DIRUT D CP10(FILEDA,CFILEDA,.VCNTAJ) G:$D(DIRUT) COPYFDX
  1.  F TIUJ=1,3,"4T9","11T13","DFLT","HEAD","ITEM" S PGM="CP"_TIUJ_"("_FILEDA_","_CFILEDA_")" D @PGM
  1.  S CNODE0=^TIU(8925.1,CFILEDA,0)
  1.  I TIUFTMPL="A"!(TIUFTMPL="J") D AUPDATE^TIUFLA1(CNODE0,CFILEDA,.CNTCHNG) S:CNTCHNG=1 VCNTAJ=VCNTAJ+1 ;P77 I 'CNTCHNG S TIUFYMSG="; Not in current View"
  1. COPYFDX ;
  1.  L -^TIU(8925.1,+$G(CFILEDA)) L -^TIU(8925.1,+$G(FILEDA))
  1.  I '$G(CFILEDA) S CFILEDA=0
  1.  Q
  1.  ;
  1. CREATE(NAME,FILEDA) ; Creates Document Definition File record of Name NAME with IFN FILEDA
  1.  ; Requires NAME for new record; Returns FILEDA of new record
  1.  ; Returns FILEDA<0 if can't create.
  1.  N DIC,DLAYGO,X,Y
  1.  K DA S (DIC,DLAYGO)=8925.1,DIC(0)="L"
  1.  S X=""""_NAME_""""
  1.  D ^DIC
  1.  S FILEDA=+Y
  1. CREAX Q
  1.  ;
  1. CP0(FILEDA,DA,NODE0) ; Copy root node NODE0 into DA. DON'T copy status, Shared, or National. If object, don't copy abbrev or printname.
  1.  N DR,DIE,TIUI
  1.  S DIE=8925.1
  1.  S DR="" F TIUI=2,3,4,5,6,14 D
  1.  . I $P(NODE0,U,4)="O",TIUI=2!(TIUI=3)!(TIUI=14) Q
  1.  . S DR=DR_".0"_TIUI_"////"_$P(NODE0,U,TIUI)_";"
  1.  D ^DIE
  1. CP0X Q
  1.  ;
  1. CP1(FILEDA,DA) ; Copy node 1 of FILEDA into DA.
  1.  N DR,DIE,TIUI,NODE,VALUE
  1.  S DIE=8925.1,NODE=$G(^TIU(8925.1,FILEDA,1)) Q:NODE=""
  1.  S DR="" F TIUI=1:1:4 S VALUE(TIUI)=$P(NODE,U,TIUI),DR=DR_"1.0"_TIUI_"///^S X=VALUE("_TIUI_")"_$S(TIUI<4:";",1:"") ;Field 1.03 may contain ';'.
  1.  D ^DIE
  1. CP1X Q
  1.  ;
  1. CP3(FILEDA,DA) ; Copy node 3 of FILEDA into DA.  DON'T copy OK to Distribute.
  1.  N DR,DIE,TIUI,NODE
  1.  S DIE=8925.1,NODE=$G(^TIU(8925.1,FILEDA,3)) Q:NODE=""
  1.  S DR="3.03////"_$P(NODE,U,3)
  1.  D ^DIE
  1. CP3X Q
  1.  ;
  1. CP4T9(FILEDA,DA) ; Copy nodes 4 thru 9 of FILEDA into DA.
  1.  N DR,DIE,TIUI,NODE4T9,PIECE
  1.  S DIE=8925.1
  1.  F TIUI=4,4.1,4.2,4.3,4.4,4.45,4.5,4.6,4.7,4.8,4.9,5,6,7,8,9 D
  1.  . S NODE4T9(TIUI)=$G(^TIU(8925.1,FILEDA,TIUI)) Q:NODE4T9(TIUI)=""
  1.  . I TIUI=9 S ^TIU(8925.1,DA,9)=NODE4T9(TIUI) Q   ;IHS/ITSC/LJF 01/07/2005 PATCH 1001
  1.  . S DR=TIUI_"////"_NODE4T9(TIUI) D ^DIE
  1.  . Q
  1.  F TIUI=6.1,6.12,6.13 D  ; 6.14 does not apply to titles
  1.  . S PIECE=$E(TIUI,$L(TIUI))
  1.  . S NODE4T9(TIUI)=$P($G(^TIU(8925.1,FILEDA,6.1)),U,PIECE) Q:NODE4T9(TIUI)=""
  1.  . S DR=TIUI_"////"_NODE4T9(TIUI) D ^DIE
  1. CP4T9X Q
  1.  ;
  1. CP10(FILEDA,CFILEDA,VCNTA) ; Copy Items into new entries, Add new entries as Items.  (If item is SHARED ancestor of nonSHARED entry selected for
  1.  ;copy, don't copy, just add as item.)
  1.  N TIUK,TIUL,IFILEDA,INODE0,MULTDA,MULTNODE,CIFILEDA,CINODE0
  1.  S TIUK=0
  1.  I $O(^TIU(8925.1,FILEDA,10,0)) W !!," Copying Items. . . ",!
  1.  F  S TIUK=$O(^TIU(8925.1,FILEDA,10,TIUK)) Q:'TIUK  D  Q:'CIFILEDA
  1.  . S MULTNODE=^TIU(8925.1,FILEDA,10,TIUK,0),IFILEDA=+MULTNODE
  1.  . K CIFILEDA D COPYFDA^TIUFHA5(IFILEDA,FILEDA,1,.CIFILEDA,.CINODE0,.VCNTA)
  1.  . ;if user uparrows out of renaming items, delete copy and copied items:
  1.  . I 'CIFILEDA D  Q
  1.  . . S DIK="^TIU(8925.1,",TENDA=0 F  S TENDA=$O(^TIU(8925.1,CFILEDA,10,TENDA)) Q:'TENDA  S DA=+$G(^TIU(8925.1,CFILEDA,10,TENDA,0)) I DA,'$P(^TIU(8925.1,DA,0),U,10) D ^DIK
  1.  . . S DA=CFILEDA D ^DIK
  1.  . D ADDTEN^TIUFLF4(CFILEDA,CIFILEDA,CINODE0,.MULTDA)
  1.  . I 'MULTDA Q
  1.  . S DIE="^TIU(8925.1,"_CFILEDA_",10,",DA(1)=CFILEDA,DA=MULTDA,DR=""
  1.  . F TIUL=2,3,4 S DR=DR_TIUL_"////"_$P(MULTNODE,U,TIUL)_$S(TIUL<4:";",1:"")
  1.  . D ^DIE
  1.  . D MTXTCHEC^TIUFT1(.DA,CIFILEDA,1) ;**43**
  1.  . Q
  1. CP10X Q
  1.  ;
  1. CP11T13(FILEDA,CFILEDA) ; Copy Nodes 11 thru 13 of FILEDA into CFILEDA.
  1.  N TIUK,TIUM,MULTDA,DIC,X,Y,DLAYGO
  1.  F TIUM=10:1:13 D
  1.  . S TIUK=0,MULTDA=""
  1.  . F  S TIUK=$O(^TIU(8925.1,FILEDA,TIUM,TIUK)) Q:'TIUK  D
  1.  . . S MULTNODE=^TIU(8925.1,FILEDA,TIUM,TIUK,0),X=$P(MULTNODE,U)
  1.  . . S DA(1)=CFILEDA,DIC="^TIU(8925.1,DA(1),"_TIUM_",",DIC(0)="L",DLAYGO=8925.1
  1.  . . S DIC("P")=$P(^DD(8925.1,TIUM,0),U,2) D ^DIC
  1.  . . S MULTDA=+Y Q:MULTDA=-1
  1.  . . Q:TIUM'=13
  1.  . . S DIE="^TIU(8925.1,CFILEDA,13,",DA(1)=CFILEDA,DA=MULTDA,DR=""
  1.  . . F TIUL=2:1:5 S DR=DR_TIUI_"////"_$P(MULTNODE,U,TIUL)_$S(TIUL<5:";",1:"")
  1.  . . D ^DIE
  1.  . . Q
  1.  . Q
  1. CP11X Q
  1.  ;
  1. CPDFLT(FILEDA,CFILEDA) ; Copy Default Node "DFLT".
  1.  I $D(^TIU(8925.1,FILEDA,"DFLT")) M ^TIU(8925.1,CFILEDA,"DFLT")=^TIU(8925.1,FILEDA,"DFLT")
  1.  ; Gave it descendant BT when added copied items. 
  1.  Q
  1.  ;
  1. CPDIAL ;
  1.  ;
  1. CPHEAD(FILEDA,CFILEDA) ; Copy Node "HEAD".
  1.  I $D(^TIU(8925.1,FILEDA,"HEAD")) M ^TIU(8925.1,CFILEDA,"HEAD")=^TIU(8925.1,FILEDA,"HEAD")
  1.  Q
  1.  ;
  1. CPITEM(FILEDA,CFILEDA) ; Copy Node "ITEM".
  1.  I $D(^TIU(8925.1,FILEDA,"ITEM")) M ^TIU(8925.1,CFILEDA,"ITEM")=^TIU(8925.1,FILEDA,"ITEM")
  1.  Q