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

TIUGR.m

Go to the documentation of this file. 
  1. TIUGR ; SLC/MAM - ID Note Review Screen Actions ; IDNOTE; 4/12/01
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
  1.  ;
  1. IDNOTE ; Review Screen Action IN Interdisciplinary Note
  1.  ;If editing this module, please keep TIUGR1 consistent with it.
  1.  ; -- Sets TIUGLINK if user starts attaching
  1.  ;    the note to an existing note: --
  1.  ;     TIUGLINK = IFN of ID entry^Lineno^Title.
  1.  ;     (If ID entry is chosen via browse instead of review, Lineno=0)
  1.  N LINENO,NTDATA,NTDA,ADDED,TIUQUIT,TITLE,TITLEDA
  1.  N CANATT,CANADD,PDOCTYP,TIUCHNG,LNO
  1.  N TIUDAARY,DETACHED,TIUACT,TIULST,TIUIDDAD
  1.  ; -- If user has already selected note to attach, but not note
  1.  ;    to attach it to, write msg and quit: --
  1.  ;I $G(TIUGLINK) D ATTCHMSG(TIUGLINK) S TIUQUIT=1 G IDNOTEX
  1.  ; -- If user has already selected note to attach, but not note
  1.  ;    to attach it to, and reselects IN, quit attach action: --
  1.  I $G(TIUGLINK) D LINKQUIT^TIUGR2 S TIUQUIT=1 G IDNOTEX
  1.  ; -- Select note to act on, if not already selected: --
  1.  I '$D(VALMY) D  I $G(TIUQUIT) G IDNOTEX
  1.  . I $P($G(XQORNOD(0)),U,4)'["=" D
  1.  . . W !!,"  To ADD a new entry to an interdisciplinary note, please select the",!,"interdisciplinary note."
  1.  . . W !,"  To ATTACH an existing stand-alone note to an interdisciplinary note,",!,"please select the note you want to attach."
  1.  . D EN^VALM2(XQORNOD(0),"S") S LINENO=+$O(VALMY(0))
  1.  . I 'LINENO S TIUQUIT=1 Q
  1.  . ; -- Reverse video selected note: --
  1.  . D RESTORE^VALM10(LINENO),CNTRL^VALM10(LINENO,6,VALM("RM"),IORVON,IORVOFF),WRITE^VALM10(LINENO)
  1.  ; -- In case note was already selected: --
  1.  S LINENO=+$O(VALMY(0))
  1.  ; -- Set notedata NTDATA = lineno^IFN^? --
  1.  S NTDATA=$G(^TMP("TIURIDX",$J,LINENO))
  1.  S NTDA=+$P(NTDATA,U,2)
  1.  I '$D(^TIU(8925,+NTDA,0)) S TIUCHNG("REFRESH")=1,TIUQUIT=1 G IDNOTEX
  1.  S TITLE=$$DOCTYPE^TIULF(NTDA)
  1.  I $O(VALMY(LINENO)) D
  1.  . W !!,"Notes must be selected one at a time for interdisciplinary"
  1.  . W !,"note actions.  Acting on your FIRST selection,"
  1.  . W !?3,$P(TITLE,U,2) H 5
  1.  . S LNO=LINENO F  S LNO=$O(VALMY(LNO)) Q:'LNO  D
  1.  . . D RESTORE^VALM10(LNO)
  1.  . . D WRITE^VALM10(LNO)
  1.  . . K VALMY(LNO)
  1.  ; -- If note is addendum, CWAD, or consult result,
  1.  ;    user can't detach/attach it or add new entry to it.
  1.  ;    Say so & quit: --
  1.  I +^TIU(8925,+NTDA,0)=81 D CANT("A") S TIUCHNG("REFRESH")=1 G IDNOTEX
  1.  S PDOCTYP=$P(^TIU(8925,+NTDA,0),U,4)
  1.  I (PDOCTYP=27)!(PDOCTYP=25)!(PDOCTYP=31)!(PDOCTYP=30) D  G IDNOTEX
  1.  . D CANT("CWAD") S TIUCHNG("REFRESH")=1
  1.  I $P($G(^TIU(8925,+NTDA,14)),U,5) D  G IDNOTEX
  1.  . D CANT("CR") S TIUCHNG("REFRESH")=1
  1.  ; -- If note is already an entry of an ID note, unlink it: --
  1.  S TIUIDDAD=$$HASIDDAD^TIUGBR(NTDA)
  1.  I TIUIDDAD D  G IDNOTEX
  1.  . S TIUACT="DETACHED",TIUDAARY(LINENO)=NTDA
  1.  . D UNLKKID^TIUGR1(NTDA,TIUIDDAD,.DETACHED)
  1.  . I '$G(DETACHED) S TIUCHNG("REFRESH")=1,TIULST="" Q
  1.  . S TIUCHNG("RBLD")=1,TIULST=LINENO
  1.  ; -- If user can add an entry to the note, do it & quit: --
  1.  S CANADD=$$CANDO^TIULP(NTDA,"ATTACH ID ENTRY")
  1.  I CANADD D  G IDNOTEX
  1.  . D ADDDAD^TIUGEDIT(NTDA,.ADDED)
  1.  . I 'ADDED S TIUCHNG("REFRESH")=1 Q
  1.  . S TIUCHNG("RBLD")=1
  1.  ; -- If user can't add entry to note, & attaching note to
  1.  ;    an existing note is not permitted, say can't add & quit: --
  1.  ;    -- Note itself has entries: --
  1.  I 'CANADD,$$HASIDKID^TIUGBR(NTDA) D  G IDNOTEX
  1.  . W !!,$P(CANADD,U,2) D PAUSE S TIUCHNG("REFRESH")=1
  1.  ;    -- Note is a possible parent: --
  1.  S TITLEDA=+^TIU(8925,NTDA,0)
  1.  I 'CANADD,$$POSSPRNT^TIULP(TITLEDA) D  G IDNOTEX
  1.  . W !!,$P(CANADD,U,2) D PAUSE S TIUCHNG("REFRESH")=1
  1.  ; -- See if user can attach note to an existing note: --
  1.  S CANATT=$$CANDO^TIULP(NTDA,"ATTACH TO ID NOTE")
  1.  ;    -- If user can attach note, set TIUGLINK,
  1.  ;       write "Attaching...", and quit: --
  1.  I CANATT D  G IDNOTEX
  1.  . S TIUGLINK=NTDA_U_LINENO_U_$P(TITLE,U,2)
  1.  . D ATTCHMSG(TIUGLINK) ; User is mid-attach, don't set TIUCHNG
  1.  ;    -- If user can't attach, say can't attach, and quit
  1.  I 'CANATT D
  1.  . W !!,$P(CANATT,U,2) D PAUSE
  1.  . S TIUCHNG("REFRESH")=1
  1. IDNOTEX ; Restore video for selected line and refresh/update/rebuild list:
  1.  I $G(TIUCHNG("REFRESH"))!$G(TIUCHNG("UPDATE"))!$G(TIUCHNG("RBLD")) D
  1.  . S VALMY(LINENO)=""
  1.  . D UPRBLD^TIURL(.TIUCHNG,.VALMY)
  1.  S VALMBCK="R" K VALMY
  1.  I $G(TIUACT)="DETACHED" D VMSG^TIURS1(TIULST,.TIUDAARY,"DETACHED")
  1.  Q
  1.  ;
  1. PAUSE ;Wait til user hits return
  1.  I $$READ^TIUU("EA","Press RETURN to continue...")
  1.  Q
  1.  ;
  1. CANT(TYPE) ; Tell user they can't act on addendum, CWAD, or
  1.  ;Consult result
  1.  I TYPE="A" D
  1.  . W !!,"  An addendum is linked to its parent when it is first made and"
  1.  . W !,"cannot be attached or detached like an interdisciplinary note."
  1.  . W !,"To add an addendum to a note, use action 'Make Addendum.'"
  1.  I TYPE="CWAD" D
  1.  . W !!,"  CWAD notes cannot be used as interdisciplinary notes."
  1.  I TYPE="CR" D
  1.  . W !!,"  Consult results cannot be used as interdisciplinary notes."
  1.  D PAUSE
  1.  Q
  1.  ;
  1. ATTCHMSG(KIDDATA) ; Offer instructions when user has selected
  1.  ;the note to attach but not the note to attach it to.
  1.  W !!,"  Attaching ",$P(KIDDATA,U,3),"."
  1.  W !,"  Please select the note you want to attach it to."
  1.  W !,"  Or, reselect action IN if you no longer wish to attach the note."
  1.  I $$READ^TIUU("EA","Press RETURN when you have finished reading this message...")
  1.  Q
  1.  ;