- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFLF4.m
r613 r623 1 TIUFLF4 2 ;;1.0;TEXT INTEGRATION UTILITIES;**11,43,236**;Jun 20, 1997;Build 2 3 4 NUMITEMS(FILEDA) 5 6 7 8 NUMIX 9 10 MISSITEM(FILEDA) 11 12 13 14 15 16 17 18 19 ANCESTOR(FILEDA,NODE0,ANCESTOR,DOCFLAG) 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 ANCEX 46 47 ORPHAN(FILEDA,NODE0,ANCESTOR) 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 ORPHX 63 64 STUFFLDS(FILEDA,PFILEDA) 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 STUFFX 92 93 ADDTEN(PFILEDA,FILEDA,NODE0,TENDA) 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 ADDTX 115 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
