- 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
