source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFHA2.m@ 1361

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

initial load of WorldVistAEHR
File size: 8.5 KB
Line 
1TIUFHA2 ; SLC/MAM - LM Templates A and H Action Copy/Move (COPYMOVE), WHICHTL(CFILEDA,PFILEDA), COPY, OVERRIDE(XDIRA) ;7/28/97 14:02
2 ;;1.0;TEXT INTEGRATION UTILITIES;**5,11,27**;Jun 20, 1997
3 ;
4WHICHTL(CFILEDA,PFILEDA) ; Function returns IFN of TL/CO to add copy Component to, or 0 if none chosen.
5 ;Requires CFILEDA = IFN of Copy Component
6 ;Requires PFILEDA = parent of original Title or 0 if Title has no parent
7 N X,Y,DIC,NEWTLY
8 S DIC=8925.1,DIC(0)="AEMNQZ"
9 S DIC("A")="Select TIU TITLE or COMPONENT NAME to add Copy to: "
10 S DIC("S")="I $P(^(0),U,4)=""DOC""!($P(^(0),U,4)=""CO"")&'$P(^(0),U,13)&'$P(^(0),U,10)&($$ORPHAN^TIUFLF4(Y,^(0))=""NO"")"
11 D ^DIC
12 I Y=-1 W !!,"Copy left in file as an orphan. To add it to a Title/Component, use action",!,"Items for the desired Title/Component.",! D PAUSE^TIUFXHLX G WTLX
13 S NEWTLY=Y
14WTLX I $D(DTOUT) S VALMQUIT=1
15 Q $S($G(NEWTLY):NEWTLY,1:0)
16 ;
17COPYMOVE ; Template H Action Copy/Move, Templates A, J Action Copy
18 ; See Description Field of Protocol TIUFHA ACTION COPY for detailed description of actions Copy, Move Title, Move Documents, and Update Documents.
19 N DIR,X,Y,DIRUT,DTOUT,ACTION,TIUFFULL,ENTRYNO,FILEDA
20 S VALMBCK="",TIUFXNOD=$G(XQORNOD(0))
21 I $G(TIUFTMPL)=""!($G(TIUFWHO)="") G CMOVX
22 D FULL^VALM1 S TIUFFULL=1 ;must full here for ? help
23 I TIUFTMPL="H" D G:$D(DIRUT) CMOVX S ACTION=Y
24 . S ENTRYNO=+$P($P(TIUFXNOD,U,4),"=",2),FILEDA=+$P($G(^TMP("TIUF1IDX",$J,ENTRYNO)),U,2)
25 . I $G(^TIU(8925.1,FILEDA,0))="CO" S ACTION="C" Q
26 . S DIR("?",1)="Enter 'MT' to Move a Title from one Document Class to another."
27 . S DIR("?",2)="Enter 'MD' to Move ALL documents from one Title to another Title."
28 . S DIR("?",3)="Enter 'C' to Copy a Title, a Component, or an Object."
29 . S DIR("?",4)="Enter 'U' to Update Parent Document Type for Documents of a Certain Title."
30 . S DIR("?")=" For details, exit Copy/Move, and enter '??' at the Select Action prompt."
31 . S DIR(0)="SB^MT:MOVE TITLE;MD:MOVE DOCUMENTS;C:COPY;U:UPDATE DOCUMENTS",DIR("A")="Select Copy/Move Action",DIR("B")="MT" D ^DIR
32 I "AJ"[TIUFTMPL S ACTION="C"
33 I TIUFTMPL="H" N DIRUT D D:ACTION'="U" PAUSE^TIUFXHLX I $D(DIRUT) W " ...Nothing ",$S(ACTION["M":"Moved",1:"Copied") H 2 G CMOVX
34 . I ACTION="C" W !,"WARNING: Entries can be COPIED without affecting the original, but be careful",!,"where you PUT the copy. Don't touch entries you are not responsible for.",! Q
35 . Q:ACTION="U"
36 . W !,"WARNING: This action affects inheritance and can CHANGE DOCUMENT BEHAVIOR. It",!,"DISREGARDS ownership. It may take awhile if the Title has many documents.",!,"Please use caution and DON'T TOUCH entries you are not responsible for.",!
37 I TIUFWHO="N" D OVERWARN
38 D COPY:ACTION="C",MOVETL^TIUFHA7:ACTION="MT",MOVEDOC^TIUFHA8:ACTION="MD",UPDATE^TIUFHA7:ACTION="U"
39CMOVX I $D(DTOUT) S VALMQUIT=1
40 I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
41 Q
42 ;
43COPY ; Copy Title, Component, or Object.
44 ; Updates Template A if started there.
45 ; Returns TIUFERR=1 if couldn't complete process.
46 ; Requires TIUFTMPL.
47 ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
48 N INFO,FILEDA,NODE0,CFILEDA,PFILEDA,PLINENO,NPLINENO
49 N MSG,TIUFSHAR,LINENO
50 N DTOUT,DIRUT,DIROUT,DUOUT,CNODE0,NPFILEDA,NPNODE0,TIUFI
51 N TYPE,DIR,X,Y,TLFILEDA,TLNODE0,NPARENTY,TLLINENO
52 S VALM("ENTITY")="Entry to Copy"
53AGAINC D EN^VALM2(TIUFXNOD,"SO") G:'$O(VALMY(0)) COPYX S INFO=$G(^TMP("TIUF1IDX",$J,$O(VALMY(0)))) I 'INFO W !!," Missing List Manager Data; See IRM",! D PAUSE^TIUFXHLX S VALMBCK="Q" G COPYX
54 S FILEDA=$P(INFO,U,2),NODE0=^TIU(8925.1,FILEDA,0),TIUFSHAR=+$P(NODE0,U,10),LINENO=+INFO
55 ; User may enter e.g. "CO=3" and THEN select subaction. If entry is bad,, user needs to redo CO prompt, not the 3 or it loops:
56 I $P(NODE0,U,4)="CL"!($P(NODE0,U,4)="DC") S MSG=" ?? Classes and Document Classes cannot be copied." W !!,MSG,! D PAUSE^TIUFXHLX G COPYX:$D(DIRUT)!(TIUFXNOD["="),AGAINC
57 S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0)),PLINENO=+$O(^TMP("TIUF1IDX",$J,"DAF",PFILEDA,0)) ; may be 0 if in template A
58 N TIUFCK D CHECK^TIUFLF3(FILEDA,PFILEDA,1,.TIUFCK) G:$D(DTOUT) COPYX K TIUFCK("P") I $D(TIUFCK)>9 W !!,"Faulty entry. Please TRY entry and correct problems before copying it.",! D PAUSE^TIUFXHLX G COPYX
59 S VALMBCK="R" K DIRUT
60 L +^TIU(8925.1,FILEDA):1 I '$T W !!,"Another user is editing this entry.",! H 2 G COPYX
61 D COPYFDA^TIUFHA5(FILEDA,0,PFILEDA,.CFILEDA,.CNODE0,.VALMCNT)
62 S TYPE=$P(NODE0,U,4) S:TYPE="DOC" TYPE="TL" S TYPE=$G(^TMP("TIUF",$J,"TYPE"_TYPE))
63 D D:'$D(DTOUT) PAUSE^TIUFXHLX G:'CFILEDA COPYX
64 . I 'CFILEDA W !!," ...Not copied" Q
65 . I $D(DIRUT) W !!," ...Copy deleted" S CFILEDA=0 Q ;deleted in CP10^TIUFHA5
66 . W !!,TYPE_" copied into File Entry #"_CFILEDA
67 I $P(NODE0,U,4)="O"!(TIUFTMPL="A") S NPLINENO=0 G MSG ;Don't add to parent from A
68 S:'$D(DIRUT) NPARENTY=$S($P(NODE0,U,4)="CO":$$WHICHTL(FILEDA,PFILEDA),$P(NODE0,U,4)="DOC":$$WHICHDC^TIUFHA7(FILEDA,PFILEDA,"C"))
69 I '$G(NPARENTY),TYPE="TITLE" D D PAUSE^TIUFXHLX
70 . W !!,"Copy left in file as an orphan. To add it to a Document Class, use action",!,"Items for the desired Document Class. Please test it thoroughly after adding it",!,"since its inheritance may have changed.",!
71 I '$G(NPARENTY) G COPYX
72 S NPFILEDA=+NPARENTY,NPLINENO=+$O(^TMP("TIUF1IDX",$J,"DAF",NPFILEDA,0)) ;NPLINENO may be 0
73 ; If copy is a component, get the Title ancestor of the new parent, (or new parent itself if new parent is a Title), and inactivate this Title and its descendants:
74 I $P(NODE0,U,4)="CO" D
75 . N DA,DIK,TENDA
76 . S NPNODE0=^TIU(8925.1,NPFILEDA,0),TLFILEDA=NPFILEDA,TLNODE0=NPNODE0
77 . I $P(NPNODE0,U,4)'="DOC" N ANCESTOR D ANCESTOR^TIUFLF4(NPFILEDA,NPNODE0,.ANCESTOR,1) S TIUFI=$O(ANCESTOR(100),-1),TLFILEDA=ANCESTOR(TIUFI),TLNODE0=^TIU(8925.1,TLFILEDA,0)
78 . L +^TIU(8925.1,TLFILEDA):1 I '$T W !!,"Another user is editing parent Title. Copy deleted. Please try again later.",! H 2 D Q
79 . . 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
80 . . S DA=CFILEDA D ^DIK
81 . I $P(TLNODE0,U,7)'=+^TMP("TIUF",$J,"STATI") D AUTOSTAT^TIUFLF6(TLFILEDA,TLNODE0,"INACTIVE")
82 D ADDTEN^TIUFLF4(NPFILEDA,CFILEDA,CNODE0,"") ;Add Copy to new parent
83 I $P(CNODE0,U,4)="CO" W !,"Inactivating Title ",$P(TLNODE0,U)
84 W !,"Copy added to ",$P(NPARENTY,U,2),!
85MSG I $P(CNODE0,U,4)="DOC" D
86 . I TIUFTMPL="A" W !,"You will need to add the copy to a Document Class in the hierarchy and activate",!,"it before it can be used. Use DETAILED DISPLAY for the Document Class, ITEMS,",!,"ADD/CREATE, and enter the name of the copy.",! Q
87 . I NPFILEDA=PFILEDA W !,"Copies are created inactive. Please activate the copy Title when it is ready",!,"for users to enter documents on it.",! Q
88 . W !,"Adding the copy Title to a different Document Class may change its behavior",!,"from that of the original. Adding it to a different CLASS may change it",!,"RADICALLY. Please test the copy thoroughly before activating it.",!
89 I $P(CNODE0,U,4)="CO" D
90 . I $D(TLNODE0) W !,"Please test the Title ",$P(TLNODE0,U),!,"and reactivate it when it is ready for users to enter documents on it.",!
91 . I TIUFTMPL="A" W !!,"You will need to add the copy to a Title in the hierarchy before it can be used.",!,"Use DETAILED DISPLAY for the Title, ITEMS, ADD/CREATE, and enter the name of",!,"the copy.",!
92 I 'NPLINENO,TIUFTMPL="H" W !,"You will have to expand the hierarchy to see the Copy in its new position.",!
93 I $P(CNODE0,U,4)="O" W !,"Please test the copy object and activate it when it is ready for users to embed",!,"it in boilerplate text.",!
94 D PAUSE^TIUFXHLX W !
95 I TIUFTMPL="H",NPLINENO D
96 . I $P(CNODE0,U,4)="CO" S TLLINENO=+$O(^TMP("TIUF1IDX",$J,"DAF",TLFILEDA,0)) D REEXPAND^TIUFHA7(TLFILEDA,TLLINENO,1) Q
97 . D REEXPAND^TIUFHA7(NPFILEDA,NPLINENO,1)
98 ; Templates A, J updated for copy already in COPYFDA.
99 D VALMBG^TIUFHA7(CFILEDA,FILEDA,LINENO)
100COPYX I $D(DTOUT) S VALMBCK="Q"
101 L -^TIU(8925.1,+$G(FILEDA)) S VALM("ENTITY")="Entry"
102 Q
103 ;
104OVERRIDE(XDIRA) ; function returns 1 if natl programmer, wants to override safeguards
105 ;Requires XDIRA = DIR("A") Requires TIUFWHO
106 N OVERRIDE,DIR,Y
107 S OVERRIDE=0,DIR("A")=XDIRA
108 I TIUFWHO'="N" G OVERX
109 S DIR(0)="Y",DIR("B")="NO"
110 S DIR("A",1)="Want to override safeguards and"
111 I $G(TIUFXNOD)["Add" S DIR("A",1)="Selecting (another) item to add: "_DIR("A",1)
112 D ^DIR
113 I Y S OVERRIDE=1
114OVERX Q OVERRIDE
115 ;
116OVERWARN ;Warn re override
117 W !,"WARNING: As a National Programmer, you are permitted to override safeguards",!,"when moving entries and when adding/deleting items. Please do NOT override"
118 W !,"safeguards except as a last resort, and then only after thoroughly testing the",!,"actions you plan to take.",!
119 Q
Note: See TracBrowser for help on using the repository browser.