| [613] | 1 | TIUFHA7 ; SLC/MAM - VALMBG(FILEDA,EFILEDA,EOLDLNO), UPDATE, MOVETL, REEXPAND(FILEDA,LINENO,UPDATE), WHICHDC(FILEDA,PFILEDA,ACTION) ;1/27/06
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**11,27,184**;Jun 20, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | WHICHDC(FILEDA,PFILEDA,ACTION) ; Function returns IFN of DC to copy/move Title to, or 0 if none chosen
|
|---|
| 5 | ;Requires FILEDA = IFN of Title to copy/move
|
|---|
| 6 | ;Requires PFILEDA = parent of Title
|
|---|
| 7 | ;Requires ACTION = MT or C
|
|---|
| 8 | N X,Y,GPFILEDA,DIC,DIR,NEWDCY,CWAD1,CWAD2
|
|---|
| 9 | S GPFILEDA=+$O(^TIU(8925.1,"AD",PFILEDA,0)) ;orig g'parent of title
|
|---|
| 10 | AGAINDC S DIC=8925.1,DIC(0)="AEMNQZ"
|
|---|
| 11 | I ACTION="MT" D
|
|---|
| 12 | . W !!," Selecting target Document Class. Enter '??' for a list of selectable ones.",!
|
|---|
| 13 | . W " You may not select PRF Flag Document Classes"
|
|---|
| 14 | . I TIUFWHO'="N" W " or Document Classes",!," outside the original Class."
|
|---|
| 15 | . E W "."
|
|---|
| 16 | . S DIC("A")="Select TIU DOCUMENT CLASS NAME to Move Title to: "
|
|---|
| 17 | . ; - Selected DC must: be DC, in hierarchy, not=current DC,
|
|---|
| 18 | . ; not addm, not PRF DC, & unless user is natl,
|
|---|
| 19 | . ; must be in same class as orig DC:
|
|---|
| 20 | . ; - Careful! last global ref could change during screen:
|
|---|
| 21 | . S DIC("S")="I $P(^(0),U,4)=""DC""&($$ORPHAN^TIUFLF4(Y,^(0))=""NO"")"
|
|---|
| 22 | . S DIC("S")=DIC("S")_"&(Y'=PFILEDA)&(Y'=512)&'$$ISPFDC^TIUPRFL(Y)"
|
|---|
| 23 | . I TIUFWHO'="N" S DIC("S")=DIC("S")_"&(GPFILEDA=+$O(^TIU(8925.1,""AD"",Y,0)))"
|
|---|
| 24 | I ACTION="C" S DIC("A")="Select TIU DOCUMENT CLASS NAME to Add Copy to: ",DIC("S")="I $P(^(0),U,4)=""DC""&($$ORPHAN^TIUFLF4(Y,^(0))=""NO"")&(Y'=512)"
|
|---|
| 25 | D ^DIC I Y=-1 G WDCX
|
|---|
| 26 | S NEWDCY=Y,NEWDCY(0)=Y(0)
|
|---|
| 27 | N TIUFCK D CHECK^TIUFLF3(+NEWDCY,+$O(^TIU(8925.1,"AD",+NEWDCY,0)),0,.TIUFCK)
|
|---|
| 28 | I 'TIUFCK D I '$$OVERRIDE^TIUFHA2("select entry even though it is FAULTY") W $S(ACTION="MT":" Title NOT moved.",1:" Copy NOT added.") D PAUSE^TIUFXHLX K NEWDCY G WDCX
|
|---|
| 29 | . W !!,"Faulty Document Class. Please TRY it and correct problems before ",$S(ACTION="MT":"Moving Title",1:"Adding Copy"),!,"to it. "
|
|---|
| 30 | I PFILEDA S CWAD1=$P(NEWDCY(0),U,14),CWAD2=$P(^TIU(8925.1,PFILEDA,0),U,14) I (CWAD1="")&(CWAD2'="")!((CWAD1'="")&(CWAD2="")) D G AGAINDC:Y=0,WDCX:'Y
|
|---|
| 31 | . S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 32 | . S DIR("A",1)="CWAD's behave differently from nonCWAD documents.",DIR("A")="Are you sure you want this Document Class" D ^DIR
|
|---|
| 33 | . I 'Y K NEWDCY
|
|---|
| 34 | WDCX I $D(DTOUT) S VALMQUIT=1
|
|---|
| 35 | Q $S($G(NEWDCY):NEWDCY,1:0)
|
|---|
| 36 | ;
|
|---|
| 37 | VALMBG(FILEDA,EFILEDA,EOLDLNO) ; Set VALMBG to show FILEDA if FILEDA is in LM Array.
|
|---|
| 38 | ; requires FILEDA.
|
|---|
| 39 | ; Requires EFILEDA = DA of LM entry of interest, EOLDLNO = old lineno of EFILEDA. EFILEDA and/or EOLDLNO may be 0.
|
|---|
| 40 | ; Entry of interest is entry to be copied, or Parent of Title to me moved, or Title whose documents are being moved.
|
|---|
| 41 | N LINENO,ENEWLNO
|
|---|
| 42 | S LINENO=+$O(^TMP("TIUF1IDX",$J,"DAF",FILEDA,0)),ENEWLNO=+$O(^TMP("TIUF1IDX",$J,"DAF",EFILEDA,0))
|
|---|
| 43 | I 'LINENO,"AJ"[TIUFTMPL W !,"... Not in Current View" H 2
|
|---|
| 44 | I 'LINENO Q
|
|---|
| 45 | ; If FILEDA shows on the screen, and entry of interest is still in same place on screen then don't change screen position:
|
|---|
| 46 | I LINENO'<VALMBG,LINENO'>(VALMBG+VALM("LINES")-1),EOLDLNO=ENEWLNO Q
|
|---|
| 47 | S VALMBG=LINENO
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | UPDATE ; Update Parent Document Type for documents of a certain title
|
|---|
| 51 | ; ALSO updates CLASS xrefs if valid OLDCLASS can be gotten from ^XTMP("TIUFMOVEN",FILEDA)=OLDCLASS
|
|---|
| 52 | N FILEDA,NODE0,INFO,DIR,OLDCLASS
|
|---|
| 53 | ; N DIR for EN^VALM2 default
|
|---|
| 54 | I '$D(TIUFMOVE) S TIUFMOVE="" ;Set to N in opt ZZTIUFH EDIT DDEFS NATL
|
|---|
| 55 | S VALM("ENTITY")="Title whose documents you want to Update"
|
|---|
| 56 | AGAINUP D EN^VALM2(TIUFXNOD,"SO") G:'$O(VALMY(0)) UPDAX 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 UPDAX
|
|---|
| 57 | S FILEDA=$P(INFO,U,2),NODE0=^TIU(8925.1,FILEDA,0)
|
|---|
| 58 | ; Need TIUFXNOD phrase to prevent loop:
|
|---|
| 59 | N DIRUT I $P(NODE0,U,4)'="DOC" W !," ?? Entry must be a TITLE (not a Document Class, etc.).",! D PAUSE^TIUFXHLX G UPDAX:$D(DIRUT)!(TIUFXNOD["="),AGAINUP
|
|---|
| 60 | I '$O(^TIU(8925,"B",FILEDA,0)) W !," ?? Title has no documents to Update",! D PAUSE^TIUFXHLX G UPDAX:$D(DIRUT)!(TIUFXNOD["="),AGAINUP
|
|---|
| 61 | I TIUFMOVE="N" S OLDCLASS=$G(^XTMP("TIUFMOVEN"_FILEDA))
|
|---|
| 62 | S OLDCLASS=+$G(OLDCLASS) ;may be 0
|
|---|
| 63 | S ^XTMP("TIUFMOVE"_TIUFMOVE_FILEDA,0)=+$$FMADD^XLFDT(DT,30)_U_DT
|
|---|
| 64 | D MTRPOINT^TIUFHA8(FILEDA,OLDCLASS)
|
|---|
| 65 | UPDAX K:TIUFMOVE="" TIUFMOVE S VALM("ENTITY")="Entry" Q
|
|---|
| 66 | ;
|
|---|
| 67 | MOVETL ; Move Title to different DC. Template H ONLY. National titles cannot be moved. Unless special arrangements are made w/ TIU developers, new DC must be in same CLASS as original DC.
|
|---|
| 68 | N INFO,FILEDA,NODE0,LINENO,PFILEDA,TENDA,NEWDCY,NDCLNO,PLINENO
|
|---|
| 69 | N GPFILEDA,OLDCLASS,DIR ; DIR for EN^VALM2 default
|
|---|
| 70 | N EXPAND,DA,DIK,TIUFI,LACKTECH,OVERRIDE
|
|---|
| 71 | S VALM("ENTITY")="Title to Move"
|
|---|
| 72 | S TIUFMOVE=$G(TIUFMOVE) ; Set to N in opt ZZTIUFH EDIT DDEFS NATL
|
|---|
| 73 | AGAINTL D EN^VALM2(TIUFXNOD,"SO") G:'$O(VALMY(0)) MTLX 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 MTLX
|
|---|
| 74 | S FILEDA=$P(INFO,U,2),NODE0=^TIU(8925.1,FILEDA,0),LINENO=+INFO
|
|---|
| 75 | ; Need TIUFXNOD phrase to prevent loop:
|
|---|
| 76 | N DIRUT I $P(NODE0,U,4)'="DOC" W !," ?? Entry must be a TITLE (not a Document Class, etc.).",! D PAUSE^TIUFXHLX G MTLX:$D(DIRUT)!(TIUFXNOD["="),AGAINTL
|
|---|
| 77 | I $P(NODE0,U,13) W !," ?? Can't Move National Titles",! D PAUSE^TIUFXHLX G MTLX:$D(DIRUT)!(TIUFXNOD["="),AGAINTL
|
|---|
| 78 | I $$ISPFTTL^TIUPRFL(FILEDA) W !," ?? Can't Move PRF Flag Titles",! D PAUSE^TIUFXHLX G MTLX:$D(DIRUT)!(TIUFXNOD["="),AGAINTL
|
|---|
| 79 | S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0))
|
|---|
| 80 | S TENDA=$P(INFO,U,6),PLINENO=$P(INFO,U,5)
|
|---|
| 81 | ; -----Check Title under PRESENT parent:
|
|---|
| 82 | N TIUFCK D CHECK^TIUFLF3(FILEDA,PFILEDA,1,.TIUFCK) G:$D(DTOUT) MTLX
|
|---|
| 83 | K TIUFCK("E"),TIUFCK("R"),TIUFCK("V"),TIUFCK("D"),TIUFCK("H"),TIUFCK("N"),TIUFCK("G")
|
|---|
| 84 | I $D(TIUFCK)>9 D G:'OVERRIDE MTLX
|
|---|
| 85 | . W !!,"Faulty Title. Please TRY it and correct problems before moving it.",!
|
|---|
| 86 | . S OVERRIDE=$$OVERRIDE^TIUFHA2("select title even though it is FAULTY")
|
|---|
| 87 | . I 'OVERRIDE W " NOT Moved",! D PAUSE^TIUFXHLX
|
|---|
| 88 | S VALMBCK="R" K DIRUT
|
|---|
| 89 | L +^TIU(8925.1,FILEDA):1 I '$T W !!,"Another user is editing this Title.",! H 4 G MTLX
|
|---|
| 90 | S NEWDCY=$$WHICHDC(FILEDA,PFILEDA,"MT")
|
|---|
| 91 | I 'NEWDCY G MTLX ;NEWDCY=New Document Class Y
|
|---|
| 92 | S GPFILEDA=+$O(^TIU(8925.1,"AD",PFILEDA,0))
|
|---|
| 93 | I GPFILEDA'=+$O(^TIU(8925.1,"AD",+NEWDCY,0)) S OLDCLASS=GPFILEDA
|
|---|
| 94 | S OLDCLASS=+$G(OLDCLASS)
|
|---|
| 95 | ; -----Check Title under PROPOSED parent:
|
|---|
| 96 | N TIUFCK D CHECK^TIUFLF3(FILEDA,NEWDCY,1,.TIUFCK) G:$D(DTOUT) MTLX
|
|---|
| 97 | ; -----If Title faulty under proposed parent, don't move:
|
|---|
| 98 | S LACKTECH=0
|
|---|
| 99 | F TIUFI="E^Edit Template","R^Print Method","V^Visit Linkage Method","D^Validation Method","H^Print Form Header","N^Print Form Number","G^Print Group" S:$D(TIUFCK($E(TIUFI))) LACKTECH=1
|
|---|
| 100 | I LACKTECH D
|
|---|
| 101 | . W !!,"Documents would not function properly under this move",!,"since Title lacks Technical Fields. Please edit Title's:",!
|
|---|
| 102 | . F TIUFI="E^Edit Template","R^Print Method","V^Visit Linkage Method","D^Validation Method","H^Print Form Header","N^Print Form Number","G^Print Group" W:$D(TIUFCK($E(TIUFI))) ?16,$P(TIUFI,U,2),!
|
|---|
| 103 | . W !,"Use values Title inherits from its ancestors. (To see inherited values, select",!,"Detailed Display for the CURRENT PARENT."
|
|---|
| 104 | . I $D(TIUFCK("H"))!$D(TIUFCK("N"))!$D(TIUFCK("G")) W " In some cases you may have to look",!,"higher up the hierarchy than current parent."
|
|---|
| 105 | . W ") Then come back and try again",!,"to move the Title.",!
|
|---|
| 106 | I LACKTECH,'$$OVERRIDE^TIUFHA2("ignore missing fields") W " Title NOT moved",! D PAUSE^TIUFXHLX G MTLX
|
|---|
| 107 | ; -----Delete Title from old parent, Add to new parent:
|
|---|
| 108 | I $P(NODE0,U,7)'=+^TMP("TIUF",$J,"STATI") D AUTOSTAT^TIUFLF6(FILEDA,NODE0,"INACTIVE")
|
|---|
| 109 | S DA=TENDA,DA(1)=PFILEDA,DIK="^TIU(8925.1,DA(1),10," D ^DIK
|
|---|
| 110 | D REEXPAND(PFILEDA,PLINENO,1)
|
|---|
| 111 | D ADDTEN^TIUFLF4(+NEWDCY,FILEDA,NODE0,"")
|
|---|
| 112 | S NDCLNO=+$O(^TMP("TIUF1IDX",$J,"DAF",+NEWDCY,0))
|
|---|
| 113 | I NDCLNO D REEXPAND(+NEWDCY,NDCLNO,1),VALMBG(FILEDA,PFILEDA,PLINENO)
|
|---|
| 114 | W !,"...Title Inactivated, Moved to ",$P(NEWDCY,U,2),"."
|
|---|
| 115 | K ^XTMP("TIUFMOVE"_TIUFMOVE_FILEDA) ; Cleanup before resetting
|
|---|
| 116 | S ^XTMP("TIUFMOVE"_TIUFMOVE_FILEDA,0)=+$$FMADD^XLFDT(DT,30)_U_DT
|
|---|
| 117 | D MTRPOINT^TIUFHA8(FILEDA,OLDCLASS)
|
|---|
| 118 | D D:'$D(DIRUT) PAUSE^TIUFXHLX
|
|---|
| 119 | . W !!,"Since the Title is in a new Document Class, it now inherits from a new parent",!,"wherever it lacks its own values, and its behavior may differ from before. It",!
|
|---|
| 120 | . W "may also differ from its new siblings wherever it HAS its own values and",!,"siblings INHERIT them.",!
|
|---|
| 121 | . W !,"Please check Title thoroughly before reactivating. Check Business Rules,",!,"TIU Document Parameters, and Document Definition attributes including Basic,",!,"Technical, and Upload fields.",!
|
|---|
| 122 | . I TIUFWHO="N" D
|
|---|
| 123 | . . W !,"Note that the IN USE display is not updated for CLASSES if old and new Document",!
|
|---|
| 124 | . . W "Classes were in different Classes. This is intentional, to speed up the move",!
|
|---|
| 125 | . . W "process. Display can be updated at any time by collapsing and reexpanding",!
|
|---|
| 126 | . . W "the hierarchy.",!
|
|---|
| 127 | MTLX I $D(DTOUT) S VALMBCK="Q"
|
|---|
| 128 | L -^TIU(8925.1,+$G(FILEDA)) S VALM("ENTITY")="Entry" K:TIUFMOVE="" TIUFMOVE
|
|---|
| 129 | Q
|
|---|
| 130 | ;
|
|---|
| 131 | REEXPAND(FILEDA,LINENO,UPDATE) ; Collapse, reexpand FILEDA; FILEDA is LINENO in LM array. Sets VALMCNT. Updates LINENO if UPDATE.
|
|---|
| 132 | ; Requires FILEDA, LINENO.
|
|---|
| 133 | ;DON'T CALL THIS except from template H or C since it resets VALMCNT.
|
|---|
| 134 | N INFO,EXPAND
|
|---|
| 135 | S INFO=^TMP("TIUF1IDX",$J,LINENO),EXPAND=$P(INFO,U,3) D PARSE^TIUFLLM(.INFO),COLLAPSE^TIUFH1(.INFO) S VALMCNT=VALMCNT-EXPAND D EXPAND1^TIUFH1(.INFO) S VALMCNT=VALMCNT+$P(INFO,U,3)
|
|---|
| 136 | I $G(UPDATE) D LINEUP^TIUFLLM1(.INFO,"H")
|
|---|
| 137 | Q
|
|---|
| 138 | ;
|
|---|
