source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFHA5.m@ 1094

Last change on this file since 1094 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1TIUFHA5 ; SLC/MAM - COPYFDA(FILEDA,ITEMFLG,PFILEDA,CFILEDA,CNODE0,VCNTAJ), CREATE(NAME,FILEDA), CP0,etc. ;7/1/97 14:02
2 ;;1.0;TEXT INTEGRATION UTILITIES;**2,14,43,77**;Jun 20, 1997
3 ;
4COPYFDA(FILEDA,ITEMFLG,PFILEDA,CFILEDA,CNODE0,VCNTAJ) ; Copy entry FILEDA into
5 ;CFILEDA; Update Template A,J if TIUFTMPL="A","J".
6 ; Requires TIUFSHAR from COPYENTY
7 ; Requires FILEDA, TIUFTMPL, ITEMFLG
8 ; Requires PFILEDA if entry being copied has a parent
9 ; Returns CFILEDA; =0 if unsuccessfull.
10 ; Returns CNODE0.
11 ; I TIUFTMPL="A"or "J", Requires VCNTAJ = VALMCNT for Template A or J, Updates VCNTAJ.
12 ; Requires ITEMFLG=0 or 1. 1 if called by CP10 (i.e. currently copying Item of entry rather than entry selected by user.)
13 ; If the entry selected for copy is nonSHARED (TIUFSHAR=0) and
14 ;module is CURRENTLY copying a SHARED ancestor, module does not copy
15 ;FILEDA into a new IFN but sets CFILEDA and CNODE0 to FILEDA and NODE0,
16 ;so that FILEDA (rather than a copy) is added to the parent.
17 N NODE0,PGM,NAME,DIR,X,Y,SHARED,TIUJ,CNTCHNG,TIUFIMSG
18 N TIUFTLST,TIUFTMSG
19 S CFILEDA=0
20 L +^TIU(8925.1,FILEDA):1 I '$T W !!," Entry accessed by another user; Please try again later.",! H 2 G COPYFDX
21 S NODE0=^TIU(8925.1,FILEDA,0),SHARED=$P(NODE0,U,10),PFILEDA=+$G(PFILEDA)
22 I ITEMFLG,'TIUFSHAR,SHARED S CFILEDA=FILEDA,CNODE0=NODE0 G COPYFDX
23READNM I '$G(TIUFFULL) D FULL^VALM1 S TIUFFULL=1 K DIRUT
24 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
25 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
26 S NAME=Y K DIR,X,Y
27 I PFILEDA,$$DUPITEM^TIUFLF7(NAME,PFILEDA) S NAME=$P(NODE0,U) W !!,TIUFIMSG,! G READNM
28 I $D(DIRUT) S CFILEDA=0 Q
29 D TYPELIST^TIUFLF7(NAME,0,PFILEDA,.TIUFTMSG,.TIUFTLST) G:$D(DTOUT) COPYFDX
30 I $D(TIUFTMSG("T")) W !!,TIUFTMSG("T"),!,"Can't Copy entry",! D PAUSE^TIUFXHLX S CFILEDA=0 G COPYFDX
31 I TIUFTLST'[$P(NODE0,U,4) W !!," Please enter a different Name; File already has entry of that Type with that",!,"Name",! G READNM
32 D CREATE(NAME,.CFILEDA) G:'CFILEDA COPYFDX
33 L +^TIU(8925.1,CFILEDA):1 I '$T W !!," Copy accessed by another user; Please recopy" D PAUSE^TIUFXHLX G COPYFDX
34 D CP0(FILEDA,CFILEDA,NODE0)
35 D STUFFLDS^TIUFLF4(CFILEDA) ;Do NOT send parent to STUFFLDS or it will
36 ;stuff SHARED
37 K DIRUT D CP10(FILEDA,CFILEDA,.VCNTAJ) G:$D(DIRUT) COPYFDX
38 F TIUJ=1,3,"4T9","11T13","DFLT","HEAD","ITEM" S PGM="CP"_TIUJ_"("_FILEDA_","_CFILEDA_")" D @PGM
39 S CNODE0=^TIU(8925.1,CFILEDA,0)
40 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"
41COPYFDX ;
42 L -^TIU(8925.1,+$G(CFILEDA)) L -^TIU(8925.1,+$G(FILEDA))
43 I '$G(CFILEDA) S CFILEDA=0
44 Q
45 ;
46CREATE(NAME,FILEDA) ; Creates Document Definition File record of Name NAME with IFN FILEDA
47 ; Requires NAME for new record; Returns FILEDA of new record
48 ; Returns FILEDA<0 if can't create.
49 N DIC,DLAYGO,X,Y
50 K DA S (DIC,DLAYGO)=8925.1,DIC(0)="L"
51 S X=""""_NAME_""""
52 D ^DIC
53 S FILEDA=+Y
54CREAX Q
55 ;
56CP0(FILEDA,DA,NODE0) ; Copy root node NODE0 into DA. DON'T copy status, Shared, or National. If object, don't copy abbrev or printname.
57 N DR,DIE,TIUI
58 S DIE=8925.1
59 S DR="" F TIUI=2,3,4,5,6,14 D
60 . I $P(NODE0,U,4)="O",TIUI=2!(TIUI=3)!(TIUI=14) Q
61 . S DR=DR_".0"_TIUI_"////"_$P(NODE0,U,TIUI)_";"
62 D ^DIE
63CP0X Q
64 ;
65CP1(FILEDA,DA) ; Copy node 1 of FILEDA into DA.
66 N DR,DIE,TIUI,NODE,VALUE
67 S DIE=8925.1,NODE=$G(^TIU(8925.1,FILEDA,1)) Q:NODE=""
68 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 ';'.
69 D ^DIE
70CP1X Q
71 ;
72CP3(FILEDA,DA) ; Copy node 3 of FILEDA into DA. DON'T copy OK to Distribute.
73 N DR,DIE,TIUI,NODE
74 S DIE=8925.1,NODE=$G(^TIU(8925.1,FILEDA,3)) Q:NODE=""
75 S DR="3.03////"_$P(NODE,U,3)
76 D ^DIE
77CP3X Q
78 ;
79CP4T9(FILEDA,DA) ; Copy nodes 4 thru 9 of FILEDA into DA.
80 N DR,DIE,TIUI,NODE4T9,PIECE
81 S DIE=8925.1
82 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
83 . S NODE4T9(TIUI)=$G(^TIU(8925.1,FILEDA,TIUI)) Q:NODE4T9(TIUI)=""
84 . S DR=TIUI_"////"_NODE4T9(TIUI) D ^DIE
85 . Q
86 F TIUI=6.1,6.12,6.13 D ; 6.14 does not apply to titles
87 . S PIECE=$E(TIUI,$L(TIUI))
88 . S NODE4T9(TIUI)=$P($G(^TIU(8925.1,FILEDA,6.1)),U,PIECE) Q:NODE4T9(TIUI)=""
89 . S DR=TIUI_"////"_NODE4T9(TIUI) D ^DIE
90CP4T9X Q
91 ;
92CP10(FILEDA,CFILEDA,VCNTA) ; Copy Items into new entries, Add new entries as Items. (If item is SHARED ancestor of nonSHARED entry selected for
93 ;copy, don't copy, just add as item.)
94 N TIUK,TIUL,IFILEDA,INODE0,MULTDA,MULTNODE,CIFILEDA,CINODE0
95 S TIUK=0
96 I $O(^TIU(8925.1,FILEDA,10,0)) W !!," Copying Items. . . ",!
97 F S TIUK=$O(^TIU(8925.1,FILEDA,10,TIUK)) Q:'TIUK D Q:'CIFILEDA
98 . S MULTNODE=^TIU(8925.1,FILEDA,10,TIUK,0),IFILEDA=+MULTNODE
99 . K CIFILEDA D COPYFDA^TIUFHA5(IFILEDA,FILEDA,1,.CIFILEDA,.CINODE0,.VCNTA)
100 . ;if user uparrows out of renaming items, delete copy and copied items:
101 . I 'CIFILEDA D Q
102 . . 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
103 . . S DA=CFILEDA D ^DIK
104 . D ADDTEN^TIUFLF4(CFILEDA,CIFILEDA,CINODE0,.MULTDA)
105 . I 'MULTDA Q
106 . S DIE="^TIU(8925.1,"_CFILEDA_",10,",DA(1)=CFILEDA,DA=MULTDA,DR=""
107 . F TIUL=2,3,4 S DR=DR_TIUL_"////"_$P(MULTNODE,U,TIUL)_$S(TIUL<4:";",1:"")
108 . D ^DIE
109 . D MTXTCHEC^TIUFT1(.DA,CIFILEDA,1) ;**43**
110 . Q
111CP10X Q
112 ;
113CP11T13(FILEDA,CFILEDA) ; Copy Nodes 11 thru 13 of FILEDA into CFILEDA.
114 N TIUK,TIUM,MULTDA,DIC,X,Y,DLAYGO
115 F TIUM=10:1:13 D
116 . S TIUK=0,MULTDA=""
117 . F S TIUK=$O(^TIU(8925.1,FILEDA,TIUM,TIUK)) Q:'TIUK D
118 . . S MULTNODE=^TIU(8925.1,FILEDA,TIUM,TIUK,0),X=$P(MULTNODE,U)
119 . . S DA(1)=CFILEDA,DIC="^TIU(8925.1,DA(1),"_TIUM_",",DIC(0)="L",DLAYGO=8925.1
120 . . S DIC("P")=$P(^DD(8925.1,TIUM,0),U,2) D ^DIC
121 . . S MULTDA=+Y Q:MULTDA=-1
122 . . Q:TIUM'=13
123 . . S DIE="^TIU(8925.1,CFILEDA,13,",DA(1)=CFILEDA,DA=MULTDA,DR=""
124 . . F TIUL=2:1:5 S DR=DR_TIUI_"////"_$P(MULTNODE,U,TIUL)_$S(TIUL<5:";",1:"")
125 . . D ^DIE
126 . . Q
127 . Q
128CP11X Q
129 ;
130CPDFLT(FILEDA,CFILEDA) ; Copy Default Node "DFLT".
131 I $D(^TIU(8925.1,FILEDA,"DFLT")) M ^TIU(8925.1,CFILEDA,"DFLT")=^TIU(8925.1,FILEDA,"DFLT")
132 ; Gave it descendant BT when added copied items.
133 Q
134 ;
135CPDIAL ;
136 ;
137CPHEAD(FILEDA,CFILEDA) ; Copy Node "HEAD".
138 I $D(^TIU(8925.1,FILEDA,"HEAD")) M ^TIU(8925.1,CFILEDA,"HEAD")=^TIU(8925.1,FILEDA,"HEAD")
139 Q
140 ;
141CPITEM(FILEDA,CFILEDA) ; Copy Node "ITEM".
142 I $D(^TIU(8925.1,FILEDA,"ITEM")) M ^TIU(8925.1,CFILEDA,"ITEM")=^TIU(8925.1,FILEDA,"ITEM")
143 Q
Note: See TracBrowser for help on using the repository browser.