TIUFHA2 ; SLC/MAM - LM Templates A and H Action Copy/Move (COPYMOVE), WHICHTL(CFILEDA,PFILEDA), COPY, OVERRIDE(XDIRA) ;7/28/97 14:02
;;1.0;TEXT INTEGRATION UTILITIES;**5,11,27**;Jun 20, 1997
;
WHICHTL(CFILEDA,PFILEDA) ; Function returns IFN of TL/CO to add copy Component to, or 0 if none chosen.
;Requires CFILEDA = IFN of Copy Component
;Requires PFILEDA = parent of original Title or 0 if Title has no parent
N X,Y,DIC,NEWTLY
S DIC=8925.1,DIC(0)="AEMNQZ"
S DIC("A")="Select TIU TITLE or COMPONENT NAME to add Copy to: "
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"")"
D ^DIC
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
S NEWTLY=Y
WTLX I $D(DTOUT) S VALMQUIT=1
Q $S($G(NEWTLY):NEWTLY,1:0)
;
COPYMOVE ; Template H Action Copy/Move, Templates A, J Action Copy
; See Description Field of Protocol TIUFHA ACTION COPY for detailed description of actions Copy, Move Title, Move Documents, and Update Documents.
N DIR,X,Y,DIRUT,DTOUT,ACTION,TIUFFULL,ENTRYNO,FILEDA
S VALMBCK="",TIUFXNOD=$G(XQORNOD(0))
I $G(TIUFTMPL)=""!($G(TIUFWHO)="") G CMOVX
D FULL^VALM1 S TIUFFULL=1 ;must full here for ? help
I TIUFTMPL="H" D G:$D(DIRUT) CMOVX S ACTION=Y
. S ENTRYNO=+$P($P(TIUFXNOD,U,4),"=",2),FILEDA=+$P($G(^TMP("TIUF1IDX",$J,ENTRYNO)),U,2)
. I $G(^TIU(8925.1,FILEDA,0))="CO" S ACTION="C" Q
. S DIR("?",1)="Enter 'MT' to Move a Title from one Document Class to another."
. S DIR("?",2)="Enter 'MD' to Move ALL documents from one Title to another Title."
. S DIR("?",3)="Enter 'C' to Copy a Title, a Component, or an Object."
. S DIR("?",4)="Enter 'U' to Update Parent Document Type for Documents of a Certain Title."
. S DIR("?")=" For details, exit Copy/Move, and enter '??' at the Select Action prompt."
. 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
I "AJ"[TIUFTMPL S ACTION="C"
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
. 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
. Q:ACTION="U"
. 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.",!
I TIUFWHO="N" D OVERWARN
D COPY:ACTION="C",MOVETL^TIUFHA7:ACTION="MT",MOVEDOC^TIUFHA8:ACTION="MD",UPDATE^TIUFHA7:ACTION="U"
CMOVX I $D(DTOUT) S VALMQUIT=1
I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
Q
;
COPY ; Copy Title, Component, or Object.
; Updates Template A if started there.
; Returns TIUFERR=1 if couldn't complete process.
; Requires TIUFTMPL.
; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
N INFO,FILEDA,NODE0,CFILEDA,PFILEDA,PLINENO,NPLINENO
N MSG,TIUFSHAR,LINENO
N DTOUT,DIRUT,DIROUT,DUOUT,CNODE0,NPFILEDA,NPNODE0,TIUFI
N TYPE,DIR,X,Y,TLFILEDA,TLNODE0,NPARENTY,TLLINENO
S VALM("ENTITY")="Entry to Copy"
AGAINC 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
S FILEDA=$P(INFO,U,2),NODE0=^TIU(8925.1,FILEDA,0),TIUFSHAR=+$P(NODE0,U,10),LINENO=+INFO
; 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:
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
S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0)),PLINENO=+$O(^TMP("TIUF1IDX",$J,"DAF",PFILEDA,0)) ; may be 0 if in template A
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
S VALMBCK="R" K DIRUT
L +^TIU(8925.1,FILEDA):1 I '$T W !!,"Another user is editing this entry.",! H 2 G COPYX
D COPYFDA^TIUFHA5(FILEDA,0,PFILEDA,.CFILEDA,.CNODE0,.VALMCNT)
S TYPE=$P(NODE0,U,4) S:TYPE="DOC" TYPE="TL" S TYPE=$G(^TMP("TIUF",$J,"TYPE"_TYPE))
D D:'$D(DTOUT) PAUSE^TIUFXHLX G:'CFILEDA COPYX
. I 'CFILEDA W !!," ...Not copied" Q
. I $D(DIRUT) W !!," ...Copy deleted" S CFILEDA=0 Q ;deleted in CP10^TIUFHA5
. W !!,TYPE_" copied into File Entry #"_CFILEDA
I $P(NODE0,U,4)="O"!(TIUFTMPL="A") S NPLINENO=0 G MSG ;Don't add to parent from A
S:'$D(DIRUT) NPARENTY=$S($P(NODE0,U,4)="CO":$$WHICHTL(FILEDA,PFILEDA),$P(NODE0,U,4)="DOC":$$WHICHDC^TIUFHA7(FILEDA,PFILEDA,"C"))
I '$G(NPARENTY),TYPE="TITLE" D D PAUSE^TIUFXHLX
. 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.",!
I '$G(NPARENTY) G COPYX
S NPFILEDA=+NPARENTY,NPLINENO=+$O(^TMP("TIUF1IDX",$J,"DAF",NPFILEDA,0)) ;NPLINENO may be 0
; 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:
I $P(NODE0,U,4)="CO" D
. N DA,DIK,TENDA
. S NPNODE0=^TIU(8925.1,NPFILEDA,0),TLFILEDA=NPFILEDA,TLNODE0=NPNODE0
. 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)
. 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
. . 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
. . S DA=CFILEDA D ^DIK
. I $P(TLNODE0,U,7)'=+^TMP("TIUF",$J,"STATI") D AUTOSTAT^TIUFLF6(TLFILEDA,TLNODE0,"INACTIVE")
D ADDTEN^TIUFLF4(NPFILEDA,CFILEDA,CNODE0,"") ;Add Copy to new parent
I $P(CNODE0,U,4)="CO" W !,"Inactivating Title ",$P(TLNODE0,U)
W !,"Copy added to ",$P(NPARENTY,U,2),!
MSG I $P(CNODE0,U,4)="DOC" D
. 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
. 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
. 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.",!
I $P(CNODE0,U,4)="CO" D
. 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.",!
. 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.",!
I 'NPLINENO,TIUFTMPL="H" W !,"You will have to expand the hierarchy to see the Copy in its new position.",!
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.",!
D PAUSE^TIUFXHLX W !
I TIUFTMPL="H",NPLINENO D
. I $P(CNODE0,U,4)="CO" S TLLINENO=+$O(^TMP("TIUF1IDX",$J,"DAF",TLFILEDA,0)) D REEXPAND^TIUFHA7(TLFILEDA,TLLINENO,1) Q
. D REEXPAND^TIUFHA7(NPFILEDA,NPLINENO,1)
; Templates A, J updated for copy already in COPYFDA.
D VALMBG^TIUFHA7(CFILEDA,FILEDA,LINENO)
COPYX I $D(DTOUT) S VALMBCK="Q"
L -^TIU(8925.1,+$G(FILEDA)) S VALM("ENTITY")="Entry"
Q
;
OVERRIDE(XDIRA) ; function returns 1 if natl programmer, wants to override safeguards
;Requires XDIRA = DIR("A") Requires TIUFWHO
N OVERRIDE,DIR,Y
S OVERRIDE=0,DIR("A")=XDIRA
I TIUFWHO'="N" G OVERX
S DIR(0)="Y",DIR("B")="NO"
S DIR("A",1)="Want to override safeguards and"
I $G(TIUFXNOD)["Add" S DIR("A",1)="Selecting (another) item to add: "_DIR("A",1)
D ^DIR
I Y S OVERRIDE=1
OVERX Q OVERRIDE
;
OVERWARN ;Warn re override
W !,"WARNING: As a National Programmer, you are permitted to override safeguards",!,"when moving entries and when adding/deleting items. Please do NOT override"
W !,"safeguards except as a last resort, and then only after thoroughly testing the",!,"actions you plan to take.",!
Q
TIUFHA2 ; SLC/MAM - LM Templates A and H Action Copy/Move (COPYMOVE), WHICHTL(CFILEDA,PFILEDA), COPY, OVERRIDE(XDIRA) ;7/28/97 14:02
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**5,11,27**;Jun 20, 1997
+2 ;
WHICHTL(CFILEDA,PFILEDA) ; Function returns IFN of TL/CO to add copy Component to, or 0 if none chosen.
+1 ;Requires CFILEDA = IFN of Copy Component
+2 ;Requires PFILEDA = parent of original Title or 0 if Title has no parent
+3 NEW X,Y,DIC,NEWTLY
+4 SET DIC=8925.1
SET DIC(0)="AEMNQZ"
+5 SET DIC("A")="Select TIU TITLE or COMPONENT NAME to add Copy to: "
+6 SET 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"")"
+7 DO ^DIC
+8 IF Y=-1
WRITE !!,"Copy left in file as an orphan. To add it to a Title/Component, use action",!,"Items for the desired Title/Component.",!
DO PAUSE^TIUFXHLX
GOTO WTLX
+9 SET NEWTLY=Y
WTLX IF $DATA(DTOUT)
SET VALMQUIT=1
+1 QUIT $SELECT($GET(NEWTLY):NEWTLY,1:0)
+2 ;
COPYMOVE ; Template H Action Copy/Move, Templates A, J Action Copy
+1 ; See Description Field of Protocol TIUFHA ACTION COPY for detailed description of actions Copy, Move Title, Move Documents, and Update Documents.
+2 NEW DIR,X,Y,DIRUT,DTOUT,ACTION,TIUFFULL,ENTRYNO,FILEDA
+3 SET VALMBCK=""
SET TIUFXNOD=$GET(XQORNOD(0))
+4 IF $GET(TIUFTMPL)=""!($GET(TIUFWHO)="")
GOTO CMOVX
+5 ;must full here for ? help
DO FULL^VALM1
SET TIUFFULL=1
+6 IF TIUFTMPL="H"
Begin DoDot:1
+7 SET ENTRYNO=+$PIECE($PIECE(TIUFXNOD,U,4),"=",2)
SET FILEDA=+$PIECE($GET(^TMP("TIUF1IDX",$JOB,ENTRYNO)),U,2)
+8 IF $GET(^TIU(8925.1,FILEDA,0))="CO"
SET ACTION="C"
QUIT
+9 SET DIR("?",1)="Enter 'MT' to Move a Title from one Document Class to another."
+10 SET DIR("?",2)="Enter 'MD' to Move ALL documents from one Title to another Title."
+11 SET DIR("?",3)="Enter 'C' to Copy a Title, a Component, or an Object."
+12 SET DIR("?",4)="Enter 'U' to Update Parent Document Type for Documents of a Certain Title."
+13 SET DIR("?")=" For details, exit Copy/Move, and enter '??' at the Select Action prompt."
+14 SET DIR(0)="SB^MT:MOVE TITLE;MD:MOVE DOCUMENTS;C:COPY;U:UPDATE DOCUMENTS"
SET DIR("A")="Select Copy/Move Action"
SET DIR("B")="MT"
DO ^DIR
End DoDot:1
IF $DATA(DIRUT)
GOTO CMOVX
SET ACTION=Y
+15 IF "AJ"[TIUFTMPL
SET ACTION="C"
+16 IF TIUFTMPL="H"
NEW DIRUT
Begin DoDot:1
+17 IF ACTION="C"
WRITE !,"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.",!
QUIT
+18 IF ACTION="U"
QUIT
+19 WRITE !,"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 responsibl
e for.",!
End DoDot:1
IF ACTION'="U"
DO PAUSE^TIUFXHLX
IF $DATA(DIRUT)
WRITE " ...Nothing ",$SELECT(ACTION["M":"Moved",1:"Copied")
HANG 2
GOTO CMOVX
+20 IF TIUFWHO="N"
DO OVERWARN
+21 IF ACTION="C"
DO COPY
IF ACTION="MT"
DO MOVETL^TIUFHA7
IF ACTION="MD"
DO MOVEDOC^TIUFHA8
IF ACTION="U"
DO UPDATE^TIUFHA7
CMOVX IF $DATA(DTOUT)
SET VALMQUIT=1
+1 IF $GET(TIUFFULL)
SET VALMBCK="R"
DO RESET^TIUFXHLX
+2 QUIT
+3 ;
COPY ; Copy Title, Component, or Object.
+1 ; Updates Template A if started there.
+2 ; Returns TIUFERR=1 if couldn't complete process.
+3 ; Requires TIUFTMPL.
+4 ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
+5 NEW INFO,FILEDA,NODE0,CFILEDA,PFILEDA,PLINENO,NPLINENO
+6 NEW MSG,TIUFSHAR,LINENO
+7 NEW DTOUT,DIRUT,DIROUT,DUOUT,CNODE0,NPFILEDA,NPNODE0,TIUFI
+8 NEW TYPE,DIR,X,Y,TLFILEDA,TLNODE0,NPARENTY,TLLINENO
+9 SET VALM("ENTITY")="Entry to Copy"
AGAINC DO EN^VALM2(TIUFXNOD,"SO")
IF '$ORDER(VALMY(0))
GOTO COPYX
SET INFO=$GET(^TMP("TIUF1IDX",$JOB,$ORDER(VALMY(0))))
IF 'INFO
WRITE !!," Missing List Manager Data; See IRM",!
DO PAUSE^TIUFXHLX
SET VALMBCK="Q"
GOTO COPYX
+1 SET FILEDA=$PIECE(INFO,U,2)
SET NODE0=^TIU(8925.1,FILEDA,0)
SET TIUFSHAR=+$PIECE(NODE0,U,10)
SET LINENO=+INFO
+2 ; 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:
+3 IF $PIECE(NODE0,U,4)="CL"!($PIECE(NODE0,U,4)="DC")
SET MSG=" ?? Classes and Document Classes cannot be copied."
WRITE !!,MSG,!
DO PAUSE^TIUFXHLX
IF $DATA(DIRUT)!(TIUFXNOD["=")
GOTO COPYX
GOTO AGAINC
+4 ; may be 0 if in template A
SET PFILEDA=+$ORDER(^TIU(8925.1,"AD",FILEDA,0))
SET PLINENO=+$ORDER(^TMP("TIUF1IDX",$JOB,"DAF",PFILEDA,0))
+5 NEW TIUFCK
DO CHECK^TIUFLF3(FILEDA,PFILEDA,1,.TIUFCK)
IF $DATA(DTOUT)
GOTO COPYX
KILL TIUFCK("P")
IF $DATA(TIUFCK)>9
WRITE !!,"Faulty entry. Please TRY entry and correct problems before copying it.",!
DO PAUSE^TIUFXHLX
GOTO COPYX
+6 SET VALMBCK="R"
KILL DIRUT
+7 LOCK +^TIU(8925.1,FILEDA):1
IF '$TEST
WRITE !!,"Another user is editing this entry.",!
HANG 2
GOTO COPYX
+8 DO COPYFDA^TIUFHA5(FILEDA,0,PFILEDA,.CFILEDA,.CNODE0,.VALMCNT)
+9 SET TYPE=$PIECE(NODE0,U,4)
IF TYPE="DOC"
SET TYPE="TL"
SET TYPE=$GET(^TMP("TIUF",$JOB,"TYPE"_TYPE))
+10 Begin DoDot:1
+11 IF 'CFILEDA
WRITE !!," ...Not copied"
QUIT
+12 ;deleted in CP10^TIUFHA5
IF $DATA(DIRUT)
WRITE !!," ...Copy deleted"
SET CFILEDA=0
QUIT
+13 WRITE !!,TYPE_" copied into File Entry #"_CFILEDA
End DoDot:1
IF '$DATA(DTOUT)
DO PAUSE^TIUFXHLX
IF 'CFILEDA
GOTO COPYX
+14 ;Don't add to parent from A
IF $PIECE(NODE0,U,4)="O"!(TIUFTMPL="A")
SET NPLINENO=0
GOTO MSG
+15 IF '$DATA(DIRUT)
SET NPARENTY=$SELECT($PIECE(NODE0,U,4)="CO":$$WHICHTL(FILEDA,PFILEDA),$PIECE(NODE0,U,4)="DOC":$$WHICHDC^TIUFHA7(FILEDA,PFILEDA,"C"))
+16 IF '$GET(NPARENTY)
IF TYPE="TITLE"
Begin DoDot:1
+17 WRITE !!,"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.",!
End DoDot:1
DO PAUSE^TIUFXHLX
+18 IF '$GET(NPARENTY)
GOTO COPYX
+19 ;NPLINENO may be 0
SET NPFILEDA=+NPARENTY
SET NPLINENO=+$ORDER(^TMP("TIUF1IDX",$JOB,"DAF",NPFILEDA,0))
+20 ; 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:
+21 IF $PIECE(NODE0,U,4)="CO"
Begin DoDot:1
+22 NEW DA,DIK,TENDA
+23 SET NPNODE0=^TIU(8925.1,NPFILEDA,0)
SET TLFILEDA=NPFILEDA
SET TLNODE0=NPNODE0
+24 IF $PIECE(NPNODE0,U,4)'="DOC"
NEW ANCESTOR
DO ANCESTOR^TIUFLF4(NPFILEDA,NPNODE0,.ANCESTOR,1)
SET TIUFI=$ORDER(ANCESTOR(100),-1)
SET TLFILEDA=ANCESTOR(TIUFI)
SET TLNODE0=^TIU(8925.1,TLFILEDA,0)
+25 LOCK +^TIU(8925.1,TLFILEDA):1
IF '$TEST
WRITE !!,"Another user is editing parent Title. Copy deleted. Please try again later.",!
HANG 2
Begin DoDot:2
+26 SET DIK="^TIU(8925.1,"
SET TENDA=0
FOR
SET TENDA=$ORDER(^TIU(8925.1,CFILEDA,10,TENDA))
IF 'TENDA
QUIT
SET DA=+$GET(^TIU(8925.1,CFILEDA,10,TENDA,0))
IF DA
IF '$PIECE(^TIU(8925.1,DA,0),U,10)
DO ^DIK
+27 SET DA=CFILEDA
DO ^DIK
End DoDot:2
QUIT
+28 IF $PIECE(TLNODE0,U,7)'=+^TMP("TIUF",$JOB,"STATI")
DO AUTOSTAT^TIUFLF6(TLFILEDA,TLNODE0,"INACTIVE")
End DoDot:1
+29 ;Add Copy to new parent
DO ADDTEN^TIUFLF4(NPFILEDA,CFILEDA,CNODE0,"")
+30 IF $PIECE(CNODE0,U,4)="CO"
WRITE !,"Inactivating Title ",$PIECE(TLNODE0,U)
+31 WRITE !,"Copy added to ",$PIECE(NPARENTY,U,2),!
MSG IF $PIECE(CNODE0,U,4)="DOC"
Begin DoDot:1
+1 IF TIUFTMPL="A"
WRITE !,"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.",!
QUIT
+2 IF NPFILEDA=PFILEDA
WRITE !,"Copies are created inactive. Please activate the copy Title when it is ready",!,"for users to enter documents on it.",!
QUIT
+3 WRITE !,"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.",!
End DoDot:1
+4 IF $PIECE(CNODE0,U,4)="CO"
Begin DoDot:1
+5 IF $DATA(TLNODE0)
WRITE !,"Please test the Title ",$PIECE(TLNODE0,U),!,"and reactivate it when it is ready for users to enter documents on it.",!
+6 IF TIUFTMPL="A"
WRITE !!,"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.",!
End DoDot:1
+7 IF 'NPLINENO
IF TIUFTMPL="H"
WRITE !,"You will have to expand the hierarchy to see the Copy in its new position.",!
+8 IF $PIECE(CNODE0,U,4)="O"
WRITE !,"Please test the copy object and activate it when it is ready for users to embed",!,"it in boilerplate text.",!
+9 DO PAUSE^TIUFXHLX
WRITE !
+10 IF TIUFTMPL="H"
IF NPLINENO
Begin DoDot:1
+11 IF $PIECE(CNODE0,U,4)="CO"
SET TLLINENO=+$ORDER(^TMP("TIUF1IDX",$JOB,"DAF",TLFILEDA,0))
DO REEXPAND^TIUFHA7(TLFILEDA,TLLINENO,1)
QUIT
+12 DO REEXPAND^TIUFHA7(NPFILEDA,NPLINENO,1)
End DoDot:1
+13 ; Templates A, J updated for copy already in COPYFDA.
+14 DO VALMBG^TIUFHA7(CFILEDA,FILEDA,LINENO)
COPYX IF $DATA(DTOUT)
SET VALMBCK="Q"
+1 LOCK -^TIU(8925.1,+$GET(FILEDA))
SET VALM("ENTITY")="Entry"
+2 QUIT
+3 ;
OVERRIDE(XDIRA) ; function returns 1 if natl programmer, wants to override safeguards
+1 ;Requires XDIRA = DIR("A") Requires TIUFWHO
+2 NEW OVERRIDE,DIR,Y
+3 SET OVERRIDE=0
SET DIR("A")=XDIRA
+4 IF TIUFWHO'="N"
GOTO OVERX
+5 SET DIR(0)="Y"
SET DIR("B")="NO"
+6 SET DIR("A",1)="Want to override safeguards and"
+7 IF $GET(TIUFXNOD)["Add"
SET DIR("A",1)="Selecting (another) item to add: "_DIR("A",1)
+8 DO ^DIR
+9 IF Y
SET OVERRIDE=1
OVERX QUIT OVERRIDE
+1 ;
OVERWARN ;Warn re override
+1 WRITE !,"WARNING: As a National Programmer, you are permitted to override safeguards",!,"when moving entries and when adding/deleting items. Please do NOT override"
+2 WRITE !,"safeguards except as a last resort, and then only after thoroughly testing the",!,"actions you plan to take.",!
+3 QUIT
