source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFLF4.m@ 1080

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

revised back to 6/30/08 version
File size: 5.0 KB
Line 
1TIUFLF4 ; 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 ;
4NUMITEMS(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
8NUMIX Q ITEMSANS
9 ;
10MISSITEM(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 ;
19ANCESTOR(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
45ANCEX Q
46 ;
47ORPHAN(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"
62ORPHX Q ORPHAN
63 ;
64STUFFLDS(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
91STUFFX Q
92 ;
93ADDTEN(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)
114ADDTX Q
115 ;
Note: See TracBrowser for help on using the repository browser.