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

TIUGR1.m

Go to the documentation of this file.
  1. TIUGR1 ; SLC/MAM - More ID Note Review Screen Actions ;4/12/01
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
  1. ;
  1. IDNOTEB(TIUDA) ; Browse Screen Action IN Interdisciplinary Note
  1. ; Requires TIUDA
  1. ; If editing this module, please keep TIUGR consistent with it.
  1. N TITLE,PREFIX,TITLEDA,CANADD,CANATT,ADDED,TIUQUIT,TIUIDDAD
  1. ;TIUCHNG is newed in TIURA2; Don't new it here
  1. S VALMBCK="R"
  1. ; -- If note is addendum, can't attach; say so & quit: --
  1. I +^TIU(8925,TIUDA,0)=81 D G IDNOTEBX
  1. . D CANT^TIUGR("A") S TIUCHNG("REFRESH")=1
  1. ; -- If note is already an entry of an ID note, unlink it: --
  1. S TIUIDDAD=$$HASIDDAD^TIUGBR(TIUDA)
  1. I TIUIDDAD D G IDNOTEBX
  1. . D UNLKKID(TIUDA,TIUIDDAD)
  1. . I $G(TIUQUIT) S TIUCHNG("REFRESH")=1 Q
  1. . S TIUCHNG("RBLD")=1
  1. . K VALMHDR ; TIUDA is no longer an ID entry so update header
  1. ; -- If user can add an entry to the note, do it & quit: --
  1. S CANADD=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
  1. I CANADD D ADDDAD^TIUGEDIT(TIUDA,.ADDED) D G IDNOTEBX
  1. . I 'ADDED S TIUCHNG("REFRESH")=1 Q
  1. . S TIUCHNG("RBLD")=1 K VALMHDR
  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(TIUDA) D G IDNOTEBX
  1. . W !!,$P(CANADD,U,2) D PAUSE^TIUGR
  1. . S TIUCHNG("REFRESH")=1
  1. ; -- Note is a possible parent: --
  1. S TITLEDA=+^TIU(8925,TIUDA,0)
  1. I 'CANADD,$$POSSPRNT^TIULP(TITLEDA) D G IDNOTEBX
  1. . W !!,$P(CANADD,U,2) D PAUSE^TIUGR
  1. . S TIUCHNG("REFRESH")=1
  1. ; -- See if user can attach note to an existing note: --
  1. S CANATT=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
  1. ; -- If user can attach, tell user not to use Browse:
  1. I CANATT W !!,"To attach this note to an ID parent, please exit Browse and try again ",!,"from a Review Screen showing a list of notes.",! H 5 S TIUCHNG("REFRESH")=1 G IDNOTEBX
  1. ; -- If user can't attach, say can't attach: --
  1. I 'CANATT W !!,$P(CANATT,U,2) D PAUSE^TIUGR S TIUCHNG("REFRESH")=1
  1. IDNOTEBX ;
  1. ; -- Rebuild browse screen for updated record: --
  1. ; (Review screen is updated from BROWSE^TIURA2)
  1. S TIUGDATA=$$IDDATA^TIURECL1(TIUDA) ;may have changed
  1. D BLDTMP^TIUBR(TIUDA)
  1. Q
  1. ;
  1. UNLKKID(KIDDA,TIUIDDAD,DETACHED) ; Unlink ID entry
  1. ; Check if user can unlink, and if so, unlink it.
  1. N CANUNLK,UNLINK,MSG,DADDA,TIUQUIT
  1. S DETACHED=0
  1. W !!,"This note is attached to an interdisciplinary note."
  1. ; -- Same users can unlink as can link: --
  1. S CANUNLK=$$CANDO^TIULP(KIDDA,"ATTACH TO ID NOTE")
  1. I CANUNLK S CANUNLK=$$CANDO^TIULP(TIUIDDAD,"ATTACH ID ENTRY")
  1. I 'CANUNLK D G UNLKKIDX
  1. . ;S MSG=$P(CANUNLK,U,2),MSG=$P(MSG,"You may not ATTACH this",2)
  1. . ;S MSG=$P(MSG,"to an ID note."),MSG=" You may not DETACH this"_MSG
  1. . W !,"You may not detach this note from its interdisciplinary note."
  1. . I $$READ^TIUU("EA","Press RETURN to continue...")
  1. . S TIUQUIT=1
  1. S UNLINK=$$READ^TIUU("Y","Do you want to detach it","NO")
  1. I 'UNLINK W !!,"Entry not detached." H 1 S TIUQUIT=1 G UNLKKIDX
  1. S DADDA=$P($G(^TMP("TIUR",$J,"IDDATA",KIDDA)),U,3)
  1. D UNLINK(KIDDA)
  1. I DADDA D UPIDDATA^TIURL1(KIDDA),UPIDDATA^TIURL1(DADDA)
  1. W !!,"Entry detached." H 1
  1. ;S VALMSG="** Entry detached **" ;4/9/01
  1. S TIUCHNG("RBLD")=1,DETACHED=1 ;4/9/01
  1. UNLKKIDX ;
  1. ;I $G(TIUQUIT) S VALMSG="** Entry not detached **",TIUCHNG("REFRESH")=1 Q ;4/9/01
  1. I $G(TIUQUIT) S TIUCHNG("REFRESH")=1 Q ;4/9/01
  1. Q
  1. ;
  1. N DIE,DR,IDDAD
  1. S IDDAD=+$G(^TIU(8925,DA,21))
  1. S DIE=8925,DR="2101////@"
  1. D ^DIE
  1. D AUDLINK(DA,"d",IDDAD)
  1. D IDDEL^TIUALRT1(DA)
  1. Q
  1. N DIC,DIE,DA,DR,X,Y,TIUD0,TIUD21,DLAYGO
  1. Q:$G(ACTION)']""!(+$G(IDPARENT)'>0)
  1. S TIUD0=$G(^TIU(8925,TIUDA,0))
  1. S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.5,DIC(0)="FLX" D ^DIC Q:+Y'>0
  1. S DA=+Y,DIE=DIC
  1. S DR="3.01////"_ACTION_";3.02////"_$$NOW^XLFDT
  1. S DR=DR_";3.03////"_DUZ_";3.04////"_$P(TIUD0,U,5)
  1. S DR=DR_";3.05////"_IDPARENT
  1. D ^DIE
  1. Q