| [613] | 1 | TIUFLF2 ; SLC/MAM - Library; File 8925.1 Related: PERSOWNS(FILEDA,PERSON), SELNAME(DEFLT), NAMSCRN(PFILEDA) ;4/23/97 18:20
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | PERSOWNS(FILEDA,PERSON) ; Function determines if PERSON owns 8925.1
|
|---|
| 5 | ;Entry FILEDA.
|
|---|
| 6 | ; Returns 1^P if FILEDA is personally-owned by PERSON;
|
|---|
| 7 | ; 1^C if FILEDA is owned by a class and PERSON belongs to it;
|
|---|
| 8 | ; 0 if PERSON doesn't own Entry
|
|---|
| 9 | ; "" if Entry is not owned except if adding FILEDA as item,
|
|---|
| 10 | ; 1 if Entry is not owned and adding FILEDA as item. (Users are confused if they don't see the item, so let them add it even if it's missing things).
|
|---|
| 11 | ; Requires 8925.1 FILEDA;
|
|---|
| 12 | ; Requires PERSON = IFN in file 200
|
|---|
| 13 | N ANS,CLASS
|
|---|
| 14 | I $D(^TIU(8925.1,"AP",PERSON,FILEDA)) S ANS="1^P" G PERSX
|
|---|
| 15 | S CLASS=$P(^TIU(8925.1,FILEDA,0),U,6)
|
|---|
| 16 | I $D(^TIU(8925.1,"AC",+CLASS,FILEDA)) D G PERSX
|
|---|
| 17 | . I $$ISA^USRLM(PERSON,CLASS) S ANS="1^C" Q
|
|---|
| 18 | . S ANS=0
|
|---|
| 19 | . Q
|
|---|
| 20 | I 'CLASS,'$P(^TIU(8925.1,FILEDA,0),U,5) S ANS=$S($G(TIUFSTMP)="T"&($G(TIUFXNOD)["Add"):1,1:"") G PERSX
|
|---|
| 21 | S ANS=0
|
|---|
| 22 | PERSX Q ANS
|
|---|
| 23 | ;
|
|---|
| 24 | SELNAME(DEFLT) ; Function Prompts for Name, Returns Name or "" if nothing selected or @ entered.
|
|---|
| 25 | ; Optional DEFLT = present Name if editing name
|
|---|
| 26 | N DIR,X,Y,DA,NAME
|
|---|
| 27 | S DIR(0)="FA^3:60^S X=$$UPPER^TIULS(X) K:'(X'?1P.E) X",(DIR("?"),DIR("??"))="^D NAME^TIUFXHLX"
|
|---|
| 28 | I (TIUFXNOD["Create") S $P(DIR(0),U)="FAO"
|
|---|
| 29 | I $D(DEFLT) S DIR("B")=DEFLT
|
|---|
| 30 | S DIR("A")=$S(TIUFXNOD["Basics"!(TIUFXNOD["Name"):"NAME: ",TIUFTMPL'="J":"Enter Document Definition Name to add as New Entry: ",1:"Enter the Name of a new Object: ")
|
|---|
| 31 | D ^DIR I $D(DTOUT)!$D(DUOUT) S NAME="" G SELNX
|
|---|
| 32 | S NAME=Y,NAME=$$UPPER^TIULS(NAME)
|
|---|
| 33 | SELNX Q NAME
|
|---|
| 34 | ;
|
|---|
| 35 | NAMSCRN(PFILEDA) ; Function returns DIC("S") for File 8925.1 Lookups when
|
|---|
| 36 | ;looking up entries to add as items to parent entry. Used in Rtn TIUFT,
|
|---|
| 37 | ;NOT in file DD's.
|
|---|
| 38 | ; Adding items is done in 2 separate steps: 1) choosing a new or
|
|---|
| 39 | ;existing entry and adding it to the file if it is new, and 2) actually
|
|---|
| 40 | ;adding entry as an item to the parent. This screen is for the first
|
|---|
| 41 | ;step ONLY. The second step is done in ADDTEN^TIUFLF4 and uses the
|
|---|
| 42 | ;screen set on fld 10, subfld .01, which prevents lookup failure due to
|
|---|
| 43 | ;duplicate names by letting only IFN TIUFISCR past the screen.
|
|---|
| 44 | ; Allows items of appropriate Type or NO Type.
|
|---|
| 45 | ; Disallows items which already have a parent EXCEPT for Shared Components (field .1).
|
|---|
| 46 | ; Disallows items which user doesn't own, EXCEPT ownerless items,
|
|---|
| 47 | ;EXCEPT Shared Components.
|
|---|
| 48 | ; Disallows entry from being its own item.
|
|---|
| 49 | ; If PFILEDA is nonNat'l, disallows Nat'l entries except Shared Comp.
|
|---|
| 50 | ; If PFILEDA is a shared component, disallows nonshared entries.
|
|---|
| 51 | ; Requires PFILEDA = IFN of 8925.1 parent entry
|
|---|
| 52 | ; Returns SCRN = screen that allows appropriate items
|
|---|
| 53 | ; TIUFIMSG is set in DUP^TIUFLF7
|
|---|
| 54 | N SCRN,PTYPE,HASPRNT,TYPEIS,TYPEISCL,TYPEISDC,TYPISDOC,TYPISNUL,TYPEISCO
|
|---|
| 55 | N SHARED,USROWNS,RTTYPE,CL,NUL,DC,DOC,CO,POSSTYPE,GOODTYPE,SELFITEM
|
|---|
| 56 | N NATLOK,PNATL,PNODE0,PSHARED
|
|---|
| 57 | S SCRN="I 0"
|
|---|
| 58 | S SELFITEM="(Y="_PFILEDA_")"
|
|---|
| 59 | S HASPRNT="+$O(^TIU(8925.1,""""AD"""",Y,0))"
|
|---|
| 60 | S TYPEIS="($P(^(0),U,4)="
|
|---|
| 61 | S NUL="""""",CL="""CL""",DC="""DC""",DOC="""DOC""",CO="""CO"""
|
|---|
| 62 | S TYPISNUL=TYPEIS_NUL_")"
|
|---|
| 63 | S TYPEISCL=TYPEIS_CL_")"
|
|---|
| 64 | S TYPEISDC=TYPEIS_DC_")"
|
|---|
| 65 | S TYPISDOC=TYPEIS_DOC_")"
|
|---|
| 66 | S TYPEISCO=TYPEIS_CO_")"
|
|---|
| 67 | S POSSTYPE=$$POSSTYPE^TIUFLF7(PFILEDA) G:$D(DTOUT) NAMSX
|
|---|
| 68 | I POSSTYPE="" W !!," Parent has no Type/Bad Type",! G NAMSX
|
|---|
| 69 | S GOODTYPE=""
|
|---|
| 70 | I POSSTYPE["CL" S GOODTYPE=$S(GOODTYPE="":TYPEISCL,1:GOODTYPE_"!"_TYPEISCL)
|
|---|
| 71 | I POSSTYPE["DC" S GOODTYPE=$S(GOODTYPE="":TYPEISDC,1:GOODTYPE_"!"_TYPEISDC)
|
|---|
| 72 | I POSSTYPE["DOC" S GOODTYPE=$S(GOODTYPE="":TYPISDOC,1:GOODTYPE_"!"_TYPISDOC)
|
|---|
| 73 | I POSSTYPE["CO" S GOODTYPE=$S(GOODTYPE="":TYPEISCO,1:GOODTYPE_"!"_TYPEISCO)
|
|---|
| 74 | S USROWNS="+$$PERSOWNS^TIUFLF2(Y,DUZ)"
|
|---|
| 75 | S SHARED="+$P(^TIU(8925.1,Y,0),U,10)",PSHARED=+$P(^TIU(8925.1,PFILEDA,0),U,10)
|
|---|
| 76 | S SCRN="I "_GOODTYPE_",'"_SELFITEM_",'$$DUP^TIUFLF7($P(^(0),U),"_PFILEDA_",Y),$$NATLOK^TIUFLF2(^TIU(8925.1,Y,0),"_PFILEDA_"),'("_PSHARED_"&'"_SHARED_") X:'"_SHARED_" ""I "_USROWNS_"&'"_HASPRNT_""""
|
|---|
| 77 | NAMSX I $D(DTOUT) S SCRN="I 0"
|
|---|
| 78 | Q SCRN
|
|---|
| 79 | ;
|
|---|
| 80 | NATLOK(NODE0,PFILEDA) ; Function returns 1/0 if item OK/not OK to add as far
|
|---|
| 81 | ;as Natl goes. Considers if parent is Natl, if Item is Natl,
|
|---|
| 82 | ;if User has Natl menu.
|
|---|
| 83 | N NATL,PNODE0,PNATL,PTYPE,SHARED,NATLANS
|
|---|
| 84 | S NATL=+$P(NODE0,U,13),PNODE0=^TIU(8925.1,PFILEDA,0),PNATL=+$P(PNODE0,U,13),PTYPE=$P(PNODE0,U,4),SHARED=$P(NODE0,U,10),NATLANS=0
|
|---|
| 85 | I PTYPE="CL"!(PTYPE="DC") S NATLANS=$S(PNATL:$S(NATL:$S(TIUFWHO="N":1,1:0),1:1),1:$S(NATL:0,1:1))
|
|---|
| 86 | I PTYPE="DOC"!(PTYPE="CO") S NATLANS=$S(PNATL:$S(NATL:1,1:0),1:$S(NATL:$S(SHARED:1,1:0),1:1))
|
|---|
| 87 | Q NATLANS
|
|---|
| 88 | ;
|
|---|
