- TIURECL ; SLC/PKR,JER - Expand/collapse LM views ;3/14/01
- ;;1.0;TEXT INTETRATION UTILITIES;**88,100**;Jun 20, 1997
- ;======================================================================
- COPYCL(LSTART,START,END) ;Copy elements of List into ^TMP("TMPLIST",$J),
- ;starting at START going to END.
- N IND,TEXT
- S ^TMP("TMPLIST",$J,0)=$G(@VALMAR@(0))
- S ^TMP("TMPLIST",$J,"TIURIDX0")=$G(^TMP("TIURIDX",$J,0))
- ; -- Copy numbered lines: --
- F IND=START:1:END D:$D(@VALMAR@(IND,0))
- . S LSTART=LSTART+1
- . S TEXT=@VALMAR@(IND,0)
- . S TEXT=$$SETFLD^VALM1(LSTART,TEXT,"NUMBER")
- . S ^TMP("TMPLIST",$J,LSTART)=TEXT_U_$P($G(^TMP("TIURIDX",$J,IND)),U,2,4)
- ; -- Copy other nodes, skipping "IDX", "IEN", "EXPAND",
- ; & "IDDATA", where I need >1 subscript: --
- S IND="A"
- F S IND=$O(@VALMAR@(IND)) Q:IND="" D
- . Q:$S(IND="IDX":1,IND="IEN":1,IND="EXPAND":1,IND="IDDATA":1,1:0)
- . S ^TMP("TMPLIST",$J,IND)=$G(@VALMAR@(IND))
- ; -- Copy "EXPAND" node: --
- S IND=0
- F S IND=$O(@VALMAR@("EXPAND",IND)) Q:IND="" D
- . S ^TMP("TMPLIST",$J,"EXPAND",IND)=$G(@VALMAR@("EXPAND",IND))
- ; -- Copy "IDDATA" node: --
- S IND=0
- F S IND=$O(@VALMAR@("IDDATA",IND)) Q:IND="" D
- . S ^TMP("TMPLIST",$J,"IDDATA",IND)=$G(@VALMAR@("IDDATA",IND))
- ; -- Copy "IEN" node: --
- S IND=0
- F S IND=$O(@VALMAR@("IEN",IND)) Q:IND="" D
- . N TIUJ S TIUJ=0
- . F S TIUJ=$O(@VALMAR@("IEN",IND,TIUJ)) Q:+TIUJ'>0 D
- . . S ^TMP("TMPLIST",$J,"IEN",IND,TIUJ)=""
- Q LSTART
- ;
- ;======================================================================
- EC(VALMY) ;Expand or contract the tree view in VALMY.
- ;Make sure the request is valid.
- I '$$VEXREQ^TIURECL1(.VALMY) Q
- N TIUI
- S TIUI=""
- ; -- Traverse pick list in reverse to avoid collisions: --
- F S TIUI=$O(VALMY(TIUI),-1) Q:+TIUI'>0 D EC1(TIUI)
- Q
- ;
- ;======================================================================
- EC1(TIUI,HUSH) ; Expand a single List Element (line TIUI):
- ; ORIGPFIX = $$PREFIX^TIULA2
- ; = Indicators followed by space (if there are any).
- ; EX:"+< ", or "*+< ", etc.
- ; CURPFIX = Beginning characters of title/pt column, up to
- ; but not including title/pt itself.
- ; = Possible spacer characters (e.g. " |_"),
- ; followed by possible indicators_space
- ; (if there are any). If item is expanded,
- ; indicators +, <, or +< may be replaced
- ; with "-".
- ; EX: " |_- ", or " | |_", etc
- ; When getting indicators for new prefix, EC1 checks for changes
- ;in record being expanded (changes such as getting an addendum).
- ; EC1 updates prefix and ^TMP("TIURIDX",$J,listno) with such
- ;changes.
- ; EC1 does NOT update text of line, or ^TMP("TIUR",$J,"IDDATA",DA).
- N ORIGPFIX,CURPFIX,TIUGDATA,PRMSORT,NEWPFIX
- N TSTART,START,LISTNUM,REBUILD,TEXT
- N TIUDATA,TIUDA,TIUPICK
- S START=1,(REBUILD,TSTART)=0
- K ^TMP("TMPLIST",$J)
- S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)) Q:'+TIUDATA
- S LISTNUM=$P(TIUDATA,U,1)
- ; -- Retrieve DA, current prefix; get original prefix: --
- S TIUDA=$P(TIUDATA,U,2),CURPFIX=$P(TIUDATA,U,3)
- S ORIGPFIX=$$PREFIX^TIULA2(TIUDA)
- S NEWPFIX=$$UPPFIX^TIURL1(TIUDA,CURPFIX)
- ; ---- If docmt cannot be expanded or collapsed, say so and quit: ----
- I ORIGPFIX'["+",ORIGPFIX'["<",CURPFIX'["-" D Q
- . N MSG
- . D RESTORE^VALM10(TIUI)
- . I '+$G(HUSH) D
- . . S MSG="** Item #"_TIUI_" cannot be expanded/collapsed. **"
- . . D MSG^VALM10(MSG) H 2
- S TEXT=$G(@VALMAR@(LISTNUM,0))
- ; ---- If docmt not expanded & has addenda but no ID kids,
- ; expand to show adda: ----
- I CURPFIX'["-",ORIGPFIX["+",ORIGPFIX'["<" D
- . S REBUILD=1
- . ; -- Set lines (from beg to line before TIUI) into ^TMP("TMPLIST",$J):
- . S TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
- . S START=LISTNUM+1
- . ;-- Set line TIUI into ^TMP("TMPLIST",$J), updating flds NUMBER,
- . ; and TITLE or PATIENT, with new prefix and spacing: --
- . S TSTART=TSTART+1
- . S TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
- . S NEWPFIX=$S(NEWPFIX["+>":$TR(NEWPFIX,"+>","-"),1:$TR(NEWPFIX,"+","-"))
- . S TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
- . ; -- Save DA, prefixes, etc., for next time: --
- . S ^TMP("TMPLIST",$J,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
- . ; -- Insert addenda of TIUI: --
- . S TSTART=$$INSADD^TIURECL2(TSTART,TIUDA,NEWPFIX)
- . ; -- Update EXPAND index to compensate for insertion: --
- . I TIUI<+$O(@VALMAR@("EXPAND",""),-1) D BUMPEXP(TIUI,TSTART)
- . ; -- Set new EXPAND node: --
- . S @VALMAR@("EXPAND",TIUI)=TIUDA
- ; ---- If tree view can be collapsed, then collapse it: ----
- I CURPFIX["-" D
- . N TEMP,CONTRACT,LEVEL
- . S REBUILD=1
- . S TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
- . S TSTART=TSTART+1
- . S LEVEL=$L(TEXT,"|")
- . S TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
- . S TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
- . S ^TMP("TMPLIST",$J,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
- . S START=TIUI+1
- . S CONTRACT=1
- . F Q:'CONTRACT D
- .. S TEMP=$G(@VALMAR@(START,0))
- ..; -- Contract if at a higher level than the main line: --
- .. I TEMP["|",$L(TEMP,"|")>LEVEL S START=START+1
- .. E S CONTRACT=0
- . I TIUI<+$O(@VALMAR@("EXPAND",""),-1) D SUCKEXP(START,TSTART)
- . K @VALMAR@("EXPAND",TIUI),^TMP("TMPLIST",$J,"EXPAND",TIUI)
- ; ---- If docmt has ID kids & hasn't
- ; been expanded, then expand it to show ID kids: ----
- I CURPFIX'["-",ORIGPFIX["<" D
- . ; -- Retrieve ID entry order (from docmt parameter): --
- . ; (Entry order should be ok even if rest needs update.)
- . S TIUGDATA=^TMP("TIUR",$J,"IDDATA",TIUDA)
- . S PRMSORT=$P(TIUGDATA,U,4)
- . S REBUILD=1
- . S TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
- . S START=LISTNUM+1
- . S TSTART=TSTART+1
- . S TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
- . S NEWPFIX=$S(NEWPFIX["+<":$TR(NEWPFIX,"+<","-"),NEWPFIX["<":$TR(NEWPFIX,"<","-"),1:$TR(NEWPFIX,"+","-"))
- . S TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
- . S ^TMP("TMPLIST",$J,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
- . S TSTART=$$INSKIDS^TIURECL2(TSTART,TIUDA,NEWPFIX,PRMSORT)
- . S ^TMP("TMPLIST",$J,"IDDATA",TIUDA)=TIUGDATA
- . I TIUI<+$O(@VALMAR@("EXPAND",""),-1) D BUMPEXP(TIUI,TSTART)
- . ; -- Set new EXPAND node: --
- . S @VALMAR@("EXPAND",TIUI)=TIUDA
- ; -- Restore the original video attributes: --
- D RESTORE^VALM10(TIUI)
- I 'REBUILD Q
- ; ---- Add the rest of the list to ^TMP("TMPLIST",$J):
- S LISTNUM=$P(@VALMAR@(0),U,1)
- S TSTART=$$COPYCL(TSTART,START,LISTNUM)
- ; --Rebuild the LM ^TMP arrays: --
- K @VALMAR,^TMP("TIURIDX",$J)
- S VALMCNT=0
- S START=0,@VALMAR@(0)=^TMP("TMPLIST",$J,0)
- S ^TMP("TIURIDX",$J,0)=^TMP("TMPLIST",$J,"TIURIDX0")
- ; -- Rebuild numbered lines and IDX and TIURIDX nodes: --
- N CURPFX
- F S START=$O(^TMP("TMPLIST",$J,START)) Q:+START'>0 D
- . S VALMCNT=VALMCNT+1
- . S TEMP=^TMP("TMPLIST",$J,START)
- . S TEXT=$P(TEMP,U),TIUDA=$P(TEMP,U,2),CURPFX=$P(TEMP,U,3)
- . S @VALMAR@(START,0)=TEXT
- . D RESTORE^VALM10(START)
- . S @VALMAR@("IDX",START,START)=""
- . S ^TMP("TIURIDX",$J,START)=START_U_TIUDA_U_CURPFX
- . S @VALMAR@("IEN",TIUDA,START)=""
- S $P(@VALMAR@(0),U)=VALMCNT
- ; -- Rebuild other nodes: --
- S START="A"
- F S START=$O(^TMP("TMPLIST",$J,START)) Q:START="" D
- . Q:START="EXPAND"
- . Q:START="IDDATA"
- . Q:START="IEN"
- . S @VALMAR@(START)=$G(^TMP("TMPLIST",$J,START))
- ; -- Rebuild EXPAND node: --
- S START=0
- F S START=$O(^TMP("TMPLIST",$J,"EXPAND",START)) Q:+START'>0 D
- . S @VALMAR@("EXPAND",START)=$G(^TMP("TMPLIST",$J,"EXPAND",START))
- ; -- Rebuild IDDATA node: --
- S START=0
- F S START=$O(^TMP("TMPLIST",$J,"IDDATA",START)) Q:+START'>0 D
- . Q:'$D(@VALMAR@("IEN",START))
- . S @VALMAR@("IDDATA",START)=$G(^TMP("TMPLIST",$J,"IDDATA",START))
- ; -- Rebuild # node: --
- S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
- S @VALMAR@("#")=TIUPICK_U_"1:"_+$G(VALMCNT)
- ; -- Update # of documents in header: --
- K VALMHDR,^TMP("TMPLIST",$J)
- Q
- ;=======================================================================
- BUMPEXP(TIUI,TSTART) ; Bump EXPAND index to compensate for insertion
- N TIUJ,GAP S TIUJ="",GAP=TSTART-TIUI
- F S TIUJ=$O(@VALMAR@("EXPAND",TIUJ),-1) Q:TIUJ'>TIUI D
- . S @VALMAR@("EXPAND",TIUJ+GAP)=$G(@VALMAR@("EXPAND",TIUJ))
- . K @VALMAR@("EXPAND",TIUJ),^TMP("TMPLIST",$J,"EXPAND",TIUJ)
- Q
- ;=======================================================================
- SUCKEXP(START,TSTART) ; Remove EXPAND index to compensate for collapse
- N TIUJ,GAP S TIUJ=START,GAP=(START-TSTART)-1
- F S TIUJ=$O(@VALMAR@("EXPAND",TIUJ)) Q:TIUJ'>0 D
- . S @VALMAR@("EXPAND",TIUJ-GAP)=$G(@VALMAR@("EXPAND",TIUJ))
- . K @VALMAR@("EXPAND",TIUJ),^TMP("TMPLIST",$J,"EXPAND",TIUJ)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURECL 8643 printed Jan 18, 2025@03:46:23 Page 2
- TIURECL ; SLC/PKR,JER - Expand/collapse LM views ;3/14/01
- +1 ;;1.0;TEXT INTETRATION UTILITIES;**88,100**;Jun 20, 1997
- +2 ;======================================================================
- COPYCL(LSTART,START,END) ;Copy elements of List into ^TMP("TMPLIST",$J),
- +1 ;starting at START going to END.
- +2 NEW IND,TEXT
- +3 SET ^TMP("TMPLIST",$JOB,0)=$GET(@VALMAR@(0))
- +4 SET ^TMP("TMPLIST",$JOB,"TIURIDX0")=$GET(^TMP("TIURIDX",$JOB,0))
- +5 ; -- Copy numbered lines: --
- +6 FOR IND=START:1:END
- if $DATA(@VALMAR@(IND,0))
- Begin DoDot:1
- +7 SET LSTART=LSTART+1
- +8 SET TEXT=@VALMAR@(IND,0)
- +9 SET TEXT=$$SETFLD^VALM1(LSTART,TEXT,"NUMBER")
- +10 SET ^TMP("TMPLIST",$JOB,LSTART)=TEXT_U_$PIECE($GET(^TMP("TIURIDX",$JOB,IND)),U,2,4)
- End DoDot:1
- +11 ; -- Copy other nodes, skipping "IDX", "IEN", "EXPAND",
- +12 ; & "IDDATA", where I need >1 subscript: --
- +13 SET IND="A"
- +14 FOR
- SET IND=$ORDER(@VALMAR@(IND))
- if IND=""
- QUIT
- Begin DoDot:1
- +15 if $SELECT(IND="IDX"
- QUIT
- +16 SET ^TMP("TMPLIST",$JOB,IND)=$GET(@VALMAR@(IND))
- End DoDot:1
- +17 ; -- Copy "EXPAND" node: --
- +18 SET IND=0
- +19 FOR
- SET IND=$ORDER(@VALMAR@("EXPAND",IND))
- if IND=""
- QUIT
- Begin DoDot:1
- +20 SET ^TMP("TMPLIST",$JOB,"EXPAND",IND)=$GET(@VALMAR@("EXPAND",IND))
- End DoDot:1
- +21 ; -- Copy "IDDATA" node: --
- +22 SET IND=0
- +23 FOR
- SET IND=$ORDER(@VALMAR@("IDDATA",IND))
- if IND=""
- QUIT
- Begin DoDot:1
- +24 SET ^TMP("TMPLIST",$JOB,"IDDATA",IND)=$GET(@VALMAR@("IDDATA",IND))
- End DoDot:1
- +25 ; -- Copy "IEN" node: --
- +26 SET IND=0
- +27 FOR
- SET IND=$ORDER(@VALMAR@("IEN",IND))
- if IND=""
- QUIT
- Begin DoDot:1
- +28 NEW TIUJ
- SET TIUJ=0
- +29 FOR
- SET TIUJ=$ORDER(@VALMAR@("IEN",IND,TIUJ))
- if +TIUJ'>0
- QUIT
- Begin DoDot:2
- +30 SET ^TMP("TMPLIST",$JOB,"IEN",IND,TIUJ)=""
- End DoDot:2
- End DoDot:1
- +31 QUIT LSTART
- +32 ;
- +33 ;======================================================================
- EC(VALMY) ;Expand or contract the tree view in VALMY.
- +1 ;Make sure the request is valid.
- +2 IF '$$VEXREQ^TIURECL1(.VALMY)
- QUIT
- +3 NEW TIUI
- +4 SET TIUI=""
- +5 ; -- Traverse pick list in reverse to avoid collisions: --
- +6 FOR
- SET TIUI=$ORDER(VALMY(TIUI),-1)
- if +TIUI'>0
- QUIT
- DO EC1(TIUI)
- +7 QUIT
- +8 ;
- +9 ;======================================================================
- EC1(TIUI,HUSH) ; Expand a single List Element (line TIUI):
- +1 ; ORIGPFIX = $$PREFIX^TIULA2
- +2 ; = Indicators followed by space (if there are any).
- +3 ; EX:"+< ", or "*+< ", etc.
- +4 ; CURPFIX = Beginning characters of title/pt column, up to
- +5 ; but not including title/pt itself.
- +6 ; = Possible spacer characters (e.g. " |_"),
- +7 ; followed by possible indicators_space
- +8 ; (if there are any). If item is expanded,
- +9 ; indicators +, <, or +< may be replaced
- +10 ; with "-".
- +11 ; EX: " |_- ", or " | |_", etc
- +12 ; When getting indicators for new prefix, EC1 checks for changes
- +13 ;in record being expanded (changes such as getting an addendum).
- +14 ; EC1 updates prefix and ^TMP("TIURIDX",$J,listno) with such
- +15 ;changes.
- +16 ; EC1 does NOT update text of line, or ^TMP("TIUR",$J,"IDDATA",DA).
- +17 NEW ORIGPFIX,CURPFIX,TIUGDATA,PRMSORT,NEWPFIX
- +18 NEW TSTART,START,LISTNUM,REBUILD,TEXT
- +19 NEW TIUDATA,TIUDA,TIUPICK
- +20 SET START=1
- SET (REBUILD,TSTART)=0
- +21 KILL ^TMP("TMPLIST",$JOB)
- +22 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
- if '+TIUDATA
- QUIT
- +23 SET LISTNUM=$PIECE(TIUDATA,U,1)
- +24 ; -- Retrieve DA, current prefix; get original prefix: --
- +25 SET TIUDA=$PIECE(TIUDATA,U,2)
- SET CURPFIX=$PIECE(TIUDATA,U,3)
- +26 SET ORIGPFIX=$$PREFIX^TIULA2(TIUDA)
- +27 SET NEWPFIX=$$UPPFIX^TIURL1(TIUDA,CURPFIX)
- +28 ; ---- If docmt cannot be expanded or collapsed, say so and quit: ----
- +29 IF ORIGPFIX'["+"
- IF ORIGPFIX'["<"
- IF CURPFIX'["-"
- Begin DoDot:1
- +30 NEW MSG
- +31 DO RESTORE^VALM10(TIUI)
- +32 IF '+$GET(HUSH)
- Begin DoDot:2
- +33 SET MSG="** Item #"_TIUI_" cannot be expanded/collapsed. **"
- +34 DO MSG^VALM10(MSG)
- HANG 2
- End DoDot:2
- End DoDot:1
- QUIT
- +35 SET TEXT=$GET(@VALMAR@(LISTNUM,0))
- +36 ; ---- If docmt not expanded & has addenda but no ID kids,
- +37 ; expand to show adda: ----
- +38 IF CURPFIX'["-"
- IF ORIGPFIX["+"
- IF ORIGPFIX'["<"
- Begin DoDot:1
- +39 SET REBUILD=1
- +40 ; -- Set lines (from beg to line before TIUI) into ^TMP("TMPLIST",$J):
- +41 SET TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
- +42 SET START=LISTNUM+1
- +43 ;-- Set line TIUI into ^TMP("TMPLIST",$J), updating flds NUMBER,
- +44 ; and TITLE or PATIENT, with new prefix and spacing: --
- +45 SET TSTART=TSTART+1
- +46 SET TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
- +47 SET NEWPFIX=$SELECT(NEWPFIX["+>":$TRANSLATE(NEWPFIX,"+>","-"),1:$TRANSLATE(NEWPFIX,"+","-"))
- +48 SET TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
- +49 ; -- Save DA, prefixes, etc., for next time: --
- +50 SET ^TMP("TMPLIST",$JOB,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
- +51 ; -- Insert addenda of TIUI: --
- +52 SET TSTART=$$INSADD^TIURECL2(TSTART,TIUDA,NEWPFIX)
- +53 ; -- Update EXPAND index to compensate for insertion: --
- +54 IF TIUI<+$ORDER(@VALMAR@("EXPAND",""),-1)
- DO BUMPEXP(TIUI,TSTART)
- +55 ; -- Set new EXPAND node: --
- +56 SET @VALMAR@("EXPAND",TIUI)=TIUDA
- End DoDot:1
- +57 ; ---- If tree view can be collapsed, then collapse it: ----
- +58 IF CURPFIX["-"
- Begin DoDot:1
- +59 NEW TEMP,CONTRACT,LEVEL
- +60 SET REBUILD=1
- +61 SET TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
- +62 SET TSTART=TSTART+1
- +63 SET LEVEL=$LENGTH(TEXT,"|")
- +64 SET TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
- +65 SET TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
- +66 SET ^TMP("TMPLIST",$JOB,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
- +67 SET START=TIUI+1
- +68 SET CONTRACT=1
- +69 FOR
- if 'CONTRACT
- QUIT
- Begin DoDot:2
- +70 SET TEMP=$GET(@VALMAR@(START,0))
- +71 ; -- Contract if at a higher level than the main line: --
- +72 IF TEMP["|"
- IF $LENGTH(TEMP,"|")>LEVEL
- SET START=START+1
- +73 IF '$TEST
- SET CONTRACT=0
- End DoDot:2
- +74 IF TIUI<+$ORDER(@VALMAR@("EXPAND",""),-1)
- DO SUCKEXP(START,TSTART)
- +75 KILL @VALMAR@("EXPAND",TIUI),^TMP("TMPLIST",$JOB,"EXPAND",TIUI)
- End DoDot:1
- +76 ; ---- If docmt has ID kids & hasn't
- +77 ; been expanded, then expand it to show ID kids: ----
- +78 IF CURPFIX'["-"
- IF ORIGPFIX["<"
- Begin DoDot:1
- +79 ; -- Retrieve ID entry order (from docmt parameter): --
- +80 ; (Entry order should be ok even if rest needs update.)
- +81 SET TIUGDATA=^TMP("TIUR",$JOB,"IDDATA",TIUDA)
- +82 SET PRMSORT=$PIECE(TIUGDATA,U,4)
- +83 SET REBUILD=1
- +84 SET TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
- +85 SET START=LISTNUM+1
- +86 SET TSTART=TSTART+1
- +87 SET TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
- +88 SET NEWPFIX=$SELECT(NEWPFIX["+<":$TRANSLATE(NEWPFIX,"+<","-"),NEWPFIX["<":$TRANSLATE(NEWPFIX,"<","-"),1:$TRANSLATE(NEWPFIX,"+","-"))
- +89 SET TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
- +90 SET ^TMP("TMPLIST",$JOB,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
- +91 SET TSTART=$$INSKIDS^TIURECL2(TSTART,TIUDA,NEWPFIX,PRMSORT)
- +92 SET ^TMP("TMPLIST",$JOB,"IDDATA",TIUDA)=TIUGDATA
- +93 IF TIUI<+$ORDER(@VALMAR@("EXPAND",""),-1)
- DO BUMPEXP(TIUI,TSTART)
- +94 ; -- Set new EXPAND node: --
- +95 SET @VALMAR@("EXPAND",TIUI)=TIUDA
- End DoDot:1
- +96 ; -- Restore the original video attributes: --
- +97 DO RESTORE^VALM10(TIUI)
- +98 IF 'REBUILD
- QUIT
- +99 ; ---- Add the rest of the list to ^TMP("TMPLIST",$J):
- +100 SET LISTNUM=$PIECE(@VALMAR@(0),U,1)
- +101 SET TSTART=$$COPYCL(TSTART,START,LISTNUM)
- +102 ; --Rebuild the LM ^TMP arrays: --
- +103 KILL @VALMAR,^TMP("TIURIDX",$JOB)
- +104 SET VALMCNT=0
- +105 SET START=0
- SET @VALMAR@(0)=^TMP("TMPLIST",$JOB,0)
- +106 SET ^TMP("TIURIDX",$JOB,0)=^TMP("TMPLIST",$JOB,"TIURIDX0")
- +107 ; -- Rebuild numbered lines and IDX and TIURIDX nodes: --
- +108 NEW CURPFX
- +109 FOR
- SET START=$ORDER(^TMP("TMPLIST",$JOB,START))
- if +START'>0
- QUIT
- Begin DoDot:1
- +110 SET VALMCNT=VALMCNT+1
- +111 SET TEMP=^TMP("TMPLIST",$JOB,START)
- +112 SET TEXT=$PIECE(TEMP,U)
- SET TIUDA=$PIECE(TEMP,U,2)
- SET CURPFX=$PIECE(TEMP,U,3)
- +113 SET @VALMAR@(START,0)=TEXT
- +114 DO RESTORE^VALM10(START)
- +115 SET @VALMAR@("IDX",START,START)=""
- +116 SET ^TMP("TIURIDX",$JOB,START)=START_U_TIUDA_U_CURPFX
- +117 SET @VALMAR@("IEN",TIUDA,START)=""
- End DoDot:1
- +118 SET $PIECE(@VALMAR@(0),U)=VALMCNT
- +119 ; -- Rebuild other nodes: --
- +120 SET START="A"
- +121 FOR
- SET START=$ORDER(^TMP("TMPLIST",$JOB,START))
- if START=""
- QUIT
- Begin DoDot:1
- +122 if START="EXPAND"
- QUIT
- +123 if START="IDDATA"
- QUIT
- +124 if START="IEN"
- QUIT
- +125 SET @VALMAR@(START)=$GET(^TMP("TMPLIST",$JOB,START))
- End DoDot:1
- +126 ; -- Rebuild EXPAND node: --
- +127 SET START=0
- +128 FOR
- SET START=$ORDER(^TMP("TMPLIST",$JOB,"EXPAND",START))
- if +START'>0
- QUIT
- Begin DoDot:1
- +129 SET @VALMAR@("EXPAND",START)=$GET(^TMP("TMPLIST",$JOB,"EXPAND",START))
- End DoDot:1
- +130 ; -- Rebuild IDDATA node: --
- +131 SET START=0
- +132 FOR
- SET START=$ORDER(^TMP("TMPLIST",$JOB,"IDDATA",START))
- if +START'>0
- QUIT
- Begin DoDot:1
- +133 if '$DATA(@VALMAR@("IEN",START))
- QUIT
- +134 SET @VALMAR@("IDDATA",START)=$GET(^TMP("TMPLIST",$JOB,"IDDATA",START))
- End DoDot:1
- +135 ; -- Rebuild # node: --
- +136 SET TIUPICK=+$ORDER(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
- +137 SET @VALMAR@("#")=TIUPICK_U_"1:"_+$GET(VALMCNT)
- +138 ; -- Update # of documents in header: --
- +139 KILL VALMHDR,^TMP("TMPLIST",$JOB)
- +140 QUIT
- +141 ;=======================================================================
- BUMPEXP(TIUI,TSTART) ; Bump EXPAND index to compensate for insertion
- +1 NEW TIUJ,GAP
- SET TIUJ=""
- SET GAP=TSTART-TIUI
- +2 FOR
- SET TIUJ=$ORDER(@VALMAR@("EXPAND",TIUJ),-1)
- if TIUJ'>TIUI
- QUIT
- Begin DoDot:1
- +3 SET @VALMAR@("EXPAND",TIUJ+GAP)=$GET(@VALMAR@("EXPAND",TIUJ))
- +4 KILL @VALMAR@("EXPAND",TIUJ),^TMP("TMPLIST",$JOB,"EXPAND",TIUJ)
- End DoDot:1
- +5 QUIT
- +6 ;=======================================================================
- SUCKEXP(START,TSTART) ; Remove EXPAND index to compensate for collapse
- +1 NEW TIUJ,GAP
- SET TIUJ=START
- SET GAP=(START-TSTART)-1
- +2 FOR
- SET TIUJ=$ORDER(@VALMAR@("EXPAND",TIUJ))
- if TIUJ'>0
- QUIT
- Begin DoDot:1
- +3 SET @VALMAR@("EXPAND",TIUJ-GAP)=$GET(@VALMAR@("EXPAND",TIUJ))
- +4 KILL @VALMAR@("EXPAND",TIUJ),^TMP("TMPLIST",$JOB,"EXPAND",TIUJ)
- End DoDot:1
- +5 QUIT