1 | TIUFLF4 ; SLC/MAM - Lib; ANCESTOR(FILEDA,NODE0,ANCESTOR,DOCFLAG), ORPHAN(FILEDA,NODE0,ANCESTOR), STUFFLDS(FILEDA,PFILEDA), ADDTEN(PFILEDA,FILEDA,NODE0,TENDA),NUMITEMS(FILEDA), MISSITEM(FILEDA) ;4/23/97 11:02
|
---|
2 | ;;1.0;TEXT INTEGRATION UTILITIES;**11,43**;Jun 20, 1997
|
---|
3 | ;
|
---|
4 | NUMITEMS(FILEDA) ; Function returns Number of Items of FILEDA; Possibly 0
|
---|
5 | N ITEMSANS,TIUFI
|
---|
6 | S (ITEMSANS,TIUFI)=0
|
---|
7 | F S TIUFI=$O(^TIU(8925.1,FILEDA,10,TIUFI)) G:'TIUFI NUMIX S ITEMSANS=ITEMSANS+1
|
---|
8 | NUMIX Q ITEMSANS
|
---|
9 | ;
|
---|
10 | MISSITEM(FILEDA) ; Function Checks FILEDA Items (doesn't check subitems etc.) for existence only. Returns IFN of first missing item it finds, else 0.
|
---|
11 | ; Requires FILEDA.
|
---|
12 | N TIUI,IFILEDA,MISSANS
|
---|
13 | S TIUI=0,MISSANS=0
|
---|
14 | F S TIUI=$O(^TIU(8925.1,FILEDA,10,TIUI)) Q:'TIUI!MISSANS D
|
---|
15 | . S IFILEDA=+^TIU(8925.1,FILEDA,10,TIUI,0)
|
---|
16 | . I '$D(^TIU(8925.1,IFILEDA,0)) S MISSANS=IFILEDA
|
---|
17 | Q MISSANS
|
---|
18 | ;
|
---|
19 | ANCESTOR(FILEDA,NODE0,ANCESTOR,DOCFLAG) ; Module traces ancestors of FILEDA,
|
---|
20 | ;creates array ANCESTOR,
|
---|
21 | ; where ANCESTOR(0)=FILEDA,
|
---|
22 | ; where ANCESTOR(1)=Parent IFN of FILEDA,
|
---|
23 | ; ANCESTOR(2)=Parent IFN of ANCESTOR(1)
|
---|
24 | ; ...
|
---|
25 | ; ANCESTOR(last subscript)=IFN of oldest ancestor of FILEDA if
|
---|
26 | ; '$G(DOCFLAG)
|
---|
27 | ; OR
|
---|
28 | ; IFN of oldest ancestor of FILEDA NOT
|
---|
29 | ; OF TYPE DC OR CL if $G(DOCFLAG)
|
---|
30 | ; Don't stop the array for problems like bad type, no type, type object.
|
---|
31 | ; If DOCFLAG, DON'T GET DC or CL; don't want array to mistakenly
|
---|
32 | ;go all the way to CLinical Documents.
|
---|
33 | ; Array may not EXIST if DOCFLAG
|
---|
34 | ; Requires FILEDA, NODE0= 0 Node;
|
---|
35 | ; DOCFLAG optional, 0 or 1
|
---|
36 | N TIUI,QUIT,ANODE0
|
---|
37 | S DOCFLAG=+$G(DOCFLAG)
|
---|
38 | I DOCFLAG,($P(NODE0,U,4)="DC")!($P(NODE0,U,4)="CL") G ANCEX
|
---|
39 | S TIUI=0,ANCESTOR(0)=FILEDA
|
---|
40 | F D Q:$G(QUIT)
|
---|
41 | . S ANCESTOR(TIUI+1)=$O(^TIU(8925.1,"AD",ANCESTOR(TIUI),0))
|
---|
42 | . I 'ANCESTOR(TIUI+1) K ANCESTOR(TIUI+1) S QUIT=1 Q
|
---|
43 | . I DOCFLAG S ANODE0=^TIU(8925.1,ANCESTOR(TIUI+1),0) I ($P(ANODE0,U,4)="DC")!($P(ANODE0,U,4)="CL") K ANCESTOR(TIUI+1) S QUIT=1 Q
|
---|
44 | . S TIUI=TIUI+1
|
---|
45 | ANCEX Q
|
---|
46 | ;
|
---|
47 | ORPHAN(FILEDA,NODE0,ANCESTOR) ; Function traces ancestors of FILEDA,
|
---|
48 | ; Returns NA if FILEDA is Object or Shared Component,
|
---|
49 | ; NO if NOT NA AND FILEDA belongs to Clinical Docmts Hierarchy,
|
---|
50 | ; YES if NOT NA, AND doesn't belong.
|
---|
51 | ; Requires FILEDA, NODE0= 0 Node;
|
---|
52 | N ORPHAN,LAST
|
---|
53 | I $P(NODE0,U,4)="O" S ORPHAN="NA" G ORPHX
|
---|
54 | I '$D(ANCESTOR) D ANCESTOR(FILEDA,NODE0,.ANCESTOR)
|
---|
55 | I '$D(^TMP("TIUF",$J,"CLINDOC")) D G:Y=-1 ORPHX
|
---|
56 | . N DIC,X,Y
|
---|
57 | . S DIC=8925.1,DIC(0)="X",X="CLINICAL DOCUMENTS" D ^DIC
|
---|
58 | . I Y=-1 S ORPHAN="UNKNOWN" Q
|
---|
59 | . S ^TMP("TIUF",$J,"CLINDOC")=+Y
|
---|
60 | S LAST=$O(ANCESTOR(100),-1) I ANCESTOR(LAST)=^TMP("TIUF",$J,"CLINDOC") S ORPHAN="NO" G ORPHX
|
---|
61 | S ORPHAN="YES"
|
---|
62 | ORPHX Q ORPHAN
|
---|
63 | ;
|
---|
64 | STUFFLDS(FILEDA,PFILEDA) ; Stuff fields .03, .04 (tries), .07, [.1]
|
---|
65 | ;for 8925.1 entry FILEDA.
|
---|
66 | ; Requires FILEDA.
|
---|
67 | ; Requires TIUFTLST as set in TYPELIST^TIUFLF7
|
---|
68 | ; Requires PFILEDA if entry has prospective (as in Create and Add Item)
|
---|
69 | ;or actual parent in order to try to stuff Type.
|
---|
70 | ; Stuffs .03 Print Name = First 60 chars of .01 Name if not from copy
|
---|
71 | ;action.
|
---|
72 | ; Stuffs .04 Type if only 1 possible type in TIUFTLST (because of parent
|
---|
73 | ;or duplicates or option e.g. create objects).
|
---|
74 | ; Stuffs .07 Status = Inactive.
|
---|
75 | ; If receives parent PFILEDA, parent is Shared, then
|
---|
76 | ;stuffs .1 Shared = 1
|
---|
77 | ; Should Lock FILEDA before calling STUFFLDS.
|
---|
78 | N DIE,DA,DR,Y,NAME,PRINTDR,TYPEDR,STATUSDR,SHAREDR
|
---|
79 | N NATL,NATLDR,NODE0,TYPE
|
---|
80 | I '$G(PFILEDA) S PFILEDA=0
|
---|
81 | S DIE=8925.1,DA=FILEDA
|
---|
82 | S NODE0=^TIU(8925.1,FILEDA,0),NAME=$P(NODE0,U),PRINTDR=".03///^S X=NAME"
|
---|
83 | I $L(TIUFTLST,U)=3 S TYPE=$P(TIUFTLST,U,2),TYPEDR=".04////^S X=TYPE"
|
---|
84 | S STATUSDR=".07///INACTIVE"
|
---|
85 | S SHAREDR=".1////1"
|
---|
86 | I $G(XQORNOD(0))'["Copy" S DR=PRINTDR
|
---|
87 | I $G(TYPEDR) S DR=$S($D(DR):DR_";"_TYPEDR,1:TYPEDR)
|
---|
88 | S DR=$S($D(DR):DR_";"_STATUSDR,1:STATUSDR)
|
---|
89 | I $P($G(^TIU(8925.1,PFILEDA,0)),U,10) S DR=DR_";"_SHAREDR
|
---|
90 | D ^DIE
|
---|
91 | STUFFX Q
|
---|
92 | ;
|
---|
93 | ADDTEN(PFILEDA,FILEDA,NODE0,TENDA) ; Add item FILEDA to 10 NODE of
|
---|
94 | ;File 8925.1 entry PFILEDA. Stuff item Menu Text
|
---|
95 | ; Requires PFILEDA = 8925.1 IFN of parent of FILEDA.
|
---|
96 | ; Requires FILEDA, Requires NODE0 = ^TIU(8925.1,FILEDA,0)
|
---|
97 | ; Returns TENDA = 10 node DA of new item.
|
---|
98 | ; Returns TENDA="" if fails lookup. Screen on fld 10, subfld .01
|
---|
99 | ;prevents lookup failure due to duplicate names by allowing only
|
---|
100 | ;FILEDA to pass screen.
|
---|
101 | ;Should Lock PFILEDA before calling ADDTEN.
|
---|
102 | N X,Y,DIE,DR,NAME,DA,DIC,DLAYGO,TIUFISCR,MSG,DUPITEM
|
---|
103 | S TENDA=""
|
---|
104 | I ('$G(PFILEDA))!('$G(FILEDA)) G ADDTX
|
---|
105 | S NAME=$P(NODE0,U)
|
---|
106 | I '$D(TIUFTLST) S DUPITEM=0,DUPITEM=$$DUPITEM^TIUFLF7(NAME,PFILEDA) I DUPITEM S MSG=" Can't add Item; Parent already has Item with the same Name" W !!,MSG,! G ADDTX ; possibly needed when called from TIU rather than from TIUF.
|
---|
107 | S X=""""_NAME_""""
|
---|
108 | S DA(1)=PFILEDA,DLAYGO=8925.1
|
---|
109 | S TIUFISCR=FILEDA ; activates screen on fld 10, Subfld .01 in DD
|
---|
110 | S DIC="^TIU(8925.1,DA(1),10,",DIC(0)="L",DIC("P")=$P(^DD(8925.1,10,0),U,2)
|
---|
111 | D ^DIC S TENDA=+Y I Y=-1 S TENDA="" G ADDTX
|
---|
112 | K DIC
|
---|
113 | S DA=TENDA,DA(1)=PFILEDA D MTXTCHEC^TIUFT1(.DA,FILEDA,1)
|
---|
114 | ADDTX Q
|
---|
115 | ;
|
---|