| 1 | TIU182D1 ; SLC/MAM - After installing TIU*1*182 ; 05/20/2004
 | 
|---|
| 2 |  ;;1.0;Text Integration Utilities;**182**;Jun 20, 1997
 | 
|---|
| 3 |  ; External References
 | 
|---|
| 4 |  ;   DBIA 3409  ^USR(8930,"B"
 | 
|---|
| 5 | DELETE(TIUDA,PIEN,ITEMDA) ; Delete DDEF TIUDA; If parent PIEN and
 | 
|---|
| 6 |  ;Item IEN ITEMDA sent, first delete item from parent
 | 
|---|
| 7 |  N DA,DIK,X,Y,I
 | 
|---|
| 8 |  I $G(PIEN),$G(ITEMDA) D
 | 
|---|
| 9 |  . S DA(1)=PIEN,DA=ITEMDA,DIK="^TIU(8925.1,DA(1),10," D ^DIK
 | 
|---|
| 10 |  N DA,DIK
 | 
|---|
| 11 |  S DA=TIUDA,DIK="^TIU(8925.1," D ^DIK
 | 
|---|
| 12 |  Q
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 | PARENT(NUM) ; Return IEN of parent new DDEF should be added to
 | 
|---|
| 15 |  N PIEN,PNUM
 | 
|---|
| 16 |  ; Parent node has form:
 | 
|---|
| 17 |  ;   ^TMP("TIU182",$J,"DATA",NUM,PIEN) = IEN of parent if known, or
 | 
|---|
| 18 |  ;   ^TMP("TIU182",$J,"DATA",NUM,PNUM) = DDEF# of parent if not
 | 
|---|
| 19 |  S PIEN=$G(^TMP("TIU182",$J,"DATA",NUM,"PIEN"))
 | 
|---|
| 20 |  ; -- If parent IEN is known, we're done:
 | 
|---|
| 21 |  I PIEN G PARENTX
 | 
|---|
| 22 |  ; -- If not, get DDEF# of parent
 | 
|---|
| 23 |  S PNUM=+$G(^TMP("TIU182",$J,"DATA",NUM,"PNUM"))
 | 
|---|
| 24 |  ; -- Get Parent IEN from "DONE" node, which was set
 | 
|---|
| 25 |  ;    when parent was created:
 | 
|---|
| 26 |  S PIEN=+$G(^XTMP("TIU182",PNUM,"DONE"))
 | 
|---|
| 27 | PARENTX I 'PIEN!'$D(^TIU(8925.1,PIEN,0)) D
 | 
|---|
| 28 |  . S ^TMP("TIU182ERR",$J,NUM)="FINDPARENT"
 | 
|---|
| 29 |  Q PIEN
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 | ADDITEM(NUM,TIUDA,PIEN)  ; Add DDEF TIUDA to Parent; Return Item IEN
 | 
|---|
| 32 |  N MENUTXT,TIUFPRIV,TIUFISCR
 | 
|---|
| 33 |  N DIE,DR
 | 
|---|
| 34 |  S TIUFPRIV=1
 | 
|---|
| 35 |  N DA,DIC,DLAYGO,X,Y
 | 
|---|
| 36 |  N I,DIY
 | 
|---|
| 37 |  S DA(1)=PIEN
 | 
|---|
| 38 |  S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="LX"
 | 
|---|
| 39 |  S DLAYGO=8925.14
 | 
|---|
| 40 |  ; -- If TIUDA is say, x, and Parent has x as IFN in Item subfile,
 | 
|---|
| 41 |  ;    code finds item x under parent instead of creating a new item,
 | 
|---|
| 42 |  ;    so don't use "`"_TIUDA:
 | 
|---|
| 43 |  S X=^TMP("TIU182",$J,"BASICS",NUM,"NAME")
 | 
|---|
| 44 |  ; -- Make sure the DDEF it adds is TIUDA and not another w same name:
 | 
|---|
| 45 |  S TIUFISCR=TIUDA ; activates item screen on fld 10, Subfld .01 in DD
 | 
|---|
| 46 |  D ^DIC I Y'>0!($P(Y,U,3)'=1) S ^TMP("TIU182ERR",$J,NUM)="ADDITEM"
 | 
|---|
| 47 |  Q Y
 | 
|---|
| 48 |  ;
 | 
|---|
| 49 | FILEITEM(NUM,PIEN,ITEMDA) ; File Menu Text for DDEF item ITEMDA
 | 
|---|
| 50 |  ;under parent
 | 
|---|
| 51 |  N TIUFPRIV,MENUTXT,ITEMFDA
 | 
|---|
| 52 |  K TIUIERR
 | 
|---|
| 53 |  S TIUFPRIV=1,MENUTXT=$G(^TMP("TIU182",$J,"DATA",NUM,"MENUTXT"))
 | 
|---|
| 54 |  S ITEMFDA(8925.14,ITEMDA_","_PIEN_",",4)=MENUTXT
 | 
|---|
| 55 |  D FILE^DIE("TE","ITEMFDA","TIUIERR")
 | 
|---|
| 56 |  I $D(TIUIERR) S ^TMP("TIU182ERR",$J,NUM)="FILEITEM"
 | 
|---|
| 57 |  Q
 | 
|---|
| 58 |  ;
 | 
|---|
| 59 | FILE(NUM,TIUDA) ; File fields for new DDEF TIUDA
 | 
|---|
| 60 |  ; Files ALL FIELDS set in "FILEDATA" nodes of ^TMP:
 | 
|---|
| 61 |  ;   ^TMP("TIU182",$J,"FILEDATA",NUM,Field#)
 | 
|---|
| 62 |  N TIUFPRIV,FDA
 | 
|---|
| 63 |  K ^TMP("DIERR",$J)
 | 
|---|
| 64 |  S TIUFPRIV=1
 | 
|---|
| 65 |  M FDA(8925.1,TIUDA_",")=^TMP("TIU182",$J,"FILEDATA",NUM)
 | 
|---|
| 66 |  D FILE^DIE("TE","FDA")
 | 
|---|
| 67 |  I $D(^TMP("DIERR",$J)) S ^TMP("TIU182ERR",$J,NUM)="FILE"
 | 
|---|
| 68 |  Q
 | 
|---|
| 69 |  ;
 | 
|---|
| 70 | CREATE(NUM) ; Create new DDEF entry
 | 
|---|
| 71 |  N DIC,DLAYGO,DA,X,Y
 | 
|---|
| 72 |  S DIC="^TIU(8925.1,",DLAYGO=8925.1
 | 
|---|
| 73 |  S DIC(0)="LX",X=^TMP("TIU182",$J,"BASICS",NUM,"NAME")
 | 
|---|
| 74 |  S DIC("S")="I $P(^(0),U,4)="_""""_^TMP("TIU182",$J,"BASICS",NUM,"INTTYPE")_""""
 | 
|---|
| 75 |  D ^DIC
 | 
|---|
| 76 |  I $P($G(Y),U,3)'=1 S ^TMP("TIU182ERR",$J,NUM)="CREATE"
 | 
|---|
| 77 |  Q $G(Y)
 | 
|---|