Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIURECL

TIURECL.m

Go to the documentation of this file.
  1. TIURECL ; SLC/PKR,JER - Expand/collapse LM views ;3/14/01
  1. ;;1.0;TEXT INTETRATION UTILITIES;**88,100**;Jun 20, 1997
  1. ;======================================================================
  1. COPYCL(LSTART,START,END) ;Copy elements of List into ^TMP("TMPLIST",$J),
  1. ;starting at START going to END.
  1. N IND,TEXT
  1. S ^TMP("TMPLIST",$J,0)=$G(@VALMAR@(0))
  1. S ^TMP("TMPLIST",$J,"TIURIDX0")=$G(^TMP("TIURIDX",$J,0))
  1. ; -- Copy numbered lines: --
  1. F IND=START:1:END D:$D(@VALMAR@(IND,0))
  1. . S LSTART=LSTART+1
  1. . S TEXT=@VALMAR@(IND,0)
  1. . S TEXT=$$SETFLD^VALM1(LSTART,TEXT,"NUMBER")
  1. . S ^TMP("TMPLIST",$J,LSTART)=TEXT_U_$P($G(^TMP("TIURIDX",$J,IND)),U,2,4)
  1. ; -- Copy other nodes, skipping "IDX", "IEN", "EXPAND",
  1. ; & "IDDATA", where I need >1 subscript: --
  1. S IND="A"
  1. F S IND=$O(@VALMAR@(IND)) Q:IND="" D
  1. . Q:$S(IND="IDX":1,IND="IEN":1,IND="EXPAND":1,IND="IDDATA":1,1:0)
  1. . S ^TMP("TMPLIST",$J,IND)=$G(@VALMAR@(IND))
  1. ; -- Copy "EXPAND" node: --
  1. S IND=0
  1. F S IND=$O(@VALMAR@("EXPAND",IND)) Q:IND="" D
  1. . S ^TMP("TMPLIST",$J,"EXPAND",IND)=$G(@VALMAR@("EXPAND",IND))
  1. ; -- Copy "IDDATA" node: --
  1. S IND=0
  1. F S IND=$O(@VALMAR@("IDDATA",IND)) Q:IND="" D
  1. . S ^TMP("TMPLIST",$J,"IDDATA",IND)=$G(@VALMAR@("IDDATA",IND))
  1. ; -- Copy "IEN" node: --
  1. S IND=0
  1. F S IND=$O(@VALMAR@("IEN",IND)) Q:IND="" D
  1. . N TIUJ S TIUJ=0
  1. . F S TIUJ=$O(@VALMAR@("IEN",IND,TIUJ)) Q:+TIUJ'>0 D
  1. . . S ^TMP("TMPLIST",$J,"IEN",IND,TIUJ)=""
  1. Q LSTART
  1. ;
  1. ;======================================================================
  1. EC(VALMY) ;Expand or contract the tree view in VALMY.
  1. ;Make sure the request is valid.
  1. I '$$VEXREQ^TIURECL1(.VALMY) Q
  1. N TIUI
  1. S TIUI=""
  1. ; -- Traverse pick list in reverse to avoid collisions: --
  1. F S TIUI=$O(VALMY(TIUI),-1) Q:+TIUI'>0 D EC1(TIUI)
  1. Q
  1. ;
  1. ;======================================================================
  1. EC1(TIUI,HUSH) ; Expand a single List Element (line TIUI):
  1. ; ORIGPFIX = $$PREFIX^TIULA2
  1. ; = Indicators followed by space (if there are any).
  1. ; EX:"+< ", or "*+< ", etc.
  1. ; CURPFIX = Beginning characters of title/pt column, up to
  1. ; but not including title/pt itself.
  1. ; = Possible spacer characters (e.g. " |_"),
  1. ; followed by possible indicators_space
  1. ; (if there are any). If item is expanded,
  1. ; indicators +, <, or +< may be replaced
  1. ; with "-".
  1. ; EX: " |_- ", or " | |_", etc
  1. ; When getting indicators for new prefix, EC1 checks for changes
  1. ;in record being expanded (changes such as getting an addendum).
  1. ; EC1 updates prefix and ^TMP("TIURIDX",$J,listno) with such
  1. ;changes.
  1. ; EC1 does NOT update text of line, or ^TMP("TIUR",$J,"IDDATA",DA).
  1. N ORIGPFIX,CURPFIX,TIUGDATA,PRMSORT,NEWPFIX
  1. N TSTART,START,LISTNUM,REBUILD,TEXT
  1. N TIUDATA,TIUDA,TIUPICK
  1. S START=1,(REBUILD,TSTART)=0
  1. K ^TMP("TMPLIST",$J)
  1. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)) Q:'+TIUDATA
  1. S LISTNUM=$P(TIUDATA,U,1)
  1. ; -- Retrieve DA, current prefix; get original prefix: --
  1. S TIUDA=$P(TIUDATA,U,2),CURPFIX=$P(TIUDATA,U,3)
  1. S ORIGPFIX=$$PREFIX^TIULA2(TIUDA)
  1. S NEWPFIX=$$UPPFIX^TIURL1(TIUDA,CURPFIX)
  1. ; ---- If docmt cannot be expanded or collapsed, say so and quit: ----
  1. I ORIGPFIX'["+",ORIGPFIX'["<",CURPFIX'["-" D Q
  1. . N MSG
  1. . D RESTORE^VALM10(TIUI)
  1. . I '+$G(HUSH) D
  1. . . S MSG="** Item #"_TIUI_" cannot be expanded/collapsed. **"
  1. . . D MSG^VALM10(MSG) H 2
  1. S TEXT=$G(@VALMAR@(LISTNUM,0))
  1. ; ---- If docmt not expanded & has addenda but no ID kids,
  1. ; expand to show adda: ----
  1. I CURPFIX'["-",ORIGPFIX["+",ORIGPFIX'["<" D
  1. . S REBUILD=1
  1. . ; -- Set lines (from beg to line before TIUI) into ^TMP("TMPLIST",$J):
  1. . S TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
  1. . S START=LISTNUM+1
  1. . ;-- Set line TIUI into ^TMP("TMPLIST",$J), updating flds NUMBER,
  1. . ; and TITLE or PATIENT, with new prefix and spacing: --
  1. . S TSTART=TSTART+1
  1. . S TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
  1. . S NEWPFIX=$S(NEWPFIX["+>":$TR(NEWPFIX,"+>","-"),1:$TR(NEWPFIX,"+","-"))
  1. . S TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
  1. . ; -- Save DA, prefixes, etc., for next time: --
  1. . S ^TMP("TMPLIST",$J,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
  1. . ; -- Insert addenda of TIUI: --
  1. . S TSTART=$$INSADD^TIURECL2(TSTART,TIUDA,NEWPFIX)
  1. . ; -- Update EXPAND index to compensate for insertion: --
  1. . I TIUI<+$O(@VALMAR@("EXPAND",""),-1) D BUMPEXP(TIUI,TSTART)
  1. . ; -- Set new EXPAND node: --
  1. . S @VALMAR@("EXPAND",TIUI)=TIUDA
  1. ; ---- If tree view can be collapsed, then collapse it: ----
  1. I CURPFIX["-" D
  1. . N TEMP,CONTRACT,LEVEL
  1. . S REBUILD=1
  1. . S TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
  1. . S TSTART=TSTART+1
  1. . S LEVEL=$L(TEXT,"|")
  1. . S TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
  1. . S TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
  1. . S ^TMP("TMPLIST",$J,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
  1. . S START=TIUI+1
  1. . S CONTRACT=1
  1. . F Q:'CONTRACT D
  1. .. S TEMP=$G(@VALMAR@(START,0))
  1. ..; -- Contract if at a higher level than the main line: --
  1. .. I TEMP["|",$L(TEMP,"|")>LEVEL S START=START+1
  1. .. E S CONTRACT=0
  1. . I TIUI<+$O(@VALMAR@("EXPAND",""),-1) D SUCKEXP(START,TSTART)
  1. . K @VALMAR@("EXPAND",TIUI),^TMP("TMPLIST",$J,"EXPAND",TIUI)
  1. ; ---- If docmt has ID kids & hasn't
  1. ; been expanded, then expand it to show ID kids: ----
  1. I CURPFIX'["-",ORIGPFIX["<" D
  1. . ; -- Retrieve ID entry order (from docmt parameter): --
  1. . ; (Entry order should be ok even if rest needs update.)
  1. . S TIUGDATA=^TMP("TIUR",$J,"IDDATA",TIUDA)
  1. . S PRMSORT=$P(TIUGDATA,U,4)
  1. . S REBUILD=1
  1. . S TSTART=$$COPYCL(TSTART,START,LISTNUM-1)
  1. . S START=LISTNUM+1
  1. . S TSTART=TSTART+1
  1. . S TEXT=$$SETFLD^VALM1(TSTART,TEXT,"NUMBER")
  1. . S NEWPFIX=$S(NEWPFIX["+<":$TR(NEWPFIX,"+<","-"),NEWPFIX["<":$TR(NEWPFIX,"<","-"),1:$TR(NEWPFIX,"+","-"))
  1. . S TEXT=$$SETTLPT^TIURECL1(TEXT,TIUDA,NEWPFIX)
  1. . S ^TMP("TMPLIST",$J,TSTART)=TEXT_U_TIUDA_U_NEWPFIX
  1. . S TSTART=$$INSKIDS^TIURECL2(TSTART,TIUDA,NEWPFIX,PRMSORT)
  1. . S ^TMP("TMPLIST",$J,"IDDATA",TIUDA)=TIUGDATA
  1. . I TIUI<+$O(@VALMAR@("EXPAND",""),-1) D BUMPEXP(TIUI,TSTART)
  1. . ; -- Set new EXPAND node: --
  1. . S @VALMAR@("EXPAND",TIUI)=TIUDA
  1. ; -- Restore the original video attributes: --
  1. D RESTORE^VALM10(TIUI)
  1. I 'REBUILD Q
  1. ; ---- Add the rest of the list to ^TMP("TMPLIST",$J):
  1. S LISTNUM=$P(@VALMAR@(0),U,1)
  1. S TSTART=$$COPYCL(TSTART,START,LISTNUM)
  1. ; --Rebuild the LM ^TMP arrays: --
  1. K @VALMAR,^TMP("TIURIDX",$J)
  1. S VALMCNT=0
  1. S START=0,@VALMAR@(0)=^TMP("TMPLIST",$J,0)
  1. S ^TMP("TIURIDX",$J,0)=^TMP("TMPLIST",$J,"TIURIDX0")
  1. ; -- Rebuild numbered lines and IDX and TIURIDX nodes: --
  1. N CURPFX
  1. F S START=$O(^TMP("TMPLIST",$J,START)) Q:+START'>0 D
  1. . S VALMCNT=VALMCNT+1
  1. . S TEMP=^TMP("TMPLIST",$J,START)
  1. . S TEXT=$P(TEMP,U),TIUDA=$P(TEMP,U,2),CURPFX=$P(TEMP,U,3)
  1. . S @VALMAR@(START,0)=TEXT
  1. . D RESTORE^VALM10(START)
  1. . S @VALMAR@("IDX",START,START)=""
  1. . S ^TMP("TIURIDX",$J,START)=START_U_TIUDA_U_CURPFX
  1. . S @VALMAR@("IEN",TIUDA,START)=""
  1. S $P(@VALMAR@(0),U)=VALMCNT
  1. ; -- Rebuild other nodes: --
  1. S START="A"
  1. F S START=$O(^TMP("TMPLIST",$J,START)) Q:START="" D
  1. . Q:START="EXPAND"
  1. . Q:START="IDDATA"
  1. . Q:START="IEN"
  1. . S @VALMAR@(START)=$G(^TMP("TMPLIST",$J,START))
  1. ; -- Rebuild EXPAND node: --
  1. S START=0
  1. F S START=$O(^TMP("TMPLIST",$J,"EXPAND",START)) Q:+START'>0 D
  1. . S @VALMAR@("EXPAND",START)=$G(^TMP("TMPLIST",$J,"EXPAND",START))
  1. ; -- Rebuild IDDATA node: --
  1. S START=0
  1. F S START=$O(^TMP("TMPLIST",$J,"IDDATA",START)) Q:+START'>0 D
  1. . Q:'$D(@VALMAR@("IEN",START))
  1. . S @VALMAR@("IDDATA",START)=$G(^TMP("TMPLIST",$J,"IDDATA",START))
  1. ; -- Rebuild # node: --
  1. S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
  1. S @VALMAR@("#")=TIUPICK_U_"1:"_+$G(VALMCNT)
  1. ; -- Update # of documents in header: --
  1. K VALMHDR,^TMP("TMPLIST",$J)
  1. Q
  1. ;=======================================================================
  1. BUMPEXP(TIUI,TSTART) ; Bump EXPAND index to compensate for insertion
  1. N TIUJ,GAP S TIUJ="",GAP=TSTART-TIUI
  1. F S TIUJ=$O(@VALMAR@("EXPAND",TIUJ),-1) Q:TIUJ'>TIUI D
  1. . S @VALMAR@("EXPAND",TIUJ+GAP)=$G(@VALMAR@("EXPAND",TIUJ))
  1. . K @VALMAR@("EXPAND",TIUJ),^TMP("TMPLIST",$J,"EXPAND",TIUJ)
  1. Q
  1. ;=======================================================================
  1. SUCKEXP(START,TSTART) ; Remove EXPAND index to compensate for collapse
  1. N TIUJ,GAP S TIUJ=START,GAP=(START-TSTART)-1
  1. F S TIUJ=$O(@VALMAR@("EXPAND",TIUJ)) Q:TIUJ'>0 D
  1. . S @VALMAR@("EXPAND",TIUJ-GAP)=$G(@VALMAR@("EXPAND",TIUJ))
  1. . K @VALMAR@("EXPAND",TIUJ),^TMP("TMPLIST",$J,"EXPAND",TIUJ)
  1. Q