TIUGR1 ; SLC/MAM - More ID Note Review Screen Actions ;4/12/01
;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
;
IDNOTEB(TIUDA) ; Browse Screen Action IN Interdisciplinary Note
; Requires TIUDA
; If editing this module, please keep TIUGR consistent with it.
N TITLE,PREFIX,TITLEDA,CANADD,CANATT,ADDED,TIUQUIT,TIUIDDAD
;TIUCHNG is newed in TIURA2; Don't new it here
S VALMBCK="R"
; -- If note is addendum, can't attach; say so & quit: --
I +^TIU(8925,TIUDA,0)=81 D G IDNOTEBX
. D CANT^TIUGR("A") S TIUCHNG("REFRESH")=1
; -- If note is already an entry of an ID note, unlink it: --
S TIUIDDAD=$$HASIDDAD^TIUGBR(TIUDA)
I TIUIDDAD D G IDNOTEBX
. D UNLKKID(TIUDA,TIUIDDAD)
. I $G(TIUQUIT) S TIUCHNG("REFRESH")=1 Q
. S TIUCHNG("RBLD")=1
. K VALMHDR ; TIUDA is no longer an ID entry so update header
; -- If user can add an entry to the note, do it & quit: --
S CANADD=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
I CANADD D ADDDAD^TIUGEDIT(TIUDA,.ADDED) D G IDNOTEBX
. I 'ADDED S TIUCHNG("REFRESH")=1 Q
. S TIUCHNG("RBLD")=1 K VALMHDR
; -- If user can't add entry to note, & attaching note to
; an existing note is not permitted, say can't add & quit: --
; -- Note itself has entries: --
I 'CANADD,$$HASIDKID^TIUGBR(TIUDA) D G IDNOTEBX
. W !!,$P(CANADD,U,2) D PAUSE^TIUGR
. S TIUCHNG("REFRESH")=1
; -- Note is a possible parent: --
S TITLEDA=+^TIU(8925,TIUDA,0)
I 'CANADD,$$POSSPRNT^TIULP(TITLEDA) D G IDNOTEBX
. W !!,$P(CANADD,U,2) D PAUSE^TIUGR
. S TIUCHNG("REFRESH")=1
; -- See if user can attach note to an existing note: --
S CANATT=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
; -- If user can attach, tell user not to use Browse:
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
; -- If user can't attach, say can't attach: --
I 'CANATT W !!,$P(CANATT,U,2) D PAUSE^TIUGR S TIUCHNG("REFRESH")=1
IDNOTEBX ;
; -- Rebuild browse screen for updated record: --
; (Review screen is updated from BROWSE^TIURA2)
S TIUGDATA=$$IDDATA^TIURECL1(TIUDA) ;may have changed
D BLDTMP^TIUBR(TIUDA)
Q
;
UNLKKID(KIDDA,TIUIDDAD,DETACHED) ; Unlink ID entry
; Check if user can unlink, and if so, unlink it.
N CANUNLK,UNLINK,MSG,DADDA,TIUQUIT
S DETACHED=0
W !!,"This note is attached to an interdisciplinary note."
; -- Same users can unlink as can link: --
S CANUNLK=$$CANDO^TIULP(KIDDA,"ATTACH TO ID NOTE")
I CANUNLK S CANUNLK=$$CANDO^TIULP(TIUIDDAD,"ATTACH ID ENTRY")
I 'CANUNLK D G UNLKKIDX
. ;S MSG=$P(CANUNLK,U,2),MSG=$P(MSG,"You may not ATTACH this",2)
. ;S MSG=$P(MSG,"to an ID note."),MSG=" You may not DETACH this"_MSG
. W !,"You may not detach this note from its interdisciplinary note."
. I $$READ^TIUU("EA","Press RETURN to continue...")
. S TIUQUIT=1
S UNLINK=$$READ^TIUU("Y","Do you want to detach it","NO")
I 'UNLINK W !!,"Entry not detached." H 1 S TIUQUIT=1 G UNLKKIDX
S DADDA=$P($G(^TMP("TIUR",$J,"IDDATA",KIDDA)),U,3)
D UNLINK(KIDDA)
I DADDA D UPIDDATA^TIURL1(KIDDA),UPIDDATA^TIURL1(DADDA)
W !!,"Entry detached." H 1
;S VALMSG="** Entry detached **" ;4/9/01
S TIUCHNG("RBLD")=1,DETACHED=1 ;4/9/01
UNLKKIDX ;
;I $G(TIUQUIT) S VALMSG="** Entry not detached **",TIUCHNG("REFRESH")=1 Q ;4/9/01
I $G(TIUQUIT) S TIUCHNG("REFRESH")=1 Q ;4/9/01
Q
;
UNLINK(DA) ; Unlink DA from DADDA
N DIE,DR,IDDAD
S IDDAD=+$G(^TIU(8925,DA,21))
S DIE=8925,DR="2101////@"
D ^DIE
D AUDLINK(DA,"d",IDDAD)
D IDDEL^TIUALRT1(DA)
Q
AUDLINK(TIUDA,ACTION,IDPARENT) ; Audit Attach/Detach Events
N DIC,DIE,DA,DR,X,Y,TIUD0,TIUD21,DLAYGO
Q:$G(ACTION)']""!(+$G(IDPARENT)'>0)
S TIUD0=$G(^TIU(8925,TIUDA,0))
S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.5,DIC(0)="FLX" D ^DIC Q:+Y'>0
S DA=+Y,DIE=DIC
S DR="3.01////"_ACTION_";3.02////"_$$NOW^XLFDT
S DR=DR_";3.03////"_DUZ_";3.04////"_$P(TIUD0,U,5)
S DR=DR_";3.05////"_IDPARENT
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUGR1 4015 printed Nov 22, 2024@17:51:32 Page 2
TIUGR1 ; SLC/MAM - More ID Note Review Screen Actions ;4/12/01
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
+2 ;
IDNOTEB(TIUDA) ; Browse Screen Action IN Interdisciplinary Note
+1 ; Requires TIUDA
+2 ; If editing this module, please keep TIUGR consistent with it.
+3 NEW TITLE,PREFIX,TITLEDA,CANADD,CANATT,ADDED,TIUQUIT,TIUIDDAD
+4 ;TIUCHNG is newed in TIURA2; Don't new it here
+5 SET VALMBCK="R"
+6 ; -- If note is addendum, can't attach; say so & quit: --
+7 IF +^TIU(8925,TIUDA,0)=81
Begin DoDot:1
+8 DO CANT^TIUGR("A")
SET TIUCHNG("REFRESH")=1
End DoDot:1
GOTO IDNOTEBX
+9 ; -- If note is already an entry of an ID note, unlink it: --
+10 SET TIUIDDAD=$$HASIDDAD^TIUGBR(TIUDA)
+11 IF TIUIDDAD
Begin DoDot:1
+12 DO UNLKKID(TIUDA,TIUIDDAD)
+13 IF $GET(TIUQUIT)
SET TIUCHNG("REFRESH")=1
QUIT
+14 SET TIUCHNG("RBLD")=1
+15 ; TIUDA is no longer an ID entry so update header
KILL VALMHDR
End DoDot:1
GOTO IDNOTEBX
+16 ; -- If user can add an entry to the note, do it & quit: --
+17 SET CANADD=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
+18 IF CANADD
DO ADDDAD^TIUGEDIT(TIUDA,.ADDED)
Begin DoDot:1
+19 IF 'ADDED
SET TIUCHNG("REFRESH")=1
QUIT
+20 SET TIUCHNG("RBLD")=1
KILL VALMHDR
End DoDot:1
GOTO IDNOTEBX
+21 ; -- If user can't add entry to note, & attaching note to
+22 ; an existing note is not permitted, say can't add & quit: --
+23 ; -- Note itself has entries: --
+24 IF 'CANADD
IF $$HASIDKID^TIUGBR(TIUDA)
Begin DoDot:1
+25 WRITE !!,$PIECE(CANADD,U,2)
DO PAUSE^TIUGR
+26 SET TIUCHNG("REFRESH")=1
End DoDot:1
GOTO IDNOTEBX
+27 ; -- Note is a possible parent: --
+28 SET TITLEDA=+^TIU(8925,TIUDA,0)
+29 IF 'CANADD
IF $$POSSPRNT^TIULP(TITLEDA)
Begin DoDot:1
+30 WRITE !!,$PIECE(CANADD,U,2)
DO PAUSE^TIUGR
+31 SET TIUCHNG("REFRESH")=1
End DoDot:1
GOTO IDNOTEBX
+32 ; -- See if user can attach note to an existing note: --
+33 SET CANATT=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
+34 ; -- If user can attach, tell user not to use Browse:
+35 IF CANATT
WRITE !!,"To attach this note to an ID parent, please exit Browse and try again ",!,"from a Review Screen showing a list of notes.",!
HANG 5
SET TIUCHNG("REFRESH")=1
GOTO IDNOTEBX
+36 ; -- If user can't attach, say can't attach: --
+37 IF 'CANATT
WRITE !!,$PIECE(CANATT,U,2)
DO PAUSE^TIUGR
SET TIUCHNG("REFRESH")=1
IDNOTEBX ;
+1 ; -- Rebuild browse screen for updated record: --
+2 ; (Review screen is updated from BROWSE^TIURA2)
+3 ;may have changed
SET TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
+4 DO BLDTMP^TIUBR(TIUDA)
+5 QUIT
+6 ;
UNLKKID(KIDDA,TIUIDDAD,DETACHED) ; Unlink ID entry
+1 ; Check if user can unlink, and if so, unlink it.
+2 NEW CANUNLK,UNLINK,MSG,DADDA,TIUQUIT
+3 SET DETACHED=0
+4 WRITE !!,"This note is attached to an interdisciplinary note."
+5 ; -- Same users can unlink as can link: --
+6 SET CANUNLK=$$CANDO^TIULP(KIDDA,"ATTACH TO ID NOTE")
+7 IF CANUNLK
SET CANUNLK=$$CANDO^TIULP(TIUIDDAD,"ATTACH ID ENTRY")
+8 IF 'CANUNLK
Begin DoDot:1
+9 ;S MSG=$P(CANUNLK,U,2),MSG=$P(MSG,"You may not ATTACH this",2)
+10 ;S MSG=$P(MSG,"to an ID note."),MSG=" You may not DETACH this"_MSG
+11 WRITE !,"You may not detach this note from its interdisciplinary note."
+12 IF $$READ^TIUU("EA","Press RETURN to continue...")
+13 SET TIUQUIT=1
End DoDot:1
GOTO UNLKKIDX
+14 SET UNLINK=$$READ^TIUU("Y","Do you want to detach it","NO")
+15 IF 'UNLINK
WRITE !!,"Entry not detached."
HANG 1
SET TIUQUIT=1
GOTO UNLKKIDX
+16 SET DADDA=$PIECE($GET(^TMP("TIUR",$JOB,"IDDATA",KIDDA)),U,3)
+17 DO UNLINK(KIDDA)
+18 IF DADDA
DO UPIDDATA^TIURL1(KIDDA)
DO UPIDDATA^TIURL1(DADDA)
+19 WRITE !!,"Entry detached."
HANG 1
+20 ;S VALMSG="** Entry detached **" ;4/9/01
+21 ;4/9/01
SET TIUCHNG("RBLD")=1
SET DETACHED=1
UNLKKIDX ;
+1 ;I $G(TIUQUIT) S VALMSG="** Entry not detached **",TIUCHNG("REFRESH")=1 Q ;4/9/01
+2 ;4/9/01
IF $GET(TIUQUIT)
SET TIUCHNG("REFRESH")=1
QUIT
+3 QUIT
+4 ;
UNLINK(DA) ; Unlink DA from DADDA
+1 NEW DIE,DR,IDDAD
+2 SET IDDAD=+$GET(^TIU(8925,DA,21))
+3 SET DIE=8925
SET DR="2101////@"
+4 DO ^DIE
+5 DO AUDLINK(DA,"d",IDDAD)
+6 DO IDDEL^TIUALRT1(DA)
+7 QUIT
AUDLINK(TIUDA,ACTION,IDPARENT) ; Audit Attach/Detach Events
+1 NEW DIC,DIE,DA,DR,X,Y,TIUD0,TIUD21,DLAYGO
+2 if $GET(ACTION)']""!(+$GET(IDPARENT)'>0)
QUIT
+3 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
+4 SET X=""""_"`"_TIUDA_""""
SET (DIC,DLAYGO)=8925.5
SET DIC(0)="FLX"
DO ^DIC
if +Y'>0
QUIT
+5 SET DA=+Y
SET DIE=DIC
+6 SET DR="3.01////"_ACTION_";3.02////"_$$NOW^XLFDT
+7 SET DR=DR_";3.03////"_DUZ_";3.04////"_$PIECE(TIUD0,U,5)
+8 SET DR=DR_";3.05////"_IDPARENT
+9 DO ^DIE
+10 QUIT
