TIUFH1 ; SLC/MAM - LM Template H (DDEF Hierarchy) Actions Expand/Collapse, Jump to DDEF (EXPDEF(ASK,FILEDA)), EXPAND1(EINFO), COLLAPSE(EINFO) ;10/2/97 21:44
;;1.0;TEXT INTEGRATION UTILITIES;**11**;Jun 20, 1997
;
EXPCOLL ; Template A Action Expand/Collapse
N INFO,OXPDLCNT,MISSITEM,FILEDA,MSG,TIUFXNOD,DTOUT,DIRUT,DIROUT
S VALMBCK="R",TIUFXNOD=$G(XQORNOD(0))
D EN^VALM2(TIUFXNOD,"SO") I '$O(VALMY(0)) S VALMBCK="" G EXPCX
S INFO=$G(^TMP("TIUF1IDX",$J,$O(VALMY(0)))) I 'INFO W !!," Missing List Manager Data; See IRM",! D PAUSE^TIUFXHLX S VALMBCK="Q" G EXPCX
S FILEDA=$P(INFO,U,2)
D PARSE^TIUFLLM(.INFO) S OXPDLCNT=INFO("XPDLCNT") ;Old XPDLCNT
I OXPDLCNT D COLLAPSE(.INFO) S VALMCNT=VALMCNT-OXPDLCNT G EXPCX
I '$O(^TIU(8925.1,FILEDA,10,0)) S VALMBCK="",MSG=" Entry has no Items to Expand/Collapse" W !!,MSG,! H 1 G EXPCX
S MISSITEM=$$MISSITEM^TIUFLF4(FILEDA) I MISSITEM W !!," Can't Expand/Collapse: File Entry "_FILEDA_" Has Nonexistent Item "_MISSITEM_"; See IRM.",! D PAUSE^TIUFXHLX S VALMBCK="" G EXPCX
D EXPAND1(.INFO)
S VALMCNT=VALMCNT+INFO("XPDLCNT")
I (+INFO+INFO("XPDLCNT"))>(VALMBG+VALM("LINES")-1) S VALMBG=+INFO
EXPCX I $D(DTOUT) S VALMBCK="Q"
Q
;
EXPDEF(ASK,FILEDA) ; If ASK, Template H action Jump to Document Def; else Expand to show entry FILEDA
; Assumes Docmt Def except Shared Components have at most 1 parent
; Requires ASK=1 to ask which entry to jump to, = 0 to not ask.
; Requires FILEDA if ASK = 0.
N DIC,X,Y,INFO,NODE0,ORPHAN,PARENT,MSG,OXPDLCNT,TIUJ,ENTRYNO
N EINFO,PFILEDA,MISSITEM,TIUFXNOD,MSG1,LINENO,DTOUT,DIRUT,DIROUT
S TIUFXNOD=$G(XQORNOD(0))
I 'ASK G NOASK
N FILEDA S VALMBCK="R"
D FULL^VALM1
S DIC=8925.1,DIC(0)="AEMNQ"
ASK K PARENT,Y,MSG D ^DIC I Y=-1 G EXPDX
S FILEDA=+Y,NODE0=^TIU(8925.1,FILEDA,0)
S ORPHAN=$$ORPHAN^TIUFLF4(FILEDA,NODE0,.PARENT)
I $P(NODE0,U,4)="O" S MSG=" Objects are not in the Hierarchy: Use SORT Option"
I $P(NODE0,U,10) S MSG=" Shared Components can occur more than once in the hierarchy; Can't Jump to",MSG1="them. To find them, use SORT Option. Edit/View shows their parents."
I ORPHAN="YES" S MSG=" Orphans are not in the Hierarchy: Use SORT Option"
I $D(MSG) W !!,MSG,! W:$D(MSG1) MSG1 K MSG,MSG1 G ASK
NOASK S INFO=^TMP("TIUF1IDX",$J,1) D PARSE^TIUFLLM(.INFO)
I 'ASK S NODE0=^TIU(8925.1,FILEDA,0),ORPHAN=$$ORPHAN^TIUFLF4(FILEDA,NODE0,.PARENT)
S OXPDLCNT=INFO("XPDLCNT") ;Original XPDLCNT
D COLLAPSE(.INFO) S VALMCNT=VALMCNT-OXPDLCNT
F TIUJ=$O(PARENT(1000),-1):-1:1 D I MISSITEM G EXPDX
. S ENTRYNO=$O(^TMP("TIUF1IDX",$J,"DAF",PARENT(TIUJ),0))
. S EINFO=^TMP("TIUF1IDX",$J,ENTRYNO)
. D PARSE^TIUFLLM(.EINFO) S PFILEDA=$P(EINFO,U,2)
. S MISSITEM=$$MISSITEM^TIUFLF4(PFILEDA)
. I MISSITEM W !! W $S(ASK:" Can't Jump",1:"Can't expand to show "_$P(NODE0,U)),": File Entry "_PFILEDA_" Has Nonexistent Item "_MISSITEM_"; See IRM",! D PAUSE^TIUFXHLX Q
. D EXPAND1(.EINFO) S VALMCNT=VALMCNT+EINFO("XPDLCNT")
. Q
S LINENO=$O(^TMP("TIUF1IDX",$J,"DAF",PARENT(0),0))
I ASK,LINENO<VALMBG!(LINENO>(VALMBG+VALM("LINES")-1)) S VALMBG=LINENO
EXPDX I ASK D RESET^TIUFXHLX S VALMBCK="R" I $D(DTOUT) S VALMBCK="Q"
Q
;
COLLAPSE(EINFO) ; Collapse ENTRYNO
; Requires EINFO array, where EINFO = ^TMP("TIUFIDX,$J,ENTRYNO), and
;where EINFO array is as set in PARSE^TIUFLLM(EINFO).
; Requires TIUFTMPL.
; Updates array EINFO; Does NOT update VALMCNT.
I ($D(EINFO)'=11) G COLLX
I 'EINFO("XPDLCNT") G COLLX
D UPDATE^TIUFLLM1(TIUFTMPL,-EINFO("XPDLCNT"),+EINFO,.EINFO)
COLLX ;
Q
;
EXPAND1(EINFO) ; Set items of List Manager array entry ENTRYNO into
;LM array (ie., expands entry); Updates Plus in front of ENTRYNO.
; Does NOT update IN USE Column.
; Requires EINFO array, where EINFO = ^TMP("TIUFIDX,$J,ENTRYNO), and
;where EINFO array is as set in PARSE^TIUFLLM(EINFO).
; Requires TIUFTMPL.
; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
; Updates array EINFO.
; Must check that items exist in file BEFORE calling EXPAND1
N OLDLNO,LINENO,TIUREC
S (OLDLNO,LINENO)=+EINFO
D BUFITEMS^TIUFLT(TIUFTMPL,.EINFO,.LINENO)
;If no items, update +, QUIT:
I LINENO=OLDLNO Q:TIUFTMPL="C" S TIUREC=^TMP("TIUF1",$J,+EINFO,0),TIUREC=$$PLUSUP^TIUFLLM(.EINFO,TIUREC),^TMP("TIUF1",$J,+EINFO,0)=TIUREC Q
; Set Buffer items into LM Template array, update entry being expanded:
D UPDATE^TIUFLLM1(TIUFTMPL,LINENO-OLDLNO,OLDLNO,.EINFO)
EXPAX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFH1 4453 printed Apr 09, 2024@21:41:25 Page 2
TIUFH1 ; SLC/MAM - LM Template H (DDEF Hierarchy) Actions Expand/Collapse, Jump to DDEF (EXPDEF(ASK,FILEDA)), EXPAND1(EINFO), COLLAPSE(EINFO) ;10/2/97 21:44
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**11**;Jun 20, 1997
+2 ;
EXPCOLL ; Template A Action Expand/Collapse
+1 NEW INFO,OXPDLCNT,MISSITEM,FILEDA,MSG,TIUFXNOD,DTOUT,DIRUT,DIROUT
+2 SET VALMBCK="R"
SET TIUFXNOD=$GET(XQORNOD(0))
+3 DO EN^VALM2(TIUFXNOD,"SO")
IF '$ORDER(VALMY(0))
SET VALMBCK=""
GOTO EXPCX
+4 SET INFO=$GET(^TMP("TIUF1IDX",$JOB,$ORDER(VALMY(0))))
IF 'INFO
WRITE !!," Missing List Manager Data; See IRM",!
DO PAUSE^TIUFXHLX
SET VALMBCK="Q"
GOTO EXPCX
+5 SET FILEDA=$PIECE(INFO,U,2)
+6 ;Old XPDLCNT
DO PARSE^TIUFLLM(.INFO)
SET OXPDLCNT=INFO("XPDLCNT")
+7 IF OXPDLCNT
DO COLLAPSE(.INFO)
SET VALMCNT=VALMCNT-OXPDLCNT
GOTO EXPCX
+8 IF '$ORDER(^TIU(8925.1,FILEDA,10,0))
SET VALMBCK=""
SET MSG=" Entry has no Items to Expand/Collapse"
WRITE !!,MSG,!
HANG 1
GOTO EXPCX
+9 SET MISSITEM=$$MISSITEM^TIUFLF4(FILEDA)
IF MISSITEM
WRITE !!," Can't Expand/Collapse: File Entry "_FILEDA_" Has Nonexistent Item "_MISSITEM_"; See IRM.",!
DO PAUSE^TIUFXHLX
SET VALMBCK=""
GOTO EXPCX
+10 DO EXPAND1(.INFO)
+11 SET VALMCNT=VALMCNT+INFO("XPDLCNT")
+12 IF (+INFO+INFO("XPDLCNT"))>(VALMBG+VALM("LINES")-1)
SET VALMBG=+INFO
EXPCX IF $DATA(DTOUT)
SET VALMBCK="Q"
+1 QUIT
+2 ;
EXPDEF(ASK,FILEDA) ; If ASK, Template H action Jump to Document Def; else Expand to show entry FILEDA
+1 ; Assumes Docmt Def except Shared Components have at most 1 parent
+2 ; Requires ASK=1 to ask which entry to jump to, = 0 to not ask.
+3 ; Requires FILEDA if ASK = 0.
+4 NEW DIC,X,Y,INFO,NODE0,ORPHAN,PARENT,MSG,OXPDLCNT,TIUJ,ENTRYNO
+5 NEW EINFO,PFILEDA,MISSITEM,TIUFXNOD,MSG1,LINENO,DTOUT,DIRUT,DIROUT
+6 SET TIUFXNOD=$GET(XQORNOD(0))
+7 IF 'ASK
GOTO NOASK
+8 NEW FILEDA
SET VALMBCK="R"
+9 DO FULL^VALM1
+10 SET DIC=8925.1
SET DIC(0)="AEMNQ"
ASK KILL PARENT,Y,MSG
DO ^DIC
IF Y=-1
GOTO EXPDX
+1 SET FILEDA=+Y
SET NODE0=^TIU(8925.1,FILEDA,0)
+2 SET ORPHAN=$$ORPHAN^TIUFLF4(FILEDA,NODE0,.PARENT)
+3 IF $PIECE(NODE0,U,4)="O"
SET MSG=" Objects are not in the Hierarchy: Use SORT Option"
+4 IF $PIECE(NODE0,U,10)
SET MSG=" Shared Components can occur more than once in the hierarchy; Can't Jump to"
SET MSG1="them. To find them, use SORT Option. Edit/View shows their parents."
+5 IF ORPHAN="YES"
SET MSG=" Orphans are not in the Hierarchy: Use SORT Option"
+6 IF $DATA(MSG)
WRITE !!,MSG,!
if $DATA(MSG1)
WRITE MSG1
KILL MSG,MSG1
GOTO ASK
NOASK SET INFO=^TMP("TIUF1IDX",$JOB,1)
DO PARSE^TIUFLLM(.INFO)
+1 IF 'ASK
SET NODE0=^TIU(8925.1,FILEDA,0)
SET ORPHAN=$$ORPHAN^TIUFLF4(FILEDA,NODE0,.PARENT)
+2 ;Original XPDLCNT
SET OXPDLCNT=INFO("XPDLCNT")
+3 DO COLLAPSE(.INFO)
SET VALMCNT=VALMCNT-OXPDLCNT
+4 FOR TIUJ=$ORDER(PARENT(1000),-1):-1:1
Begin DoDot:1
+5 SET ENTRYNO=$ORDER(^TMP("TIUF1IDX",$JOB,"DAF",PARENT(TIUJ),0))
+6 SET EINFO=^TMP("TIUF1IDX",$JOB,ENTRYNO)
+7 DO PARSE^TIUFLLM(.EINFO)
SET PFILEDA=$PIECE(EINFO,U,2)
+8 SET MISSITEM=$$MISSITEM^TIUFLF4(PFILEDA)
+9 IF MISSITEM
WRITE !!
WRITE $SELECT(ASK:" Can't Jump",1:"Can't expand to show "_$PIECE(NODE0,U)),": File Entry "_PFILEDA_" Has Nonexistent Item "_MISSITEM_"; See IRM",!
DO PAUSE^TIUFXHLX
QUIT
+10 DO EXPAND1(.EINFO)
SET VALMCNT=VALMCNT+EINFO("XPDLCNT")
+11 QUIT
End DoDot:1
IF MISSITEM
GOTO EXPDX
+12 SET LINENO=$ORDER(^TMP("TIUF1IDX",$JOB,"DAF",PARENT(0),0))
+13 IF ASK
IF LINENO<VALMBG!(LINENO>(VALMBG+VALM("LINES")-1))
SET VALMBG=LINENO
EXPDX IF ASK
DO RESET^TIUFXHLX
SET VALMBCK="R"
IF $DATA(DTOUT)
SET VALMBCK="Q"
+1 QUIT
+2 ;
COLLAPSE(EINFO) ; Collapse ENTRYNO
+1 ; Requires EINFO array, where EINFO = ^TMP("TIUFIDX,$J,ENTRYNO), and
+2 ;where EINFO array is as set in PARSE^TIUFLLM(EINFO).
+3 ; Requires TIUFTMPL.
+4 ; Updates array EINFO; Does NOT update VALMCNT.
+5 IF ($DATA(EINFO)'=11)
GOTO COLLX
+6 IF 'EINFO("XPDLCNT")
GOTO COLLX
+7 DO UPDATE^TIUFLLM1(TIUFTMPL,-EINFO("XPDLCNT"),+EINFO,.EINFO)
COLLX ;
+1 QUIT
+2 ;
EXPAND1(EINFO) ; Set items of List Manager array entry ENTRYNO into
+1 ;LM array (ie., expands entry); Updates Plus in front of ENTRYNO.
+2 ; Does NOT update IN USE Column.
+3 ; Requires EINFO array, where EINFO = ^TMP("TIUFIDX,$J,ENTRYNO), and
+4 ;where EINFO array is as set in PARSE^TIUFLLM(EINFO).
+5 ; Requires TIUFTMPL.
+6 ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
+7 ; Updates array EINFO.
+8 ; Must check that items exist in file BEFORE calling EXPAND1
+9 NEW OLDLNO,LINENO,TIUREC
+10 SET (OLDLNO,LINENO)=+EINFO
+11 DO BUFITEMS^TIUFLT(TIUFTMPL,.EINFO,.LINENO)
+12 ;If no items, update +, QUIT:
+13 IF LINENO=OLDLNO
if TIUFTMPL="C"
QUIT
SET TIUREC=^TMP("TIUF1",$JOB,+EINFO,0)
SET TIUREC=$$PLUSUP^TIUFLLM(.EINFO,TIUREC)
SET ^TMP("TIUF1",$JOB,+EINFO,0)=TIUREC
QUIT
+14 ; Set Buffer items into LM Template array, update entry being expanded:
+15 DO UPDATE^TIUFLLM1(TIUFTMPL,LINENO-OLDLNO,OLDLNO,.EINFO)
EXPAX ;
+1 QUIT
+2 ;
