source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFHA3.m@ 1800

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

initial load of WorldVistAEHR
File size: 7.0 KB
RevLine 
[613]1TIUFHA3 ; SLC/MAM - LM Templates H, A Action Edit Status, INACTIVE(TYPE,FILEDA,NODE0), WARNING, WARNOBJI(FILEDA) ; 03/16/2007
2 ;;1.0;TEXT INTEGRATION UTILITIES;**13,64,211,225**;Jun 20, 1997;Build 13
3 ;
4EDSTAT ; Action Edit Status for Templates H, A, J, C
5 N STATUS,TIUFXNOD,TIUFFULL
6 N DTOUT,DIRUT,DIROUT
7 S VALMBCK="",TIUFXNOD=$G(XQORNOD(0))
8 S STATUS=$$SELSTAT^TIUFLF5,STATUS=$P(STATUS,U,2) I $D(DTOUT)!(STATUS="") G EDSTX
9 I "AJ"[TIUFTMPL D TMPLA(STATUS) G EDSTX
10 ; Template H, C
11 I STATUS'="ACTIVE" D ONE(STATUS) G EDSTX
12 D MANY(STATUS)
13EDSTX I $D(DTOUT) S VALMBCK="Q" Q
14 I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
15 Q
16 ;
17MANY(STATUS) ; Select multiple entries for Status ACTIVE for Templates H, C.
18 ; Requires STATUS
19 N LINENO,INFO,TIUFQUIT
20 I $P(TIUFXNOD,U,4)'["=" W !!," Selecting Entries for Status ACTIVE. You may enter multiple entries",!,"at the same time."
21 D EN^VALM2(TIUFXNOD,"O") Q:'$O(VALMY(0)) K DIRUT
22 S (LINENO,TIUFQUIT)=0 F S LINENO=$O(VALMY(LINENO)) Q:'LINENO S INFO=$G(^TMP("TIUF1IDX",$J,LINENO)) D EDONE(STATUS,INFO,.TIUFQUIT) Q:TIUFQUIT D LINEUP^TIUFLLM1(INFO,TIUFTMPL) Q:$D(DIRUT)
23 Q
24 ;
25ONE(STATUS) ; Select one entry (in loop) for Status INACTIVE or TEST for Templates H, C.
26 N INFO,TIUFQUIT,EXPAND
27 I $P(TIUFXNOD,U,4)'["=" W !!," Selecting Entry for Status ",STATUS,". Please select ONE entry. You will be",!,"prompted for another." K DIRUT
28 F D EN^VALM2(TIUFXNOD,"SO") Q:'$O(VALMY(0)) S INFO=$G(^TMP("TIUF1IDX",$J,$O(VALMY(0)))) D Q:TIUFQUIT!$D(DIRUT)
29 . I STATUS="TEST" W " ... "
30 . S (EXPAND,TIUFQUIT)=0 K DIRUT D EDONE(STATUS,.INFO,.TIUFQUIT,.EXPAND) Q:TIUFQUIT!$D(DIRUT)
31 . D LINEUP^TIUFLLM1(INFO,TIUFTMPL)
32 . I EXPAND D EXPAND1^TIUFH1(.INFO) S VALMCNT=VALMCNT+$P(INFO,U,3)
33 . I VALMBCK="R" S VALMSG=$$VMSG^TIUFL D RE^VALM4
34 . S $P(TIUFXNOD,U,4)="ST"
35 . W !!,"Selecting Another Entry for Status "_STATUS_":"
36 Q
37 ;
38TMPLA(STATUS) ; Select multiple entries for Status edit for Template A
39 ; Requires STATUS
40 N LINENO,INFO,TIUFQUIT
41 I $P(TIUFXNOD,U,4)'["=" W !!," Selecting Entries for Status ",STATUS,". You may enter multiple entries",!,"at the same time."
42 D EN^VALM2(TIUFXNOD,"O") Q:'$O(VALMY(0)) K DIRUT
43 S (LINENO,TIUFQUIT)=0 F S LINENO=$O(VALMY(LINENO)) Q:'LINENO S INFO=$G(^TMP("TIUF1IDX",$J,LINENO)) D EDONE(STATUS,INFO,.TIUFQUIT) Q:TIUFQUIT!$D(DIRUT)
44 I VALMBCK="R" D INIT^TIUFA
45 Q
46 ;
47EDONE(STATUS,INFO,TIUFQUIT,EXPAND) ; Edit Status for one LM entry.
48 ; Requires STATUS,INFO; returns TIUFQUIT, EXPAND.
49 N FILEDA,NODE0,TYPE,MSG,STATOK,PFILEDA,LIST
50 S (TIUFQUIT,EXPAND)=0 S:STATUS'="ACTIVE" VALMBCK=""
51 I 'INFO W !!," Missing List Manager Information; See IRM",! D PAUSE^TIUFXHLX S TIUFQUIT=1 G EDONX
52 S FILEDA=+$P(INFO,U,2),NODE0=$G(^TIU(8925.1,FILEDA,0))
53 I NODE0="" W !!," Entry "_+INFO_" does not exist in the File; See IRM",! D PAUSE^TIUFXHLX S TIUFQUIT=1 G EDONX
54 S TYPE=$P(NODE0,U,4)
55 I FILEDA=81!(FILEDA=512) S MSG=" Addendum; Can't edit Status" W !!,MSG,! D PAUSE^TIUFXHLX G EDONX ;P64
56 I $P(NODE0,U,13),TYPE'="DOC",TIUFWHO'="N" S MSG=" Entry "_+INFO_" is National; Can't edit Status" W !!,MSG,! D PAUSE^TIUFXHLX G EDONX ;P64 restrict msg to nontitles
57 I TYPE="O" W !!,"Entry "_+INFO_" is an Object. To edit Status please select action Detailed",!,"Display and then select Basics.",! D PAUSE^TIUFXHLX G EDONX
58 I "AJ"[TIUFTMPL!(STATUS="ACTIVE") S MSG=" Editing Status for Entry "_+INFO_" ... " W !!,MSG H 1
59 I TYPE="CO",$P(NODE0,U,10) S MSG=" Shared Components have no Status; Can't Edit Status" W !,MSG,! D PAUSE^TIUFXHLX G EDONX
60 I TYPE="CO" S MSG=" Component Status is determined by Parent; Can't Edit Status" W !,MSG,! D PAUSE^TIUFXHLX G EDONX
61 L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry; please try later.",! D PAUSE^TIUFXHLX G EDONX
62 S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0))
63 D STATLIST^TIUFLF5(FILEDA,PFILEDA,$E(STATUS),.MSG,.LIST) G:$D(DTOUT) EDONX I LIST'[$E(STATUS) W !,MSG,! D PAUSE^TIUFXHLX G EDONX
64 I $$STATWORD^TIUFLF5($P(NODE0,U,7))=STATUS S MSG=" Status already "_STATUS W MSG,! D PAUSE^TIUFXHLX G EDONX
65 D INACTIVE(TYPE,FILEDA,NODE0):STATUS="INACTIVE",TEST(FILEDA,NODE0):STATUS="TEST",ACTIVE(FILEDA,NODE0):STATUS="ACTIVE"
66 I STATUS="INACTIVE",TYPE="CL"!(TYPE="DC")!(TYPE="DOC") D COLLEXPD(.INFO,0,.EXPAND)
67 I STATUS="ACTIVE",TYPE="DOC" D COLLEXPD(.INFO,1)
68 I STATUS="TEST" D COLLEXPD(.INFO,0,.EXPAND)
69 S VALMSG=$$VMSG^TIUFL
70EDONX L -^TIU(8925.1,FILEDA)
71 Q
72 ;
73INACTIVE(TYPE,FILEDA,NODE0) ; Change Status to Inactive.
74 ; Requires TYPE, FILEDA, NODE0
75 N CONTINUE
76 I TYPE="O" S CONTINUE=$$WARNOBJI(FILEDA) D G:'CONTINUE INACX
77 . I CONTINUE W " Inactivated" H 1 Q
78 . W " NOT Inactivated" H 1
79 I TYPE="CL"!(TYPE="DC"),$$HASITEMS^TIUFLF1(FILEDA) S CONTINUE=$$WARNING I 'CONTINUE W " NOT Inactivated" H 1 G INACX
80 I TYPE'="O" D
81 . I $G(CONTINUE) W !," Entry and descendants Inactivated" H 1 Q
82 . I TYPE="DOC" W !," Entry (& any nonShared Components) Inactivated" H 1 Q
83 . W " Entry Inactivated" H 1
84 D AUTOSTAT^TIUFLF6(FILEDA,NODE0,"INACTIVE") S:$P(TIUFXNOD,U,3)["Status" VALMBCK="R"
85INACX Q
86 ;
87COLLEXPD(INFO,EXPDFLG,EXPAND) ; Collapse entry, reexpand (to items only) if EXPDFLG=1
88 ; Requires string INFO. Passes back array INFO. If 'EXPDFLG, must reexpand later, or reinit the whole screen.
89 S EXPAND=$P(INFO,U,3) Q:'EXPAND
90 D PARSE^TIUFLLM(.INFO),COLLAPSE^TIUFH1(.INFO)
91 I $G(EXPDFLG) D EXPAND1^TIUFH1(.INFO)
92 S VALMCNT=$S($G(EXPDFLG):VALMCNT-EXPAND+$P(INFO,U,3),1:VALMCNT-EXPAND)
93 Q
94 ;
95WARNING() ; Function Warns user who asks to Inactivate, Returns 1 to Inactivate, 0 to not Inactivate.
96 N DIR,X,Y
97 S DIR(0)="Y",DIR("B")="NO",DIR("A",1)=" This will Inactivate ALL DESCENDANTS (except Shared Components). Before"
98 S DIR("A",2)="Inactivating, please note which Descendants are presently Inactive. This will"
99 S DIR("A",3)="help you know which Descendants NOT to reactivate later."
100 S DIR("A")=" Sure you want to Inactivate"
101 D ^DIR W " ... "
102 Q Y
103 ;
104ACTIVE(FILEDA,NODE0) ; Change Status to Active.
105 N TIUOUT
106 D FULL^VALM1
107 I ($P(NODE0,U,4)="DOC"),(+$G(^TIU(8925.1,FILEDA,15))'>0) D Q:+$G(TIUOUT)
108 . W !!,$C(7),"You MUST first map ",$P(NODE0,U),!
109 . D DIRECT^TIUMAP2(FILEDA)
110 . I +$G(^TIU(8925.1,FILEDA,15))'>0 W $C(7)," Status unchanged...",! H 2
111 . I S TIUOUT=1,VALMBCK="R"
112 D AUTOSTAT^TIUFLF6(FILEDA,NODE0,"ACTIVE") S VALMBCK="R"
113 I $P(NODE0,U,4)="DOC" W " Entry and any (nonShared) Components Activated",! H 1 Q
114 W " Entry Activated",! H 1
115 Q
116 ;
117TEST(FILEDA,NODE0) ; Change Status to Test.
118 ; Requires FILEDA, NODE0, INFO from EDSTAT.
119 D AUTOSTAT^TIUFLF6(FILEDA,NODE0,"TEST") S VALMBCK="R"
120 W !," Entry & any (nonShared) Components changed to TEST",! H 1
121 Q
122 ;
123WARNOBJI(FILEDA) ; Function Warns user inactivating an object, Returns 1 to Proceed, 0 to Stop.
124 N DIR,X,Y,USED,WARNANS
125 S USED=$$OBJUSED^TIUFLJ(FILEDA) I USED'["A" S WARNANS=1 G WARNX
126 S DIR(0)="Y",DIR("B")="NO",DIR("A",1)=" WARNING: Object is embedded in boilerplate text of active titles. If you"
127 S DIR("A",2)="inactivate the object, it will not function when users enter documents against"
128 S DIR("A",3)="such titles. You might want to warn users or even take such titles offline"
129 S DIR("A",4)="while the Object is inactive."
130 S DIR("A")=" Continue"
131 D ^DIR W " ... " S WARNANS=Y
132WARNX Q WARNANS
133 ;
Note: See TracBrowser for help on using the repository browser.