TIU182D1 ; SLC/MAM - After installing TIU*1*182 ; 05/20/2004
;;1.0;Text Integration Utilities;**182**;Jun 20, 1997
; External References
; DBIA 3409 ^USR(8930,"B"
DELETE(TIUDA,PIEN,ITEMDA) ; Delete DDEF TIUDA; If parent PIEN and
;Item IEN ITEMDA sent, first delete item from parent
N DA,DIK,X,Y,I
I $G(PIEN),$G(ITEMDA) D
. S DA(1)=PIEN,DA=ITEMDA,DIK="^TIU(8925.1,DA(1),10," D ^DIK
N DA,DIK
S DA=TIUDA,DIK="^TIU(8925.1," D ^DIK
Q
;
PARENT(NUM) ; Return IEN of parent new DDEF should be added to
N PIEN,PNUM
; Parent node has form:
; ^TMP("TIU182",$J,"DATA",NUM,PIEN) = IEN of parent if known, or
; ^TMP("TIU182",$J,"DATA",NUM,PNUM) = DDEF# of parent if not
S PIEN=$G(^TMP("TIU182",$J,"DATA",NUM,"PIEN"))
; -- If parent IEN is known, we're done:
I PIEN G PARENTX
; -- If not, get DDEF# of parent
S PNUM=+$G(^TMP("TIU182",$J,"DATA",NUM,"PNUM"))
; -- Get Parent IEN from "DONE" node, which was set
; when parent was created:
S PIEN=+$G(^XTMP("TIU182",PNUM,"DONE"))
PARENTX I 'PIEN!'$D(^TIU(8925.1,PIEN,0)) D
. S ^TMP("TIU182ERR",$J,NUM)="FINDPARENT"
Q PIEN
;
ADDITEM(NUM,TIUDA,PIEN) ; Add DDEF TIUDA to Parent; Return Item IEN
N MENUTXT,TIUFPRIV,TIUFISCR
N DIE,DR
S TIUFPRIV=1
N DA,DIC,DLAYGO,X,Y
N I,DIY
S DA(1)=PIEN
S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="LX"
S DLAYGO=8925.14
; -- If TIUDA is say, x, and Parent has x as IFN in Item subfile,
; code finds item x under parent instead of creating a new item,
; so don't use "`"_TIUDA:
S X=^TMP("TIU182",$J,"BASICS",NUM,"NAME")
; -- Make sure the DDEF it adds is TIUDA and not another w same name:
S TIUFISCR=TIUDA ; activates item screen on fld 10, Subfld .01 in DD
D ^DIC I Y'>0!($P(Y,U,3)'=1) S ^TMP("TIU182ERR",$J,NUM)="ADDITEM"
Q Y
;
FILEITEM(NUM,PIEN,ITEMDA) ; File Menu Text for DDEF item ITEMDA
;under parent
N TIUFPRIV,MENUTXT,ITEMFDA
K TIUIERR
S TIUFPRIV=1,MENUTXT=$G(^TMP("TIU182",$J,"DATA",NUM,"MENUTXT"))
S ITEMFDA(8925.14,ITEMDA_","_PIEN_",",4)=MENUTXT
D FILE^DIE("TE","ITEMFDA","TIUIERR")
I $D(TIUIERR) S ^TMP("TIU182ERR",$J,NUM)="FILEITEM"
Q
;
FILE(NUM,TIUDA) ; File fields for new DDEF TIUDA
; Files ALL FIELDS set in "FILEDATA" nodes of ^TMP:
; ^TMP("TIU182",$J,"FILEDATA",NUM,Field#)
N TIUFPRIV,FDA
K ^TMP("DIERR",$J)
S TIUFPRIV=1
M FDA(8925.1,TIUDA_",")=^TMP("TIU182",$J,"FILEDATA",NUM)
D FILE^DIE("TE","FDA")
I $D(^TMP("DIERR",$J)) S ^TMP("TIU182ERR",$J,NUM)="FILE"
Q
;
CREATE(NUM) ; Create new DDEF entry
N DIC,DLAYGO,DA,X,Y
S DIC="^TIU(8925.1,",DLAYGO=8925.1
S DIC(0)="LX",X=^TMP("TIU182",$J,"BASICS",NUM,"NAME")
S DIC("S")="I $P(^(0),U,4)="_""""_^TMP("TIU182",$J,"BASICS",NUM,"INTTYPE")_""""
D ^DIC
I $P($G(Y),U,3)'=1 S ^TMP("TIU182ERR",$J,NUM)="CREATE"
Q $G(Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIU182D1 2799 printed Dec 13, 2024@02:38:23 Page 2
TIU182D1 ; SLC/MAM - After installing TIU*1*182 ; 05/20/2004
+1 ;;1.0;Text Integration Utilities;**182**;Jun 20, 1997
+2 ; External References
+3 ; DBIA 3409 ^USR(8930,"B"
DELETE(TIUDA,PIEN,ITEMDA) ; Delete DDEF TIUDA; If parent PIEN and
+1 ;Item IEN ITEMDA sent, first delete item from parent
+2 NEW DA,DIK,X,Y,I
+3 IF $GET(PIEN)
IF $GET(ITEMDA)
Begin DoDot:1
+4 SET DA(1)=PIEN
SET DA=ITEMDA
SET DIK="^TIU(8925.1,DA(1),10,"
DO ^DIK
End DoDot:1
+5 NEW DA,DIK
+6 SET DA=TIUDA
SET DIK="^TIU(8925.1,"
DO ^DIK
+7 QUIT
+8 ;
PARENT(NUM) ; Return IEN of parent new DDEF should be added to
+1 NEW PIEN,PNUM
+2 ; Parent node has form:
+3 ; ^TMP("TIU182",$J,"DATA",NUM,PIEN) = IEN of parent if known, or
+4 ; ^TMP("TIU182",$J,"DATA",NUM,PNUM) = DDEF# of parent if not
+5 SET PIEN=$GET(^TMP("TIU182",$JOB,"DATA",NUM,"PIEN"))
+6 ; -- If parent IEN is known, we're done:
+7 IF PIEN
GOTO PARENTX
+8 ; -- If not, get DDEF# of parent
+9 SET PNUM=+$GET(^TMP("TIU182",$JOB,"DATA",NUM,"PNUM"))
+10 ; -- Get Parent IEN from "DONE" node, which was set
+11 ; when parent was created:
+12 SET PIEN=+$GET(^XTMP("TIU182",PNUM,"DONE"))
PARENTX IF 'PIEN!'$DATA(^TIU(8925.1,PIEN,0))
Begin DoDot:1
+1 SET ^TMP("TIU182ERR",$JOB,NUM)="FINDPARENT"
End DoDot:1
+2 QUIT PIEN
+3 ;
ADDITEM(NUM,TIUDA,PIEN) ; Add DDEF TIUDA to Parent; Return Item IEN
+1 NEW MENUTXT,TIUFPRIV,TIUFISCR
+2 NEW DIE,DR
+3 SET TIUFPRIV=1
+4 NEW DA,DIC,DLAYGO,X,Y
+5 NEW I,DIY
+6 SET DA(1)=PIEN
+7 SET DIC="^TIU(8925.1,"_DA(1)_",10,"
SET DIC(0)="LX"
+8 SET DLAYGO=8925.14
+9 ; -- If TIUDA is say, x, and Parent has x as IFN in Item subfile,
+10 ; code finds item x under parent instead of creating a new item,
+11 ; so don't use "`"_TIUDA:
+12 SET X=^TMP("TIU182",$JOB,"BASICS",NUM,"NAME")
+13 ; -- Make sure the DDEF it adds is TIUDA and not another w same name:
+14 ; activates item screen on fld 10, Subfld .01 in DD
SET TIUFISCR=TIUDA
+15 DO ^DIC
IF Y'>0!($PIECE(Y,U,3)'=1)
SET ^TMP("TIU182ERR",$JOB,NUM)="ADDITEM"
+16 QUIT Y
+17 ;
FILEITEM(NUM,PIEN,ITEMDA) ; File Menu Text for DDEF item ITEMDA
+1 ;under parent
+2 NEW TIUFPRIV,MENUTXT,ITEMFDA
+3 KILL TIUIERR
+4 SET TIUFPRIV=1
SET MENUTXT=$GET(^TMP("TIU182",$JOB,"DATA",NUM,"MENUTXT"))
+5 SET ITEMFDA(8925.14,ITEMDA_","_PIEN_",",4)=MENUTXT
+6 DO FILE^DIE("TE","ITEMFDA","TIUIERR")
+7 IF $DATA(TIUIERR)
SET ^TMP("TIU182ERR",$JOB,NUM)="FILEITEM"
+8 QUIT
+9 ;
FILE(NUM,TIUDA) ; File fields for new DDEF TIUDA
+1 ; Files ALL FIELDS set in "FILEDATA" nodes of ^TMP:
+2 ; ^TMP("TIU182",$J,"FILEDATA",NUM,Field#)
+3 NEW TIUFPRIV,FDA
+4 KILL ^TMP("DIERR",$JOB)
+5 SET TIUFPRIV=1
+6 MERGE FDA(8925.1,TIUDA_",")=^TMP("TIU182",$JOB,"FILEDATA",NUM)
+7 DO FILE^DIE("TE","FDA")
+8 IF $DATA(^TMP("DIERR",$JOB))
SET ^TMP("TIU182ERR",$JOB,NUM)="FILE"
+9 QUIT
+10 ;
CREATE(NUM) ; Create new DDEF entry
+1 NEW DIC,DLAYGO,DA,X,Y
+2 SET DIC="^TIU(8925.1,"
SET DLAYGO=8925.1
+3 SET DIC(0)="LX"
SET X=^TMP("TIU182",$JOB,"BASICS",NUM,"NAME")
+4 SET DIC("S")="I $P(^(0),U,4)="_""""_^TMP("TIU182",$JOB,"BASICS",NUM,"INTTYPE")_""""
+5 DO ^DIC
+6 IF $PIECE($GET(Y),U,3)'=1
SET ^TMP("TIU182ERR",$JOB,NUM)="CREATE"
+7 QUIT $GET(Y)
