| [613] | 1 | TIUFD2 ; SLC/MAM - LM Template D (Display) Action Edit Basics ;02/16/06
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**13,64,211**;Jun 20, 1997;Build 26
|
|---|
| 3 | ;
|
|---|
| 4 | ;*** INCLUDES JOEL'S MODS FOR VUID PATCH ***
|
|---|
| 5 | ;
|
|---|
| 6 | EDBASICS ; Template D (Display) Action Edit Basics
|
|---|
| 7 | ; Requires TIUFTMPL.
|
|---|
| 8 | ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL
|
|---|
| 9 | ; Requires CURRENT array TIUFINFO, CURRENT variable TIUFVCN1
|
|---|
| 10 | ;as set in EDVIEW^TIUFHA, updated (if Template A has changed)
|
|---|
| 11 | ;in AUPDATE^TIUFLA1, or (if Template H has changed) in UPDATE^TIUFLLM1.
|
|---|
| 12 | ;WARNING: +TIUFINFO may = 0 if Template A has changed!
|
|---|
| 13 | ; If TIUFWHO="C" (Clinician), only owner can edit.
|
|---|
| 14 | ; If TIUFTMPL = "A", requires TIUFATTR and TIUFAVAL as set in protocols
|
|---|
| 15 | ;TIUF SORT BY ... and subprotocols.
|
|---|
| 16 | ; Edit Basics for LM entries as entries in file 8925.1 (not as items
|
|---|
| 17 | ;for entries in 8925.1).
|
|---|
| 18 | N FILEDA,NAME,OPTFLDS,NEWFLAG,NODE0,STATUS,FIELDS,NEWSTAT,DTOUT,DIRUT
|
|---|
| 19 | N DIROUT,CNTCHNG,MSG
|
|---|
| 20 | N PFILEDA,DIR,X,Y,ALLFLDS,BYPASS,TIUFXNOD,TIUFFULL,TYPE,LINENO
|
|---|
| 21 | S FILEDA=TIUFINFO("FILEDA"),VALMBCK="" ;Redisplay each time.
|
|---|
| 22 | S NODE0=$G(^TIU(8925.1,FILEDA,0)),TIUFXNOD=$G(XQORNOD(0))
|
|---|
| 23 | I NODE0="" W !!," Entry not in File; See IRM",! D PAUSE^TIUFXHLX G EDBAX
|
|---|
| 24 | S NAME=$P(NODE0,U),STATUS=$P(NODE0,U,7),TYPE=$P(NODE0,U,4)
|
|---|
| 25 | S STATUS=$$STATWORD^TIUFLF5(STATUS) ;e.g. INACTIVE
|
|---|
| 26 | L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry.",! H 2 G EDBAX
|
|---|
| 27 | S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0))
|
|---|
| 28 | D G:'$D(FIELDS)!$D(DTOUT) EDBAX
|
|---|
| 29 | . S ALLFLDS=";.01;.02;.03;"_$S(TYPE="DOC":"1501;",1:"")_".04;.05;.06;.07;.1;.13;3.02;3.03;"
|
|---|
| 30 | . I $P(NODE0,U,10),'$$PERSOWNS^TIUFLF2(FILEDA,DUZ) S FIELDS=";.05;.06;" W !!," Edit Owner only: only an Owner can edit a Shared Component.",! Q
|
|---|
| 31 | . ; Natl entry, nonnat user => protocol screens out all except titles;
|
|---|
| 32 | . ;edit status & abbrev only, quit:
|
|---|
| 33 | . I $P(NODE0,U,13),TIUFWHO'="N" S FIELDS=";.02;.07;" W !!," Edit Abbreviation and Status only: Entry is National Title." Q ;P64 permit edit of abbr, stat for natl titles
|
|---|
| 34 | . I TYPE="O",'$$PERSOWNS^TIUFLF2(FILEDA,DUZ) S FIELDS=";.05;.06;" W !!," Edit Owner only: only an Owner can edit an Object.",! Q
|
|---|
| 35 | . I STATUS="NO/BAD",TYPE'="CO" S FIELDS=";.07;" W !!," Edit Status only: Entry has No Status/Bad Status",! Q
|
|---|
| 36 | . I STATUS'="INACTIVE",TIUFWHO="N" K DIRUT D Q:$D(DIRUT) I BYPASS=1 S FIELDS=ALLFLDS Q
|
|---|
| 37 | . . S DIR(0)="Y",DIR("A",1)=" Entry not Inactive. You can edit 'safe' Basic fields only OR you can bypass" ;P64 too many safe fields to list them
|
|---|
| 38 | . . S DIR("A",2)="safety measures and edit ALL Basic fields even though this may cause errors"
|
|---|
| 39 | . . S DIR("A",3)="if, for example, a document is being entered using this entry." ;P64 language works for objects (as well as titles)
|
|---|
| 40 | . . S DIR("A")="Do you want to edit ALL Basic Fields"
|
|---|
| 41 | . . S DIR("B")="NO" D ^DIR S BYPASS=Y K DIR,X,Y
|
|---|
| 42 | . I STATUS="NO/BAD" D Q
|
|---|
| 43 | . . S FIELDS=";.07;" W !!," Edit Status only; Entry has No Status/Bad Status" Q
|
|---|
| 44 | . I STATUS'="INACTIVE" D Q
|
|---|
| 45 | . . I TYPE="CO" S FIELDS=";.05;.06;" W !!," Edit Owner only; Entry is not Inactive" Q
|
|---|
| 46 | . . S FIELDS=";.02;.05;.06;.07;" ;Abbrev, Pers&Cls Owner, Status
|
|---|
| 47 | . . S MSG=" Edit Abbreviation, Owner"
|
|---|
| 48 | . . I TYPE="O" S $E(MSG,6,19)="",$E(FIELDS,1,4)="" ;P64 add abbr to editable flds except if entry is object
|
|---|
| 49 | . . S MSG=MSG_$S(TIUFWHO'="N":" and Status",1:", Status, & OK to Distribute")_" only; Entry not Inactive"
|
|---|
| 50 | . . I TIUFWHO="N" S FIELDS=FIELDS_"3.02;"
|
|---|
| 51 | . . W !!,MSG
|
|---|
| 52 | . I $P(NODE0,U,10),'$$CANEDIT^TIUFLF6(FILEDA) S FIELDS=";.05;.06;" W !!," Edit Owner only: Shared Component with parent that isn't Inactive" Q
|
|---|
| 53 | . I TIUFWHO="C" S FIELDS=";.02;.03;"_$S(TYPE="DOC":"1501;",1:"")_";.05;.06;.07;" Q
|
|---|
| 54 | . I TYPE="O" S FIELDS=";.01;.02;.03;.05;.06;.07;3.02;" Q
|
|---|
| 55 | . S FIELDS=ALLFLDS
|
|---|
| 56 | D ASKFLDS^TIUFLF1(FILEDA,FIELDS,PFILEDA,.NEWSTAT) G:$D(DTOUT) EDBAX
|
|---|
| 57 | D NODE0ARR^TIUFLF(FILEDA,.TIUFNOD0) G:$D(DTOUT) EDBAX
|
|---|
| 58 | I TIUFTMPL="A"!(TIUFTMPL="J") D ; Update line if 'REDO, no new status:
|
|---|
| 59 | . I NEWSTAT S TIUFREDO=1 ; One new status affects status globally.
|
|---|
| 60 | . ;Update line even if going to reinit, to get correct VALMCNT, and to get Not in Current View msg:
|
|---|
| 61 | . D AUPDATE^TIUFLA1(TIUFNOD0,FILEDA,.CNTCHNG) I CNTCHNG S TIUFVCN1=TIUFVCN1-1 ;doesn't match.
|
|---|
| 62 | ; Update entry itself in TIUFTMPL; entry will be reexpanded when leave EV:
|
|---|
| 63 | I "HC"[TIUFTMPL D LINEUP^TIUFLLM1(.TIUFINFO,TIUFTMPL)
|
|---|
| 64 | S LINENO=0 D DSBASICS^TIUFD(.LINENO) S VALMCNT=LINENO
|
|---|
| 65 | G:$D(DTOUT) EDBAX
|
|---|
| 66 | D HDR^TIUFD
|
|---|
| 67 | S VALMSG=$$VMSG^TIUFL D RE^VALM4 I $G(TIUFFULL) D RESET^TIUFXHLX
|
|---|
| 68 | EDBAX ;
|
|---|
| 69 | L -^TIU(8925.1,+$G(FILEDA))
|
|---|
| 70 | I $D(DTOUT) S VALMBCK="Q"
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
