BTIUFD ;IHS/CIA/MGH - LM Routine to display and edit description field ;26-Jan-2006 12:40;MGH
;;1.0;TEXT INTEGRATION UTILITIES;**1003**;NOV 04,2004
DESC(LASTLIN) ; EP Set Display Array TIUF3 starting with Description.
; Used by subtemplates D and X AND T
; See DSBASICS for required variables, etc.
N LINENO,CNT,TIUI,FILEDA,NAME,TIUFBLIN
S (TIUFBLIN,LINENO)=LASTLIN
G:TIUFNOD0("DESC")="" DSBOX ; NA
;If called to redisplay edited screen rather than by Init, kill array starting with Desc tx before resetting array.
S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
S FILEDA=TIUFINFO("FILEDA")
I TIUFSTMP'="X" D
.S LINENO=LINENO+1
.S ^TMP("TIUF3",$J,LINENO,0)=""
.S LINENO=LINENO+1
.S ^TMP("TIUF3",$J,LINENO,0)=" Description"
I TIUFNOD0("TYPE")="COMPONENT" S NAME=$P(TIUFNOD0,U),LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=NAME_":"
D SETDESC(FILEDA,.LINENO)
DSBOX K TIUFQ S LASTLIN=LINENO Q:$D(DTOUT)
Q
;
SETDESC(FILEDA,LASTLIN) ;Set description
N TIUFJ,TIUFI,LINE2
F TIUFJ=LASTLIN+1:1 Q:'$D(^TMP("TIUF3",$J,TIUFJ,0)) K ^TMP("TIUF3",$J,TIUFJ,0)
S LINE2=LASTLIN,TIUFI=0
F S TIUFI=$O(^TIU(8925.1,+FILEDA,9003130.1,TIUFI)) Q:+TIUFI'>0 D
.S LINE2=LINE2+1
.S ^TMP("TIUF3",$J,LINE2,0)=$G(^TIU(8925.1,+FILEDA,9003130.1,+TIUFI,0))
S LASTLIN=LINE2
SETBX Q
HASDESC(FILDEDA,NODEO) ; EP Function returns no or yes if description field exists
N ANS
S ANS=0
S ANS=$D(^TIU(8925.1,FILEDA,9003130.1,0))
I ANS>0 S ANS="1"
Q ANS
EDDES ; EP Entry point to edit the description field
; Requires CURRENT arrays TIUFINFO, TIUFNOD0.
N FILEDA,LINENO,CNTCHNG,TIUFXNOD,MSG,STATUS,DTOUT,DIRUT,DIROUT
S FILEDA=TIUFINFO("FILEDA")
S VALMBCK="R",TIUFXNOD=$G(XQORNOD(0))
S STATUS=$$STATWORD^TIUFLF5($P(^TIU(8925.1,FILEDA,0),U,7))
I STATUS'="INACTIVE" W !!,"Entry is not Inactive: Can't edit Description" D PAUSE^TIUFXHLX S VALMBCK="" G EDBOX
I TIUFSTMP="X" L +^TIU(8925.1,FILEDA):1 I '$T W !!," Another user is editing this entry.",! H 2 G EDBOX
D EDDESC(FILEDA,TIUFNOD0) G:$D(DTOUT) EDBOX
D NODE0ARR^TIUFLF(FILEDA,.TIUFNOD0) G:$D(DTOUT) EDBOX
; Update template D or X:
S LINENO=TIUFBLIN D DESC(.LINENO) G:$D(DTOUT) EDBOX S VALMCNT=LINENO
I TIUFTMPL="A" D AUPDATE^TIUFLA1(TIUFNOD0,FILEDA,.CNTCHNG) S:CNTCHNG TIUFVCN1=TIUFVCN1-1 ;doesn't match.
I "HC"[TIUFTMPL D LINEUP^TIUFLLM1(.TIUFINFO,TIUFTMPL)
EDBOX ;
I TIUFSTMP="X" L -^TIU(8925.1,+$G(FILEDA))
I $D(DTOUT) S VALMBCK="Q"
Q
EDDESC(FILEDA,NODE0) ; Edit Description of FILEDA.
; Requires FILEDA, NODE0 of FILEDA
D FULL^VALM1
N DIC,DWPK,DIWESUB
S DIC="^TIU(8925.1,"_FILEDA_",9003130.1,",DWPK=1
S DIWESUB=$P(NODE0,U)
D EN^DIWE
Q
BTIUFD ;IHS/CIA/MGH - LM Routine to display and edit description field ;26-Jan-2006 12:40;MGH
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1003**;NOV 04,2004
DESC(LASTLIN) ; EP Set Display Array TIUF3 starting with Description.
+1 ; Used by subtemplates D and X AND T
+2 ; See DSBASICS for required variables, etc.
+3 NEW LINENO,CNT,TIUI,FILEDA,NAME,TIUFBLIN
+4 SET (TIUFBLIN,LINENO)=LASTLIN
+5 ; NA
IF TIUFNOD0("DESC")=""
GOTO DSBOX
+6 ;If called to redisplay edited screen rather than by Init, kill array starting with Desc tx before resetting array.
+7 SET CNT=$ORDER(^TMP("TIUF3",$JOB,1000000),-1)
+8 FOR TIUI=LASTLIN+1:1:CNT
KILL ^TMP("TIUF3",$JOB,TIUI),^TMP("TIUF3IDX",$JOB,TIUI)
+9 SET FILEDA=TIUFINFO("FILEDA")
+10 IF TIUFSTMP'="X"
Begin DoDot:1
+11 SET LINENO=LINENO+1
+12 SET ^TMP("TIUF3",$JOB,LINENO,0)=""
+13 SET LINENO=LINENO+1
+14 SET ^TMP("TIUF3",$JOB,LINENO,0)=" Description"
End DoDot:1
+15 IF TIUFNOD0("TYPE")="COMPONENT"
SET NAME=$PIECE(TIUFNOD0,U)
SET LINENO=LINENO+1
SET ^TMP("TIUF3",$JOB,LINENO,0)=NAME_":"
+16 DO SETDESC(FILEDA,.LINENO)
DSBOX KILL TIUFQ
SET LASTLIN=LINENO
IF $DATA(DTOUT)
QUIT
+1 QUIT
+2 ;
SETDESC(FILEDA,LASTLIN) ;Set description
+1 NEW TIUFJ,TIUFI,LINE2
+2 FOR TIUFJ=LASTLIN+1:1
IF '$DATA(^TMP("TIUF3",$JOB,TIUFJ,0))
QUIT
KILL ^TMP("TIUF3",$JOB,TIUFJ,0)
+3 SET LINE2=LASTLIN
SET TIUFI=0
+4 FOR
SET TIUFI=$ORDER(^TIU(8925.1,+FILEDA,9003130.1,TIUFI))
IF +TIUFI'>0
QUIT
Begin DoDot:1
+5 SET LINE2=LINE2+1
+6 SET ^TMP("TIUF3",$JOB,LINE2,0)=$GET(^TIU(8925.1,+FILEDA,9003130.1,+TIUFI,0))
End DoDot:1
+7 SET LASTLIN=LINE2
SETBX QUIT
HASDESC(FILDEDA,NODEO) ; EP Function returns no or yes if description field exists
+1 NEW ANS
+2 SET ANS=0
+3 SET ANS=$DATA(^TIU(8925.1,FILEDA,9003130.1,0))
+4 IF ANS>0
SET ANS="1"
+5 QUIT ANS
EDDES ; EP Entry point to edit the description field
+1 ; Requires CURRENT arrays TIUFINFO, TIUFNOD0.
+2 NEW FILEDA,LINENO,CNTCHNG,TIUFXNOD,MSG,STATUS,DTOUT,DIRUT,DIROUT
+3 SET FILEDA=TIUFINFO("FILEDA")
+4 SET VALMBCK="R"
SET TIUFXNOD=$GET(XQORNOD(0))
+5 SET STATUS=$$STATWORD^TIUFLF5($PIECE(^TIU(8925.1,FILEDA,0),U,7))
+6 IF STATUS'="INACTIVE"
WRITE !!,"Entry is not Inactive: Can't edit Description"
DO PAUSE^TIUFXHLX
SET VALMBCK=""
GOTO EDBOX
+7 IF TIUFSTMP="X"
LOCK +^TIU(8925.1,FILEDA):1
IF '$TEST
WRITE !!," Another user is editing this entry.",!
HANG 2
GOTO EDBOX
+8 DO EDDESC(FILEDA,TIUFNOD0)
IF $DATA(DTOUT)
GOTO EDBOX
+9 DO NODE0ARR^TIUFLF(FILEDA,.TIUFNOD0)
IF $DATA(DTOUT)
GOTO EDBOX
+10 ; Update template D or X:
+11 SET LINENO=TIUFBLIN
DO DESC(.LINENO)
IF $DATA(DTOUT)
GOTO EDBOX
SET VALMCNT=LINENO
+12 ;doesn't match.
IF TIUFTMPL="A"
DO AUPDATE^TIUFLA1(TIUFNOD0,FILEDA,.CNTCHNG)
IF CNTCHNG
SET TIUFVCN1=TIUFVCN1-1
+13 IF "HC"[TIUFTMPL
DO LINEUP^TIUFLLM1(.TIUFINFO,TIUFTMPL)
EDBOX ;
+1 IF TIUFSTMP="X"
LOCK -^TIU(8925.1,+$GET(FILEDA))
+2 IF $DATA(DTOUT)
SET VALMBCK="Q"
+3 QUIT
EDDESC(FILEDA,NODE0) ; Edit Description of FILEDA.
+1 ; Requires FILEDA, NODE0 of FILEDA
+2 DO FULL^VALM1
+3 NEW DIC,DWPK,DIWESUB
+4 SET DIC="^TIU(8925.1,"_FILEDA_",9003130.1,"
SET DWPK=1
+5 SET DIWESUB=$PIECE(NODE0,U)
+6 DO EN^DIWE
+7 QUIT
