source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIU182D1.m@ 1520

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1TIU182D1 ; 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"
5DELETE(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 ;
14PARENT(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"))
27PARENTX I 'PIEN!'$D(^TIU(8925.1,PIEN,0)) D
28 . S ^TMP("TIU182ERR",$J,NUM)="FINDPARENT"
29 Q PIEN
30 ;
31ADDITEM(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 ;
49FILEITEM(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 ;
59FILE(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 ;
70CREATE(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)
Note: See TracBrowser for help on using the repository browser.