- TIUFLF2 ; SLC/MAM - Library; File 8925.1 Related: PERSOWNS(FILEDA,PERSON), SELNAME(DEFLT), NAMSCRN(PFILEDA) ;4/23/97 18:20
- ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
- ;
- PERSOWNS(FILEDA,PERSON) ; Function determines if PERSON owns 8925.1
- ;Entry FILEDA.
- ; Returns 1^P if FILEDA is personally-owned by PERSON;
- ; 1^C if FILEDA is owned by a class and PERSON belongs to it;
- ; 0 if PERSON doesn't own Entry
- ; "" if Entry is not owned except if adding FILEDA as item,
- ; 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).
- ; Requires 8925.1 FILEDA;
- ; Requires PERSON = IFN in file 200
- N ANS,CLASS
- I $D(^TIU(8925.1,"AP",PERSON,FILEDA)) S ANS="1^P" G PERSX
- S CLASS=$P(^TIU(8925.1,FILEDA,0),U,6)
- I $D(^TIU(8925.1,"AC",+CLASS,FILEDA)) D G PERSX
- . I $$ISA^USRLM(PERSON,CLASS) S ANS="1^C" Q
- . S ANS=0
- . Q
- I 'CLASS,'$P(^TIU(8925.1,FILEDA,0),U,5) S ANS=$S($G(TIUFSTMP)="T"&($G(TIUFXNOD)["Add"):1,1:"") G PERSX
- S ANS=0
- PERSX Q ANS
- ;
- SELNAME(DEFLT) ; Function Prompts for Name, Returns Name or "" if nothing selected or @ entered.
- ; Optional DEFLT = present Name if editing name
- N DIR,X,Y,DA,NAME
- S DIR(0)="FA^3:60^S X=$$UPPER^TIULS(X) K:'(X'?1P.E) X",(DIR("?"),DIR("??"))="^D NAME^TIUFXHLX"
- I (TIUFXNOD["Create") S $P(DIR(0),U)="FAO"
- I $D(DEFLT) S DIR("B")=DEFLT
- 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: ")
- D ^DIR I $D(DTOUT)!$D(DUOUT) S NAME="" G SELNX
- S NAME=Y,NAME=$$UPPER^TIULS(NAME)
- SELNX Q NAME
- ;
- NAMSCRN(PFILEDA) ; Function returns DIC("S") for File 8925.1 Lookups when
- ;looking up entries to add as items to parent entry. Used in Rtn TIUFT,
- ;NOT in file DD's.
- ; Adding items is done in 2 separate steps: 1) choosing a new or
- ;existing entry and adding it to the file if it is new, and 2) actually
- ;adding entry as an item to the parent. This screen is for the first
- ;step ONLY. The second step is done in ADDTEN^TIUFLF4 and uses the
- ;screen set on fld 10, subfld .01, which prevents lookup failure due to
- ;duplicate names by letting only IFN TIUFISCR past the screen.
- ; Allows items of appropriate Type or NO Type.
- ; Disallows items which already have a parent EXCEPT for Shared Components (field .1).
- ; Disallows items which user doesn't own, EXCEPT ownerless items,
- ;EXCEPT Shared Components.
- ; Disallows entry from being its own item.
- ; If PFILEDA is nonNat'l, disallows Nat'l entries except Shared Comp.
- ; If PFILEDA is a shared component, disallows nonshared entries.
- ; Requires PFILEDA = IFN of 8925.1 parent entry
- ; Returns SCRN = screen that allows appropriate items
- ; TIUFIMSG is set in DUP^TIUFLF7
- N SCRN,PTYPE,HASPRNT,TYPEIS,TYPEISCL,TYPEISDC,TYPISDOC,TYPISNUL,TYPEISCO
- N SHARED,USROWNS,RTTYPE,CL,NUL,DC,DOC,CO,POSSTYPE,GOODTYPE,SELFITEM
- N NATLOK,PNATL,PNODE0,PSHARED
- S SCRN="I 0"
- S SELFITEM="(Y="_PFILEDA_")"
- S HASPRNT="+$O(^TIU(8925.1,""""AD"""",Y,0))"
- S TYPEIS="($P(^(0),U,4)="
- S NUL="""""",CL="""CL""",DC="""DC""",DOC="""DOC""",CO="""CO"""
- S TYPISNUL=TYPEIS_NUL_")"
- S TYPEISCL=TYPEIS_CL_")"
- S TYPEISDC=TYPEIS_DC_")"
- S TYPISDOC=TYPEIS_DOC_")"
- S TYPEISCO=TYPEIS_CO_")"
- S POSSTYPE=$$POSSTYPE^TIUFLF7(PFILEDA) G:$D(DTOUT) NAMSX
- I POSSTYPE="" W !!," Parent has no Type/Bad Type",! G NAMSX
- S GOODTYPE=""
- I POSSTYPE["CL" S GOODTYPE=$S(GOODTYPE="":TYPEISCL,1:GOODTYPE_"!"_TYPEISCL)
- I POSSTYPE["DC" S GOODTYPE=$S(GOODTYPE="":TYPEISDC,1:GOODTYPE_"!"_TYPEISDC)
- I POSSTYPE["DOC" S GOODTYPE=$S(GOODTYPE="":TYPISDOC,1:GOODTYPE_"!"_TYPISDOC)
- I POSSTYPE["CO" S GOODTYPE=$S(GOODTYPE="":TYPEISCO,1:GOODTYPE_"!"_TYPEISCO)
- S USROWNS="+$$PERSOWNS^TIUFLF2(Y,DUZ)"
- S SHARED="+$P(^TIU(8925.1,Y,0),U,10)",PSHARED=+$P(^TIU(8925.1,PFILEDA,0),U,10)
- 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_""""
- NAMSX I $D(DTOUT) S SCRN="I 0"
- Q SCRN
- ;
- NATLOK(NODE0,PFILEDA) ; Function returns 1/0 if item OK/not OK to add as far
- ;as Natl goes. Considers if parent is Natl, if Item is Natl,
- ;if User has Natl menu.
- N NATL,PNODE0,PNATL,PTYPE,SHARED,NATLANS
- 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
- 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))
- I PTYPE="DOC"!(PTYPE="CO") S NATLANS=$S(PNATL:$S(NATL:1,1:0),1:$S(NATL:$S(SHARED:1,1:0),1:1))
- Q NATLANS
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFLF2 4731 printed Jan 18, 2025@03:42:14 Page 2
- TIUFLF2 ; SLC/MAM - Library; File 8925.1 Related: PERSOWNS(FILEDA,PERSON), SELNAME(DEFLT), NAMSCRN(PFILEDA) ;4/23/97 18:20
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
- +2 ;
- PERSOWNS(FILEDA,PERSON) ; Function determines if PERSON owns 8925.1
- +1 ;Entry FILEDA.
- +2 ; Returns 1^P if FILEDA is personally-owned by PERSON;
- +3 ; 1^C if FILEDA is owned by a class and PERSON belongs to it;
- +4 ; 0 if PERSON doesn't own Entry
- +5 ; "" if Entry is not owned except if adding FILEDA as item,
- +6 ; 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).
- +7 ; Requires 8925.1 FILEDA;
- +8 ; Requires PERSON = IFN in file 200
- +9 NEW ANS,CLASS
- +10 IF $DATA(^TIU(8925.1,"AP",PERSON,FILEDA))
- SET ANS="1^P"
- GOTO PERSX
- +11 SET CLASS=$PIECE(^TIU(8925.1,FILEDA,0),U,6)
- +12 IF $DATA(^TIU(8925.1,"AC",+CLASS,FILEDA))
- Begin DoDot:1
- +13 IF $$ISA^USRLM(PERSON,CLASS)
- SET ANS="1^C"
- QUIT
- +14 SET ANS=0
- +15 QUIT
- End DoDot:1
- GOTO PERSX
- +16 IF 'CLASS
- IF '$PIECE(^TIU(8925.1,FILEDA,0),U,5)
- SET ANS=$SELECT($GET(TIUFSTMP)="T"&($GET(TIUFXNOD)["Add"):1,1:"")
- GOTO PERSX
- +17 SET ANS=0
- PERSX QUIT ANS
- +1 ;
- SELNAME(DEFLT) ; Function Prompts for Name, Returns Name or "" if nothing selected or @ entered.
- +1 ; Optional DEFLT = present Name if editing name
- +2 NEW DIR,X,Y,DA,NAME
- +3 SET DIR(0)="FA^3:60^S X=$$UPPER^TIULS(X) K:'(X'?1P.E) X"
- SET (DIR("?"),DIR("??"))="^D NAME^TIUFXHLX"
- +4 IF (TIUFXNOD["Create")
- SET $PIECE(DIR(0),U)="FAO"
- +5 IF $DATA(DEFLT)
- SET DIR("B")=DEFLT
- +6 SET DIR("A")=$SELECT(TIUFXNOD["Basics"!(TIUFXNOD["Name"):"NAME: ",TIUFTMPL'="J":"Enter Document Definition Name to add as New Entry: ",1:"Enter the Name of a new Object: ")
- +7 DO ^DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET NAME=""
- GOTO SELNX
- +8 SET NAME=Y
- SET NAME=$$UPPER^TIULS(NAME)
- SELNX QUIT NAME
- +1 ;
- NAMSCRN(PFILEDA) ; Function returns DIC("S") for File 8925.1 Lookups when
- +1 ;looking up entries to add as items to parent entry. Used in Rtn TIUFT,
- +2 ;NOT in file DD's.
- +3 ; Adding items is done in 2 separate steps: 1) choosing a new or
- +4 ;existing entry and adding it to the file if it is new, and 2) actually
- +5 ;adding entry as an item to the parent. This screen is for the first
- +6 ;step ONLY. The second step is done in ADDTEN^TIUFLF4 and uses the
- +7 ;screen set on fld 10, subfld .01, which prevents lookup failure due to
- +8 ;duplicate names by letting only IFN TIUFISCR past the screen.
- +9 ; Allows items of appropriate Type or NO Type.
- +10 ; Disallows items which already have a parent EXCEPT for Shared Components (field .1).
- +11 ; Disallows items which user doesn't own, EXCEPT ownerless items,
- +12 ;EXCEPT Shared Components.
- +13 ; Disallows entry from being its own item.
- +14 ; If PFILEDA is nonNat'l, disallows Nat'l entries except Shared Comp.
- +15 ; If PFILEDA is a shared component, disallows nonshared entries.
- +16 ; Requires PFILEDA = IFN of 8925.1 parent entry
- +17 ; Returns SCRN = screen that allows appropriate items
- +18 ; TIUFIMSG is set in DUP^TIUFLF7
- +19 NEW SCRN,PTYPE,HASPRNT,TYPEIS,TYPEISCL,TYPEISDC,TYPISDOC,TYPISNUL,TYPEISCO
- +20 NEW SHARED,USROWNS,RTTYPE,CL,NUL,DC,DOC,CO,POSSTYPE,GOODTYPE,SELFITEM
- +21 NEW NATLOK,PNATL,PNODE0,PSHARED
- +22 SET SCRN="I 0"
- +23 SET SELFITEM="(Y="_PFILEDA_")"
- +24 SET HASPRNT="+$O(^TIU(8925.1,""""AD"""",Y,0))"
- +25 SET TYPEIS="($P(^(0),U,4)="
- +26 SET NUL=""""""
- SET CL="""CL"""
- SET DC="""DC"""
- SET DOC="""DOC"""
- SET CO="""CO"""
- +27 SET TYPISNUL=TYPEIS_NUL_")"
- +28 SET TYPEISCL=TYPEIS_CL_")"
- +29 SET TYPEISDC=TYPEIS_DC_")"
- +30 SET TYPISDOC=TYPEIS_DOC_")"
- +31 SET TYPEISCO=TYPEIS_CO_")"
- +32 SET POSSTYPE=$$POSSTYPE^TIUFLF7(PFILEDA)
- if $DATA(DTOUT)
- GOTO NAMSX
- +33 IF POSSTYPE=""
- WRITE !!," Parent has no Type/Bad Type",!
- GOTO NAMSX
- +34 SET GOODTYPE=""
- +35 IF POSSTYPE["CL"
- SET GOODTYPE=$SELECT(GOODTYPE="":TYPEISCL,1:GOODTYPE_"!"_TYPEISCL)
- +36 IF POSSTYPE["DC"
- SET GOODTYPE=$SELECT(GOODTYPE="":TYPEISDC,1:GOODTYPE_"!"_TYPEISDC)
- +37 IF POSSTYPE["DOC"
- SET GOODTYPE=$SELECT(GOODTYPE="":TYPISDOC,1:GOODTYPE_"!"_TYPISDOC)
- +38 IF POSSTYPE["CO"
- SET GOODTYPE=$SELECT(GOODTYPE="":TYPEISCO,1:GOODTYPE_"!"_TYPEISCO)
- +39 SET USROWNS="+$$PERSOWNS^TIUFLF2(Y,DUZ)"
- +40 SET SHARED="+$P(^TIU(8925.1,Y,0),U,10)"
- SET PSHARED=+$PIECE(^TIU(8925.1,PFILEDA,0),U,10)
- +41 SET 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_""""
- NAMSX IF $DATA(DTOUT)
- SET SCRN="I 0"
- +1 QUIT SCRN
- +2 ;
- NATLOK(NODE0,PFILEDA) ; Function returns 1/0 if item OK/not OK to add as far
- +1 ;as Natl goes. Considers if parent is Natl, if Item is Natl,
- +2 ;if User has Natl menu.
- +3 NEW NATL,PNODE0,PNATL,PTYPE,SHARED,NATLANS
- +4 SET NATL=+$PIECE(NODE0,U,13)
- SET PNODE0=^TIU(8925.1,PFILEDA,0)
- SET PNATL=+$PIECE(PNODE0,U,13)
- SET PTYPE=$PIECE(PNODE0,U,4)
- SET SHARED=$PIECE(NODE0,U,10)
- SET NATLANS=0
- +5 IF PTYPE="CL"!(PTYPE="DC")
- SET NATLANS=$SELECT(PNATL:$SELECT(NATL:$SELECT(TIUFWHO="N":1,1:0),1:1),1:$SELECT(NATL:0,1:1))
- +6 IF PTYPE="DOC"!(PTYPE="CO")
- SET NATLANS=$SELECT(PNATL:$SELECT(NATL:1,1:0),1:$SELECT(NATL:$SELECT(SHARED:1,1:0),1:1))
- +7 QUIT NATLANS
- +8 ;