- 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 Feb 19, 2025@00:07:10 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 ;